diff options
Diffstat (limited to 'lisp')
421 files changed, 22591 insertions, 15438 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1f9724e17fd..29c912933c8 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,2858 @@ +2013-06-03 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/lisp.el: Use lexical-binding. + (lisp--local-variables-1, lisp--local-variables): New functions. + (lisp--local-variables-completion-table): New var. + (lisp-completion-at-point): Use it to provide completion of let-bound vars. + + * emacs-lisp/lisp-mode.el (eval-sexp-add-defvars): Expand macros + eagerly (bug#14422). + +2013-06-03 Michael Albinus <michael.albinus@gmx.de> + + * autorevert.el (auto-revert-notify-enabled) + (auto-revert-notify-rm-watch, auto-revert-notify-add-watch) + (auto-revert-notify-event-p, auto-revert-notify-event-file-name) + (auto-revert-notify-handler): Handle also gfilenotify. + + * subr.el: (file-notify-handle-event): New defun. Replacing ... + (inotify-event-p, inotify-handle-event, w32notify-handle-event): + Removed. + +2013-06-03 Juri Linkov <juri@jurta.org> + + * bindings.el (search-map): Bind `highlight-symbol-at-point' to + `M-s h .'. (Bug#14427) + + * hi-lock.el (highlight-symbol-at-point): New alias for the new + command `hi-lock-face-symbol-at-point'. + (hi-lock-face-symbol-at-point): New command. + (hi-lock-map): Bind `highlight-symbol-at-point' to `C-x w .'. + (hi-lock-menu): Add `highlight-symbol-at-point'. + (hi-lock-mode): Doc fix. + + * isearch.el (isearch-forward-symbol-at-point): New command. + (search-map): Bind `isearch-forward-symbol-at-point' to `M-s .'. + (isearch-highlight-regexp): Add a regexp which matches + words/symbols for word/symbol mode. + + * subr.el (find-tag-default-bounds): New function with the body + mostly moved from `find-tag-default'. + (find-tag-default): Move most code to `find-tag-default-bounds', + call it and apply `buffer-substring-no-properties' afterwards. + +2013-06-03 Tassilo Horn <tsdh@gnu.org> + + * eshell/em-term.el (eshell-term-initialize): Use + `cl-intersection' rather than `intersection'. + +2013-06-02 Eric Ludlam <zappo@gnu.org> + + * emacs-lisp/eieio.el (eieio--defalias, eieio-hook) + (eieio-error-unsupported-class-tags, eieio-skip-typecheck) + (eieio-optimize-primary-methods-flag, eieio-initializing-object) + (eieio-unbound, eieio-default-superclass) + (eieio--define-field-accessors, method-static, method-before) + (method-primary, method-after, method-num-lists) + (method-generic-before, method-generic-primary) + (method-generic-after, method-num-slots) + (eieio-specialized-key-to-generic-key) + (eieio--check-type, class-v, class-p) + (eieio-class-name, define-obsolete-function-alias) + (eieio-class-parents-fast, eieio-class-children-fast) + (same-class-fast-p, class-constructor, generic-p) + (generic-primary-only-p, generic-primary-only-one-p) + (class-option-assoc, class-option, eieio-object-p) + (class-abstract-p, class-method-invocation-order) + (eieio-defclass-autoload-map, eieio-defclass-autoload) + (eieio-class-un-autoload, eieio-defclass) + (eieio-eval-default-p, eieio-perform-slot-validation-for-default) + (eieio-add-new-slot, eieio-copy-parents-into-subclass) + (eieio--defgeneric-init-form, eieio-defgeneric-form) + (eieio-defgeneric-reset-generic-form) + (eieio-defgeneric-form-primary-only) + (eieio-defgeneric-reset-generic-form-primary-only) + (eieio-defgeneric-form-primary-only-one) + (eieio-defgeneric-reset-generic-form-primary-only-one) + (eieio-unbind-method-implementations) + (eieio--defmethod, eieio--typep) + (eieio-perform-slot-validation, eieio-validate-slot-value) + (eieio-validate-class-slot-value, eieio-barf-if-slot-unbound) + (eieio-oref, eieio-oref-default, eieio-default-eval-maybe) + (eieio-oset, eieio-oset-default, eieio-slot-originating-class-p) + (eieio-slot-name-index, eieio-class-slot-name-index) + (eieio-set-defaults, eieio-initarg-to-attribute) + (eieio-attribute-to-initarg, eieio-c3-candidate) + (eieio-c3-merge-lists, eieio-class-precedence-c3) + (eieio-class-precedence-dfs, eieio-class-precedence-bfs) + (eieio-class-precedence-list, eieio-generic-call-methodname) + (eieio-generic-call-arglst, eieio-generic-call-key) + (eieio-generic-call-next-method-list) + (eieio-pre-method-execution-functions, eieio-generic-call) + (eieio-generic-call-primary-only, eieiomt-method-list) + (eieiomt-optimizing-obarray, eieiomt-install) + (eieiomt-add, eieiomt-next, eieiomt-sym-optimize) + (eieio-generic-form, eieio-defmethod, make-obsolete) + (eieio-defgeneric, make-obsolete): Moved to eieio-core.el + (defclass): Remove `eval-and-compile' from macro. + (call-next-method, shared-initialize): Instead of using + `scoped-class' variable, use new eieio--scoped-class, and + eieio--with-scoped-class. + (initialize-instance): Rename local variable 'scoped-class' to + 'this-class' to remove ambiguitity from old global. + + * emacs-lisp/eieio-core.el: New file. Derived from key parts of + eieio.el. + (eieio--scoped-class-stack): New variable + (eieio--scoped-class): New fcn + (eieio--with-scoped-class): New scoping macro. + (eieio-defclass): Use pushnew instead of add-to-list. + (eieio-defgeneric-form-primary-only-one, eieio-oset-default) + (eieio-slot-name-index, eieio-set-defaults, eieio-generic-call) + (eieio-generic-call-primary-only, eieiomt-add): Instead of using + `scoped-class' variable, use new eieio--scoped-class, and + eieio--with-scoped-class. + + * emacs-lisp/eieio-base.el (cl-lib): Require during compile. + +2013-06-02 Tassilo Horn <tsdh@gnu.org> + + * eshell/esh-ext.el (eshell-external-command): Pass args to + `eshell-find-interpreter'. + (eshell-find-interpreter): Add new second parameter ARGS. + + * eshell/em-script.el (eshell-script-initialize): Add second arg + to the function added as MATCH to `eshell-interpreter-alist' + + * eshell/em-dirs.el (eshell-dirs-initialize): Add second arg to + the function added as MATCH to `eshell-interpreter-alist' + + * eshell/em-term.el (eshell-visual-subcommands): New defcustom. + (eshell-visual-options): New defcustom. + (eshell-escape-control-x): Adapt docstring. + (eshell-term-initialize): Test `eshell-visual-subcommands' and + `eshell-visual-options' in addition to `eshell-visual-commands'. + (eshell-exec-visual): Pass args to `eshell-find-interpreter'. + +2013-06-01 Fabián Ezequiel Gallina <fgallina@gnu.org> + + * progmodes/python.el (python-indent-block-enders): Add break, + continue and raise keywords. + +2013-06-01 Glenn Morris <rgm@gnu.org> + + * pcmpl-gnu.el (pcomplete/tar): Check obsolete variable is bound. + + Plain (f)boundp silences compilation warnings since Emacs 22.1. + * progmodes/cc-cmds.el (delete-forward-p): + * progmodes/cc-defs.el (buffer-syntactic-context-depth): + * progmodes/cc-engine.el (buffer-syntactic-context): + * progmodes/cc-fonts.el (face-property-instance): + * progmodes/cc-mode.el (set-keymap-parents): + * progmodes/cc-vars.el (get-char-table): No need for cc-bytecomp-defun. + * progmodes/cc-defs.el (c-set-region-active, c-beginning-of-defun-1) + * progmodes/cc-mode.el (c-make-inherited-keymap): Use plain fboundp. + * progmodes/cc-defs.el (zmacs-region-stays, zmacs-regions) + (lookup-syntax-properties): Remove unecessary cc-bytecomp-defvar. + + * progmodes/cc-vars.el (other): Emacs has this widget since + at least 21.1, so don't (re)define it. + + * eshell/em-cmpl.el (eshell-cmpl-initialize): + Replace the obsolete alias pcomplete-arg-quote-list. + +2013-06-01 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-mode-syntax-table): Give `.' + punctuation syntax. + (inferior-octave-minimal-columns) + (inferior-octave-last-column-width): New variables. + (inferior-octave-track-window-width-change): New function. + (inferior-octave-mode): Adjust column width so that Octave output, + for example from 'ls', can fit into the window nicely. + +2013-05-31 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/ruby-mode.el (ruby-syntax-expansion-allowed-p): + Highlight expansions inside regexp literals. + +2013-05-31 Glenn Morris <rgm@gnu.org> + + * obsolete/sym-comp.el (symbol-complete): + Replace obsolete completion-annotate-function. + + * progmodes/cc-vars.el (c-make-macro-with-semi-re): Silence compiler. + +2013-05-31 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/ruby-mode.el (ruby-syntax-expansion-allowed-p): New + function, checks if point is inside a literal that allows + expression expansion. + (ruby-syntax-propertize-expansion): Use it. + (ruby-syntax-propertize-function): Bind `case-fold-search' to nil + around the body. + +2013-05-30 Juri Linkov <juri@jurta.org> + + * isearch.el (isearch-mode-map): Bind `isearch-toggle-invisible' + to "\M-si". + (isearch-invisible): New variable. + (isearch-forward): Doc fix. + (isearch-mode): Set `isearch-invisible' + to the value of `search-invisible'. + (isearch-toggle-case-fold): Doc fix. + (isearch-toggle-invisible): New command. + (isearch-query-replace): Let-bind `search-invisible' + to the value of `isearch-invisible'. + (isearch-search): Use `isearch-invisible' instead of + `search-invisible'. Let-bind `search-invisible' + to the value of `isearch-invisible'. (Bug#11378) + +2013-05-30 Juri Linkov <juri@jurta.org> + + * replace.el (perform-replace): Avoid `isearch-range-invisible' + call when `query-flag' is nil and `search-invisible' is non-nil. + (Bug#11746) + +2013-05-30 Glenn Morris <rgm@gnu.org> + + * progmodes/gdb-mi.el (gdb-wait-for-pending): Fix typo. + + * progmodes/cc-bytecomp.el (cc-bytecomp-noruntime-functions): New. + (cc-require): Suppress spurious "noruntime" warnings. + (cc-require-when-compile): Use fboundp, for sake of compiler. + + * progmodes/cc-mode.el: Move load of cc-vars before that of + cc-langs (which in turn loads cc-vars), to quieten compiler. + +2013-05-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * paren.el: Simplify the code. + (show-paren-mode): Always start the timer. + (show-paren--idle-timer): Rename from show-paren-idle-timer. + (show-paren--overlay, show-paren--overlay-1): Rename from + show-paren-overlay and show-paren-overlay-1, and initialize to an + overlay rather than to nil. + (show-paren-function): Misc cleanup and simplifications. + +2013-05-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * paren.el (show-paren-data-function): New hook. + (show-paren--default): New function, extracted from show-paren-function. + (show-paren-function): Use show-paren-data-function. + +2013-05-30 Glenn Morris <rgm@gnu.org> + + * ielm.el (ielm-map, ielm-complete-symbol): + Use completion-at-point rather than obsolete functions. + (inferior-emacs-lisp-mode): Doc fix. + Set completion-at-point-functions, rather than + comint-dynamic-complete-functions. + + * eshell/em-cmpl.el (eshell-complete-lisp-symbol): New function. + (eshell-cmpl-initialize, eshell-complete-parse-arguments): + Replace obsolete lisp-complete-symbol with eshell-complete-lisp-symbol. + + * image.el (image-animated-p): Tweak definition. + + * net/rlogin.el (rlogin-program, rlogin-explicit-args): Default to ssh. + (rlogin-process-connection-type): Tweak default. Add set-after. + (rlogin-host): Doc fix. + (rlogin): Tweak prompt. + (rlogin-tab-or-complete): Use completion-at-point rather than alias. + + * net/net-utils.el (nslookup-mode-map, ftp-mode-map): + * progmodes/tcl.el (inferior-tcl-mode-map): + Use completion-at-point rather than obsolete alias. + + * emacs-lisp/eieio.el (eieio-eval-default-p): Move before use. + + * minibuffer.el (read-file-name-completion-ignore-case): + Move before completion--in-region, for eager macro expansion. + +2013-05-29 Juri Linkov <juri@jurta.org> + + * replace.el (occur-engine): Rename `globalcount' to `global-lines' + for total count of matching lines. Add `global-matches' for total + count of matches. Rename `matches' to `lines' for count of + matching lines. Add `matches' for count of matches. + Rename `lines' to `curr-line' for line count. Rename `prev-lines' + to `prev-line' for line number of prev match endpt. + Increment `matches' for every match. Print the number of + matching lines in the header. + (occur-context-lines): Rename `lines' to `curr-line'. + Rename `prev-lines' to `prev-line'. (Bug#14017) + +2013-05-29 Juri Linkov <juri@jurta.org> + + * replace.el (perform-replace): Add `skip-read-only-count', + `skip-filtered-count', `skip-invisible-count' let-bound to 0. + Increment them for corresponding conditions and report the number + of skipped occurrences in the final message. (Bug#11746) + (query-replace, query-replace-regexp, query-replace-regexp-eval) + (replace-string, replace-regexp): Doc fix. + +2013-05-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/trace.el (trace--read-args): Provide a default. + + * emacs-lisp/lisp-mode.el (lisp-mode-shared-map): Inherit from + prog-mode-map. + +2013-05-29 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-indent-comment): Tweak regexps. + (octave-help): Small simplification. + + * emacs-lisp/smie.el (smie-highlight-matching-block): Always turn + off the highlight first. + +2013-05-29 Glenn Morris <rgm@gnu.org> + + * progmodes/idlwave.el (idlwave-concatenate-rinfo-lists): + Handle idlwave-last-system-routine-info-cons-cell being nil. + + * progmodes/idlwave.el (idlwave-scan-user-lib-files) + (idlwave-write-paths): Simplify via with-temp-buffer. + + * emulation/cua-gmrk.el: Also load cua-base, cua-rect at run time. + * emulation/cua-rect.el: Also load cua-base at run time. + + * progmodes/cperl-mode.el (imenu-choose-buffer-index) + (file-of-tag, etags-snarf-tag, etags-goto-tag-location): Declare. + (cperl-imenu-on-info): Require imenu. + +2013-05-28 Alan Mackenzie <acm@muc.de> + + Handle "capitalised keywords" correctly. + * progmodes/cc-mode.el (c-after-change): Bind case-fold-search to nil. + +2013-05-28 Aidan Gauland <aidalgol@amuri.net> + + * eshell/em-unix.el: Added -r option to cp + +2013-05-28 Glenn Morris <rgm@gnu.org> + + * vc/vc-arch.el (vc-exec-after): Declare. + (vc-switches): Autoload. + * vc/vc-bzr.el: No need to require vc when compiling. + (vc-exec-after, vc-set-async-update, vc-default-dir-printer) + (vc-resynch-buffer, vc-dir-refresh): Declare. + (vc-setup-buffer, vc-switches): Autoload. + * vc/vc-cvs.el (vc-exec-after, vc-coding-system-for-diff) + (vc-resynch-buffer): Declare. + (vc-switches, vc-default-revert, vc-version-backup-file): Autoload. + * vc/vc-dir.el (desktop-missing-file-warning): Declare. + * vc/vc-git.el (vc-exec-after, vc-set-async-update) + (grep-read-regexp, grep-read-files, grep-expand-template) + (vc-dir-refresh): Declare. + (vc-setup-buffer, vc-switches, vc-resynch-buffer): Autoload. + * vc/vc-hg.el (vc-exec-after, vc-set-async-update): Declare. + (vc-setup-buffer, vc-switches, vc-do-async-command): Autoload. + * vc/vc-mtn.el (vc-exec-after): Declare. + (vc-switches): Autoload. + * vc/vc-rcs.el (vc-expand-dirs, vc-switches) + (vc-tag-precondition, vc-buffer-sync, vc-rename-master): Autoload. + (vc-file-tree-walk): Declare. + * vc/vc-sccs.el (vc-file-tree-walk): Declare. + (vc-expand-dirs, vc-switches, vc-setup-buffer, vc-delistify) + (vc-tag-precondition, vc-rename-master): Autoload. + * vc/vc-svn.el (vc-exec-after): Declare. + (vc-switches, vc-setup-buffer): Autoload. + * obsolete/vc-mcvs.el (vc-checkout, vc-switches, vc-default-revert): + Autoload. + (vc-resynch-buffer): Declare. + + * obsolete/fast-lock.el (byte-compile-warnings): + Don't warn about obsolete features in this obsolete file. + + * progmodes/cc-vars.el (c-macro-names-with-semicolon): + Move definition before use. + + * play/dunnet.el (byte-compile-warnings): Don't disable them all. + (dun-unix-verbs): Remove dun-zippy. + (dun-zippy): Remove function. + + * emacs-lisp/bytecomp.el (byte-compile-warnings): Doc fix. + +2013-05-27 Juri Linkov <juri@jurta.org> + + * replace.el (replace-search): New function with code moved out + from `perform-replace'. + (replace-highlight, replace-dehighlight): Move function definitions + up closer to `replace-search'. (Bug#11746) + +2013-05-27 Juri Linkov <juri@jurta.org> + + * replace.el (perform-replace): Ignore invisible matches. + In addition to checking `query-replace-skip-read-only', also + filter out matches by calling `run-hook-with-args-until-failure' + on `isearch-filter-predicates', and also check `search-invisible' + for t or call `isearch-range-invisible'. + (replace-dehighlight): Call `isearch-clean-overlays'. (Bug#11746) + +2013-05-27 Juri Linkov <juri@jurta.org> + + * isearch.el (isearch-filter-predicates): Rename from + `isearch-filter-predicate'. Doc fix. (Bug#11378) + (isearch-message-prefix): Display text from the property + `isearch-message-prefix' of the currently active filters. + (isearch-search): Don't compare `isearch-filter-predicate' with + `isearch-filter-visible'. Call `run-hook-with-args-until-failure' + on `isearch-filter-predicates'. Also check `search-invisible' for t + or call `isearch-range-invisible'. + (isearch-filter-visible): Make obsolete. + (isearch-lazy-highlight-search): + Call `run-hook-with-args-until-failure' on + `isearch-filter-predicates' and use `isearch-range-invisible'. + + * info.el (Info-search): Call `run-hook-with-args-until-failure' on + `isearch-filter-predicates' instead of `funcall'ing + `isearch-filter-predicate'. + (Info-mode): Set `Info-isearch-filter' to + `isearch-filter-predicates' instead of `isearch-filter-predicate'. + + * dired-aux.el (dired-isearch-filter-predicate-orig): + Remove variable. + (dired-isearch-filenames-toggle, dired-isearch-filenames-setup) + (dired-isearch-filenames-end): Add and remove + `dired-isearch-filter-filenames' in `isearch-filter-predicates' + instead of changing the value of `isearch-filter-predicate'. + Rebind `dired-isearch-filenames-toggle' from "\M-sf" to "\M-sff". + (dired-isearch-filter-filenames): Don't use `isearch-filter-visible'. + Put property `isearch-message-prefix' to "filename " on + `dired-isearch-filter-filenames'. + + * wdired.el (wdired-change-to-wdired-mode): + Add `isearch-filter-predicates' to `wdired-isearch-filter-read-only' + locally instead of changing `isearch-filter-predicate'. + (wdired-isearch-filter-read-only): Don't use `isearch-filter-visible'. + +2013-05-27 Dmitry Gutov <dgutov@yandex.ru> + + * vc/vc-git.el (vc-git-working-revision): When in detached mode, + return the commit hash (Bug#14459). Also set the + `vc-git-detached' property. + (vc-git--rev-parse): Extract from `vc-git-previous-revision'. + (vc-git-mode-line-string): Use the same help-echo format whether + in detached mode or not, because we know the actual revision now. + When in detached mode, shorten the revision to 7 chars. + +2013-05-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/easy-mmode.el (define-minor-mode): + * emacs-lisp/derived.el (define-derived-mode): Always defvar the + mode hook and provide a docstring. + +2013-05-27 Alan Mackenzie <acm@muc.de> + + Remove spurious syntax-table text properties inserted by C-y. + * progmodes/cc-mode.el (c-after-change): Also clear hard + syntax-table property with value nil. + +2013-05-27 Michael Albinus <michael.albinus@gmx.de> + + * net/dbus.el (dbus-call-method): Let-bind `inhibit-redisplay' + when reading the events; the buffer layout shall not be changed. + +2013-05-27 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (inferior-octave-directory-tracker-resync): + New variable. + (inferior-octave-directory-tracker): Automatically re-sync + default-directory. + (octave-help): Improve handling of 'See also'. + +2013-05-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * doc-view.el: Minor naming convention tweaks. + (desktop-buffer-mode-handlers): Don't add to it repeatedly. + + * image-mode.el (image-mode-reapply-winprops): Call image-mode-winprops + even if there's no `display' property yet (bug#14435). + +2013-05-25 Eli Zaretskii <eliz@gnu.org> + + * subr.el (unmsys--file-name): Rename from reveal-filename. + + * Makefile.in (custom-deps, finder-data, autoloads) + ($(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): All users changed. + +2013-05-25 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/lisp.el (lisp-completion-at-point): Don't use + error-completion on the first 2 args of condition-case (bug#14446). + Don't burp at EOB. + +2013-05-25 Leo Liu <sdl.web@gmail.com> + + * comint.el (comint-previous-matching-input): Do not flood the + *Messages* buffer with trivial messages. + +2013-05-25 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/flymake.el (flymake-nop): Don't return a string. + (flymake-set-at): Fix typo. + + * simple.el (read--expression): New function, extracted from + eval-expression. Set completion-at-point-functions (bug#14465). + (eval-expression, eval-minibuffer): Use it. + +2013-05-25 Xue Fuqiao <xfq.free@gmail.com> + + * progmodes/flymake.el (flymake-save-buffer-in-file) + (flymake-makehash, flymake-posn-at-point-as-event, flymake-nop) + (flymake-selected-frame, flymake-log, flymake-ins-after) + (flymake-set-at, flymake-get-buildfile-from-cache) + (flymake-add-buildfile-to-cache, flymake-clear-buildfile-cache) + (flymake-find-possible-master-files, flymake-save-buffer-in-file): + Refine the doc string. + (flymake-get-file-name-mode-and-masks): Reformat. + (flymake-get-real-file-name-function): Fix a minor bug. + +2013-05-24 Juri Linkov <juri@jurta.org> + + * progmodes/grep.el (grep-mode-font-lock-keywords): + Support =linenumber= format used by git-grep for lines with + function names. (Bug#13549) + +2013-05-24 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/octave.el (octave-smie-rules): Return nil rather than + 0 after a semi-colon; it works better for smie-auto-fill. + (octave--indent-new-comment-line): New function. + (octave-indent-new-comment-line): Use it (indirectly). + (octave-mode): Don't disable smie-auto-fill. Use add-function to + modify comment-line-break-function. + + * emacs-lisp/smie.el (smie-auto-fill): Rework to be more robust. + (smie-setup): Use add-function to set it. + +2013-05-24 Sam Steingold <sds@gnu.org> + + * sort.el (delete-duplicate-lines): Accept an optional `keep-blanks' + argument (before the `interactive' argument). + +2013-05-24 Stefan Monnier <monnier@iro.umontreal.ca> + + * image-mode.el (image-mode-winprops): Add winprops to + image-mode-winprops-alist before running + image-mode-new-window-functions. + * doc-view.el (doc-view-new-window-function): Don't delay + doc-view-goto-page via timers (bug#14435). + +2013-05-24 Tassilo Horn <tsdh@gnu.org> + + * doc-view.el: Integrate with desktop.el. (Bug#14435) + (doc-view-desktop-save-buffer): New function. + (doc-view-restore-desktop-buffer): New function. + (desktop-buffer-mode-handlers): + Add `doc-view-restore-desktop-buffer' as desktop.el buffer mode + handler. + (doc-view-mode): Set `doc-view-desktop-save-buffer' as custom + `desktop-save-buffer' function. + +2013-05-24 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-gvfs.el (tramp-gvfs-enabled): New defconst. + (tramp-gvfs-file-name-handler): Raise a user error when + `tramp-gvfs-enabled' is nil. + (top): Register signals only when `tramp-gvfs-enabled' is non-nil. + Do not raise a user error when loading package. (Bug#14447) + + * net/xesam.el: Move to obsolete/. + +2013-05-24 Glenn Morris <rgm@gnu.org> + + * font-lock.el (lisp-font-lock-keywords-2): Add with-coding-priority. + + * emacs-lisp/chart.el (chart-sort): Replace obsolete `object-name'. + + * progmodes/cperl-mode.el (cperl-mode): Use fboundp. + (Info-find-node, Man-getpage-in-background): Declare. + + * mail/unrmail.el (unrmail): + Replace obsolete detect-coding-with-priority. + + * net/socks.el (socks-split-string): Use this rather than split-string. + (socks-nslookup-host): Update for above change. + (dynamic-choice, s5-dynamic-choice-match) + (s5-dynamic-choice-match-inline, s5-widget-value-create): + Comment out unused code. + + * tooltip.el (tooltip-use-echo-area): Warn only on 'set. + * progmodes/gud.el (gud-gdb-completion-function): Move before use. + (gud-tooltip-echo-area): Make obsolete. + (gud-tooltip-process-output, gud-tooltip-tips): Also check tooltip-mode. + + * progmodes/js.el (js--optimize-arglist): Declare. + + * progmodes/ruby-mode.el (ruby-syntax-propertize-expansion): Declare. + + * progmodes/which-func.el (ediff-window-A, ediff-window-B) + (ediff-window-C): Declare. + + * obsolete/pgg-gpg.el, obsolete/pgg-pgp.el, obsolete/pgg-pgp5.el: + Tweak requires to silence compiler. + + * obsolete/sym-comp.el: No need to load hipper-exp when compiling. + (he-search-string, he-tried-table, he-expand-list) + (he-init-string, he-string-member, he-substitute-string) + (he-reset-string): Declare. + + * obsolete/options.el (list-options): Use custom-variable-p, + rather than obsolete alias. + +2013-05-23 Sam Steingold <sds@gnu.org> + + * simple.el (shell-command-on-region): Pass the `replace' argument + down to `call-process-region' to comply with the doc as reported on + <http://stackoverflow.com/questions/16720458/emacs-noninteractive-call-to-shell-command-on-region-always-deletes-region> + +2013-05-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/smie.el (smie-indent-forward-token) + (smie-indent-backward-token): Handle string tokens (bug#14381). + +2013-05-23 Rüdiger Sonderfeld <ruediger@c-plusplus.de> + + * ielm.el (ielm-menu): New menu. + (inferior-emacs-lisp-mode): Set comment-start. + +2013-05-23 Rüdiger Sonderfeld <ruediger@c-plusplus.de> + + * lisp/textmodes/reftex.el (reftex-ref-style-toggle): + Fix deactivate action. + + * lisp/textmodes/reftex-vars.el (reftex-ref-style-alist): + Add cleveref macros. + + * lisp/textmodes/reftex-parse.el + (reftex-locate-bibliography-files): Accept options for + bibliography commands. + * lisp/textmodes/reftex-vars.el (reftex-bibliography-commands): + Add addbibresource. Basic Biblatex support. + +2013-05-23 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-gvfs.el (top): + * net/xesam.el (xesam-dbus-unique-names): Suppress D-Bus errors + when loading package. (Bug#14447) + +2013-05-23 Glenn Morris <rgm@gnu.org> + + * progmodes/js.el: No need to load comint when compiling. + (ring-insert, comint-send-string, comint-send-input) + (comint-last-input-end, ido-chop): Declare. + + * vc/ediff-diff.el, vc/ediff-merg.el: Require ediff-util at run-time. + * vc/ediff-mult.el: Adjust requires. + (ediff-directories-internal, ediff-directory-revisions-internal) + (ediff-patch-file-internal): Declare. + * vc/ediff-ptch.el: Adjust requires. + (ediff-use-last-dir, ediff-buffers-internal): Declare. + (ediff-find-file): Autoload. + * vc/ediff-util.el: No need to load ediff when compiling. + (ediff-regions-internal): Declare. + * vc/ediff-wind.el: Adjust requires. + (ediff-compute-toolbar-width): Define when compiling. + (ediff-setup-control-buffer, ediff-make-bottom-toolbar): Declare. + * vc/ediff.el: No need to load dired, ediff-ptch when compiling. + (dired-get-filename, dired-get-marked-files) + (ediff-last-dir-patch, ediff-patch-default-directory) + (ediff-get-patch-buffer, ediff-dispatch-file-patching-job) + (ediff-patch-buffer-internal): Declare. + + * emacs-lisp/checkdoc.el: No need to load ispell when compiling. + (ispell-process, ispell-buffer-local-words, lm-summary) + (lm-section-start, lm-section-end): Declare. + (checkdoc-ispell-init): Simplify. + + * progmodes/vera-mode.el (he-init-string, he-dabbrev-beg) + (he-string-member, he-reset-string, he-substitute-string): Declare. + + * eshell/em-ls.el: Adjust requires. + (eshell-glob-regexp): Declare. + * eshell/em-tramp.el: Adjust requires. + (eshell-parse-command): Autoload. + * eshell/em-xtra.el: Adjust requires. + (eshell-parse-command): Autoload. + * eshell/esh-ext.el: Adjust requires. + (eshell-parse-command, eshell-close-handles): Autoload. + * eshell/esh-io.el: Adjust requires. + (eshell-output-filter): Autoload. + * eshell/esh-util.el: No need to load tramp when compiling. + (tramp-file-name-structure, ange-ftp-ls, ange-ftp-file-modtime): + Declare. + (eshell-parse-ange-ls): Require ange-ftp and tramp. + * eshell/em-alias.el, eshell/em-banner.el, eshell/em-basic.el: + * eshell/em-cmpl.el, eshell/em-glob.el, eshell/em-pred.el: + * eshell/em-prompt.el, eshell/em-rebind.el, eshell/em-smart.el: + * eshell/em-term.el, eshell/esh-arg.el, eshell/esh-mode.el: + * eshell/esh-opt.el, eshell/esh-proc.el: + * eshell/esh-var.el: Adjust requires. + * eshell/eshell.el: Do not require esh-util twice. + (eshell-add-input-to-history): Declare. + (eshell-command): Check history module is active before using it. + + * eshell/em-ls.el (eshell-ls-dir): Fix -A handling. + +2013-05-22 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (inferior-octave-startup): Fix bug#14433. + +2013-05-22 Michael Albinus <michael.albinus@gmx.de> + + * autorevert.el (auto-revert-notify-add-watch) + (auto-revert-notify-handler): Add `attrib' for the inotify case, + it indicates changes in file modification time. + +2013-05-22 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/bytecomp.el (byte-compile-file-form-autoload): + Always delete the autoloaded function from the noruntime and + unresolved functions lists. + + * allout.el: No need to load epa, epg, overlay when compiling. + (epg-context-set-passphrase-callback, epg-list-keys) + (epg-decrypt-string, epg-encrypt-string, epg-user-id-string) + (epg-key-user-id-list): Declare. + + * emulation/viper-cmd.el (viper-set-searchstyle-toggling-macros) + (viper-set-parsing-style-toggling-macro) + (viper-set-emacs-state-searchstyle-macros): + Use called-interactively-p on Emacs. + (viper-looking-back): Make it an obsolete alias. Update callers. + * emulation/viper-ex.el: Load viper-keym, not viper-cmd. + Use looking-back rather than viper-looking-back. + (viper-tmp-insert-at-eob, viper-enlarge-region) + (viper-read-string-with-history, viper-register-to-point) + (viper-append-to-register, viper-change-state-to-vi) + (viper-backward-char-carefully, viper-forward-char-carefully) + (viper-Put-back, viper-put-back, viper-add-newline-at-eob-if-necessary) + (viper-change-state-to-emacs): Declare. + * emulation/viper-macs.el: Load viper-mous, viper-ex, not viper-cmd. + (viper-change-state-to-insert, viper-change-state-to-vi): Declare. + * emulation/viper-mous.el: Do not load viper-cmd. + (viper-backward-char-carefully, viper-forward-char-carefully) + (viper-forward-word, viper-adjust-window): Declare. + + * vc/ediff.el (ediff-version): Use called-interactively-p on Emacs. + + * progmodes/idlw-help.el (idlwave-help-fontify): + Use called-interactively-p. + + * term/w32console.el (w32-get-console-codepage) + (w32-get-console-output-codepage): Declare. + + * dframe.el (x-sensitive-text-pointer-shape, x-pointer-shape): + Remove unnecessary declarations. + (dframe-message): Doc fix. + + * info.el (dframe-select-attached-frame, dframe-current-frame): + Declare. + + * speedbar.el (speedbar-message): Make it an obsolete alias. + Update all callers. + (speedbar-with-attached-buffer) + (speedbar-maybee-jump-to-attached-frame): Make these aliases obsolete. + (speedbar-with-writable): Use backquote. + * emacs-lisp/eieio-opt.el (eieio-describe-class-sb): + * emacs-lisp/eieio-speedbar.el (eieio-speedbar-handle-click): + Use dframe-with-attached-buffer, dframe-maybee-jump-to-attached-frame + rather than speedbar- aliases. + * mail/rmail.el: Load dframe rather than speedbar when compiling. + (speedbar-make-specialized-keymap, speedbar-insert-button) + (dframe-select-attached-frame, dframe-maybee-jump-to-attached-frame) + (speedbar-do-function-pointer): Declare. + (rmail-speedbar-button, rmail-speedbar-find-file) + (rmail-speedbar-move-message): + Use dframe-with-attached-buffer rather than speedbar- alias. + * progmodes/gud.el: Load dframe rather than speedbar when compiling. + (dframe-message, speedbar-make-specialized-keymap) + (speedbar-add-expansion-list, speedbar-mode-functions-list) + (speedbar-make-tag-line, speedbar-remove-localized-speedbar-support) + (speedbar-insert-button, dframe-select-attached-frame) + (dframe-maybee-jump-to-attached-frame) + (speedbar-change-initial-expansion-list) + (speedbar-previously-used-expansion-list-name): Declare. + (gud-speedbar-item-info, gud-gdb-goto-stackframe): + Use dframe-message, dframe-with-attached-buffer rather than + speedbar- aliases. + (gud-sentinel): Silence compiler. + * progmodes/vhdl-mode.el (speedbar-refresh) + (speedbar-do-function-pointer, speedbar-add-supported-extension) + (speedbar-add-mode-functions-list, speedbar-make-specialized-keymap) + (speedbar-change-initial-expansion-list, speedbar-add-expansion-list) + (speedbar-extension-list-to-regex, speedbar-directory-buttons) + (speedbar-file-lists, speedbar-make-tag-line) + (speedbar-line-directory, speedbar-goto-this-file) + (speedbar-center-buffer-smartly, speedbar-change-expand-button-char) + (speedbar-delete-subblock, speedbar-position-cursor-on-line) + (speedbar-make-button, speedbar-reset-scanners) + (speedbar-files-item-info, speedbar-line-text) + (speedbar-find-file-in-frame, speedbar-set-timer) + (dframe-maybee-jump-to-attached-frame, speedbar-line-file): Declare. + (speedbar-with-writable): Do not (re)define it. + (vhdl-speedbar-find-file): Use dframe-maybee-jump-to-attached-frame + rather than speedbar- alias. + +2013-05-21 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-mode-menu): Update and re-organize + menu items. + (octave-mode): Tweak fill-nobreak-predicate. + (inferior-octave-startup): Check process to avoid infinite loop. + (inferior-octave): Pop to buffer first to show abornmal process + exit information. + +2013-05-21 Glenn Morris <rgm@gnu.org> + + * printing.el (pr-menu-bar): Define when compiling. + +2013-05-21 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-auto-fill): Remove. + (octave-indent-new-comment-line): Improve. + (octave-mode): Use auto fill mode through + comment-line-break-function and fill-nobreak-predicate + (octave-goto-function-definition): Support DEFUN_DLD. + (octave-beginning-of-defun): Small Tweak + (octave-help): Show parent directory. + +2013-05-21 Glenn Morris <rgm@gnu.org> + + * files.el (dired-unmark): + * progmodes/gud.el (gdb-input): Update declarations. + + * calculator.el (electric, ehelp): No need to load when compiling. + (Electric-command-loop, electric-describe-mode): Declare. + + * doc-view.el (doc-view-current-converter-processes): Move before use. + + * emacs-lisp/easy-mmode.el (define-globalized-minor-mode): + Move MODE-set-explicitly definition before use. + + * international/mule-diag.el (mule-diag): + Don't use obsolete window-system-version. + + * mail/feedmail.el (smtpmail): No need to load when compiling. + (smtpmail-via-smtp, smtpmail-smtp-server): Declare. + + * mail/mail-utils.el (rfc822): No need to load when compiling. + (rfc822-addresses): Autoload it. + (mail-strip-quoted-names): Trivial simplification. + + * mail/rmail.el (rmail-mime-message-p, rmail-mime-toggle-raw): Declare. + (rmail-retry-failure): Don't assume that rmail-mime-feature == rmailmm. + + * net/snmp-mode.el (tempo): Don't duplicate requires. + + * progmodes/prolog.el (info): No need to load when compiling. + (comint): Require before shell requires it. + (Info-goto-node): Autoload it. + (Info-follow-nearest-node): Declare. + (prolog-help-info, prolog-goto-predicate-info): No need to require info. + + * textmodes/artist.el (picture-mode-exit): Declare. + + * textmodes/reftex-parse.el (reftex-parse-from-file): + Trivial rewrite so the compiler can parse it better. + +2013-05-20 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-help-mode-map) + (octave-help-mode-finish-hook): New variables. + (octave-help-mode, octave-help-mode-finish): New functions. + (octave-help): Use octave-help-mode. + +2013-05-20 Glenn Morris <rgm@gnu.org> + + * format-spec.el (format-spec): Allow spec chars with nil. (Bug#14420) + +2013-05-19 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/ruby-mode.el (ruby-expression-expansion-re): Allow to + start at point, so that expansion starting right after opening + slash in a regexp is recognized. + (ruby-syntax-before-regexp-re): New defvar, extracted from + ruby-syntax-propertize-function. Since the value of this regexp + is looked up at runtime now, we should be able to turn + `ruby-syntax-methods-before-regexp' into a defcustom later. + (ruby-syntax-propertize-function): Split regexp matching into two + parts, for opening and closing slashes. That allows us to skip + over string interpolations and support multiline regexps. + Don't call `ruby-syntax-propertize-expansions', instead use another rule + for them, which calls `ruby-syntax-propertize-expansion'. + (ruby-syntax-propertize-expansions): Move `remove-text-properties' + call to `ruby-syntax-propertize-function'. + (ruby-syntax-propertize-expansion): Extracted from + `ruby-syntax-propertize-expansions'. Handles one expansion. + (ruby-syntax-propertize-percent-literal): Leave point right after + the percent symbol, so that the expression expansion rule can + propertize the contents. + (ruby-syntax-propertize-heredoc): Leave point at bol following the + heredoc openers. + (ruby-syntax-propertize-expansions): Remove. + +2013-05-18 Juri Linkov <juri@jurta.org> + + * man.el (Man-default-man-entry): Remove `-' from the end + of the default value. (Bug#14400) + +2013-05-18 Glenn Morris <rgm@gnu.org> + + * comint.el (comint-password-prompt-regexp): + Allow "password for XXX" where XXX contains colons (eg https://...). + +2013-05-18 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (inferior-octave-startup): Use OCTAVE_SRCDIR + instead. Include "--no-gui" to prevent hangs for Octave > 3.7. + (octave-source-directories): Don't check process. + (octave-source-directories, octave-find-definition): Doc fix. + +2013-05-18 Glenn Morris <rgm@gnu.org> + + * progmodes/vhdl-mode.el (vhdl-mode-map-init): + Remove backspace/delete bindings. (Bug#14392) + + * cus-dep.el (custom-make-dependencies): Sort the output. + (custom-versions-load-alist): Convert comment to doc. + +2013-05-17 Leo Liu <sdl.web@gmail.com> + + * newcomment.el (comment-search-backward): Stricter in finding + comment start. (Bug#14303) + + * progmodes/octave.el (octave-comment-start): Remove the SPC char. + (octave-comment-start-skip): Properly anchored. + +2013-05-17 Leo Liu <sdl.web@gmail.com> + + * emacs-lisp/smie.el (smie-highlight-matching-block-mode): + Clean up when turned off. (Bug#14395) + (smie--highlight-matching-block-overlay): No longer buffer-local. + (smie-highlight-matching-block): Adjust. + +2013-05-17 Paul Eggert <eggert@cs.ucla.edu> + + Doc string fix for "nanoseconds" (Bug#14406). + * emacs-lisp/timer.el (timer-relative-time, timer-inc-time): + Fix doc string typo that had "nanoseconds" instead of "microseconds". + +2013-05-17 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-units.el (math-extract-units): Preserve powers + of units. + +2013-05-17 Leo Liu <sdl.web@gmail.com> + + * subr.el (delete-consecutive-dups): New function. + * ido.el (ido-set-matches-1): Use it. + * progmodes/octave.el (inferior-octave-completion-table): Use it. + * ido.el (ido-remove-consecutive-dups): Remove. + +2013-05-17 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/f90.el (f90-keywords-re, f90-keywords-level-3-re) + (f90-hpf-keywords-re, f90-constants-re): Use \\_< rather than + regexp-opt's `words'. + +2013-05-16 Leo Liu <sdl.web@gmail.com> + + * emacs-lisp/smie.el (smie-matching-block-highlight): New face. + (smie--highlight-matching-block-overlay) + (smie--highlight-matching-block-lastpos) + (smie--highlight-matching-block-timer): New variables. + (smie-highlight-matching-block): New function. + (smie-highlight-matching-block-mode): New minor mode. (Bug#14395) + (smie-setup): Conditionally enable smie-blink-matching-open. + +2013-05-16 Wilson Snyder <wsnyder@wsnyder.org> + + Sync with upstream verilog-mode r840. + * progmodes/verilog-mode.el (verilog-mode-version) + (verilog-mode-release-date): Update. + (verilog-auto-lineup, verilog-auto-reset): Doc fixes. + (verilog-sig-tieoff): Fix string error on + AUTORESET with colon define, bug594. Reported by Andrew Hou. + (verilog-read-decls): Fix parameters confusing + AUTOINST interfaces, bug565. Reported by Leith Johnson. + +2013-05-16 Eli Zaretskii <eliz@gnu.org> + + * subr.el (reveal-filename): New function. + + * loadup.el: Compute Emacs executable versions on MS-Windows, + where executables have the .exe extension. Add a hard link + emacs-XX.YY.ZZ.exe on MS-Windows. + + * Makefile.in (XARGS_LIMIT): New variable. + (custom-deps, finder-data, autoloads) + ($(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 reveal-filename. + (compile-main): Limit xargs according to $(XARGS_LIMIT). + +2013-05-16 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-indent-defun): Mark obsolete. + (octave-mode-menu, octave-mode-map): Remove its uses. + +2013-05-16 Reto Zimmermann <reto@gnu.org> + + Sync with upstream vhdl mode v3.34.2. + * progmodes/vhdl-mode.el: Use `push' throughout. + (vhdl-version, vhdl-time-stamp, vhdl-doc-release-notes): Update. + (vhdl-compiler-alist): Replace "\t\n" by "\\t\\n". + Add IBM & Quartus compiler. Enhance entry for ADVance MS compiler. + (vhdl-actual-generic-name): New option to derive actual generic name. + (vhdl-port-paste-signals): Replace formal by actual generics. + (vhdl-beautify): New name for old group vhdl-align. Update users. + (vhdl-beautify-options): New option. + (vhdl-last-input-event): New compat alias. Use throughout. + (vhdl-goto-line): Replace user level function `goto-line'. + (vhdl-mode-map): Add bindings for vhdl-fix-statement-region, + vhdl-fix-statement-buffer. + (vhdl-create-mode-menu): Add some entries. + (vhdl-align-region-groups): Respect vhdl-beautify-options. + (vhdl-align-inline-comment-region-1): Handle "--" inside string. + (vhdl-fixup-whitespace-region): Handle symbols at EOL. + (vhdl-fix-statement-region, vhdl-fix-statement-buffer): New commands, + to force statements on one line. + (vhdl-remove-trailing-spaces-region): + New, split from vhdl-remove-trailing-spaces. + (vhdl-beautify-region): Fix statements, trailing spaces, ^M character. + Respect vhdl-beautify-options. + (vhdl-update-sensitivity-list-buffer): If non-interactive save buffer. + (vhdl-update-sensitivity-list): Not add with index if exists without. + Not include array index with signal. Ignore keywords in comments. + (vhdl-get-visible-signals): Regexp tweaks. + (vhdl-template-component-inst): Handle empty library. + (vhdl-template-type): Add template for 'enum' type. + (vhdl-port-paste-generic-map, vhdl-port-paste-constants): + Use vhdl-replace-string. + (vhdl-port-paste-signals): Use vhdl-prepare-search-1. + (vhdl-speedbar-mode-map): Rename from vhdl-speedbar-key-map. + (vhdl-speedbar-initialize): Update for above name change. + (vhdl-compose-wire-components): Fix in handling of constants. + (vhdl-error-regexp-emacs-alist): New variable. + (vhdl-error-regexp-add-emacs): New function; + adds support for new compile.el (Emacs 22+) + (vhdl-generate-makefile-1): Change target order for single lib. units. + Allow use of absolute file names. + +2013-05-16 Leo Liu <sdl.web@gmail.com> + + * simple.el (prog-indent-sexp): Indent enclosing defun. + +2013-05-15 Glenn Morris <rgm@gnu.org> + + * cus-start.el (show-trailing-whitespace): Move to editing basics. + * faces.el (trailing-whitespace): Don't use whitespace-faces group. + * obsolete/old-whitespace.el (whitespace-faces): Remove group. + (whitespace-highlight): Move to whitespace group. + + * comint.el (comint-source): + * pcmpl-linux.el (pcmpl-linux): + * shell.el (shell-faces): + * eshell/esh-opt.el (eshell-opt): + * international/ccl.el (ccl): Remove empty custom groups. + + * completion.el (dynamic-completion-mode): + * jit-lock.el (jit-lock-debug-mode): + * minibuffer.el (completion-in-region-mode): + * type-break.el (type-break-mode-line-message-mode) + (type-break-query-mode): + * emulation/tpu-edt.el (tpu-edt-mode): + * progmodes/subword.el (global-subword-mode, global-superword-mode): + * progmodes/vhdl-mode.el (vhdl-electric-mode, vhdl-stutter-mode): + * term/vt100.el (vt100-wide-mode): Specify explicit :group. + + * term/xterm.el (xterm): Change parent group to terminals. + + * master.el (master): Remove empty custom group. + (master-mode): Remove unused :group argument. + * textmodes/refill.el (refill): Remove empty custom group. + (refill-mode): Remove unused :group argument. + + * textmodes/rst.el (rst-compile-toolsets): Use rst-compile group. + + * cus-dep.el: Provide a feature. + (custom-make-dependencies): Ignore dotfiles (dir-locals). + Don't mistakenly ignore files whose basenames match a basename + from preloaded-file-list (eg cedet/ede/simple.el). + Add a fallback method for getting :group. + +2013-05-15 Juri Linkov <juri@jurta.org> + + * isearch.el (isearch-char-by-name): Rename from + `isearch-insert-char-by-name'. Doc fix. + (isearch-forward): Mention `isearch-char-by-name' in + the docstring. (Bug#13348) + + * isearch.el (minibuffer-local-isearch-map): Bind "\r" to + `exit-minibuffer' instead of + `isearch-nonincremental-exit-minibuffer'. + (isearch-edit-string): Remove mention of + `isearch-nonincremental-exit-minibuffer' from docstring. + (isearch-nonincremental-exit-minibuffer): Mark as obsolete. + (isearch-forward-exit-minibuffer) + (isearch-reverse-exit-minibuffer): Add docstring. (Bug#13348) + +2013-05-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * loadup.el: Just use unversioned DOC. + + * nxml/nxml-mode.el: Treat unclosed <[[, <?, comment, and other + literals as extending to EOB. + (nxml-last-fontify-end): Remove unused variable. + (nxml-after-change1): Use with-silent-modifications. + (nxml-extend-after-change-region): Simplify. + (nxml-extend-after-change-region1): Remove function. + (nxml-after-change1): Don't adjust for dependent regions. + (nxml-fontify-matcher): Simplify. + * nxml/xmltok.el (xmltok-dependent-regions): Remove variable. + (xmltok-add-dependent): Remove function. + (xmltok-scan-after-lt, xmltok-scan-after-processing-instruction-open) + (xmltok-scan-after-comment-open, xmltok-scan-prolog-literal) + (xmltok-scan-prolog-after-processing-instruction-open): Treat + unclosed <[[, <?, comment, and other literals as extending to EOB. + * nxml/rng-valid.el (rng-mark-xmltok-dependent-regions) + (rng-mark-xmltok-dependent-region, rng-dependent-region-changed): + Remove functions. + (rng-do-some-validation-1): Don't mark dependent regions. + * nxml/nxml-rap.el (nxml-adjust-start-for-dependent-regions) + (nxml-mark-parse-dependent-regions, nxml-mark-parse-dependent-region) + (nxml-clear-dependent-regions): Remove functions. + (nxml-scan-after-change, nxml-scan-prolog, nxml-tokenize-forward) + (nxml-ensure-scan-up-to-date): + Don't clear&mark dependent regions. + +2013-05-15 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-goto-function-definition): + Improve and fix callers. + +2013-05-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/cl-extra.el (cl-getf): Return the proper value in + the setter (bug#14387). + + * progmodes/f90.el (f90-blocks-re): Include the terminating \> in the + surrounding group (bug#14402). + +2013-05-14 Juri Linkov <juri@jurta.org> + + * subr.el (find-tag-default-as-regexp): Return nil if `tag' is nil. + (Bug#14390) + +2013-05-14 Glenn Morris <rgm@gnu.org> + + * progmodes/f90.el (f90-imenu-generic-expression): + Fix typo in 2013-05-08 change. (Bug#14402) + +2013-05-14 Jean-Philippe Gravel <jpgravel@gmail.com> + + * progmodes/gdb-mi.el (gdb-running, gdb-starting): + Remove signals for which replies are never received. + +2013-05-14 Jean-Philippe Gravel <jpgravel@gmail.com> + + * progmodes/gdb-mi.el: Fix non-responsive gud commands (bug#13845) + (gdb-handler-alist, gdb-handler-number): Remove variables. + (gdb-handler-list): New variable. + (gdb-add-handler, gdb-delete-handler, gdb-get-handler-function) + (gdb-pending-handler-p, gdb-handle-reply) + (gdb-remove-all-pending-triggers): New functions. + (gdb-discard-unordered-replies): New defcustom. + (gdb-handler): New defstruct. + (gdb-wait-for-pending): Fix invalid backquote. Use gdb-handler-list. + instead of gdb-pending-triggers. Update docstring. + (gdb-init-1): Remove dead variables. Initialize gdb-handler-list. + (gdb-speedbar-update, gdb-speedbar-timer-fn, gdb-var-update) + (gdb-var-update-handler, def-gdb-auto-update-trigger) + (def-gdb-auto-update-handler, gdb-get-changed-registers) + (gdb-changed-registers-handler, gdb-get-main-selected-frame) + (gdb-frame-handler): Pending triggers are now automatically managed. + (def-gdb-trigger-and-handler, def-gdb-auto-update-handler): + Remove argument. + (gdb-input): Automatically handles pending triggers. Update docstring. + (gdb-resync): Replace gdb-pending-triggers by gdb-handler-list. + (gdb-thread-exited, gdb-thread-selected, gdb-register-names-handler): + Update comments. + (gdb-done-or-error): Now use gdb-handle-reply. + +2013-05-14 Jean-Philippe Gravel <jpgravel@gmail.com> + + * progmodes/gdb-mi.el (gdb-input): Include token numbers in + gdb-debug-log. + +2013-05-14 Glenn Morris <rgm@gnu.org> + + * subr.el (user-emacs-directory-warning): New option. + (locate-user-emacs-file): Handle non-accessible .emacs.d. (Bug#13930) + +2013-05-14 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-font-lock-keywords): Fix error + during redisplay. + (octave-goto-function-definition, octave-find-definition): Minor tweaks. + (octave-font-lock-texinfo-comment): Fix invalid search bound + error: wrong side of point. + +2013-05-14 Glenn Morris <rgm@gnu.org> + + * progmodes/flymake.el (flymake-xml-program): New option. + (flymake-xml-init): Use it. + + * term/xterm.el: Provide a feature. + + * term/sup-mouse.el: Move to obsolete/. Provide a feature. + +2013-05-13 Glenn Morris <rgm@gnu.org> + + * cus-dep.el (defcustom-mh, defgroup-mh, defface-mh): + Add compat aliases as a hack workaround. (Bug#14384) + +2013-05-13 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-indent-comment): Fix indentation for + ###, and %!. + (octave-mode-map): Bind octave-indent-defun to C-c C-q instead of + C-M-q. + (octave-comment-start-skip): Include %!. + (octave-mode): Set comment-start-skip to octave-comment-start-skip. + +2013-05-12 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (inferior-octave-startup): Store the value + of __octave_srcdir__ for octave-source-directories. + (inferior-octave-check-process): New function refactored out of + inferior-octave-send-list-and-digest. + (octave-source-directories) + (octave-find-definition-filename-function): New variables. + (octave-source-directories) + (octave-find-definition-default-filename): New functions. + (octave-find-definition): Improve to find functions implemented in C++. + +2013-05-12 Glenn Morris <rgm@gnu.org> + + * calendar/diary-lib.el (diary-outlook-format-1): + Don't include dayname in the output. (Bug#14349) + +2013-05-11 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/autoload.el (generated-autoload-load-name): Doc fix. + + * cus-dep.el (custom-make-dependencies): Only use safe local variables. + Treat cc-provide like provide. + +2013-05-11 Kevin Ryde <user42@zip.com.au> + + * cus-dep.el (custom-make-dependencies): + Use generated-autoload-load-name for the sake of files such + such cedet/semantic/bovine/c.el, where the base file name + is not in load-path. (Bug#5277) + +2013-05-11 Glenn Morris <rgm@gnu.org> + + * dos-vars.el, emacs-lisp/cl-indent.el, emulation/tpu-extras.el: + Provide features. + +2013-05-11 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-indent-comment): Improve. + (octave-eldoc-message-style, octave-eldoc-cache): New variables. + (octave-eldoc-function-signatures, octave-eldoc-function): + New functions. + (octave-mode, inferior-octave-mode): Add eldoc support. + +2013-05-11 Richard Stallman <rms@gnu.org> + + * epa.el (epa-decrypt-file): Take output file name as argument + and read it using `interactive'. + +2013-05-11 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-beginning-of-line) + (octave-end-of-line): Check before using up-list because it jumps + out of more syntactic contructs since moving to smie. + (octave-indent-comment): New function. + (octave-mode): Use it in smie-indent-functions. (Bug#14350) + (octave-begin-keywords, octave-end-keywords) + (octave-reserved-words, octave-smie-bnf-table) + (octave-smie-rules): Add new keywords from Octave 3.6.4. + +2013-05-11 Glenn Morris <rgm@gnu.org> + + * faces.el (internal-face-x-get-resource): + * frame.el (ns-display-monitor-attributes-list): + * calc/calc-aent.el (math-to-radians-2): Fix declarations. + + * emacs-lisp/package.el (tar-header-name, tar-header-link-type): + + * calc/calc-menu.el: Make it loadable in isolation. + + * net/eudcb-bbdb.el: Make it loadable without bbdb. + (eudc-bbdb-filter-non-matching-record, eudc-bbdb-extract-phones) + (eudc-bbdb-extract-addresses, eudc-bbdb-format-record-as-result) + (eudc-bbdb-query-internal): Require 'bbdb. + + * lpr.el (lpr-headers-switches): + * emacs-lisp/testcover.el (testcover-compose-functions): Fix :type. + + * progmodes/sql.el (sql-login-params): Fix and improve :type. + + * emulation/edt-mapper.el: In batch mode, error rather than hang. + + * term.el (term-set-escape-char): Make it idempotent. + +2013-05-10 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (inferior-octave-completion-table): + No longer a function and all uses changed. Use cache to speed up + completion due to bug#11906. + (octave-beginning-of-defun): Re-write to be more general. + +2013-05-10 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/cl-macs.el (cl-loop): Doc fix. + +2013-05-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * comint.el (comint-redirect-send-command-to-process): Use :around + rather than :override for comint-redirect-filter. + (comint-redirect-filter): Add the corresponding `orig-filter' argument. + Call it instead of comint-redirect-original-filter-function (which + is gone). Reported by Juanma Barranquero <lekktu@gmail.com>. + +2013-05-09 Jan Djärv <jan.h.d@swipnet.se> + + * frame.el (display-monitor-attributes-list): Add NS case. + (ns-display-monitor-attributes-list): Declare. + +2013-05-09 Ulrich Mueller <ulm@gentoo.org> + + * descr-text.el (describe-char): Fix %d/%x typo. (Bug#14360) + +2013-05-09 Glenn Morris <rgm@gnu.org> + + * international/fontset.el (vertical-centering-font-regexp): + Set standard-value. + + * tar-mode.el (tar-superior-buffer, tar-superior-descriptor): Add doc. + + * bookmark.el (bookmark-search-delay): + * cus-start.el (vertical-centering-font-regexp): + * ps-mule.el (ps-mule-font-info-database-default): + * ps-print.el (ps-default-fg, ps-default-bg): + * type-break.el (type-break-good-break-interval): + * whitespace.el (whitespace-indentation-regexp) + (whitespace-space-after-tab-regexp): + * emacs-lisp/testcover.el (testcover-1value-functions) + (testcover-noreturn-functions, testcover-progn-functions) + (testcover-prog1-functions): + * emulation/viper-init.el (viper-emacs-state-cursor-color): + * eshell/em-glob.el (eshell-glob-translate-alist): + * play/tetris.el (tetris-tty-colors): + * progmodes/cpp.el (cpp-face-default-list): + * progmodes/flymake.el (flymake-allowed-file-name-masks): + * progmodes/idlw-help.el (idlwave-help-browser-generic-program) + (idlwave-help-browser-generic-args): + * progmodes/make-mode.el (makefile-special-targets-list): + * progmodes/python.el (python-shell-virtualenv-path): + * progmodes/verilog-mode.el (verilog-active-low-regexp) + (verilog-auto-input-ignore-regexp, verilog-auto-inout-ignore-regexp) + (verilog-auto-output-ignore-regexp, verilog-auto-tieoff-ignore-regexp) + (verilog-auto-unused-ignore-regexp, verilog-typedef-regexp): + * textmodes/reftex-vars.el (reftex-format-label-function): + * textmodes/remember.el (remember-diary-file): Fix custom types. + + * jka-cmpr-hook.el (jka-compr-mode-alist-additions): Fix typo. + Add :version. + +2013-05-09 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (inferior-octave-completion-at-point): + Restore file completion. (Bug#14300) + (inferior-octave-startup): Fix incorrect highlighting for the + first prompt. + +2013-05-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/ruby-mode.el: First cut at SMIE support. + (ruby-use-smie): New var. + (ruby-smie-grammar): New constant. + (ruby-smie--bosp, ruby-smie--implicit-semi-p) + (ruby-smie--forward-token, ruby-smie--backward-token) + (ruby-smie-rules): New functions. + (ruby-mode-variables): Setup SMIE if applicable. + +2013-05-08 Eli Zaretskii <eliz@gnu.org> + + * simple.el (line-move-visual): Signal beginning/end of buffer + only if vertical-motion moved less than it was requested. Avoids + silly incorrect error messages when there are display strings with + multiple newlines at EOL. + +2013-05-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/vera-mode.el (vera-underscore-is-part-of-word): + * progmodes/prolog.el (prolog-underscore-wordchar-flag) + (prolog-char-quote-workaround): + * progmodes/cperl-mode.el (cperl-under-as-char): + * progmodes/vhdl-mode.el (vhdl-underscore-is-part-of-word): + Mark as obsolete. + (vhdl-mode-syntax-table, vhdl-mode-ext-syntax-table): Initialize in + their declaration. + (vhdl-mode-syntax-table-init): Remove. + + * progmodes/m4-mode.el (m4-mode-syntax-table): Add comment on + last change. + + * progmodes/ld-script.el (ld-script-mode-syntax-table): Use symbol + syntax for "_". + (ld-script-font-lock-keywords): + Change regexps to use things like \_< and \_>. + + * progmodes/f90.el (f90-mode-syntax-table): Use symbol syntax for "_". + Change all regexps to use things like \_< and \_>. + + * progmodes/autoconf.el (autoconf-definition-regexp) + (autoconf-font-lock-keywords, autoconf-current-defun-function): + Handle a _ with symbol syntax. + (autoconf-mode): Don't change the syntax-table for imenu and font-lock. + + * progmodes/ada-mode.el (ada-mode-abbrev-table): + Consolidate declaration. + (ada-mode-syntax-table, ada-mode-symbol-syntax-table): Initialize in + the declaration. + (ada-create-syntax-table): Remove. + (ada-capitalize-word): Don't mess with the syntax of "_" since it + already has the right syntax nowadays. + (ada-goto-next-word): Don't change the syntax of "_". + + * font-lock.el (lisp-font-lock-keywords-2): Don't highlight obsolete + with-wrapper-hook. + +2013-05-08 Sam Steingold <sds@gnu.org> + + * thingatpt.el (thing-at-point): Accept optional second argument + NO-PROPERTIES to strip the text properties from the return value. + * net/browse-url.el (browse-url-url-at-point): Pass NO-PROPERTIES + to `thing-at-point' instead of stripping the properties ourselves. + Also, when `thing-at-point' fails to find a url, prepend "http://" + to the filename at point on the assumption that the user is + pointing at something like gnu.org/gnu. + +2013-05-08 Juanma Barranquero <lekktu@gmail.com> + + * emacs-lisp/bytecomp.el (byte-compile-insert-header): + * faces.el (crm-separator): + Silence byte-compiler. + + * progmodes/gud.el (gdb-speedbar-auto-raise, gud-tooltip-mode) + (tool-bar-map): Remove unneeded defvars. + +2013-05-08 Leo Liu <sdl.web@gmail.com> + + Re-work a fix for bug#10994 based on Le Wang's patch. + * ido.el (ido-remove-consecutive-dups): New helper. + (ido-completing-read): Use it. + (ido-chop): Revert fix for bug#10994. + +2013-05-08 Adam Spiers <emacs@adamspiers.org> + + * cus-edit.el (custom-save-variables): + Pretty-print long values. (Bug#14187) + +2013-05-08 Glenn Morris <rgm@gnu.org> + + * progmodes/m4-mode.el (m4-program): Assume it is in PATH. + (m4-mode-syntax-table): Init in the defvar. + (m4-mode-abbrev-table): Let define-derived-mode define it. + +2013-05-08 Tom Tromey <tromey@redhat.com> + + * progmodes/m4-mode.el (m4-mode-syntax-table): + Do not treat "_" as word constituent. (Bug#14167) + +2013-05-07 Glenn Morris <rgm@gnu.org> + + * eshell/em-hist.el (eshell-isearch-map): Initialize in the defvar. + Remove explicit eshell-isearch-cancel-map. + + * progmodes/f90.el (f90-smart-end-names): New option. + (f90-smart-end): Doc fix. + (f90-end-block-optional-name): New constant. + (f90-block-match): Respect f90-smart-end-names. + +2013-05-07 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/octave.el (octave-smie-forward-token): Be more careful + about implicit semi-colons (bug#14218). + +2013-05-07 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * frame.el (display-monitor-attributes-list) + (frame-monitor-attributes): New functions. + +2013-05-06 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-syntax-propertize-function): Change + \'s syntax to escape when inside double-quoted strings. (Bug#14332) + (octave-font-lock-keywords): Use octave-operator-regexp. + (octave-completion-at-point): Rename from + octave-completion-at-point-function. + (inferior-octave-directory-tracker): Robustify. + (octave-text-functions): Remove and fix its uses. No such things + any more. + +2013-05-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/trace.el (trace--display-buffer): New function. + (trace-make-advice): Use it. + +2013-05-06 Juri Linkov <juri@jurta.org> + + * emacs-lisp/lisp-mode.el (eval-defun-2): Doc fix. (Bug#14344) + (eval-defun-2, eval-defun, eval-last-sexp, eval-last-sexp-1): + Doc fix. + (emacs-lisp-mode-map): Replace "minibuffer" with "echo area" + in the help string. (Bug#12985) + +2013-05-06 Kelly Dean <kellydeanch@yahoo.com> (tiny change) + + * simple.el (shell-command-on-region): Doc fix. (Bug#14279) + +2013-05-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/perl-mode.el: Add support for here documents. + (perl-syntax-propertize-function): Match here-doc markers. + (perl-syntax-propertize-special-constructs): Find their end. + (perl-imenu-generic-expression): Use [:alnum:]. + + * emacs-lisp/nadvice.el (advice--member-p): Return the advice if found. + (advice--add-function): Refresh the advice if already present + (bug#14317). + +2013-05-06 Ivan Andrus <darthandrus@gmail.com> + + * find-file.el (cc-other-file-alist): Add ".m" for ObjC. (Bug#14339) + +2013-05-06 Glenn Morris <rgm@gnu.org> + + * w32-fns.el (w32-charset-info-alist): Declare. + + * eshell/em-cmpl.el: Simply require pcomplete; eg we use a bunch + of its defcustom properties. + (eshell-cmpl-initialize): No need to load pcomplete. + + * generic-x.el: No need to require comint when compiling. + + * net/eudc-export.el: Make it loadable without bbdb. + (top-level): Use require rather than load-library. + (eudc-create-bbdb-record, eudc-bbdbify-phone) + (eudc-batch-export-records-to-bbdb) + (eudc-insert-record-at-point-into-bbdb, eudc-try-bbdb-insert): + Require bbdb. + +2013-05-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/octave.el (octave-texinfo-font-lock-keywords): Remove. + (octave-font-lock-texinfo-comment): Use texinfo-font-lock-keywords with + some tweaks, instead. + +2013-05-05 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-font-lock-keywords) + (octave-font-lock-texinfo-comment): Adjust for the byte-compiler. + (inferior-octave-send-list-and-digest): Improve error message. + (octave-mode, inferior-octave-mode): Use setq-local. + (octave-help): Set info-lookup-mode. + +2013-05-05 Richard Stallman <rms@gnu.org> + + * vc/compare-w.el (compare-windows-whitespace): + Treat no-break space as whitespace. + + * mail/rmailsum.el (rmail-summary-rmail-update): + Detect empty summary and don't change selected message. + (rmail-summary-goto-msg): Likewise. + + * mail/rmailsum.el (rmail-new-summary, rmail-new-summary-1): + Doc fixes, rename args. + +2013-05-05 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-defs.el (c-version): Increment to 5.32.5. + +2013-05-05 Juri Linkov <juri@jurta.org> + + * info.el (Info-read-subfile): Use (point-min) instead of (point) + to not add the length of the summary segment to the return value. + (Bug#14125) + +2013-05-05 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (inferior-octave-strip-ctrl-g) + (inferior-octave-output-filter): Remove. + (octave-send-region, inferior-octave-startup): Fix callers. + (inferior-octave-mode-map): Don't use comint-dynamic-complete. + (octave-binary-file-extensions): New user variable. + (octave-find-definition): Confirm if opening binary files. + (octave-help-file): Use octave-find-definition to get the binary + confirmation. + (octave-help): Adjust for octave-help-file change. + +2013-05-05 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/pascal.el (pascal-font-lock-keywords): Use backquotes. + Merge the two entries that handle function definitions. + (pascal--syntax-propertize): New const. + (pascal-mode): Use it. Use setq-local. + +2013-05-04 Glenn Morris <rgm@gnu.org> + + * calendar/diary-lib.el (diary-from-outlook-function): New variable. + (diary-from-outlook): Respect diary-from-outlook-function. + +2013-05-04 Stefan Monnier <monnier@iro.umontreal.ca> + + * simple.el (read-expression-map): Use completion-at-point (bug#14255). + Move the declaration from C. + (read-minibuffer, eval-minibuffer): Move from C. + (completion-setup-function): Avoid minibuffer-completion-contents. + +2013-05-03 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-font-lock-keywords): Do not + dehighlight 'end' in comments or strings. + (octave-completing-read, octave-goto-function-definition): + New helpers. + (octave-help-buffer): New user variable. + (octave-help-file, octave-help-function): New button types. + (octave-help): New command and bind it to C-h ;. + (octave-find-definition): New command and bind it to M-. + (user-error): Alias to error if not defined. + +2013-05-02 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-mode-syntax-table): Correct syntax + for \. (bug#14332) + (octave-font-lock-keywords): Include [ and {. + +2013-05-02 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (inferior-octave-startup-file): Change default. + (inferior-octave): Remove calling comint-mode and return the buffer. + (inferior-octave-startup): Cosmetic changes. + +2013-05-02 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-syntax-propertize-function): + Include the case when ' is at line beginning. (Bug#14336) + +2013-05-02 Glenn Morris <rgm@gnu.org> + + * vc/vc-dir.el (vc-dir-mode): Don't autoload it for everyone. + * desktop.el (vc-dir-mode): Just autoload it here. + +2013-05-02 Alan Mackenzie <acm@muc.de> + + Eliminate variable c-standard-font-lock-fontify-region-function. + * progmodes/cc-mode.el + (c-standard-font-lock-fontify-region-function): Remove. + (c-font-lock-fontify-region, c-after-font-lock-init): Adapt. + +2013-05-01 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el: Compatible with older emacs-24 releases. + (inferior-octave-has-built-in-variables): Remove. Built-in + variables were removed from Octave in 2007. + (inferior-octave-startup): Fix uses. + (comint-line-beginning-position): Remove compatibility code for + emacs 21. + +2013-05-01 Juri Linkov <juri@jurta.org> + + * isearch.el (isearch-forward, isearch-mode): Doc fix. (Bug#13923) + +2013-05-01 Juri Linkov <juri@jurta.org> + + * comint.el (comint-previous-matching-input): Don't print message + "History item: %d" when `isearch-mode' is active. + (comint-history-isearch-message): Print message "History item: %d" + when `comint-input-ring-index' is not empty and this function is + called from `isearch-update' with a nil `ellipsis'. (Bug#13223) + +2013-05-01 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-abbrev-table): Remove abbrev + definitions. Use completion-at-point to insert keywords. + (octave-abbrev-start): Remove. + (inferior-octave-mode, octave-mode): Use :abbrev-table instead. + +2013-04-30 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (inferior-octave-prompt-read-only): Fix last + change. + +2013-04-30 Alan Mackenzie <acm@muc.de> + + Handle arbitrarily long C++ member initialisation lists. + * progmodes/cc-engine.el (c-back-over-member-initializers): + new function. + (c-guess-basic-syntax): New CASE 5R (extracted from 5B) to handle + (most) member init lists. + +2013-04-30 Rüdiger Sonderfeld <ruediger@c-plusplus.de> + + * progmodes/octave.el (inferior-octave-prompt-read-only): New user + variable. + +2013-04-30 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-variables): Remove. No builtin + variables any more. All converted to functions. + (octave-font-lock-keywords, octave-completion-at-point-function): + Fix uses. + (octave-font-lock-texinfo-comment): New user variable. + (octave-texinfo-font-lock-keywords): New variable for texinfo + comment block. + (octave-function-comment-block): New face. + (octave-font-lock-texinfo-comment): New function. + (octave-mode): Font lock texinfo comment block. + +2013-04-29 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-font-lock-keywords): Handle 'end' in + indexing expression. + (octave-continuation-string): Do not use \. + (inferior-octave-complete-impossible): Remove. + (inferior-octave-completion-table) + (inferior-octave-completion-at-point): Remove its uses. + (inferior-octave-startup): completion_matches was introduced to + Octave in 1996 so safe to assume it. + (octave-function-file-comment): Improve to follow how Octave does it. + (octave-update-function-file-comment): Tweak. + +2013-04-29 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (inferior-octave-startup-hook): Obsolete. + (inferior-octave-startup): Remove inferior-octave-startup-hook. + (octave-function-file-comment): Fix typo. + (octave-sync-function-file-names): Use read-char-choice. + +2013-04-28 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc.el (math-normalize): Don't set `math-normalize-error' + to t for the less important warnings. + +2013-04-27 Darren Hoo <darren.hoo@gmail.com> (tiny change) + + * isearch.el (isearch-fail-pos): Check for empty `cmds'. (Bug#14268) + +2013-04-27 Glenn Morris <rgm@gnu.org> + + * vc/log-view.el (log-view-current-entry): + Treat "---" separator lines as part of the following rev. (Bug#14169) + +2013-04-27 Juri Linkov <juri@jurta.org> + + * subr.el (read-number): Doc fix about using it by interactive + code letter `n'. (Bug#14254) + +2013-04-27 Juri Linkov <juri@jurta.org> + + * desktop.el (desktop-auto-save-timeout): New option. + (desktop-file-checksum): New variable. + (desktop-save): Add optional arg `auto-save' and don't auto-save + if nothing changed. + (desktop-auto-save-timer): New variable. + (desktop-auto-save, desktop-auto-save-set-timer): New functions. + (after-init-hook): Call `desktop-auto-save-set-timer'. + Suggested by Reuben Thomas <rrt@sc3d.org> in + <http://lists.gnu.org/archive/html/emacs-devel/2013-04/msg00327.html>. + +2013-04-27 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-function-file-p) + (octave-skip-comment-forward, octave-function-file-comment) + (octave-update-function-file-comment): New functions. + (octave-mode-map): Bind C-c ; to + octave-update-function-file-comment. + (octave-mode-menu): Add octave-update-function-file-comment. + (octave-mode, inferior-octave-mode): Fix doc-string. + (octave-insert-defun): Conform to Octave's coding convention. + (Bug#14285) + + * files.el (basic-save-buffer): Don't let errors in + before-save-hook prevent saving buffer. + +2013-04-20 Roland Winkler <winkler@gnu.org> + + * faces.el (read-face-name): Use completing-read if arg multiple + is nil. + +2013-04-27 Ingo Lohmar <i.lohmar@gmail.com> (tiny change) + + * ls-lisp.el (ls-lisp-insert-directory): If no files are + displayed, move point to after the totals line. + See http://lists.gnu.org/archive/html/emacs-devel/2013-04/msg00677.html + for the details. + +2013-04-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/package.el (package-autoload-ensure-default-file): + Add current dir to the load-path. + (package-generate-autoloads): Don't rely on + autoload-ensure-default-file. + +2013-04-26 Reuben Thomas <rrt@sc3d.org> + + * textmodes/remember.el (remember-store-in-files): Document that + the file name format is passed to `format-time-string'. + +2013-04-26 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-sync-function-file-names): New function. + (octave-mode): Use it in before-save-hook. + +2013-04-26 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/tabulated-list.el (tabulated-list-mode): Disable undo + (bug#14274). + + * progmodes/octave.el (octave-smie-forward-token): Properly skip + \n and comment, even if it's not an implicit ; (bug#14218). + +2013-04-26 Glenn Morris <rgm@gnu.org> + + * subr.el (read-number): Once more use `read' rather than + `string-to-number', to trap non-numeric input. (Bug#14254) + +2013-04-26 Erik Charlebois <erikcharlebois@gmail.com> + + * emacs-lisp/syntax.el (syntax-propertize-multiline): + Use `syntax-multiline' text property consistently instead of + `font-lock-multiline'. (Bug#14237) + +2013-04-26 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/shadow.el (list-load-path-shadows): + No longer necessary to check for duplicate simple.el, since + 2012-07-07 change to init_lread to not include installation lisp + directories in load-path when running uninstalled. (Bug#14270) + +2013-04-26 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-submit-bug-report): Obsolete. + (octave-mode, inferior-octave-mode): Use setq-local. + (octave-not-in-string-or-comment-p): Rename to + octave-in-string-or-comment-p. + (octave-in-comment-p, octave-in-string-p) + (octave-in-string-or-comment-p): Replace defsubst with defun. + +2013-04-25 Paul Eggert <eggert@cs.ucla.edu> + + * Makefile.in (distclean): Remove $(lisp)/loaddefs.el~. + +2013-04-25 Bastien Guerry <bzg@gnu.org> + + * textmodes/remember.el (remember-data-directory) + (remember-directory-file-name-format): Fix custom types. + +2013-04-25 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave.el (octave-completion-at-point-function): + Make use of inferior octave process. + (octave-initialize-completions): Remove. + (inferior-octave-completion-table): New function. + (inferior-octave-completion-at-point): Use it. + (octave-completion-alist): Remove. + +2013-04-25 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/opascal.el: Use font-lock and syntax-propertize. + (opascal-mode-syntax-table): New var. + (opascal-literal-kind, opascal-is-literal-end) + (opascal-literal-token-at): Rewrite. + (opascal--literal-start-re, opascal-font-lock-keywords) + (opascal--syntax-propertize): New constants. + (opascal-font-lock-defaults): Adjust. + (opascal-mode): Use them. Set comment-<foo> variables as well. + (delphi-comment-face, opascal-comment-face, delphi-string-face) + (opascal-string-face, delphi-keyword-face, opascal-keyword-face) + (delphi-other-face, opascal-other-face): Remove face variables. + (opascal-save-state): Remove macro. + (opascal-fontifying-progress-step): Remove constant. + (opascal--ignore-changes): Remove var. + (opascal-set-token-property, opascal-parse-next-literal) + (opascal-is-stable-literal, opascal-complete-literal) + (opascal-is-literal-start, opascal-face-of) + (opascal-parse-region, opascal-parse-region-until-stable) + (opascal-fontify-region, opascal-after-change) + (opascal-debug-show-is-stable, opascal-debug-unparse-buffer) + (opascal-debug-parse-region, opascal-debug-parse-window) + (opascal-debug-parse-buffer, opascal-debug-fontify-window) + (opascal-debug-fontify-buffer): Remove. + (opascal-debug-mode-map): Adjust accordingly. + +2013-04-25 Leo Liu <sdl.web@gmail.com> + + Merge octave-mod.el and octave-inf.el into octave.el with some + cleanups. + * progmodes/octave.el: New file renamed from octave-mod.el. + * progmodes/octave-inf.el: Merged into octave.el. + * progmodes/octave-mod.el: Renamed to octave.el. + +2013-04-25 Tassilo Horn <tsdh@gnu.org> + + * textmodes/reftex-vars.el + (reftex-label-ignored-macros-and-environments): New defcustom. + + * textmodes/reftex-parse.el (reftex-parse-from-file): Use it. + +2013-04-25 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/smie.el (smie-indent--hanging-p): Don't burp at EOB. + (smie-indent-keyword): Improve the check to ensure that the next + comment is really on the same line. + (smie-indent-comment): Don't align with a subsequent closer (or eob). + + * progmodes/octave-mod.el (octave-smie-forward-token): Only emit + semi-colons if the line is not otherwise empty (bug#14218). + +2013-04-25 Glenn Morris <rgm@gnu.org> + + * vc/vc-bzr.el (vc-bzr-print-log): Tweak LIMIT = 1 case. + +2013-04-24 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/opascal.el (opascal-set-token-property): Rename from + opascal-set-text-properties and only set `token' (bug#14134). + Suggested by Erik Knowles <eknowles@geosystemsoftware.com>. + (opascal-literal-text-properties): Remove. + (opascal-parse-next-literal, opascal-debug-unparse-buffer): + Adjust callers. + +2013-04-24 Reuben Thomas <rrt@sc3d.org> + + * textmodes/remember.el (remember-handler-functions): Add an + option for a new handler `remember-store-in-files'. + (remember-data-directory, remember-directory-file-name-format): + New options. + (remember-store-in-files): New function to store remember notes + as separate files within a directory. + +2013-04-24 Magnus Henoch <magnus.henoch@gmail.com> + + * progmodes/compile.el (compilation-next-error-function): + Pass "formats" to compilation-find-file (bug#11777). + +2013-04-24 Glenn Morris <rgm@gnu.org> + + * vc/vc-bzr.el (vc-bzr-print-log): + * vc/vc-hg.el (vc-hg-print-log): + * vc/vc-svn.el (vc-svn-print-log): + Fix START-REVISION with LIMIT != 1. (Bug#14168) + + * vc/vc-bzr.el (vc-bzr-print-log): + * vc/vc-cvs.el (vc-cvs-print-log): + * vc/vc-git.el (vc-git-print-log): + * vc/vc-hg.el (vc-hg-print-log): + * vc/vc-mtn.el (vc-mtn-print-log): + * vc/vc-rcs.el (vc-rcs-print-log): + * vc/vc-sccs.el (vc-sccs-print-log): + * vc/vc-svn.el (vc-svn-print-log): + * vc/vc.el (vc-print-log-internal): Doc fixes. + +2013-04-23 Glenn Morris <rgm@gnu.org> + + * startup.el (normal-no-mouse-startup-screen, normal-about-screen): + Remove venerable code attempting to avoid substitute-command-keys. + +2013-04-23 Tassilo Horn <tsdh@gnu.org> + + * textmodes/reftex-vars.el (reftex-label-regexps): + Call `reftex-compile-variables' after changes to this variable. + +2013-04-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * jit-lock.el: Fix signals in jit-lock-force-redisplay (bug#13542). + Use lexical-binding. + (jit-lock-force-redisplay): Use markers, check buffer's continued + existence and beware narrowed buffers. + (jit-lock-fontify-now): Adjust call accordingly. + +2013-04-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * minibuffer.el (minibuffer-completion-contents): Fix obsolescence info + to avoid misleading the user. + +2013-04-22 Leo Liu <sdl.web@gmail.com> + + * info-look.el: Prefer latex2e.info. (Bug#14240) + +2013-04-22 Michael Albinus <michael.albinus@gmx.de> + + Fix pack/unpack coding. Reported by David Smith <davidsmith@acm.org>. + + * net/tramp-compat.el (tramp-compat-call-process): Move function ... + * net/tramp.el (tramp-call-process): ... here + (tramp-set-completion-function, tramp-parse-putty): + * net/tramp-adb.el (tramp-adb-execute-adb-command): + * net/tramp-gvfs.el (tramp-gvfs-send-command): + * net/tramp-sh.el (tramp-sh-handle-set-file-times) + (tramp-set-file-uid-gid, tramp-sh-handle-write-region) + (tramp-call-local-coding-command): Use `tramp-call-process' + instead of `tramp-compat-call-process'. + + * net/tramp-sh.el (tramp-perl-pack, tramp-perl-unpack): New defconst. + (tramp-local-coding-commands, tramp-remote-coding-commands): Use them. + (tramp-sh-handle-file-local-copy, tramp-sh-handle-write-region): + (tramp-find-inline-compress): Improve traces. + (tramp-maybe-send-script): Check for Perl binary. + (tramp-get-inline-coding): Do not redirect STDOUT for local decoding. + +2013-04-22 Daiki Ueno <ueno@gnu.org> + + * epg.el (epg-context-pinentry-mode): New function. + (epg-context-set-pinentry-mode): New function. + (epg--start): Pass --pinentry-mode option to gpg command. + +2013-04-21 Xue Fuqiao <xfq.free@gmail.com> + + * comint.el (comint-dynamic-complete-functions, comint-mode-map): + `comint-dynamic-complete' is obsolete since 24.1, replaced by + `completion-at-point'. (Bug#13774) + + * startup.el (normal-no-mouse-startup-screen): Bug fix, the + default key binding for `describe-distribution' has been moved to + `C-h C-o'. (Bug#13970) + +2013-04-21 Glenn Morris <rgm@gnu.org> + + * vc/vc.el (vc-print-log-setup-buttons, vc-print-log-internal): + Add doc strings. + (vc-print-log): Clarify interactive prompt. + +2013-04-20 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/bytecomp.el (byte-compile-insert-header): + No longer include timestamp etc information. + +2013-04-20 Roland Winkler <winkler@gnu.org> + + * faces.el (read-face-name): Bug fix, return just one face if arg + multiple is nil. (Bug#14209) + +2013-04-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/nadvice.el (advice--where-alist): Add :override. + (remove-function): Autoload. + + * comint.el (comint-redirect-original-filter-function): Remove. + (comint-redirect-cleanup, comint-redirect-send-command-to-process): + * vc/vc-cvs.el (vc-cvs-annotate-process-filter,vc-cvs-annotate-command): + * progmodes/octave-inf.el (inferior-octave-send-list-and-digest): + * progmodes/prolog.el (prolog-consult-compile): + * progmodes/gdb-mi.el (gdb, gdb--check-interpreter): + Use add/remove-function instead. + * progmodes/gud.el (gud-tooltip-original-filter): Remove. + (gud-tooltip-process-output, gud-tooltip-tips): + Use add/remove-function instead. + * progmodes/xscheme.el (xscheme-previous-process-state): Remove. + (scheme-interaction-mode, exit-scheme-interaction-mode): + Use add/remove-function instead. + + * vc/vc-dispatcher.el: Use lexical-binding. + (vc--process-sentinel): Rename from vc-process-sentinel. + Change last arg to be the code to run. Don't use vc-previous-sentinel + and vc-sentinel-commands any more. + (vc-exec-after): Allow code to be a function. Use add/remove-function. + (compilation-error-regexp-alist, view-old-buffer-read-only): Declare. + +2013-04-19 Masatake YAMATO <yamato@redhat.com> + + * progmodes/sh-script.el (sh-imenu-generic-expression): + Handle function names with a single character. (Bug#14111) + +2013-04-19 Dima Kogan <dima@secretsauce.net> (tiny change) + + * progmodes/gud.el (gud-perldb-marker-filter): Understand position info + for subroutines defined in an eval (bug#14182). + +2013-04-19 Thierry Volpiatto <thierry.volpiatto@gmail.com> + + * bookmark.el (bookmark-completing-read): Improve handling of empty + string (bug#14176). + +2013-04-19 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc/vc-dispatcher.el (vc-do-command): Get rid of default sentinel msg. + +2013-04-19 Fabián Ezequiel Gallina <fgallina@gnu.org> + + New faster Imenu implementation (bug#14058). + * 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): + New vars. + (python-imenu-format-item-label) + (python-imenu-format-parent-item-label) + (python-imenu-format-parent-item-jump-label) + (python-imenu--put-parent, python-imenu--build-tree) + (python-imenu-create-index, python-imenu-create-flat-index) + (python-util-popn): New functions. + (python-mode): Set imenu-create-index-function to + python-imenu-create-index. + +2013-04-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * winner.el (winner-active-region): Use region-active-p, activate-mark + and deactivate-mark (bug#14225). + + * simple.el (deactivate-mark): Don't inline it. + +2013-04-18 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-sh.el (tramp-remote-process-environment): Add "TMOUT=0". + +2013-04-18 Tassilo Horn <tsdh@gnu.org> + + * files.el (auto-mode-alist): Delete OpenDocument and StarOffice + file extensions from the archive-mode entry in order to prefer + doc-view-mode-maybe with archive-mode as fallback (bug#14188). + +2013-04-18 Leo Liu <sdl.web@gmail.com> + + * bindings.el (help-event-list): Add ?\?. + +2013-04-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (with-wrapper-hook): Declare obsolete. + * simple.el (filter-buffer-substring-function): New hook. + (filter-buffer-substring): Use it. + (filter-buffer-substring-functions): Mark obsolete. + * minibuffer.el (completion-in-region-function): New hook. + (completion-in-region): Use it. + (completion-in-region-functions): Mark obsolete. + * mail/mailabbrev.el (mail-abbrevs-setup): Use abbrev-expand-function. + * abbrev.el (abbrev-expand-function): New hook. + (expand-abbrev): Use it. + (abbrev-expand-functions): Mark obsolete. + * emacs-lisp/nadvice.el (advice--where-alist): Add :filter-args + and :filter-return. + +2013-04-17 Fabián Ezequiel Gallina <fgallina@gnu.org> + + * progmodes/python.el (python-nav--syntactically): Fix cornercases + and do not care about match data. + +2013-04-17 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/lisp.el (lisp-completion-at-point): Provide specialized + completion tables when completing error conditions and + `declare' arguments. + (lisp-complete-symbol, field-complete): Mark as obsolete. + (check-parens): Unmatched parens are user errors. + * minibuffer.el (minibuffer-completion-contents): Mark as obsolete. + +2013-04-17 Michal Nazarewicz <mina86@mina86.com> + + * textmodes/flyspell.el (flyspell-check-pre-word-p): Return nil if + command changed buffer (ie. `flyspell-pre-buffer' is not current + buffer), which prevents making decisions based on invalid value of + `flyspell-pre-point' in the wrong buffer. Most notably, this used to + cause an error when `flyspell-pre-point' was nil after switching + buffers. + (flyspell-post-command-hook): No longer needs to change buffers when + checking pre-word. While at it remove unnecessary progn. + +2013-04-17 Nicolas Richard <theonewiththeevillook@yahoo.fr> (tiny change) + + * textmodes/ispell.el (ispell-add-per-file-word-list): + Fix `flyspell-correct-word-before-point' error when accepting + words and `coment-padding' is an integer by using + `comment-normalize-vars' (Bug #14214). + +2013-04-17 Fabián Ezequiel Gallina <fgallina@gnu.org> + + New defun movement commands. + * progmodes/python.el (python-nav--syntactically) + (python-nav--forward-defun, python-nav-backward-defun) + (python-nav-forward-defun): New functions. + +2013-04-17 Fabián Ezequiel Gallina <fgallina@gnu.org> + + * progmodes/python.el (python-syntax--context-compiler-macro): New defun. + (python-syntax-context): Use named compiler-macro for backwards + compatibility with Emacs 24.x. + +2013-04-17 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave-mod.el (octave-mode-map): Fix key binding to + octave-hide-process-buffer. + +2013-04-17 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc/vc-hg.el (vc-hg-annotate-re): Disallow ": " in file names + (bug#14216). + +2013-04-17 Jean-Philippe Gravel <jpgravel@gmail.com> + + * progmodes/gdb-mi.el (gdbmi-bnf-incomplete-record-result): + Fix adjustment of offset when receiving incomplete responses from GDB + (bug#14129). + +2013-04-16 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/python.el (python-mode-skeleton-abbrev-table): Rename from + python-mode-abbrev-table. + (python-skeleton-define): Adjust accordingly. + (python-mode-abbrev-table): New table that inherits from it so that + python-skeleton-autoinsert does not affect non-skeleton abbrevs. + + * abbrev.el (abbrev--symbol): New function, extracted from abbrev-symbol. + (abbrev-symbol): Use it. + (abbrev--before-point): Use it since we already handle inheritance. + +2013-04-16 Leo Liu <sdl.web@gmail.com> + + * progmodes/octave-mod.el (octave-mode-map): Remove redundant key + binding to info-lookup-symbol. + +2013-04-16 Juanma Barranquero <lekktu@gmail.com> + + * minibuffer.el (completion--twq-all): + * term/ns-win.el (ns-initialize-window-system): + * term/w32-win.el (w32-initialize-window-system): Silence byte-compiler. + +2013-04-16 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/nadvice.el (add-function): Default simple vars to their + global bindings. + + * doc-view.el (doc-view-start-process): Handle url-handler directories. + +2013-04-15 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/ruby-mode.el (ruby-beginning-of-defun) + (ruby-end-of-defun, ruby-move-to-block): Bind `case-fold-search' + to nil. + (ruby-end-of-defun): Remove the unused arg, change the docstring + to reflect that this function is only used as the value of + `end-of-defun-function'. + (ruby-beginning-of-defun): Remove "top-level" from the docstring, + to reflect an earlier change that beginning/end-of-defun functions + jump between methods in a class definition, as well as top-level + functions. + +2013-04-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * minibuffer.el (minibuffer-complete): Don't just scroll + a *Completions* that's been iconified. + (minibuffer-force-complete): Make sure repetitions do cycle when going + through completion-in-region -> minibuffer-complete. + +2013-04-15 Alan Mackenzie <acm@muc.de> + + Correct the placement of c-cpp-delimiters when there're #s not at + col 0. + + * progmodes/cc-langs.el (c-anchored-cpp-prefix): Reformulate and + place a submatch around the #. + * progmodes/cc-mode.el(c-neutralize-syntax-in-and-mark-CPP): + Start a search at BOL. Put the c-cpp-delimiter category text propertiy + on the #, not BOL. + +2013-04-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/nadvice.el: Properly test names when adding advice. + (advice--member-p): New arg `name'. + (advice--add-function, advice-member-p): Use it (bug#14202). + +2013-04-15 Filipp Gunbin <fgunbin@fastmail.fm> + + Reformulate java imenu-generic-expression. + The old expression contained ill formed regexps. + + * progmodes/cc-menus.el (cc-imenu-java-ellipsis-regexp) + (cc-imenu-java-type-spec-regexp, cc-imenu-java-comment-regexp) + (cc-imenu-java-method-arg-regexp): New defconsts. + (cc-imenu-java-build-type-args-regex): New defun. + (cc-imenu-java-generic-expression): Fix, to remove "ambiguous" + handling of spaces in the regexp. + +2013-03-15 AgustÃn MartÃn Domingo <agustin.martin@hispalinux.es> + + * textmodes/ispell.el (ispell-command-loop): Remove + flyspell highlight of a word when ispell accepts it (bug #14178). + +2013-04-15 Michael Albinus <michael.albinus@gmx.de> + + * net/ange-ftp.el (ange-ftp-run-real-handler-orig): New defun, + uses code from the previous `ange-ftp-run-real-handler'. + (ange-ftp-run-real-handler): Set it to `tramp-run-real-handler' + only in case that function exist. This is needed for proper + unloading of Tramp. + +2013-04-15 Tassilo Horn <tsdh@gnu.org> + + * textmodes/reftex-vars.el (reftex-label-regexps): New defcustom. + + * textmodes/reftex.el (reftex-compile-variables): Use it. + +2013-04-14 Stefan Monnier <monnier@iro.umontreal.ca> + + * files.el (normal-mode): Only use default major-mode if no other mode + was specified. + + * emacs-lisp/trace.el (trace-values): New function. + + * files.el: Allow : in local variables (bug#14089). + (hack-local-variable-regexp): New var. + (hack-local-variables-prop-line, hack-local-variables): Use it. + +2013-04-13 Roland Winkler <winkler@gnu.org> + + * textmodes/bibtex.el (bibtex-search-entries): Bug fix. Use match + data before it gets modified by bibtex-beginning-of-entry. + +2013-04-13 Roland Winkler <winkler@gnu.org> + + * textmodes/bibtex.el (bibtex-url): Doc fix. + +2013-04-13 Roland Winkler <winkler@gnu.org> + + * textmodes/bibtex.el (bibtex-initialize): If the current buffer + does not visit a BibTeX file, exclude it from the list of buffers + returned by bibtex-initialize. + +2013-04-13 Stephen Berman <stephen.berman@gmx.net> + + * window.el (split-window): Remove interactive form, since as a + command this function is a special case of split-window-below. + Correct doc string. + +2013-04-12 Roland Winkler <winkler@gnu.org> + + * faces.el (read-face-name): Do not override value of arg default. + Allow single faces and strings as default values. Remove those + elements from return value that are not faces. + (describe-face): Simplify. + (face-at-point): New optional args thing and multiple so that this + function can provide the same functionality previously provided by + read-face-name. + (make-face-bold, make-face-unbold, make-face-italic) + (make-face-unitalic, make-face-bold-italic, invert-face) + (modify-face, read-face-and-attribute): Use face-at-point. + + * cus-edit.el (customize-face, customize-face-other-window) + * cus-theme.el (custom-theme-add-face) + * face-remap.el (buffer-face-set) + * facemenu.el (facemenu-set-face): Use face-at-point. + +2013-04-12 Michael Albinus <michael.albinus@gmx.de> + + * info.el (Info-file-list-for-emacs): Add "tramp" and "dbus". + +2013-04-10 Tassilo Horn <tsdh@gnu.org> + + * textmodes/reftex-cite.el (reftex-parse-bibtex-entry): Don't cut + off leading { and trailing } from field values. + +2013-04-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/timer.el (timer--check): New function. + (timer--time, timer-set-function, timer-event-handler): Use it. + (timer-set-idle-time): Simplify. + (timer--activate): CSE. + (timer-event-handler): Give more info in error message. + (internal-timer-start-idle): New function, moved from C. + + * mpc.el (mpc-proc): Add `restart' argument. + (mpc-proc-cmd): Use it. + (mpc--status-timer-run): Also catch signals from `mpc-proc'. + (mpc-status-buffer-show, mpc-tagbrowser-dir-toggle): Call `mpc-proc' + less often. + +2013-04-10 Masatake YAMATO <yamato@redhat.com> + + * progmodes/sh-script.el: Implement `sh-mode' own + `add-log-current-defun-function' (bug#14112). + (sh-current-defun-name): New function. + (sh-mode): Use the function. + +2013-04-09 Bastien Guerry <bzg@gnu.org> + + * simple.el (choose-completion-string): Fix docstring (bug#14163). + +2013-04-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/edebug.el (edebug-mode): Fix typo (bug#14144). + + * emacs-lisp/timer.el (timer-event-handler): Don't retrigger a canceled + timer (bug#14156). + +2013-04-07 Nic Ferrier <nferrier@ferrier.me.uk> + + * emacs-lisp/ert.el (should, should-not, should-error): Add edebug + declaration. + +2013-04-07 Leo Liu <sdl.web@gmail.com> + + * pcmpl-x.el: New file. + +2013-04-06 Dmitry Antipov <dmantipov@yandex.ru> + + Do not set x-display-name until X connection is established. + This is needed to prevent from weird situation described at + <http://lists.gnu.org/archive/html/emacs-devel/2013-04/msg00212.html>. + * frame.el (make-frame): Set x-display-name after call to + window system initialization function, not before. + * term/x-win.el (x-initialize-window-system): Add optional + display argument and use it. + * term/w32-win.el (w32-initialize-window-system): + * term/ns-win.el (ns-initialize-window-system): + * term/pc-win.el (msdos-initialize-window-system): + Add compatible optional display argument. + +2013-04-06 Eli Zaretskii <eliz@gnu.org> + + * files.el (normal-backup-enable-predicate): On MS-Windows and + MS-DOS compare truenames of temporary-file-directory and of the + file, so that 8+3 aliases (usually found in $TEMP on Windows) + don't fail comparison by compare-strings. Also, compare file + names case-insensitively on MS-Windows and MS-DOS. + +2013-04-05 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/package.el (package-compute-transaction): Fix last fix. + Suggested by Donald Curtis <dcurtis@coe.edu> (bug#14082). + +2013-04-05 Dmitry Gutov <dgutov@yandex.ru> + + * whitespace.el (whitespace-color-on, whitespace-color-off): + Only call `font-lock-fontify-buffer' when `font-lock-mode' is on. + +2013-04-05 Jacek ChrzÄ…szcz <chrzaszcz@mimuw.edu.pl> (tiny change) + + * ispell.el (ispell-set-spellchecker-params): + Really set `ispell-args' for all equivs. + +2013-04-05 Stefan Monnier <monnier@iro.umontreal.ca> + + * ido.el (ido-completions): Use extra elements of ido-decorations + (bug#14143). + (ido-decorations): Update docstring. + +2013-04-05 Michael Albinus <michael.albinus@gmx.de> + + * autorevert.el (auto-revert-mode, auto-revert-tail-mode) + (global-auto-revert-mode): Let-bind `auto-revert-use-notify' to + nil during initialization, in order not to miss changes since the + file was opened. (Bug#14140) + +2013-04-05 Leo Liu <sdl.web@gmail.com> + + * kmacro.el (kmacro-call-macro): Fix bug#14135. + +2013-04-05 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-units.el (calc-convert-units): Rewrite conditional. + +2013-04-04 Glenn Morris <rgm@gnu.org> + + * electric.el (electric-pair-inhibit-predicate): Add :version. + +2013-04-04 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/package.el (package-compute-transaction): Fix ordering + when a package is required several times (bug#14082). + +2013-04-04 Roland Winkler <winkler@gnu.org> + + * faces.el (read-face-name): Behave as promised by the docstring. + Assume that arg default is a list of faces. + (describe-face): Call read-face-name with list of default faces. + +2013-04-04 Thierry Volpiatto <thierry.volpiatto@gmail.com> + + * bookmark.el: Fix deletion of bookmarks (bug#13972). + (bookmark-bmenu-list): Don't toggle filenames if alist is empty. + (bookmark-bmenu-execute-deletions): Only skip first line if it's + the header. + (bookmark-exit-hook-internal): Save even if list is empty. + +2013-04-04 Yann Hodique <yann.hodique@gmail.com> (tiny change) + + * emacs-lisp/package.el (package-pinned-packages): New var. + (package--add-to-archive-contents): Obey it (bug#14118). + +2013-04-03 Alan Mackenzie <acm@muc.de> + + Handle `parse-partial-sexp' landing inside a comment opener (Bug#13244). + Also adapt to the new values of element 7 of a parse state. + + * progmodes/cc-engine.el (c-state-pp-to-literal): New optional + parameter `not-in-delimiter'. Handle being inside comment opener. + (c-invalidate-state-cache-1): Reckon with an extra "invalid" + character in case we're typing a '*' after a '/'. + (c-literal-limits): Handle the awkward "not-in-delimiter" cond arm + instead by passing the parameter to c-state-pp-to-literal. + + * progmodes/cc-fonts.el (c-font-lock-doc-comments): New handling + for elt. 7 of a parse state. + +2013-04-01 Paul Eggert <eggert@cs.ucla.edu> + + Use UTF-8 for most files with non-ASCII characters (Bug#13936). + * international/latin1-disp.el, international/mule-util.el: + * language/cyril-util.el, language/european.el, language/ind-util.el: + * language/lao-util.el, language/thai.el, language/tibet-util.el: + * language/tibetan.el, language/viet-util.el: + Switch from iso-2022-7bit to utf-8 or (if needed) utf-8-emacs. + +2013-04-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * electric.el (electric-pair-inhibit-predicate): New var (bug#14000). + (electric-pair-post-self-insert-function): Use it. + (electric-pair-default-inhibit): New function, extracted from + electric-pair-post-self-insert-function. + +2013-03-31 Roland Winkler <winkler@gnu.org> + + * emacs-lisp/crm.el (completing-read-multiple): Doc fix. + +2013-03-31 Stefan Monnier <monnier@iro.umontreal.ca> + + * hi-lock.el (hi-lock-mode): Cleanup after revert-buffer (bug#13891). + +2013-03-30 Fabián Ezequiel Gallina <fabian@anue.biz> + + Un-indent after "pass" and "return" statements (Bug#13888) + * progmodes/python.el (python-indent-block-enders): New var. + (python-indent-calculate-indentation): Use it. + +2013-03-30 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-drop-volume-letter): Make it an ordinary + defun. Defining it as defalias could introduce too eager + byte-compiler optimization. (Bug#14030) + +2013-03-30 Chong Yidong <cyd@gnu.org> + + * iswitchb.el (iswitchb-read-buffer): Fix typo. + +2013-03-30 Leo Liu <sdl.web@gmail.com> + + * kmacro.el (kmacro-call-macro): Add optional arg MACRO. + (kmacro-execute-from-register): Pass the keyboard macro to + kmacro-call-macro or repeating won't work correctly. + +2013-03-30 Teodor Zlatanov <tzz@lifelogs.com> + + * progmodes/subword.el: Back to using `forward-symbol'. + + * subr.el (forward-whitespace, forward-symbol) + (forward-same-syntax): Move from thingatpt.el. + +2013-03-29 Leo Liu <sdl.web@gmail.com> + + * kmacro.el (kmacro-to-register): New command. + (kmacro-execute-from-register): New function. + (kmacro-keymap): Bind to 'x'. (Bug#14071) + +2013-03-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * mpc.el: Use defvar-local and setq-local. + (mpc--proc-connect): Connection failures are not bugs. + (mpc-mode-map): `follow-link' only applies to the buffer's content. + (mpc-volume-map): Bind to the up-events. + +2013-03-29 Teodor Zlatanov <tzz@lifelogs.com> + + * progmodes/subword.el (superword-mode): Use `forward-sexp' + instead of `forward-symbol'. + +2013-03-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/edebug.el (edebug-mode): Make it a minor mode. + (edebug--recursive-edit): Use it. + (edebug-kill-buffer): Don't let-bind kill-buffer-hook. + (edebug-temp-display-freq-count): Don't let-bind buffer-read-only. + +2013-03-28 Leo Liu <sdl.web@gmail.com> + + * vc/vc-bzr.el (vc-bzr-revert): Don't backup. (Bug#14066) + +2013-03-27 Eli Zaretskii <eliz@gnu.org> + + * facemenu.el (list-colors-callback): New defvar. + (list-colors-redisplay): New function. + (list-colors-display): Install list-colors-redisplay as the + revert-buffer-function. (Bug#14063) + +2013-03-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * minibuffer.el (completion-pcm--merge-completions): Make sure prefixes + and suffixes don't overlap (bug#14061). + + * case-table.el: Use lexical-binding. + (case-table-get-table): New function. + (get-upcase-table): Use it. Mark as obsolete. Adjust callers. + +2013-03-27 Teodor Zlatanov <tzz@lifelogs.com> + + * progmodes/subword.el: Add `superword-mode' to do word motion + over symbol_words (parallels and leverages `subword-mode' which + does word motion inside MixedCaseWords). + +2013-03-27 Aidan Gauland <aidalgol@no8wireless.co.nz> + + * eshell/em-unix.el: Move su and sudo to... + * eshell/em-tramp.el: ...Eshell tramp module. + +2013-03-26 Stefan Monnier <monnier@iro.umontreal.ca> + + * desktop.el (desktop--v2s): Rename from desktop-internal-v2s. + Change return value to be a sexp. Delay `get-buffer' to after + restoring the desktop (bug#13951). + +2013-03-26 Leo Liu <sdl.web@gmail.com> + + * register.el: Move semantic tag handling back to + cedet/semantic/senator.el. (Bug#14052) + +2013-03-26 Stefan Monnier <monnier@iro.umontreal.ca> + + * eshell/em-prompt.el (eshell-emit-prompt): Make sure we can't insert + into the prompt either (bug#13963). + +2013-03-25 Stefan Monnier <monnier@iro.umontreal.ca> + + * font-lock.el (lisp-font-lock-keywords-2): Don't highlight the "error" + part of "(error-foo)". + +2013-03-24 Juri Linkov <juri@jurta.org> + + * replace.el (list-matching-lines-prefix-face): New defcustom. + (occur-1): Pass `list-matching-lines-prefix-face' to the function + `occur-engine' if `face-differs-from-default-p' returns t. + (occur-engine): Add `,' inside backquote construct to evaluate + `prefix-face'. Propertize the prefix with the `prefix-face' face. + Pass `prefix-face' to the functions `occur-context-lines' and + `occur-engine-add-prefix'. + (occur-engine-add-prefix, occur-context-lines): Add optional arg + `prefix-face' and propertize the prefix with `prefix-face'. + (Bug#14017) + +2013-03-24 Leo Liu <sdl.web@gmail.com> + + * nxml/rng-valid.el (rng-validate-while-idle) + (rng-validate-quick-while-idle): Guard against deleted buffer. + (Bug#13999) + + * emacs-lisp/edebug.el (edebug-mode): Make sure edebug-kill-buffer + is the last entry in kill-buffer-hook. + + * files.el (kill-buffer-hook): Doc fix. + +2013-03-23 Dmitry Gutov <dgutov@yandex.ru> + + * emacs-lisp/lisp-mode.el (emacs-lisp-docstring-fill-column): + Make it safe-local. + + * vc/diff-mode.el (diff-mode-shared-map): Unbind "/" (Bug#14034). + +2013-03-23 Leo Liu <sdl.web@gmail.com> + + * nxml/nxml-util.el (nxml-with-unmodifying-text-property-changes): + Remove. + + * nxml/rng-valid.el (rng-validate-mode) + (rng-after-change-function, rng-do-some-validation): + * nxml/rng-maint.el (rng-validate-buffer): + * nxml/nxml-rap.el (nxml-tokenize-forward, nxml-ensure-scan-up-to-date): + * nxml/nxml-outln.el (nxml-show-all, nxml-set-outline-state): + * nxml/nxml-mode.el (nxml-mode, nxml-degrade, nxml-after-change) + (nxml-extend-after-change-region): Use with-silent-modifications. + + * nxml/rng-nxml.el (rng-set-state-after): Do not let-bind + timer-idle-list. + + * nxml/rng-valid.el (rng-validate-while-idle-continue-p) + (rng-next-error-1, rng-previous-error-1): Do not let-bind + timer-idle-list. (Bug#13999) + +2013-03-23 Juri Linkov <juri@jurta.org> + + * info.el (info-index-match): New face. + (Info-index, Info-apropos-matches): Add a nested subgroup to the + main pattern and add text properties with the new face to matches + in index entries relative to the beginning of the index entry. + (Bug#14015) + +2013-03-21 Eric Ludlam <zappo@gnu.org> + + * eieio/eieio-datadebug.el (data-debug/eieio-insert-slots): + Inhibit read only while inserting objects. + +2013-03-22 Teodor Zlatanov <tzz@lifelogs.com> + + * progmodes/cfengine.el: Update docs to mention + `cfengine-auto-mode'. Use \_> and \_< instead of \> and \< for + symbol motion. Remove "_" from the word syntax. + +2013-03-21 Teodor Zlatanov <tzz@lifelogs.com> + + * progmodes/cfengine.el (cfengine-common-syntax): Add "_" to word + syntax for both `cfengine2-mode' and `cfengine3-mode'. + +2013-03-20 Juri Linkov <juri@jurta.org> + + * info.el (Info-next-reference-or-link) + (Info-prev-reference-or-link): New functions. + (Info-next-reference, Info-prev-reference): Use them. + (Info-try-follow-nearest-node): Handle footnote navigation. + (Info-fontify-node): Fontify footnotes. (Bug#13989) + +2013-03-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (posn-point, posn-string): Fix it here instead (bug#13979). + * mouse.el (mouse-on-link-p): Undo scroll-bar fix. + +2013-03-20 Paul Eggert <eggert@cs.ucla.edu> + + Suppress unnecessary non-ASCII chatter during build process. + * international/ja-dic-cnv.el (skkdic-collect-okuri-nasi) + (batch-skkdic-convert): Suppress most of the chatter. + It's not needed so much now that machines are faster, + and its non-ASCII component was confusing; see Dmitry Gutov in + <http://lists.gnu.org/archive/html/emacs-devel/2013-03/msg00508.html>. + +2013-03-20 Leo Liu <sdl.web@gmail.com> + + * ido.el (ido-chop): Fix bug#10994. + +2013-03-19 Dmitry Gutov <dgutov@yandex.ru> + + * whitespace.el (whitespace-font-lock, whitespace-font-lock-mode): + Remove vars. + (whitespace-color-on, whitespace-color-off): + Use `font-lock-fontify-buffer' (Bug#13817). + +2013-03-19 Stefan Monnier <monnier@iro.umontreal.ca> + + * mouse.el (mouse--down-1-maybe-follows-link): Fix follow-link + remapping in mode-line. + (mouse-on-link-p): Also check [mode-line follow-link] bindings. + +2013-03-19 Dmitry Gutov <dgutov@yandex.ru> + + * whitespace.el (whitespace-color-on): Use `prepend' OVERRIDE + value for `whitespace-line' face (Bug#13875). + (whitespace-font-lock-keywords): Change description. + (whitespace-color-on): Don't save `font-lock-keywords' value, save + the constructed keywords instead. + (whitespace-color-off): Use `font-lock-remove-keywords' (Bug#13817). + +2013-03-19 Leo Liu <sdl.web@gmail.com> + + * progmodes/compile.el (compilation-display-error): New command. + (compilation-mode-map, compilation-minor-mode-map): Bind it to + C-o. (Bug#13992) + +2013-03-18 Paul Eggert <eggert@cs.ucla.edu> + + * term/x-win.el (x-keysym-pair): Add a Fixme (Bug#13936). + +2013-03-18 Jan Djärv <jan.h.d@swipnet.se> + + * mouse.el (mouse-on-link-p): Check for scroll bar (Bug#13979). + +2013-03-18 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-compat.el (tramp-compat-user-error): New defun. + + * net/tramp-adb.el (tramp-adb-handle-shell-command): + * net/tramp-gvfs.el (top): + * net/tramp.el (tramp-find-method, tramp-dissect-file-name) + (tramp-handle-shell-command): Use it. + (tramp-dissect-file-name): Raise an error when hostname is a + method name, and neither method nor user is specified. + + * net/trampver.el: Update release number. + +2013-03-18 Leo Liu <sdl.web@gmail.com> + + Make sure eldoc can be turned off properly. + * emacs-lisp/eldoc.el (eldoc-schedule-timer): Conditionalize on + eldoc-mode. + (eldoc-display-message-p): Revert last change. + (eldoc-display-message-no-interference-p) + (eldoc-print-current-symbol-info): Tweak. + +2013-03-18 Tassilo Horn <tsdh@gnu.org> + + * doc-view.el (doc-view-new-window-function): Check the new window + overlay's display property instead the char property of the + buffer's first char. Use `with-selected-window' instead of + `save-window-excursion' with `select-window'. + (doc-view-document->bitmap): Check the current doc-view overlay's + display property instead the char property of the buffer's first char. + +2013-03-18 Paul Eggert <eggert@cs.ucla.edu> + + Automate the build of ja-dic.el (Bug#13984). + * international/ja-dic-cnv.el (skkdic-convert): Remove the annotations + from the input, rather than assume that it's been done for us by the + SKK script unannotate.awk. Switch ja-dic.el to UTF-8. Don't put + the current date into a ja-dic.el comment, as that complicates + regression testing. + +2013-03-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * whitespace.el: Fix double evaluation. + (whitespace-space, whitespace-hspace, whitespace-tab) + (whitespace-newline, whitespace-trailing, whitespace-line) + (whitespace-space-before-tab, whitespace-indentation) + (whitespace-empty, whitespace-space-after-tab): Turn defcustoms into + obsolete defvars. + (whitespace-hspace-regexp): Fix regexp for emacs-unicode. + (whitespace-color-on): Use a single font-lock-add-keywords call. + Fix double-evaluation of face variables. + +2013-03-17 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-adb.el (tramp-adb-parse-device-names): + Use `start-process' instead of `call-process'. Otherwise, the + function might be blocked under MS Windows. (Bug#13299) + +2013-03-17 Leo Liu <sdl.web@gmail.com> + + Extend eldoc to display info in the mode-line. (Bug#13978) + * emacs-lisp/eldoc.el (eldoc-post-insert-mode): New minor mode. + (eldoc-mode-line-string): New variable. + (eldoc-minibuffer-message): New function. + (eldoc-message-function): New variable. + (eldoc-message): Use it. + (eldoc-display-message-p) + (eldoc-display-message-no-interference-p): + Support eldoc-post-insert-mode. + + * simple.el (eval-expression-minibuffer-setup-hook): New hook. + (eval-expression): Run it. + 2013-03-17 Roland Winkler <winkler@gnu.org> * emacs-lisp/crm.el (completing-read-multiple): Ignore empty @@ -22,10 +2877,6 @@ * thingatpt.el (end-of-sexp): Fix bug#13952. Use syntax-after. -2013-03-16 Glenn Morris <rgm@gnu.org> - - * Version 24.3 released. - 2013-03-16 Eli Zaretskii <eliz@gnu.org> * startup.el (command-line-normalize-file-name): Fix handling of @@ -286,7 +3137,7 @@ 2013-03-08 Jambunathan K <kjambunathan@gmail.com> * hi-lock.el (hi-lock-read-regexp-defaults-function): New var. - (hi-lock-read-regexp-defaults): New defun. + (hi-lock-read-regexp-defaults): New defun. (hi-lock-line-face-buffer, hi-lock-face-buffer) (hi-lock-face-phrase-buffer): Propagate above change. Update docstring (bug#13892). @@ -764,6 +3615,10 @@ * emacs-lisp/eieio-opt.el (eieio-class-button, eieio-describe-generic) (eieio-browse-tree, eieio-browse): Use eieio--check-type. +2013-02-18 Aidan Gauland <aidalgol@no8wireless.co.nz> + + * eshell/em-cmpl.el: Correct "context-related help" keybinding in + commentary. 2013-02-18 Michael Heerdegen <michael_heerdegen@web.de> @@ -966,7 +3821,7 @@ [scpc, rsyncc]: Remove methods. (top): Remove completion functions for "scpc", "rsyncc", "ssh1_old" and "ssh2_old". - (tramp-do-copy-or-rename-file-out-of-band): Change trace level. + (tramp-do-copy-or-rename-file-out-of-band): Change trace level. (tramp-maybe-open-connection): Reuse tmpfile for ControlPath. 2013-02-13 Stefan Monnier <monnier@iro.umontreal.ca> @@ -975,7 +3830,7 @@ 2013-02-13 Jambunathan K <kjambunathan@gmail.com> - * icomplete.el (icomplete-hide-common-prefix): New user option. + * icomplete.el (icomplete-hide-common-prefix): New user option. (icomplete-first-match): New face. (icomplete-completions): Correct handling of "complete but not unique" (Bug#12638). @@ -1258,7 +4113,7 @@ instead passing extra parameter HERE to several functions. Remove 'BOD strategy. -2013-02-06 Nicolas Richard <theonewiththeevillook@yahoo.fr> (tiny change) +2013-02-06 Nicolas Richard <theonewiththeevillook@yahoo.fr> (tiny change) * emacs-lisp/package.el (describe-package-1): Tell what archive is used to install the package. @@ -1650,7 +4505,7 @@ * xml.el (xml-entity-or-char-ref-re): Fix regexp. -2013-01-24 Aaron Ecay <aaronecay@gmail.com> (tiny change) +2013-01-24 Aaron Ecay <aaronecay@gmail.com> (tiny change) * paren.el (show-paren-function): Make sure to set 'priority and 'face only if the overlay does exist. @@ -1810,7 +4665,7 @@ 2013-01-15 Michael R. Mauger <mmaug@yahoo.com> - * progmodes/sql.el: (sql-imenu-generic-expression): + * progmodes/sql.el (sql-imenu-generic-expression): (sql-mode-font-lock-object-name): Match schema qualified names. (sql-connect): Use string keys. (sql-product-interactive): Wait for interpreter prompt. @@ -2429,7 +5284,7 @@ * calc/calc-forms.el (math-parse-date): Try using `math-parse-iso-date' when it looks like it might be needed. Allow times of 24:00. - (math-parse-date-validate, math-parse-iso-date-validate): Allow times + (math-parse-date-validate, math-parse-iso-date-validate): Allow times of 24:00. 2012-12-30 Glenn Morris <rgm@gnu.org> @@ -2592,7 +5447,7 @@ (tramp-adb-get-toolbox): New defun. Check for remote shell implementation (BusyBox or Toolbox). -2012-12-24 Constantin Kulikov <zxnotdead@gmail.com> (tiny change) +2012-12-24 Constantin Kulikov <zxnotdead@gmail.com> (tiny change) * startup.el (initial-buffer-choice): Allow function as value (Bug#13251). @@ -2739,7 +5594,7 @@ Add `file-acl' and `set-file-acl' handlers. (tramp-smb-handle-copy-file): Handle PRESERVE-EXTENDED-ATTRIBUTES. -2012-12-17 Kelly Dean <kellydeanch@yahoo.com> (tiny change) +2012-12-17 Kelly Dean <kellydeanch@yahoo.com> (tiny change) * help-macro.el (make-help-screen): Instead of switch-to-buffer use pop-to-buffer with NORECORD argument t. As buffer name, use @@ -2940,7 +5795,7 @@ 2012-12-11 Jay Belanger <jay.p.belanger@gmail.com> - * calc/calc.el (calc-standard-date-formats): Add more date + * calc/calc.el (calc-standard-date-formats): Add more date formats. * calc/calc-forms.el (math-parse-iso-date): New function. (math-parse-date): Use `math-parse-iso-date' when appropriate. @@ -2974,7 +5829,7 @@ * subr.el (inotify-event-p, inotify-handle-event): New functions. -2012-12-10 Dani Moncayo <dmoncayo@gmail.com> +2012-12-10 Dani Moncayo <dmoncayo@gmail.com> * simple.el (just-one-space): Doc fix. @@ -3812,7 +6667,7 @@ 2012-11-19 Jay Belanger <jay.p.belanger@gmail.com> - * calc/calc-forms.el (math-leap-year-p): Fix formula for negative + * calc/calc-forms.el (math-leap-year-p): Fix formula for negative year numbers. (math-date-to-julian-dt): Adjust the initial approximation for the year to deal with the new definition of the DATE. @@ -4897,7 +7752,7 @@ Recover input meta mode when the new coding system doesn not use 8-bit. Supply TERMINAL arg to set-input-meta-mode. -2012-10-17 Michael Heerdegen <michael_heerdegen@web.de> +2012-10-17 Michael Heerdegen <michael_heerdegen@web.de> * wdired.el (wdired-old-marks): New variable. (wdired-change-to-wdired-mode): Locally set wdired-old-marks. @@ -5179,7 +8034,7 @@ * term/ns-win.el (ns-read-file-name): Update declaration to match nsfns.m. - (ns-respond-to-change-font): Change fontsize separatly so we are sure + (ns-respond-to-change-font): Change fontsize separately so we are sure it is set when font is acted upon. 2012-10-07 Fabián Ezequiel Gallina <fgallina@cuca> diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10 index 641ab617043..2d331a2819d 100644 --- a/lisp/ChangeLog.10 +++ b/lisp/ChangeLog.10 @@ -19493,7 +19493,7 @@ * menu-bar.el (menu-bar-showhide-scroll-bar-menu): Quote `window-system'. - * tmm.el (tmm-get-keymap): Honour :visible in `menu-item'. + * tmm.el (tmm-get-keymap): Honor :visible in `menu-item'. Add Keywords header. Update Commentary section. Update copyright notice. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 1e701df348f..4884213daeb 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -24,6 +24,10 @@ abs_top_builddir = @abs_top_builddir@ lisp = $(srcdir) VPATH = $(srcdir) +# Empty for all systems except MinGW, where xargs needs an explicit +# limitation. +XARGS_LIMIT = @XARGS_LIMIT@ + # You can specify a different executable on the make command line, # e.g. "make EMACS=../src/emacs ...". @@ -160,21 +164,21 @@ $(lisp)/cus-load.el: custom-deps: doit cd $(lisp); $(setwins_almost); \ echo Directories: $$wins; \ - $(emacs) -l cus-dep --eval '(setq generated-custom-dependencies-file "$(lisp)/cus-load.el")' -f custom-make-dependencies $$wins + $(emacs) -l cus-dep --eval '(setq generated-custom-dependencies-file (unmsys--file-name "$(lisp)/cus-load.el"))' -f custom-make-dependencies $$wins $(lisp)/finder-inf.el: $(MAKE) $(MFLAGS) finder-data finder-data: doit cd $(lisp); $(setwins_almost); \ echo Directories: $$wins; \ - $(emacs) -l finder --eval '(setq generated-finder-keywords-file "$(lisp)/finder-inf.el")' -f finder-compile-keywords-make-dist $$wins + $(emacs) -l finder --eval '(setq generated-finder-keywords-file (unmsys--file-name "$(lisp)/finder-inf.el"))' -f finder-compile-keywords-make-dist $$wins # The chmod +w is to handle env var CVSREAD=1. autoloads: $(LOADDEFS) doit cd $(lisp) && chmod +w $(AUTOGEN_VCS) cd $(lisp); $(setwins_almost); \ echo Directories: $$wins; \ - $(emacs) -l autoload --eval '(setq generated-autoload-file "$(lisp)/loaddefs.el")' -f batch-update-autoloads $$wins + $(emacs) -l autoload --eval '(setq generated-autoload-file (unmsys--file-name "$(lisp)/loaddefs.el"))' -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. @@ -274,7 +278,7 @@ compile-main: compile-clean test -f $$el || continue; \ test ! -f $${el}c && GREP_OPTIONS= grep '^;.*no-byte-compile: t' $$el > /dev/null && continue; \ echo "$${el}c"; \ - done | xargs echo) | \ + done | xargs $(XARGS_LIMIT) echo) | \ while read chunk; do \ $(MAKE) $(MFLAGS) compile-targets EMACS="$(EMACS)" TARGETS="$$chunk"; \ done @@ -369,7 +373,7 @@ mh-autoloads: $(MH_E_DIR)/mh-loaddefs.el $(MH_E_DIR)/mh-loaddefs.el: $(MH_E_SRC) $(emacs) -l autoload \ --eval "(setq generate-autoload-cookie \";;;###mh-autoload\")" \ - --eval "(setq generated-autoload-file \"$@\")" \ + --eval "(setq generated-autoload-file (unmsys--file-name \"$@\"))" \ --eval "(setq make-backup-files nil)" \ -f batch-update-autoloads $(MH_E_DIR) @@ -387,7 +391,7 @@ TRAMP_SRC = $(TRAMP_DIR)/tramp.el $(TRAMP_DIR)/tramp-adb.el \ $(TRAMP_DIR)/tramp-loaddefs.el: $(TRAMP_SRC) $(emacs) -l autoload \ --eval "(setq generate-autoload-cookie \";;;###tramp-autoload\")" \ - --eval "(setq generated-autoload-file \"$@\")" \ + --eval "(setq generated-autoload-file (unmsys--file-name \"$@\"))" \ --eval "(setq make-backup-files nil)" \ -f batch-update-autoloads $(TRAMP_DIR) @@ -409,21 +413,21 @@ CAL_SRC = $(CAL_DIR)/cal-bahai.el $(CAL_DIR)/cal-china.el \ $(CAL_DIR)/cal-loaddefs.el: $(CAL_SRC) $(emacs) -l autoload \ --eval "(setq generate-autoload-cookie \";;;###cal-autoload\")" \ - --eval "(setq generated-autoload-file \"$@\")" \ + --eval "(setq generated-autoload-file (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 \ --eval "(setq generate-autoload-cookie \";;;###diary-autoload\")" \ - --eval "(setq generated-autoload-file \"$@\")" \ + --eval "(setq generated-autoload-file (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 \ --eval "(setq generate-autoload-cookie \";;;###holiday-autoload\")" \ - --eval "(setq generated-autoload-file \"$@\")" \ + --eval "(setq generated-autoload-file (unmsys--file-name \"$@\"))" \ --eval "(setq make-backup-files nil)" \ -f batch-update-autoloads $(CAL_DIR) @@ -433,7 +437,7 @@ bootstrap-clean: cd $(lisp); rm -f *.elc */*.elc */*/*.elc */*/*/*.elc $(AUTOGENEL) distclean: - -rm -f ./Makefile + -rm -f ./Makefile $(lisp)/loaddefs.el~ maintainer-clean: distclean bootstrap-clean diff --git a/lisp/abbrev.el b/lisp/abbrev.el index bd09653103f..27cd7089a07 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -532,7 +532,7 @@ This is the first thing that `expand-abbrev' does, and so this may change the current abbrev table before abbrev lookup happens." :type 'hook :group 'abbrev-mode) -(make-obsolete-variable 'pre-abbrev-expand-hook 'abbrev-expand-functions "23.1") +(make-obsolete-variable 'pre-abbrev-expand-hook 'abbrev-expand-function "23.1") (defun clear-abbrev-table (table) "Undefine all abbrevs in abbrev table TABLE, leaving it empty." @@ -669,6 +669,26 @@ either a single abbrev table or a list of abbrev tables." tables)))) +(defun abbrev--symbol (abbrev table) + "Return the symbol representing abbrev named ABBREV in TABLE. +This symbol's name is ABBREV, but it is not the canonical symbol of that name; +it is interned in the abbrev-table TABLE rather than the normal obarray. +The value is nil if that abbrev is not defined." + (let* ((case-fold (not (abbrev-table-get table :case-fixed))) + ;; In case the table doesn't set :case-fixed but some of the + ;; abbrevs do, we have to be careful. + (sym + ;; First try without case-folding. + (or (intern-soft abbrev table) + (when case-fold + ;; We didn't find any abbrev, try case-folding. + (let ((sym (intern-soft (downcase abbrev) table))) + ;; Only use it if it doesn't require :case-fixed. + (and sym (not (abbrev-get sym :case-fixed)) + sym)))))) + (if (symbol-value sym) + sym))) + (defun abbrev-symbol (abbrev &optional table) "Return the symbol representing abbrev named ABBREV. This symbol's name is ABBREV, but it is not the canonical symbol of that name; @@ -678,23 +698,11 @@ Optional second arg TABLE is abbrev table to look it up in. The default is to try buffer's mode-specific abbrev table, then global table." (let ((tables (abbrev--active-tables table)) sym) - (while (and tables (not (symbol-value sym))) - (let* ((table (pop tables)) - (case-fold (not (abbrev-table-get table :case-fixed)))) + (while (and tables (not sym)) + (let* ((table (pop tables))) (setq tables (append (abbrev-table-get table :parents) tables)) - ;; In case the table doesn't set :case-fixed but some of the - ;; abbrevs do, we have to be careful. - (setq sym - ;; First try without case-folding. - (or (intern-soft abbrev table) - (when case-fold - ;; We didn't find any abbrev, try case-folding. - (let ((sym (intern-soft (downcase abbrev) table))) - ;; Only use it if it doesn't require :case-fixed. - (and sym (not (abbrev-get sym :case-fixed)) - sym))))))) - (if (symbol-value sym) - sym))) + (setq sym (abbrev--symbol abbrev table)))) + sym)) (defun abbrev-expansion (abbrev &optional table) @@ -748,7 +756,7 @@ then ABBREV is looked up in that table only." (setq start (match-beginning 1)) (setq end (match-end 1))))) (setq name (buffer-substring start end)) - (let ((abbrev (abbrev-symbol name table))) + (let ((abbrev (abbrev--symbol name table))) (when abbrev (setq enable-fun (abbrev-get abbrev :enable-function)) (and (or (not enable-fun) (funcall enable-fun)) @@ -824,10 +832,12 @@ see `define-abbrev' for details." value)) (defvar abbrev-expand-functions nil - "Wrapper hook around `expand-abbrev'. -The functions on this special hook are called with one argument: -a function that performs the abbrev expansion. It should return -the abbrev symbol if expansion took place.") + "Wrapper hook around `expand-abbrev'.") +(make-obsolete-variable 'abbrev-expand-functions 'abbrev-expand-function "24.4") + +(defvar abbrev-expand-function #'abbrev--default-expand + "Function to perform abbrev expansion. +Takes no argument and should return the abbrev symbol if expansion took place.") (defun expand-abbrev () "Expand the abbrev before point, if there is an abbrev there. @@ -836,6 +846,9 @@ Returns the abbrev symbol, if expansion took place. (The actual return value is that of `abbrev-insert'.)" (interactive) (run-hooks 'pre-abbrev-expand-hook) + (funcall abbrev-expand-function)) + +(defun abbrev--default-expand () (with-wrapper-hook abbrev-expand-functions () (pcase-let ((`(,sym ,name ,wordstart ,wordend) (abbrev--before-point))) (when sym diff --git a/lisp/allout.el b/lisp/allout.el index 9ca72514fd2..5a9b03b7a0e 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -77,11 +77,6 @@ ;;;_* Dependency loads (require 'overlay) (eval-when-compile - ;; Most of the requires here are for stuff covered by autoloads, which - ;; byte-compiling doesn't trigger. - (require 'epg) - (require 'epa) - (require 'overlay) ;; `cl' is required for `assert'. `assert' is not covered by a standard ;; autoload, but it is a macro, so that eval-when-compile is sufficient ;; to byte-compile it in, or to do the require when the buffer evalled. @@ -6046,6 +6041,16 @@ See `allout-toggle-current-subtree-encryption' for more details." (run-hook-with-args 'allout-structure-added-functions bullet-pos subtree-end)))) + +(declare-function epg-context-set-passphrase-callback "epg" + (context passphrase-callback)) +(declare-function epg-list-keys "epg" (context &optional name mode)) +(declare-function epg-decrypt-string "epg" (context cipher)) +(declare-function epg-encrypt-string "epg" + (context plain recipients &optional sign always-trust)) +(declare-function epg-user-id-string "epg" (user-id)) +(declare-function epg-key-user-id-list "epg" (key)) + ;;;_ > allout-encrypt-string (text decrypt allout-buffer keymode-cue ;;; &optional rejected) (defun allout-encrypt-string (text decrypt allout-buffer keymode-cue diff --git a/lisp/autorevert.el b/lisp/autorevert.el index a2d70c37762..90dda93a166 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -271,7 +271,7 @@ This variable becomes buffer local when set in any fashion.") :version "24.4") (defconst auto-revert-notify-enabled - (or (featurep 'inotify) (featurep 'w32notify)) + (or (featurep 'gfilenotify) (featurep 'inotify) (featurep 'w32notify)) "Non-nil when Emacs has been compiled with file notification support.") (defcustom auto-revert-use-notify auto-revert-notify-enabled @@ -367,8 +367,9 @@ without being changed in the part that is already in the buffer." (delq (current-buffer) auto-revert-buffer-list))) (auto-revert-set-timer) (when auto-revert-mode - (auto-revert-buffers) - (setq auto-revert-tail-mode nil))) + (let (auto-revert-use-notify) + (auto-revert-buffers) + (setq auto-revert-tail-mode nil)))) ;;;###autoload @@ -422,7 +423,8 @@ Use `auto-revert-mode' for changes other than appends!" (y-or-n-p "File changed on disk, content may be missing. \ Perform a full revert? ") ;; Use this (not just revert-buffer) for point-preservation. - (auto-revert-handler)) + (let (auto-revert-use-notify) + (auto-revert-handler))) ;; else we might reappend our own end when we save (add-hook 'before-save-hook (lambda () (auto-revert-tail-mode 0)) nil t) (or (local-variable-p 'auto-revert-tail-pos) ; don't lose prior position @@ -467,7 +469,8 @@ specifies in the mode line." :global t :group 'auto-revert :lighter global-auto-revert-mode-text (auto-revert-set-timer) (if global-auto-revert-mode - (auto-revert-buffers) + (let (auto-revert-use-notify) + (auto-revert-buffers)) (dolist (buf (buffer-list)) (with-current-buffer buf (when auto-revert-use-notify @@ -499,9 +502,12 @@ will use an up-to-date value of `auto-revert-interval'" (puthash key value auto-revert-notify-watch-descriptor-hash-list) (remhash key auto-revert-notify-watch-descriptor-hash-list) (ignore-errors - (funcall (if (fboundp 'inotify-rm-watch) - 'inotify-rm-watch 'w32notify-rm-watch) - auto-revert-notify-watch-descriptor))))) + (funcall + (cond + ((fboundp 'gfile-rm-watch) 'gfile-rm-watch) + ((fboundp 'inotify-rm-watch) 'inotify-rm-watch) + ((fboundp 'w32notify-rm-watch) 'w32notify-rm-watch)) + auto-revert-notify-watch-descriptor))))) auto-revert-notify-watch-descriptor-hash-list) (remove-hook 'kill-buffer-hook 'auto-revert-notify-rm-watch)) (setq auto-revert-notify-watch-descriptor nil @@ -516,11 +522,18 @@ will use an up-to-date value of `auto-revert-interval'" (when (and buffer-file-name auto-revert-use-notify (not auto-revert-notify-watch-descriptor)) - (let ((func (if (fboundp 'inotify-add-watch) - 'inotify-add-watch 'w32notify-add-watch)) - (aspect (if (fboundp 'inotify-add-watch) - '(create modify moved-to) '(size last-write-time))) - (file (if (fboundp 'inotify-add-watch) + (let ((func + (cond + ((fboundp 'gfile-add-watch) 'gfile-add-watch) + ((fboundp 'inotify-add-watch) 'inotify-add-watch) + ((fboundp 'w32notify-add-watch) 'w32notify-add-watch))) + (aspect + (cond + ((fboundp 'gfile-add-watch) '(watch-mounts)) + ;; `attrib' is needed for file modification time. + ((fboundp 'inotify-add-watch) '(attrib create modify moved-to)) + ((fboundp 'w32notify-add-watch) '(size last-write-time)))) + (file (if (or (fboundp 'gfile-add-watch) (fboundp 'inotify-add-watch)) (directory-file-name (expand-file-name default-directory)) (buffer-file-name)))) (setq auto-revert-notify-watch-descriptor @@ -541,10 +554,13 @@ will use an up-to-date value of `auto-revert-interval'" (defun auto-revert-notify-event-p (event) "Check that event is a file notification event." - (cond ((featurep 'inotify) - (and (listp event) (= (length event) 4))) - ((featurep 'w32notify) - (and (listp event) (= (length event) 3) (stringp (nth 2 event)))))) + (and (listp event) + (cond ((featurep 'gfilenotify) + (and (>= (length event) 3) (stringp (nth 2 event)))) + ((featurep 'inotify) + (= (length event) 4)) + ((featurep 'w32notify) + (and (= (length event) 3) (stringp (nth 2 event))))))) (defun auto-revert-notify-event-descriptor (event) "Return watch descriptor of file notification event, or nil." @@ -557,7 +573,8 @@ will use an up-to-date value of `auto-revert-interval'" (defun auto-revert-notify-event-file-name (event) "Return file name of file notification event, or nil." (and (auto-revert-notify-event-p event) - (cond ((featurep 'inotify) (nth 3 event)) + (cond ((featurep 'gfilenotify) (nth 2 event)) + ((featurep 'inotify) (nth 3 event)) ((featurep 'w32notify) (nth 2 event))))) (defun auto-revert-notify-handler (event) @@ -572,11 +589,18 @@ will use an up-to-date value of `auto-revert-interval'" ;; Check, that event is meant for us. ;; TODO: Filter events which stop watching, like `move' or `removed'. (cl-assert descriptor) - (when (featurep 'inotify) - (cl-assert (or (memq 'create action) + (cond + ((featurep 'gfilenotify) + (cl-assert (or (eq 'attribute-changed action) + (eq 'changed action) + (eq 'created action) + (eq 'deleted action)))) + ((featurep 'inotify) + (cl-assert (or (memq 'attrib action) + (memq 'create action) (memq 'modify action) (memq 'moved-to action)))) - (when (featurep 'w32notify) (cl-assert (eq 'modified action))) + ((featurep 'w32notify) (cl-assert (eq 'modified action)))) ;; Since we watch a directory, a file name must be returned. (cl-assert (stringp file)) (dolist (buffer buffers) diff --git a/lisp/bindings.el b/lisp/bindings.el index 5c95bcd0baa..2013c079820 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -675,7 +675,7 @@ language you are using." (garbage-collect) -(setq help-event-list '(help f1)) +(setq help-event-list '(help f1 ?\?)) (make-variable-buffer-local 'minor-mode-overriding-map-alist) @@ -894,6 +894,7 @@ if `inhibit-field-text-motion' is non-nil." (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) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 47e13799625..cab81c3b135 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -170,7 +170,7 @@ A non-nil value may result in truncated bookmark names." (defcustom bookmark-search-delay 0.2 "Time before `bookmark-bmenu-search' updates the display." :group 'bookmark - :type 'integer) + :type 'number) (defface bookmark-menu-heading '((t (:inherit font-lock-type-face))) @@ -427,8 +427,8 @@ just return it." "Prompting with PROMPT, read a bookmark name in completion. PROMPT will get a \": \" stuck on the end no matter what, so you probably don't want to include one yourself. -Optional second arg DEFAULT is a string to return if the user enters -the empty string." +Optional arg DEFAULT is a string to return if the user input is empty. +If DEFAULT is nil then return empty string for empty input." (bookmark-maybe-load-default-file) ; paranoia (if (listp last-nonmenu-event) (bookmark-menu-popup-paned-menu t prompt @@ -437,22 +437,17 @@ the empty string." 'string-lessp) (bookmark-all-names))) (let* ((completion-ignore-case bookmark-completion-ignore-case) - (default default) + (default (unless (equal "" default) default)) (prompt (concat prompt (if default (format " (%s): " default) - ": "))) - (str - (completing-read prompt - (lambda (string pred action) - (if (eq action 'metadata) - '(metadata (category . bookmark)) - (complete-with-action - action bookmark-alist string pred))) - nil - 0 - nil - 'bookmark-history))) - (if (string-equal "" str) default str)))) + ": ")))) + (completing-read prompt + (lambda (string pred action) + (if (eq action 'metadata) + '(metadata (category . bookmark)) + (complete-with-action + action bookmark-alist string pred))) + nil 0 nil 'bookmark-history default)))) (defmacro bookmark-maybe-historicize-string (string) @@ -1582,8 +1577,8 @@ deletion, or > if it is flagged for displaying." (if bookmark-bmenu-use-header-line (bookmark-bmenu-set-header) (forward-line bookmark-bmenu-inline-header-height)) - (if bookmark-bmenu-toggle-filenames - (bookmark-bmenu-toggle-filenames t)))) + (when (and bookmark-alist bookmark-bmenu-toggle-filenames) + (bookmark-bmenu-toggle-filenames t)))) ;;;###autoload (defalias 'list-bookmarks 'bookmark-bmenu-list) @@ -1998,7 +1993,8 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\ (progn (end-of-line) (point)))))) (o-col (current-column))) (goto-char (point-min)) - (forward-line 1) + (unless bookmark-bmenu-use-header-line + (forward-line 1)) (while (re-search-forward "^D" (point-max) t) (bookmark-delete (bookmark-bmenu-bookmark) t)) ; pass BATCH arg (bookmark-bmenu-list) @@ -2186,8 +2182,7 @@ strings returned are not." "Save bookmark state, if necessary, at Emacs exit time. This also runs `bookmark-exit-hook'." (run-hooks 'bookmark-exit-hook) - (and bookmark-alist - (bookmark-time-to-save-p t) + (and (bookmark-time-to-save-p t) (bookmark-save))) (unless noninteractive diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index ae0230633af..6b0cfbb55d9 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el @@ -42,7 +42,7 @@ (declare-function math-simplify "calc-alg" (top-expr)) (declare-function math-known-matrixp "calc-arith" (a)) (declare-function math-parse-fortran-subscr "calc-lang" (sym args)) -(declare-function math-to-radians-2 "calc-math" (a)) +(declare-function math-to-radians-2 "calc-math" (a &optional force-symbolic)) (declare-function math-read-string "calc-ext" ()) (declare-function math-read-brackets "calc-vec" (space-sep math-rb-close)) (declare-function math-read-angle-brackets "calc-forms" ()) diff --git a/lisp/calc/calc-menu.el b/lisp/calc/calc-menu.el index ee98cc98c8f..5120528eaf4 100644 --- a/lisp/calc/calc-menu.el +++ b/lisp/calc/calc-menu.el @@ -1634,7 +1634,9 @@ (Info-goto-node "Help Commands"))]) "Menu for Calc's help functions.") -(defvar calc-mode-map) +;; Needed to make this file loadable in isolation. +;; Another option would be to use calc-load-hook. +(require 'calc) (easy-menu-define calc-menu diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index 335980af4dd..595d875eb6e 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -437,7 +437,7 @@ If COMP or STD is non-nil, put that in the units table instead." (list new-units (car default-units)) math-default-units-table)))))) -(defvar calc-allow-units-as-numbers) +(defvar calc-allow-units-as-numbers t) (defun calc-convert-units (&optional old-units new-units) (interactive) @@ -451,7 +451,9 @@ If COMP or STD is non-nil, put that in the units table instead." defunits) (if (or (not (math-units-in-expr-p expr t)) (setq unitscancel (and - calc-allow-units-as-numbers + (if (get 'calc-allow-units-as-numbers 'saved-value) + (car (get 'calc-allow-units-as-numbers 'saved-value)) + calc-allow-units-as-numbers) (eq (math-get-standard-units expr) 1)))) (let ((uold (or old-units (progn @@ -1495,10 +1497,8 @@ If COMP or STD is non-nil, put that in the units table instead." ((memq (car-safe expr) '(* /)) (cons (car expr) (mapcar 'math-extract-units (cdr expr)))) - ((and - (eq (car-safe expr) '^) - (math-check-unit-name (nth 1 expr))) - expr) + ((eq (car-safe expr) '^) + (list '^ (math-extract-units (nth 1 expr)) (nth 2 expr))) ((math-check-unit-name expr) expr) (t 1))) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index db30d53d537..bd5c9089bcc 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -426,14 +426,6 @@ when converting units." :version "24.3" :type 'boolean) -(defcustom calc-allow-units-as-numbers - t - "If non-nil, allow unit expressions to be treated like numbers -when converting units, if the expression can be simplified to be unitless." - :group 'calc - :version "24.4" - :type 'boolean) - (defcustom calc-undo-length 100 "The number of undo steps that will be preserved when Calc is quit." @@ -2709,7 +2701,6 @@ largest Emacs integer.") (cons (car math-normalize-a) args)) nil) (wrong-type-argument - (setq math-normalize-error t) (or calc-next-why (calc-record-why "Wrong type of argument" (cons (car math-normalize-a) args))) @@ -2720,7 +2711,6 @@ largest Emacs integer.") (cons (car math-normalize-a) args)) nil) (inexact-result - (setq math-normalize-error t) (calc-record-why "No exact representation for result" (cons (car math-normalize-a) args)) nil) diff --git a/lisp/calculator.el b/lisp/calculator.el index 89fa460e531..8b253b810f5 100644 --- a/lisp/calculator.el +++ b/lisp/calculator.el @@ -668,7 +668,9 @@ more information. \\{calculator-mode-map}") -(eval-when-compile (require 'electric) (require 'ehelp)) +(declare-function Electric-command-loop "electric" + (return-tag &optional prompt inhibit-quitting + loop-function loop-state)) ;;;###autoload (defun calculator () @@ -1667,6 +1669,8 @@ Used by `calculator-paste' and `get-register'." (interactive "cRegister to get value from: ") (calculator-put-value (cdr (assq reg calculator-registers)))) +(declare-function electric-describe-mode "ehelp" ()) + (defun calculator-help () ;; this is used as the quick reference screen you get with `h' "Quick reference: @@ -1697,7 +1701,7 @@ Used by `calculator-paste' and `get-register'." (if (or (not calculator-electric-mode) ;; XEmacs has a problem with electric-describe-mode (featurep 'xemacs)) - (describe-mode) + (describe-mode) (electric-describe-mode)) (if calculator-electric-mode (use-global-map g-map)) diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index f4aa26a0864..7be44b4083e 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -366,7 +366,7 @@ Returns a string using match elements 1-5, where: ;; use the standard function calendar-date-string. (concat (if month (calendar-date-string (list month (string-to-number day) - (string-to-number year))) + (string-to-number year)) nil t) (cond ((eq calendar-date-style 'iso) "\\3 \\1 \\2") ; YMD ((eq calendar-date-style 'european) "\\2 \\1 \\3") ; DMY (t "\\1 \\2 \\3"))) ; MDY @@ -2611,14 +2611,23 @@ user is asked to confirm its addition." (diary-from-outlook-internal subject body) (message "Diary entry added")))))) +(defvar diary-from-outlook-function nil + "If non-nil, a function of one argument for `diary-from-outlook' to call. +If the current buffer contains an Outlook-style appointment message, +this function should extract it into a diary entry. If the argument is +nil, it should ask for confirmation before adding this entry to the diary. +For examples, see `diary-from-outlook-rmail' and `diary-from-outlook-gnus'.") + (defun diary-from-outlook (&optional noconfirm) "Maybe snarf diary entry from current Outlook-generated message. -Currently knows about Gnus and Rmail modes. Unless the optional -argument NOCONFIRM is non-nil (which is the case when this -function is called interactively), then if an entry is found the -user is asked to confirm its addition." +Uses `diary-from-outlook-function' if that is non-nil, else +`diary-from-outlook-rmail' for Rmail or `diary-from-outlook-gnus' for Gnus. +Unless the optional argument NOCONFIRM is non-nil (which is the +case when this function is called interactively), then if an +entry is found the user is asked to confirm its addition." (interactive "p") (let ((func (cond + (diary-from-outlook-function) ((eq major-mode 'rmail-mode) #'diary-from-outlook-rmail) ((memq major-mode '(gnus-summary-mode gnus-article-mode)) diff --git a/lisp/case-table.el b/lisp/case-table.el index 711d4e4ec8c..7d4aa27de1c 100644 --- a/lisp/case-table.el +++ b/lisp/case-table.el @@ -1,4 +1,4 @@ -;;; case-table.el --- code to extend the character set and support case tables +;;; case-table.el --- code to extend the character set and support case tables -*- lexical-binding: t -*- ;; Copyright (C) 1988, 1994, 2001-2013 Free Software Foundation, Inc. @@ -65,18 +65,26 @@ (describe-vector description) (help-mode))))) +(defun case-table-get-table (case-table table) + "Return the TABLE of CASE-TABLE. +TABLE can be `down', `up', `eqv' or `canon'." + (let ((slot-nb (cdr (assq table '((up . 0) (canon . 1) (eqv . 2)))))) + (or (if (eq table 'down) case-table) + (char-table-extra-slot case-table slot-nb) + ;; Setup all extra slots of CASE-TABLE by temporarily selecting + ;; it as the standard case table. + (let ((old (standard-case-table))) + (unwind-protect + (progn + (set-standard-case-table case-table) + (char-table-extra-slot case-table slot-nb)) + (or (eq case-table old) + (set-standard-case-table old))))))) + (defun get-upcase-table (case-table) "Return the upcase table of CASE-TABLE." - (or (char-table-extra-slot case-table 0) - ;; Setup all extra slots of CASE-TABLE by temporarily selecting - ;; it as the standard case table. - (let ((old (standard-case-table))) - (unwind-protect - (progn - (set-standard-case-table case-table) - (char-table-extra-slot case-table 0)) - (or (eq case-table old) - (set-standard-case-table old)))))) + (case-table-get-table case-table 'up)) +(make-obsolete 'get-upcase-table 'case-table-get-table "24.4") (defun copy-case-table (case-table) (let ((copy (copy-sequence case-table)) @@ -97,7 +105,7 @@ It also modifies `standard-syntax-table' to indicate left and right delimiters." (aset table l l) (aset table r r) - (let ((up (get-upcase-table table))) + (let ((up (case-table-get-table table 'up))) (aset up l l) (aset up r r)) ;; Clear out the extra slots so that they will be @@ -117,7 +125,7 @@ It also modifies `standard-syntax-table' to give them the syntax of word constituents." (aset table uc lc) (aset table lc lc) - (let ((up (get-upcase-table table))) + (let ((up (case-table-get-table table 'up))) (aset up uc uc) (aset up lc uc)) ;; Clear out the extra slots so that they will be @@ -132,7 +140,7 @@ word constituents." It also modifies `standard-syntax-table' to give them the syntax of word constituents." (aset table lc lc) - (let ((up (get-upcase-table table))) + (let ((up (case-table-get-table table 'up))) (aset up uc uc) (aset up lc uc)) ;; Clear out the extra slots so that they will be @@ -148,7 +156,7 @@ It also modifies `standard-syntax-table' to give them the syntax of word constituents." (aset table uc lc) (aset table lc lc) - (let ((up (get-upcase-table table))) + (let ((up (case-table-get-table table 'up))) (aset up uc uc)) ;; Clear out the extra slots so that they will be ;; recomputed from the main (downcase) table and upcase table. @@ -164,7 +172,7 @@ that will be used as the downcase part of a case table. It also modifies `standard-syntax-table'. SYNTAX should be \" \", \"w\", \".\" or \"_\"." (aset table c c) - (let ((up (get-upcase-table table))) + (let ((up (case-table-get-table table 'up))) (aset up c c)) ;; Clear out the extra slots so that they will be ;; recomputed from the main (downcase) table and upcase table. diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index 2ccce8bb01d..98548a919d5 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -1,3 +1,326 @@ +2013-06-02 Eric Ludlam <zappo@gnu.org> + + * semantic/edit.el (semantic-change-function): Use + `save-match-data' around running hooks. + + * semantic/decorate/mode.el + (semantic-decorate-style-predicate-default) + (semantic-decorate-style-highlighter-default): New. + (semantic-decoration-mode): Do not require + `semantic/decorate/include' anymore. + (semantic-toggle-decoration-style): Error if an unknown decoration + style is toggled. + (define-semantic-decoration-style): Add new :load option. When + :load is specified, add autoload tokens for the definition + functions so that code is loaded when the mode is used. + (semantic-decoration-on-includes): New autoload definition for + highlighting includes. + + * semantic/bovine/c.el (semantic-lex-c-ifdef): Allow some misc + characters to appear after the tested variable. + + * semantic/ede-grammar.el (project-compile-target): Calculate full + src name via ede-expand-filename instead of the crutch of the + current buffer. Enables this target to compile in batch mode. + + * semantic/idle.el + (semantic-idle-symbol-maybe-highlight): Wrap highlighting of + remote symbol with `save-excursion'. + (semantic-idle-scheduler-work-parse-neighboring-files): Instead of + using directory-files on each found mode pattern, collect all the + patterns for the current mode, and then for each file, see if it + matches any of them. If it does, parse the file. (Patch + inspiration from Tomasz Gajewski.) + + * semantic/ctxt.el (semantic-ctxt-end-of-symbol): New. + (semantic-ctxt-current-symbol-default): New. + + * semantic/bovine/el.el (semantic-default-elisp-setup): Add + autoload cookie. Explain existence. + (footer): Add local variable for loaddefs. + + * semantic/db.el (semanticdb-file-table-object): Add new filter, + only checking for regular files too. + + * semantic/wisent/python.el + (semantic-format-tag-abbreviate): New override. Cuts back on size + of code tags. + + * srecode/compile.el (srecode-compile-templates): Fix warning + punctuation. Remove status messages to clean up testing output + + * ede/base.el (ede-project-placeholder-cache-file): Update doc to + mention 'nil' value. + (ede-save-cache): Disable cache save if file is nil. + + * ede.el (ede-initialize-state-current-buffer): Flush deleted + projects. + (global-ede-mode): Always append our find-file-hook to the end. + (ede-flush-deleted-projects): New command. + + * ede/cpp-root.el (ede-preprocessor-map): Protect against init + problems. + + * ede/proj.el (ede-proj-target): Added a new "custom" option for + custom symbols representing a compiler or linker instead of + restricting things to only the predefined compilers and linkers. + +2013-06-02 David Engster <dengste@eml.cc> + + * semantic.el (semantic-mode-map): To avoid showing showing + Development menu twice, only disable menu item if menu-bar is + actually enabled, otherwise the popup 'global menu' might display + a disabled Development menu. + + * srecode/srt-wy.el: Regenerate. + +2013-06-02 Pete Beardmore <elbeardmorez@msn.com> + + * semantic/complete.el + (semantic-displayor-show-request): Fix which slot in obj is set to + the max tags. + +2013-06-01 Glenn Morris <rgm@gnu.org> + + * semantic/grammar.el (semantic-grammar-complete): + Replace the obsolete function lisp-complete-symbol. + + * semantic/analyze/fcn.el (semantic-tag-similar-p): Autoload. + + * srecode/args.el, srecode/java.el: Require ede. + + * semantic/lex.el (semantic-lex-make-type-table): Fix transposed args. + +2013-05-24 Glenn Morris <rgm@gnu.org> + + * semantic/bovine/grammar.el (bovine-make-parsers): + Avoid free variable `copyright-end'. + + * semantic/bovine/c-by.el (semantic-parse-region): + * semantic/wisent/javat-wy.el (semantic-parse-region): + * semantic/wisent/js-wy.el (semantic-parse-region): + * semantic/wisent/python-wy.el (semantic-parse-region): Declare. + +2013-05-22 Glenn Morris <rgm@gnu.org> + + * ede/speedbar.el (ede-file-find, ede-tag-find): + * semantic/sb.el (semantic-sb-token-jump): + Use dframe-maybee-jump-to-attached-frame rather than speedbar- alias. + +2013-05-15 Glenn Morris <rgm@gnu.org> + + * semantic/symref/list.el (semantic-symref-auto-expand-results) + (semantic-symref-results-mode-hook) + (semantic-symref-results-summary-function): Fix :group. + +2013-05-14 Glenn Morris <rgm@gnu.org> + + * ede/simple.el, semantic/java.el: Set generated-autoload-load-name. + +2013-05-11 Glenn Morris <rgm@gnu.org> + + * ede/project-am.el, semantic/db-ebrowse.el, semantic/grammar.el: + * semantic/sb.el, semantic/bovine/grammar.el, semantic/wisent/comp.el: + * semantic/wisent/grammar.el, semantic/wisent/wisent.el: + * srecode/fields.el: Set generated-autoload-load-name (for cus-load). + + * ede/locate.el (cedet-cscope-version-check) + (cedet-cscope-support-for-directory): + * semantic/grammar.el (semantic-grammar-wy--install-parser): + Fix declarations. + + * ede/project-am.el (project-am-compile-project-command): Fix :type. + +2013-05-09 Glenn Morris <rgm@gnu.org> + + * semantic/db-find.el (semanticdb-find-throttle-custom-list): + Fix value. + +2013-04-27 David Engster <deng@randomsample.de> + + * semantic/complete.el + (semantic-collector-calculate-completions-raw): If + `completionslist' is not set, refresh the cache if necessary and + use it for completions. This fixes the + `semantic-collector-buffer-deep' collector (bug#14265). + +2013-03-26 Leo Liu <sdl.web@gmail.com> + + * semantic/senator.el (senator-copy-tag-to-register): Move + register handling logic from register.el. (Bug#14052) + +2013-03-21 Eric Ludlam <zappo@gnu.org> + + * semantic.el (navigate-menu): Yank Tag :enable. Make sure + `senator-tag-ring' is bound. + (semantic-parse-region-default): Stop reversing the output of + parse-whole-stream. + (semantic-repeat-parse-whole-stream): Append returned tags + differently, so they come out in the right order. + + * semantic/sb.el (semantic-sb-filter-tags-of-class): New option. + (semantic-sb-fetch-tag-table): Filter tags being bucketed to + exclude tags belonging to above filtered classes. + + * semantic/find.el (semantic-filter-tags-by-class): New function. + + * semantic/tag-ls.el (semantic-tag-similar-p-default): Add + short-circuit in case tag1 and 2 are identical. + + * semantic/analyze/fcn.el + (semantic-analyze-dereference-metatype-stack): Use + `semantic-tag-similar-p' instead of 'eq' when comparing two tags + during metatype evaluation in case they are the same, but not the + same node. (Tweaked patch from Tomasz Gajewski) (Tiny change) + + * semantic/db-find.el (semanticdb-partial-synchronize): Fix + require to semantic/db-typecache to be correct. + (semanticdb-find-tags-external-children-of-type): Make this a + brutish search by default. + + * semantic/sort.el + (semantic-tag-external-member-children-default): When calling + `semanticdb-find-tags-external-children-of-type', pass in the + input tag as the place to start searching for externally defined + methods. + + * semantic/db-file.el (semanticdb-default-save-directory): Doc + fix: Add ref to default value. + + * semantic/complete.el (semantic-complete-post-command-hook): When + detecting if cursor is outside completion area, do so if cursor + moves before start of overlay, or the original starting location + of the overlay (i.e., if user deletes past beginning of the + overlay region). + (semantic-complete-inline-tag-engine): Initialize original start + of `semantic-complete-inline-overlay'. + + * semantic/bovine/c.el (semantic-c-describe-environment): Update + some section titles. Test semanticdb table before printing it. + (semantic-c-reset-preprocessor-symbol-map): Update + `semantic-lex-spp-macro-symbol-obarray' outside the loop over all + the files contributing to its value. + (semantic-c-describe-environment): If there is an EDE project but + no spp symbols from it, say so. + + * srecode/args.el (srecode-semantic-handle-:project): New argument + handler. Provide variable values if not in an EDE project. + + * srecode/srt-mode.el (srecode-template-mode): Fix typo on srecode + name. + + * srecode/cpp.el (srecode-semantic-handle-:c): Replace all + characters in FILENAME_SYMBOL that aren't valid CPP symbol chars. + + * srecode/map.el (srecode-map-validate-file-for-mode): Force + semantic to load if it is not active in the template being added + to the map. + + * srecode/srt.el: Add local variables for setting the autoload + file name. + (srecode-semantic-handle-:srt): New autoload cookie + + * ede.el (ede-apply-preprocessor-map): Apply map to + `semantic-lex-spp-project-macro-symbol-obarray' instead of the + system one. Add require for semantic. + + * ede/proj-elisp.el (ede-update-version-in-source): In case a file + has both a version variable and a Version: comment, always use + `call-next-method'. + + * ede/cpp-root.el (ede-set-project-variables): Deleted. + `ede-preprocessor-map' does the job this function was attempting + to do with :spp-table. + (ede-preprocessor-map): Update file tests to provide better + messages. Do not try to get symbols from a file that is the file + in the current buffer. + + * ede/base.el (ede-project-placeholder): Add more documentation to + :file slot. + (ede-load-cache): Use `insert-file-contents' instead of + `find-file-noselect' in order to avoid activating other tools. + +2013-03-21 David Engster <deng@randomsample.de> + + * semantic/bovine/c.el (semantic-get-local-variables): Also add a + new variable 'this' if we are in an inline member function. For + detecting this, we check overlays at point if there is a class + spanning the current function. Also, the variable 'this' has to + be a pointer. + + * semantic/bovine/gcc.el (semantic-gcc-setup): Fail gracefully + when querying g++ for defines returns an error. + + * srecode/srt-mode.el: + * srecode/compile.el: + * semantic/elp.el: + * semantic/db-el.el: + * semantic/complete.el: + * ede.el: + * cogre.el: + * srecode/table.el: + * srecode/mode.el: + * srecode/insert.el: + * srecode/compile.el: + * semantic/decorate/include.el: + * semantic/db.el: + * semantic/adebug.el: + * ede/auto.el: + * srecode/dictionary.el: + * semantic/ede-grammar.el: + * semantic/db.el: + * semantic/db-find.el: + * semantic/db-file.el: + * semantic/complete.el: + * semantic/bovine/c.el: + * semantic/analyze.el: + * ede/util.el: + * ede/proj.el: + * ede/proj-elisp.el: + * ede/pconf.el: + * ede/locate.el: + * ede.el: Adapt to EIEIO namespace cleanup: Rename `object-name' + to `eieio-object-name', `object-set-name-string' to + `eieio-object-set-name-string', `object-class' to + `eieio-object-class', `class-parent' to `eieio-class-parent', + `class-parents' to `eieio-class-parents', `class-children' to + `eieio-class-children', `object-name-string' to + `eieio-object-name-string', `object-class-fast' to + `eieio--object-class'. Also replace direct access with new + accessor functions. + +2013-03-21 Tomasz Gajewski <tomga@wp.pl> (tiny change) + + * ede/cpp-root.el (ede-project-autoload, initialize-instance): Fix + EDE file symbol to match rename. Fix ede-cpp-root symbol to + include -project in name. + +2013-03-21 Alex Ott <alexott@gmail.com> + + * cedet-files.el (cedet-files-list-recursively): New. Recursively + find files whose names are matching to given regex + + * ede.el (ede-current-project): Rewrite to avoid imperative style. + + * ede/files.el (ede-find-file): Simplify code. + + * ede/base.el (ede-normalize-file/directory): Add function to + normalize :file or :directory slots if they are missing. + + * ede/cpp-root.el (ede-cpp-root-project): Add compile-command + slot. + (project-compile-project): Compiles project using value specified + in :compule-command slot or in compile-command local variable. + Value of slot or local variable could be string or function that + receives project and should return string that will be invoked as + command. + (project-compile-target): Invokes compilation of whole project + + * ede/files.el (ede-find-project-root): New function to + find root of project that contains specific file. + (ede-files-find-existing): New function which checks presence of + given directory in the list of registered projects. + 2013-03-04 Paul Eggert <eggert@cs.ucla.edu> * semantic/wisent/wisent.el (wisent): Stick to ASCII in the ASCII art. diff --git a/lisp/cedet/cedet-files.el b/lisp/cedet/cedet-files.el index 36561090bd2..236040befb8 100644 --- a/lisp/cedet/cedet-files.el +++ b/lisp/cedet/cedet-files.el @@ -88,6 +88,24 @@ specific conversions during tests." (setq file (concat "//" (substring file 1))))) file)) +(defun cedet-files-list-recursively (dir re) + "Returns list of files in directory matching to given regex" + (when (file-accessible-directory-p dir) + (let ((files (directory-files dir t)) + matched) + (dolist (file files matched) + (let ((fname (file-name-nondirectory file))) + (cond + ((or (string= fname ".") + (string= fname "..")) nil) + ((and (file-regular-p file) + (string-match re fname)) + (setq matched (cons file matched))) + ((file-directory-p file) + (let ((tfiles (cedet-files-list-recursively file re))) + (when tfiles (setq matched (append matched tfiles))))))))))) + + (provide 'cedet-files) ;;; cedet-files.el ends here diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index 3867f628b93..3483d541122 100644 --- a/lisp/cedet/ede.el +++ b/lisp/cedet/ede.el @@ -330,14 +330,14 @@ Argument MENU-DEF is the menu definition to use." (easy-menu-create-menu "Project Forms" (let* ((obj (ede-current-project)) - (class (if obj (object-class obj))) + (class (if obj (eieio-object-class obj))) (menu nil)) (condition-case err (progn (while (and class (slot-exists-p class 'menu)) ;;(message "Looking at class %S" class) (setq menu (append menu (oref class menu)) - class (class-parent class)) + class (eieio-class-parent class)) (if (listp class) (setq class (car class)))) (append '( [ "Add Target" ede-new-target (ede-current-project) ] @@ -382,7 +382,7 @@ but can also be used interactively." (oref proj configuration-default))))) (oset (ede-current-project) configuration-default newconfig) (message "%s will now build in %s mode." - (object-name (ede-current-project)) + (eieio-object-name (ede-current-project)) newconfig)) (defun ede-customize-forms-menu (menu-def) @@ -494,6 +494,11 @@ provided `global-ede-mode' is enabled." (defun ede-initialize-state-current-buffer () "Initialize the current buffer's state for EDE. Sets buffer local variables for EDE." + ;; due to inode recycling, make sure we don't + ;; we flush projects deleted off the system. + (ede-flush-deleted-projects) + + ;; Init the buffer. (let* ((ROOT nil) (proj (ede-directory-get-open-project default-directory 'ROOT)) @@ -569,7 +574,9 @@ an EDE controlled project." (add-hook 'semanticdb-project-predicate-functions 'ede-directory-project-p) (add-hook 'semanticdb-project-root-functions 'ede-toplevel-project-or-nil) (add-hook 'ecb-source-path-functions 'ede-ecb-project-paths) - (add-hook 'find-file-hook 'ede-turn-on-hook) + ;; Append our hook to the end. This allows mode-local to finish + ;; it's stuff before we start doing misc file loads, etc. + (add-hook 'find-file-hook 'ede-turn-on-hook t) (add-hook 'dired-mode-hook 'ede-turn-on-hook) (add-hook 'kill-emacs-hook 'ede-save-cache) (ede-load-cache) @@ -727,7 +734,7 @@ Optional argument NAME is the name to give this project." 'name (let* ((l ede-project-class-files) (cp (ede-current-project)) - (cs (when cp (object-class cp))) + (cs (when cp (eieio-object-class cp))) (r nil)) (while l (if cs @@ -779,7 +786,7 @@ Optional argument NAME is the name to give this project." :targets nil))) (inits (oref obj initializers))) ;; Force the name to match for new objects. - (object-set-name-string nobj (oref nobj :name)) + (eieio-object-set-name-string nobj (oref nobj :name)) ;; Handle init args. (while inits (eieio-oset nobj (car inits) (car (cdr inits))) @@ -885,7 +892,7 @@ a string \"y\" or \"n\", which answers the y/n question done interactively." (when (not ede-object) (error "Can't add %s to target %s: Wrong file type" (file-name-nondirectory (buffer-file-name)) - (object-name target))) + (eieio-object-name target))) (ede-apply-target-options)) (defun ede-remove-file (&optional force) @@ -979,12 +986,12 @@ Argument PROMPT is the prompt to use when querying the user for a target." (defmethod project-add-file ((ot ede-target) file) "Add the current buffer into project project target OT. Argument FILE is the file to add." - (error "add-file not supported by %s" (object-name ot))) + (error "add-file not supported by %s" (eieio-object-name ot))) (defmethod project-remove-file ((ot ede-target) fnnd) "Remove the current buffer from project target OT. Argument FNND is an argument." - (error "remove-file not supported by %s" (object-name ot))) + (error "remove-file not supported by %s" (eieio-object-name ot))) (defmethod project-edit-file-target ((ot ede-target)) "Edit the target OT associated with this file." @@ -992,45 +999,45 @@ Argument FNND is an argument." (defmethod project-new-target ((proj ede-project) &rest args) "Create a new target. It is up to the project PROJ to get the name." - (error "new-target not supported by %s" (object-name proj))) + (error "new-target not supported by %s" (eieio-object-name proj))) (defmethod project-new-target-custom ((proj ede-project)) "Create a new target. It is up to the project PROJ to get the name." - (error "New-target-custom not supported by %s" (object-name proj))) + (error "New-target-custom not supported by %s" (eieio-object-name proj))) (defmethod project-delete-target ((ot ede-target)) "Delete the current target OT from its parent project." - (error "add-file not supported by %s" (object-name ot))) + (error "add-file not supported by %s" (eieio-object-name ot))) (defmethod project-compile-project ((obj ede-project) &optional command) "Compile the entire current project OBJ. Argument COMMAND is the command to use when compiling." - (error "compile-project not supported by %s" (object-name obj))) + (error "compile-project not supported by %s" (eieio-object-name obj))) (defmethod project-compile-target ((obj ede-target) &optional command) "Compile the current target OBJ. Argument COMMAND is the command to use for compiling the target." - (error "compile-target not supported by %s" (object-name obj))) + (error "compile-target not supported by %s" (eieio-object-name obj))) (defmethod project-debug-target ((obj ede-target)) "Run the current project target OBJ in a debugger." - (error "debug-target not supported by %s" (object-name obj))) + (error "debug-target not supported by %s" (eieio-object-name obj))) (defmethod project-run-target ((obj ede-target)) "Run the current project target OBJ." - (error "run-target not supported by %s" (object-name obj))) + (error "run-target not supported by %s" (eieio-object-name obj))) (defmethod project-make-dist ((this ede-project)) "Build a distribution for the project based on THIS project." - (error "Make-dist not supported by %s" (object-name this))) + (error "Make-dist not supported by %s" (eieio-object-name this))) (defmethod project-dist-files ((this ede-project)) "Return a list of files that constitute a distribution of THIS project." - (error "Dist-files is not supported by %s" (object-name this))) + (error "Dist-files is not supported by %s" (eieio-object-name this))) (defmethod project-rescan ((this ede-project)) "Rescan the EDE project THIS." - (error "Rescanning a project is not supported by %s" (object-name this))) + (error "Rescanning a project is not supported by %s" (eieio-object-name this))) (defun ede-ecb-project-paths () "Return a list of all paths for all active EDE projects. @@ -1057,6 +1064,18 @@ On success, return the added project." (add-to-list 'ede-projects proj) proj) +(defun ede-flush-deleted-projects () + "Scan the projects list for projects which no longer exist. +Flush the dead projects from the project cache." + (interactive) + (let ((dead nil)) + (dolist (P ede-projects) + (when (not (file-exists-p (oref P :file))) + (add-to-list 'dead P))) + (dolist (D dead) + (setq ede-projects (remove D ede-projects))) + )) + (defun ede-load-project-file (dir &optional rootreturn) "Project file independent way to read a project in from DIR. Optional ROOTRETURN will return the root project for DIR." @@ -1157,18 +1176,15 @@ Optional argument OBJ is an object to find the parent of." (defun ede-current-project (&optional dir) "Return the current project file. If optional DIR is provided, get the project for DIR instead." - (let ((ans nil)) - ;; If it matches the current directory, do we have a pre-existing project? - (when (and (or (not dir) (string= dir default-directory)) - ede-object-project) - (setq ans ede-object-project) - ) + ;; If it matches the current directory, do we have a pre-existing project? + (let ((proj (when (and (or (not dir) (string= dir default-directory)) + ede-object-project) + ede-object-project))) ;; No current project. - (when (not ans) + (if proj + proj (let* ((ldir (or dir default-directory))) - (setq ans (ede-directory-get-open-project ldir)))) - ;; Return what we found. - ans)) + (ede-directory-get-open-project ldir))))) (defun ede-buffer-object (&optional buffer projsym) "Return the target object for BUFFER. @@ -1372,20 +1388,24 @@ and <root>/doc for doc sources." ;; C/C++ (defun ede-apply-preprocessor-map () "Apply preprocessor tables onto the current buffer." + ;; TODO - what if semantic-mode isn't enabled? + ;; what if we never want to load a C mode? Does this matter? + ;; Note: This require is needed for the case where EDE ends up + ;; in the hook order before Semantic based hooks. + (require 'semantic/lex-spp) (when (and ede-object - (boundp 'semantic-lex-spp-macro-symbol-obarray) - semantic-lex-spp-macro-symbol-obarray) + (boundp 'semantic-lex-spp-project-macro-symbol-obarray)) (let* ((objs ede-object) (map (ede-preprocessor-map (if (consp objs) (car objs) objs)))) (when map ;; We can't do a require for the below symbol. - (setq semantic-lex-spp-macro-symbol-obarray + (setq semantic-lex-spp-project-macro-symbol-obarray (semantic-lex-make-spp-table map))) (when (consp objs) (message "Choosing preprocessor syms for project %s" - (object-name (car objs))))))) + (eieio-object-name (car objs))))))) (defmethod ede-system-include-path ((this ede-project)) "Get the system include path used by project THIS." diff --git a/lisp/cedet/ede/auto.el b/lisp/cedet/ede/auto.el index 22fce372e24..c0baf0fc8f8 100644 --- a/lisp/cedet/ede/auto.el +++ b/lisp/cedet/ede/auto.el @@ -199,8 +199,8 @@ added. Possible values are: front of the list so more generic projects don't get priority." ;; First, can we identify PROJAUTO as already in the list? If so, replace. (let ((projlist ede-project-class-files) - (projname (object-name-string projauto))) - (while (and projlist (not (string= (object-name-string (car projlist)) projname))) + (projname (eieio-object-name-string projauto))) + (while (and projlist (not (string= (eieio-object-name-string (car projlist)) projname))) (setq projlist (cdr projlist))) (if projlist diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el index 1368ea348a0..a94ce8f1868 100644 --- a/lisp/cedet/ede/base.el +++ b/lisp/cedet/ede/base.el @@ -135,7 +135,9 @@ other desired outcome.") (dirinode :documentation "The inode id for :directory.") (file :type string :initarg :file - :documentation "File name where this project is stored.") + :documentation "The File uniquely tagging this project instance. +For some project types, this will be the file that stores the project configuration. +In other projects types, this file is merely a unique identifier to this type of project.") (rootproject ; :initarg - no initarg, don't save this slot! :initform nil :type (or null ede-project-placeholder-child) @@ -304,7 +306,8 @@ All specific project types must derive from this project." ;; (defcustom ede-project-placeholder-cache-file (locate-user-emacs-file "ede-projects.el" ".projects.ede") - "File containing the list of projects EDE has viewed." + "File containing the list of projects EDE has viewed. +If set to nil, then the cache is not saved." :group 'ede :type 'file) @@ -314,48 +317,49 @@ All specific project types must derive from this project." (defun ede-save-cache () "Save a cache of EDE objects that Emacs has seen before." (interactive) - (let ((p ede-projects) - (c ede-project-cache-files) - (recentf-exclude '( (lambda (f) t) )) - ) - (condition-case nil - (progn - (set-buffer (find-file-noselect ede-project-placeholder-cache-file t)) - (erase-buffer) - (insert ";; EDE project cache file. -;; This contains a list of projects you have visited.\n(") - (while p - (when (and (car p) (ede-project-p p)) - (let ((f (oref (car p) file))) - (when (file-exists-p f) - (insert "\n \"" f "\"")))) - (setq p (cdr p))) - (while c - (insert "\n \"" (car c) "\"") - (setq c (cdr c))) - (insert "\n)\n") - (condition-case nil - (save-buffer 0) - (error - (message "File %s could not be saved." - ede-project-placeholder-cache-file))) - (kill-buffer (current-buffer)) + (when ede-project-placeholder-cache-file + (let ((p ede-projects) + (c ede-project-cache-files) + (recentf-exclude '( (lambda (f) t) )) ) - (error - (message "File %s could not be read." - ede-project-placeholder-cache-file)) - - ))) + (condition-case nil + (progn + (set-buffer (find-file-noselect ede-project-placeholder-cache-file t)) + (erase-buffer) + (insert ";; EDE project cache file. +;; This contains a list of projects you have visited.\n(") + (while p + (when (and (car p) (ede-project-p p)) + (let ((f (oref (car p) file))) + (when (file-exists-p f) + (insert "\n \"" f "\"")))) + (setq p (cdr p))) + (while c + (insert "\n \"" (car c) "\"") + (setq c (cdr c))) + (insert "\n)\n") + (condition-case nil + (save-buffer 0) + (error + (message "File %s could not be saved." + ede-project-placeholder-cache-file))) + (kill-buffer (current-buffer)) + ) + (error + (message "File %s could not be read." + ede-project-placeholder-cache-file)) + + )))) (defun ede-load-cache () "Load the cache of EDE projects." (save-excursion - (let ((cachebuffer nil)) + (let ((cachebuffer (get-buffer-create "*ede cache*"))) (condition-case nil - (progn - (setq cachebuffer - (find-file-noselect ede-project-placeholder-cache-file t)) - (set-buffer cachebuffer) + (with-current-buffer cachebuffer + (erase-buffer) + (when (file-exists-p ede-project-placeholder-cache-file) + (insert-file-contents ede-project-placeholder-cache-file)) (goto-char (point-min)) (let ((c (read (current-buffer))) (new nil) @@ -610,6 +614,28 @@ instead of the current project." cp))))) +;;; Utility functions +;; + +(defun ede-normalize-file/directory (this project-file-name) + "Fills :directory or :file slots if they're missing in project THIS. +The other slot will be used to calculate values. +PROJECT-FILE-NAME is a name of project file (short name, like 'pom.xml', etc." + (when (and (or (not (slot-boundp this :file)) + (not (oref this :file))) + (slot-boundp this :directory) + (oref this :directory)) + (oset this :file (expand-file-name project-file-name (oref this :directory)))) + (when (and (or (not (slot-boundp this :directory)) + (not (oref this :directory))) + (slot-boundp this :file) + (oref this :file)) + (oset this :directory (file-name-directory (oref this :file)))) + ) + + + + ;;; Hooks & Autoloads ;; ;; These let us watch various activities, and respond appropriately. diff --git a/lisp/cedet/ede/cpp-root.el b/lisp/cedet/ede/cpp-root.el index d31ede723cc..719289765a3 100644 --- a/lisp/cedet/ede/cpp-root.el +++ b/lisp/cedet/ede/cpp-root.el @@ -242,11 +242,11 @@ ROOTPROJ is nil, since there is only one project." (ede-add-project-autoload (ede-project-autoload "cpp-root" :name "CPP ROOT" - :file 'ede-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 + :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 @@ -272,10 +272,12 @@ ROOTPROJ is nil, since there is only one project." ;; level include paths, and PreProcessor macro tables. (defclass ede-cpp-root-target (ede-target) - () + ((project :initform nil + :initarg :project)) "EDE cpp-root project target. All directories need at least one target.") +;;;###autoload (defclass ede-cpp-root-project (ede-project eieio-instance-tracker) ((tracking-symbol :initform 'ede-cpp-root-project-list) (include-path :initarg :include-path @@ -339,6 +341,15 @@ The function symbol must take two arguments: It should return the fully qualified file name passed in from NAME. If that file does not exist, it should return nil." ) + (compile-command :initarg :compile-command + :initform nil + :type (or null string function) + :documentation + "Compilation command that will be used for this project. +It could be string or function that will accept proj argument and should return string. +The string will be passed to 'compile' function that will be issued in root +directory of project." + ) ) "EDE cpp-root project class. Each directory needs a project file to control it.") @@ -366,7 +377,7 @@ Each directory needs a project file to control it.") (when (or (not (file-exists-p f)) (file-directory-p f)) (delete-instance this) - (error ":file for ede-cpp-root must be a file")) + (error ":file for ede-cpp-root-project must be a file")) (oset this :file f) (oset this :directory (file-name-directory f)) (ede-project-directory-remove-hash (file-name-directory f)) @@ -404,7 +415,8 @@ If one doesn't exist, create a new one for this directory." :name (file-name-nondirectory (directory-file-name dir)) :path dir - :source nil)) + :source nil + :project proj)) (object-add-to-list proj :targets ans) ) ans)) @@ -481,15 +493,6 @@ This is for project include paths and spp source files." filename)) -(defmethod ede-set-project-variables ((project ede-cpp-root-project) &optional buffer) - "Set variables local to PROJECT in BUFFER. -Also set up the lexical preprocessor map." - (call-next-method) - (when (and (featurep 'semantic/bovine/c) (featurep 'semantic/lex-spp)) - (setq semantic-lex-spp-project-macro-symbol-obarray - (semantic-lex-make-spp-table (oref project spp-table))) - )) - (defmethod ede-system-include-path ((this ede-cpp-root-project)) "Get the system include path used by project THIS." (oref this system-include-path)) @@ -504,13 +507,23 @@ Also set up the lexical preprocessor map." (lambda (F) (let* ((expfile (ede-expand-filename root F)) (table (when expfile - (semanticdb-file-table-object expfile))) + ;; Disable EDE init on preprocessor file load + ;; otherwise we recurse, cause errs, etc. + (let ((ede-constructing t)) + (semanticdb-file-table-object expfile)))) ) - (if (not table) - (message "Cannot find file %s in project." F) + (cond + ((not (file-exists-p expfile)) + (message "Cannot find file %s in project." F)) + ((string= expfile (buffer-file-name)) + ;; Don't include this file in it's own spp table. + ) + ((not table) + (message "No db table available for %s." expfile)) + (t (when (semanticdb-needs-refresh-p table) (semanticdb-refresh-table table)) - (setq spp (append spp (oref table lexical-table)))))) + (setq spp (append spp (oref table lexical-table))))))) (oref this spp-files)) spp)) @@ -522,6 +535,29 @@ Also set up the lexical preprocessor map." "Get the pre-processor map for project THIS." (ede-preprocessor-map (ede-target-parent this))) +(defmethod project-compile-project ((proj ede-cpp-root-project) &optional command) + "Compile the entire current project PROJ. +Argument COMMAND is the command to use when compiling." + ;; we need to be in the proj root dir for this to work + (let* ((cmd (oref proj :compile-command)) + (ov (oref proj :local-variables)) + (lcmd (when ov (cdr (assoc 'compile-command ov)))) + (cmd-str (cond + ((stringp cmd) cmd) + ((functionp cmd) (funcall cmd proj)) + ((stringp lcmd) lcmd) + ((functionp lcmd) (funcall lcmd proj))))) + (when cmd-str + (let ((default-directory (ede-project-root-directory proj))) + (compile cmd-str))))) + +(defmethod project-compile-target ((obj ede-cpp-root-target) &optional command) + "Compile the current target OBJ. +Argument COMMAND is the command to use for compiling the target." + (when (oref obj :project) + (project-compile-project (oref obj :project) command))) + + ;;; 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/emacs.el b/lisp/cedet/ede/emacs.el index 925730c8121..f5a85f4a01b 100644 --- a/lisp/cedet/ede/emacs.el +++ b/lisp/cedet/ede/emacs.el @@ -59,7 +59,7 @@ DIR is the directory to search from." "Get the root directory for DIR." (when (not dir) (setq dir default-directory)) (let ((case-fold-search t) - (proj (ede-emacs-file-existing dir))) + (proj (ede-files-find-existing dir ede-emacs-project-list))) (if proj (ede-up-directory (file-name-directory (oref proj :file))) @@ -134,7 +134,7 @@ 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-emacs-file-existing dir) + (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 diff --git a/lisp/cedet/ede/files.el b/lisp/cedet/ede/files.el index 015f4fd9663..91433add7b0 100644 --- a/lisp/cedet/ede/files.el +++ b/lisp/cedet/ede/files.el @@ -50,12 +50,13 @@ There is no completion at the prompt. FILE is searched for within the current EDE project." (interactive "sFile: ") - (let ((fname (ede-expand-filename (ede-current-project) file)) + (let* ((proj (ede-current-project)) + (fname (ede-expand-filename proj file)) ) (unless fname (error "Could not find %s in %s" file - (ede-project-root-directory (ede-current-project)))) + (ede-project-root-directory proj))) (find-file fname))) (defun ede-flush-project-hash () @@ -508,6 +509,26 @@ 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) ;; Local variables: diff --git a/lisp/cedet/ede/locate.el b/lisp/cedet/ede/locate.el index 072e2c2666a..d8b29d3f0be 100644 --- a/lisp/cedet/ede/locate.el +++ b/lisp/cedet/ede/locate.el @@ -163,7 +163,7 @@ that created this EDE locate object." "Create or update the database for the current project. You cannot create projects for the baseclass." (error "Cannot create/update a database of type %S" - (object-name loc))) + (eieio-object-name loc))) ;;; LOCATE ;; @@ -310,8 +310,8 @@ that created this EDE locate object." ;;; CSCOPE ;; -(declare-function cedet-cscope-version-check "cedet-scope") -(declare-function cedet-cscope-support-for-directory "cedet-scope") +(declare-function cedet-cscope-version-check "cedet-cscope") +(declare-function cedet-cscope-support-for-directory "cedet-cscope") (declare-function cedet-cscope-expand-filename "cedet-cscope") (declare-function cedet-cscope-create/update-database "cedet-cscope") diff --git a/lisp/cedet/ede/pconf.el b/lisp/cedet/ede/pconf.el index 310014a0b64..a29e3720ea2 100644 --- a/lisp/cedet/ede/pconf.el +++ b/lisp/cedet/ede/pconf.el @@ -152,7 +152,7 @@ don't do it. A value of nil means to just do it.") (defmethod ede-proj-configure-recreate ((this ede-proj-project)) "Delete project THIS's configure script and start over." (if (not (ede-proj-configure-file this)) - (error "Could not determine configure.ac for %S" (object-name this))) + (error "Could not determine configure.ac for %S" (eieio-object-name this))) (let ((b (get-file-buffer (ede-proj-configure-file this)))) ;; Destroy all evidence of the old configure.ac (delete-file (ede-proj-configure-file this)) diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el index 8b426aa183f..d7720f25681 100644 --- a/lisp/cedet/ede/proj-elisp.el +++ b/lisp/cedet/ede/proj-elisp.el @@ -170,7 +170,7 @@ Bonus: Return a cons cell: (COMPILED . UPTODATE)." (setq utd (1+ utd))))))) (oref obj source)) - (message "All Emacs Lisp sources are up to date in %s" (object-name obj)) + (message "All Emacs Lisp sources are up to date in %s" (eieio-object-name obj)) (cons comp utd))) (defmethod ede-update-version-in-source ((this ede-proj-target-elisp) version) @@ -194,7 +194,8 @@ is found, such as a `-version' variable, or the standard header." (goto-char (match-beginning 1)) (insert version))))) (setq vs (cdr vs))) - (if (not match) (call-next-method))))) + ;; The next method will include comments such as "Version:" + (call-next-method)))) ;;; Makefile generation functions diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el index 2da2737d377..99a5978b005 100644 --- a/lisp/cedet/ede/proj.el +++ b/lisp/cedet/ede/proj.el @@ -104,6 +104,7 @@ distributed, and each should have a corresponding rule to build it.") :initform nil :type (or null symbol) :custom (choice (const :tag "None" nil) + (symbol :tag "Custom Compiler Symbol") :slotofchoices availablecompilers) :label "Compiler for building sources" :group make @@ -116,6 +117,7 @@ of these compiler resources, and global customization thereof.") :initform nil :type (or null symbol) :custom (choice (const :tag "None" nil) + (symbol :tag "Custom Linker Symbol") :slotofchoices availablelinkers) :label "Linker for combining intermediate object files." :group make @@ -512,11 +514,11 @@ Optional argument COMMAND is the s the alternate command to use." (defmethod project-debug-target ((obj ede-proj-target)) "Run the current project target OBJ in a debugger." - (error "Debug-target not supported by %s" (object-name obj))) + (error "Debug-target not supported by %s" (eieio-object-name obj))) (defmethod project-run-target ((obj ede-proj-target)) "Run the current project target OBJ." - (error "Run-target not supported by %s" (object-name obj))) + (error "Run-target not supported by %s" (eieio-object-name obj))) (defmethod ede-proj-makefile-target-name ((this ede-proj-target)) "Return the name of the main target for THIS target." diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el index f49a9d07940..459959e220d 100644 --- a/lisp/cedet/ede/project-am.el +++ b/lisp/cedet/ede/project-am.el @@ -55,7 +55,7 @@ (defcustom project-am-compile-project-command nil "*Default command used to compile a project." :group 'project-am - :type 'string) + :type '(choice (const nil) string)) (defcustom project-am-compile-target-command (concat ede-make-command " -k %s") "*Default command used to compile a project." @@ -1014,4 +1014,8 @@ per file or in .dir-locals.el or similar." (provide 'ede/project-am) +;; Local variables: +;; generated-autoload-load-name: "ede/project-am" +;; End: + ;;; ede/project-am.el ends here diff --git a/lisp/cedet/ede/simple.el b/lisp/cedet/ede/simple.el index 06e1a5dc0d5..c1f72d48080 100644 --- a/lisp/cedet/ede/simple.el +++ b/lisp/cedet/ede/simple.el @@ -118,4 +118,8 @@ Each directory needs a project file to control it.") (provide 'ede/simple) +;; Local variables: +;; generated-autoload-load-name: "ede/simple" +;; End: + ;;; ede/simple.el ends here diff --git a/lisp/cedet/ede/speedbar.el b/lisp/cedet/ede/speedbar.el index d963a56697a..0f3c96b1a7d 100644 --- a/lisp/cedet/ede/speedbar.el +++ b/lisp/cedet/ede/speedbar.el @@ -257,7 +257,7 @@ It has depth DEPTH." INDENT is the current indentation level." (speedbar-find-file-in-frame (expand-file-name token (speedbar-line-directory indent))) - (speedbar-maybee-jump-to-attached-frame)) + (dframe-maybee-jump-to-attached-frame)) (defun ede-create-tag-buttons (filename indent) "Create the tag buttons associated with FILENAME at INDENT." @@ -304,7 +304,7 @@ INDENT is the current indentation level." (goto-char token) (run-hooks 'speedbar-visiting-tag-hook) ;;(recenter) - (speedbar-maybee-jump-to-attached-frame) + (dframe-maybee-jump-to-attached-frame) )) ;;; EDE and the speedbar FILE display diff --git a/lisp/cedet/ede/util.el b/lisp/cedet/ede/util.el index 88a3e0a4512..71a79a1b706 100644 --- a/lisp/cedet/ede/util.el +++ b/lisp/cedet/ede/util.el @@ -49,7 +49,7 @@ Argument NEWVERSION is the version number to use in the current project." (defmethod project-update-version ((ot ede-project)) "The :version of the project OT has been updated. Handle saving, or other detail." - (error "project-update-version not supported by %s" (object-name ot))) + (error "project-update-version not supported by %s" (eieio-object-name ot))) (defmethod ede-update-version-in-source ((this ede-project) version) "Change occurrences of a version string in sources. diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index edf2d0cb21a..909902a71fe 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -466,11 +466,10 @@ unterminated syntax." (widen) (when (or (< end start) (> end (point-max))) (error "Invalid parse region bounds %S, %S" start end)) - (nreverse - (semantic-repeat-parse-whole-stream + (semantic-repeat-parse-whole-stream (or (cdr (assq start semantic-lex-block-streams)) (semantic-lex start end depth)) - nonterminal returnonerror)))) + nonterminal returnonerror))) ;;; Parsing functions ;; @@ -756,7 +755,7 @@ This function returns semantic tags without overlays." tag 'reparse-symbol nonterm)) tag) (semantic--tag-expand tag)) - result (append tag result)) + result (append result tag)) ;; No error in this case, a purposeful nil means don't ;; store anything. ) @@ -900,7 +899,8 @@ Throw away all the old tags, and recreate the tag database." ;; and Semantic are both enabled. Is there a better way? (define-key map [menu-bar cedet-menu] (list 'menu-item "Development" cedet-menu-map - :enable (quote (not (bound-and-true-p global-ede-mode))))) + :enable (quote (not (and menu-bar-mode + (bound-and-true-p global-ede-mode)))))) ;; (define-key km "-" 'senator-fold-tag) ;; (define-key km "+" 'senator-unfold-tag) map)) @@ -934,7 +934,8 @@ Throw away all the old tags, and recreate the tag database." '("--")) (define-key edit-menu [senator-yank-tag] '(menu-item "Yank Tag" senator-yank-tag - :enable (not (ring-empty-p senator-tag-ring)) + :enable (and (boundp 'senator-tag-ring) + (not (ring-empty-p senator-tag-ring))) :help "Yank the head of the tag ring into the buffer")) (define-key edit-menu [senator-copy-tag-to-register] '(menu-item "Copy Tag To Register" senator-copy-tag-to-register diff --git a/lisp/cedet/semantic/analyze.el b/lisp/cedet/semantic/analyze.el index d1476111403..000193d4a55 100644 --- a/lisp/cedet/semantic/analyze.el +++ b/lisp/cedet/semantic/analyze.el @@ -800,7 +800,7 @@ CONTEXT's content is described in `semantic-analyze-current-context'." (semantic-analyze-pulse context) (with-output-to-temp-buffer "*Semantic Context Analysis*" (princ "Context Type: ") - (princ (object-name context)) + (princ (eieio-object-name context)) (princ "\n") (princ "Bounds: ") (princ (oref context bounds)) diff --git a/lisp/cedet/semantic/analyze/fcn.el b/lisp/cedet/semantic/analyze/fcn.el index 6ee85b298a2..4300c89c9df 100644 --- a/lisp/cedet/semantic/analyze/fcn.el +++ b/lisp/cedet/semantic/analyze/fcn.el @@ -245,6 +245,8 @@ used by the analyzer debugger." (semantic-scope-set-typecache scope nil) ))))) +(autoload 'semantic-tag-similar-p "semantic/tag-ls") + (defun semantic-analyze-dereference-metatype-stack (type scope &optional type-declaration) "Dereference metatypes repeatedly until we hit a real TYPE. Uses `semantic-analyze-dereference-metatype'. @@ -255,7 +257,7 @@ Optional argument TYPE-DECLARATION is how TYPE was found referenced." (nexttype (semantic-analyze-dereference-metatype type scope type-declaration)) (idx 0)) (catch 'metatype-recursion - (while (and nexttype (not (eq (car nexttype) lasttype))) + (while (and nexttype (not (semantic-tag-similar-p (car nexttype) lasttype))) (setq lasttype (car nexttype) lasttypedeclaration (cadr nexttype)) (setq nexttype (semantic-analyze-dereference-metatype lasttype scope lasttypedeclaration)) diff --git a/lisp/cedet/semantic/bovine/c-by.el b/lisp/cedet/semantic/bovine/c-by.el index 5317d838fbd..af3724a32c8 100644 --- a/lisp/cedet/semantic/bovine/c-by.el +++ b/lisp/cedet/semantic/bovine/c-by.el @@ -28,9 +28,13 @@ ;;; Prologue ;; -(declare-function semantic-c-reconstitute-token "semantic/bovine/c") -(declare-function semantic-c-reconstitute-template "semantic/bovine/c") -(declare-function semantic-expand-c-tag "semantic/bovine/c") +(declare-function semantic-c-reconstitute-token "semantic/bovine/c" + (tokenpart declmods typedecl)) +(declare-function semantic-c-reconstitute-template "semantic/bovine/c" + (tag specifier)) +(declare-function semantic-expand-c-tag "semantic/bovine/c" (tag)) +(declare-function semantic-parse-region "semantic" + (start end &optional nonterminal depth returnonerror)) ;;; Declarations ;; diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el index 7aa93a0c942..3c991ea8555 100644 --- a/lisp/cedet/semantic/bovine/c.el +++ b/lisp/cedet/semantic/bovine/c.el @@ -155,15 +155,16 @@ part of the preprocessor map.") ;; not be in a buffer. (semanticdb-refresh-table table t) (error (message "Error updating tables for %S" - (object-name table))))) + (eieio-object-name table))))) (setq filemap (append filemap (oref table lexical-table))) - ;; Update symbol obarray - (setq-mode-local c-mode - semantic-lex-spp-macro-symbol-obarray - (semantic-lex-make-spp-table - (append semantic-lex-c-preprocessor-symbol-map-builtin - semantic-lex-c-preprocessor-symbol-map - filemap))))))))))) + ))))) + ;; Update symbol obarray + (setq-mode-local c-mode + semantic-lex-spp-macro-symbol-obarray + (semantic-lex-make-spp-table + (append semantic-lex-c-preprocessor-symbol-map-builtin + semantic-lex-c-preprocessor-symbol-map + filemap)))))) ;; Make sure the preprocessor symbols are set up when mode-local kicks ;; in. @@ -528,7 +529,7 @@ code to parse." (define-lex-regex-analyzer semantic-lex-c-ifdef "Code blocks wrapped up in #ifdef. Uses known macro tables in SPP to determine what block to skip." - "^\\s-*#\\s-*\\(ifndef\\|ifdef\\)\\s-+\\(\\(\\sw\\|\\s_\\)+\\)$" + "^\\s-*#\\s-*\\(ifndef\\|ifdef\\)\\s-+\\(\\(\\sw\\|\\s_\\)+\\)\\([ \t\C-m].*\\)?$" (semantic-c-do-lex-ifdef)) (defun semantic-c-do-lex-ifdef () @@ -1946,15 +1947,17 @@ have to be wrapped in that namespace." "Do what `semantic-get-local-variables' does, plus add `this' if needed." (let* ((origvar (semantic-get-local-variables-default)) (ct (semantic-current-tag)) - (p (semantic-tag-function-parent ct))) + (p (when (semantic-tag-of-class-p ct 'function) + (or (semantic-tag-function-parent ct) + (car-safe (semantic-find-tags-by-type + "class" (semantic-find-tag-by-overlay))))))) ;; If we have a function parent, then that implies we can - (if (and p (semantic-tag-of-class-p ct 'function)) - ;; Append a new tag THIS into our space. - (cons (semantic-tag-new-variable "this" p nil) + (if p + ;; Append a new tag THIS into our space. + (cons (semantic-tag-new-variable "this" p nil :pointer 1) origvar) ;; No parent, just return the usual - origvar) - )) + origvar))) (define-mode-local-override semantic-idle-summary-current-symbol-info c-mode () @@ -2151,14 +2154,18 @@ actually in their parent which is not accessible.") (princ "\n"))) (princ "\n\nMacro Summary:\n") + (when semantic-lex-c-preprocessor-symbol-file - (princ "\n Your CPP table is primed from these files:\n") + (princ "\n Your CPP table is primed from these system files:\n") (dolist (file semantic-lex-c-preprocessor-symbol-file) (princ " ") (princ file) (princ "\n") (princ " in table: ") - (princ (object-print (semanticdb-file-table-object file))) + (let ((fto (semanticdb-file-table-object file))) + (if fto + (princ (object-print fto)) + (princ "No Table"))) (princ "\n") )) @@ -2173,7 +2180,7 @@ actually in their parent which is not accessible.") )) (when semantic-lex-c-preprocessor-symbol-map - (princ "\n User symbol map:\n") + (princ "\n User symbol map (primed from system files):\n") (dolist (S semantic-lex-c-preprocessor-symbol-map) (princ " ") (princ (car S)) @@ -2183,25 +2190,27 @@ actually in their parent which is not accessible.") )) (when (and (boundp 'ede-object) - ede-object - (arrayp semantic-lex-spp-project-macro-symbol-obarray)) + ede-object) (princ "\n Project symbol map:\n") (when (and (boundp 'ede-object) ede-object) - (princ " Your project symbol map is derived from the EDE object:\n ") + (princ " Your project symbol map is also derived from the EDE object:\n ") (princ (object-print ede-object))) (princ "\n\n") - (let ((macros nil)) - (mapatoms - #'(lambda (symbol) - (setq macros (cons symbol macros))) - semantic-lex-spp-project-macro-symbol-obarray) - (dolist (S macros) - (princ " ") - (princ (symbol-name S)) - (princ " = ") - (princ (symbol-value S)) - (princ "\n") - ))) + (if (arrayp semantic-lex-spp-project-macro-symbol-obarray) + (let ((macros nil)) + (mapatoms + #'(lambda (symbol) + (setq macros (cons symbol macros))) + semantic-lex-spp-project-macro-symbol-obarray) + (dolist (S macros) + (princ " ") + (princ (symbol-name S)) + (princ " = ") + (princ (symbol-value S)) + (princ "\n") + )) + ;; Else, not map + (princ " No Symbols.\n"))) (princ "\n\n Use: M-x semantic-lex-spp-describe RET\n") (princ "\n to see the complete macro table.\n") diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el index a8ddbe106f7..07e0e08bbaf 100644 --- a/lisp/cedet/semantic/bovine/el.el +++ b/lisp/cedet/semantic/bovine/el.el @@ -940,8 +940,11 @@ ELisp variables can be pretty long, so track this one too.") (define-child-mode lisp-mode emacs-lisp-mode "Make `lisp-mode' inherit mode local behavior from `emacs-lisp-mode'.") +;;;###autoload (defun semantic-default-elisp-setup () "Setup hook function for Emacs Lisp files and Semantic." + ;; This is here mostly to get this file loaded when a .el file is + ;; loaded into Emacs. ) (add-hook 'emacs-lisp-mode-hook 'semantic-default-elisp-setup) @@ -960,6 +963,12 @@ ELisp variables can be pretty long, so track this one too.") '(require 'semantic/db-el) ) + (provide 'semantic/bovine/el) +;; Local variables: +;; generated-autoload-file: "../loaddefs.el" +;; generated-autoload-load-name: "semantic/bovine/el" +;; End: + ;;; semantic/bovine/el.el ends here diff --git a/lisp/cedet/semantic/bovine/gcc.el b/lisp/cedet/semantic/bovine/gcc.el index 82876adb37e..7beb8ff3203 100644 --- a/lisp/cedet/semantic/bovine/gcc.el +++ b/lisp/cedet/semantic/bovine/gcc.el @@ -157,7 +157,11 @@ It should also include other symbols GCC was compiled with.") ;; `cpp' command in `semantic-gcc-setup' doesn't work on ;; Mac, try `gcc'. (apply 'semantic-gcc-query "gcc" cpp-options)))) - (defines (semantic-cpp-defs query)) + (defines (if (stringp query) + (semantic-cpp-defs query) + (message (concat "Could not query gcc for defines. " + "Maybe g++ is not installed.")) + nil)) (ver (cdr (assoc 'version fields))) (host (or (cdr (assoc 'target fields)) (cdr (assoc '--target fields)) diff --git a/lisp/cedet/semantic/bovine/grammar.el b/lisp/cedet/semantic/bovine/grammar.el index 138f15bc447..0133ee72b18 100644 --- a/lisp/cedet/semantic/bovine/grammar.el +++ b/lisp/cedet/semantic/bovine/grammar.el @@ -455,7 +455,7 @@ Menu items are appended to the common grammar menu.") (with-current-buffer (find-file-noselect f) (semantic-grammar-create-package)) (error (message "%s" (error-message-string err)) nil))) - lang filename) + lang filename copyright-end) (when (and packagename (string-match "^.*/\\(.*\\)-by\\.el\\'" packagename)) (setq lang (match-string 1 packagename)) @@ -503,4 +503,8 @@ Menu items are appended to the common grammar menu.") (provide 'semantic/bovine/grammar) +;; Local variables: +;; generated-autoload-load-name: "semantic/bovine/grammar" +;; End: + ;;; semantic/bovine/grammar.el ends here diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el index 194e0ee5f66..b42e24fb9c0 100644 --- a/lisp/cedet/semantic/complete.el +++ b/lisp/cedet/semantic/complete.el @@ -678,7 +678,8 @@ a reasonable distance." ;;(message "Inline Hook installed, but overlay deleted.") (semantic-complete-inline-exit)) ;; Exit if commands caused us to exit the area of interest - (let ((s (semantic-overlay-start semantic-complete-inline-overlay)) + (let ((os (semantic-overlay-get semantic-complete-inline-overlay 'semantic-original-start)) + (s (semantic-overlay-start semantic-complete-inline-overlay)) (e (semantic-overlay-end semantic-complete-inline-overlay)) (b (semantic-overlay-buffer semantic-complete-inline-overlay)) (txt nil) @@ -686,8 +687,10 @@ a reasonable distance." (cond ;; EXIT when we are no longer in a good place. ((or (not (eq b (current-buffer))) - (<= (point) s) - (> (point) e)) + (< (point) s) + (< (point) os) + (> (point) e) + ) ;;(message "Exit: %S %S %S" s e (point)) (semantic-complete-inline-exit) ) @@ -710,7 +713,6 @@ a reasonable distance." (t ;; Else, show completions now (semantic-complete-inline-force-display) - )))) ;; If something goes terribly wrong, clean up after ourselves. (error (semantic-complete-inline-exit)))) @@ -761,6 +763,10 @@ END is at the end of the current symbol being completed." (semantic-overlay-put semantic-complete-inline-overlay 'window-config-start (current-window-configuration)) + ;; Save the original start. We need to exit completion if START + ;; moves. + (semantic-overlay-put semantic-complete-inline-overlay + 'semantic-original-start start) ;; Install our command hooks (add-hook 'pre-command-hook 'semantic-complete-pre-command-hook) (add-hook 'post-command-hook 'semantic-complete-post-command-hook) @@ -982,14 +988,17 @@ Calculate the cache if there isn't one." "Calculate the completions for prefix from completionlist. Output must be in semanticdb Find result format." ;; Must output in semanticdb format + (unless completionlist + (setq completionlist + (or (oref obj cache) + (semantic-collector-calculate-cache obj)))) (let ((table (with-current-buffer (oref obj buffer) semanticdb-current-table)) (result (semantic-find-tags-for-completion prefix ;; To do this kind of search with a pre-built completion ;; list, we need to strip it first. - (semanticdb-strip-find-results completionlist))) - ) + (semanticdb-strip-find-results completionlist)))) (if result (list (cons table result))))) @@ -1171,7 +1180,7 @@ These collectors track themselves on a per-buffer basis." (let ((old nil) (bl semantic-collector-per-buffer-list)) (while (and bl (null old)) - (if (eq (object-class (car bl)) this) + (if (eq (eieio-object-class (car bl)) this) (setq old (car bl)))) (unless old (let ((new (call-next-method))) @@ -1510,7 +1519,7 @@ one in the source buffer." (insert (semantic-format-tag-summarize tag nil t) "\n\n") (when table (insert "From table: \n") - (insert (object-name table) "\n\n")) + (insert (eieio-object-name table) "\n\n")) (when buf (insert "In buffer: \n\n") (insert (format "%S" buf))) @@ -1658,7 +1667,7 @@ Display mechanism using tooltip for a list of possible completions.") (setq msg "..."))) ((eq mode 'verbose) ;; Always show extended match set. - (oset obj max-tags semantic-displayor-tooltip-max-tags) + (oset obj max-tags-initial semantic-displayor-tooltip-max-tags) (setq max-tags semantic-displayor-tooltip-max-tags))) (unless msg (oset obj shown t) diff --git a/lisp/cedet/semantic/ctxt.el b/lisp/cedet/semantic/ctxt.el index 2c0b428c195..efaec4f63b4 100644 --- a/lisp/cedet/semantic/ctxt.el +++ b/lisp/cedet/semantic/ctxt.el @@ -357,6 +357,87 @@ beginning and end of a command." (def-edebug-spec semantic-with-buffer-narrowed-to-command (def-body)))) +(define-overloadable-function semantic-ctxt-end-of-symbol (&optional point) + "Move point to the end of the current symbol under POINT. +This skips forward over symbols in a complex reference. +For example, in the C statement: + this.that().entry; + +If the cursor is on 'this', will move point to the ; after entry.") + +(defun semantic-ctxt-end-of-symbol-default (&optional point) + "Move poin to the end of the current symbol under POINT. +This will move past type/field names when applicable. +Depends on `semantic-type-relation-separator-character', and will +work on C like languages." + (if point (goto-char point)) + (let* ((fieldsep1 (mapconcat (lambda (a) (regexp-quote a)) + semantic-type-relation-separator-character + "\\|")) + ;; NOTE: The [ \n] expression below should used \\s-, but that + ;; doesn't work in C since \n means end-of-comment, and isn't + ;; really whitespace. + (fieldsep (concat "[ \t\n\r]*\\(" fieldsep1 "\\)[ \t\n\r]*\\(\\w\\|\\s_\\)")) + (case-fold-search semantic-case-fold) + (continuesearch t) + (end nil) + ) + (with-syntax-table semantic-lex-syntax-table + (cond ((looking-at "\\w\\|\\s_") + ;; In the middle of a symbol, move to the end. + (forward-sexp 1)) + ((looking-at fieldsep1) + ;; We are in a fine spot.. do nothing. + nil + ) + ((save-excursion + (and (condition-case nil + (progn (forward-sexp -1) + (forward-sexp 1) + t) + (error nil)) + (looking-at fieldsep1))) + (setq symlist (list "")) + (forward-sexp -1) + ;; Skip array expressions. + (while (looking-at "\\s(") (forward-sexp -1)) + (forward-sexp 1)) + ) + ;; Set the current end marker. + (setq end (point)) + + ;; Cursor is at the safe end of some symbol. Look until we + ;; find the logical end of this current complex symbol. + (condition-case nil + (while continuesearch + ;; If there are functional arguments, arrays, etc, skip them. + (when (looking-at "\\s(") + (forward-sexp 1)) + + ;; If there is a field separator, then skip that, plus + ;; the next expected symbol. + (if (not (looking-at fieldsep1)) + ;; We hit the end. + (error nil) + + ;; Skip the separator and the symbol. + (goto-char (match-end 0)) + + (if (looking-at "\\w\\|\\s_") + ;; Skip symbols + (forward-sexp 1) + ;; No symbol, exit the search... + (setq continuesearch nil)) + + (setq end (point))) + + ;; Cont... + ) + + ;; Restore position if we go to far.... + (error (goto-char end)) ) + + ))) (define-overloadable-function semantic-ctxt-current-symbol (&optional point) "Return the current symbol the cursor is on at POINT in a list. @@ -391,7 +472,7 @@ Depends on `semantic-type-relation-separator-character'." ;; In the middle of a symbol, move to the end. (forward-sexp 1)) ((looking-at fieldsep1) - ;; We are in a find spot.. do nothing. + ;; We are in a fine spot.. do nothing. nil ) ((save-excursion diff --git a/lisp/cedet/semantic/db-ebrowse.el b/lisp/cedet/semantic/db-ebrowse.el index f067a30eb91..a62ac549ea7 100644 --- a/lisp/cedet/semantic/db-ebrowse.el +++ b/lisp/cedet/semantic/db-ebrowse.el @@ -660,4 +660,8 @@ Return a list of tags." (provide 'semantic/db-ebrowse) +;; Local variables: +;; generated-autoload-load-name: "semantic/db-ebrowse" +;; End: + ;;; semantic/db-ebrowse.el ends here diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el index 260f964c191..1b0f3292ad3 100644 --- a/lisp/cedet/semantic/db-el.el +++ b/lisp/cedet/semantic/db-el.el @@ -216,9 +216,8 @@ TOKTYPE is a hint to the type of tag desired." (symbol-name sym) "class" (semantic-elisp-desymbolify - (aref (class-v semanticdb-project-database) - class-public-a)) ;; slots - (semantic-elisp-desymbolify (class-parents sym)) ;; parents + (eieio--class-public-a (class-v semanticdb-project-database))) ;; slots + (semantic-elisp-desymbolify (eieio-class-parents sym)) ;; parents )) ((not toktype) ;; Figure it out on our own. diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el index 269ff264126..2ef4fba1288 100644 --- a/lisp/cedet/semantic/db-file.el +++ b/lisp/cedet/semantic/db-file.el @@ -44,6 +44,8 @@ (defcustom semanticdb-default-save-directory (locate-user-emacs-file "semanticdb" ".semanticdb") "Directory name where semantic cache files are stored. +By default, it is either ~/.emacs.d/semanticdb, or ~/.semanticdb depending +on which exists. If this value is nil, files are saved in the current directory. If the value is a valid directory, then it overrides `semanticdb-default-file-name' and stores caches in a coded file name in this directory." @@ -316,7 +318,7 @@ Argument OBJ is the object to write." (data-debug-new-buffer (concat "*SEMANTICDB ERROR*")) (data-debug-insert-thing obj "*" "") (setq semanticdb-data-debug-on-write-error nil)) - (message "Error Writing Table: %s" (object-name obj)) + (message "Error Writing Table: %s" (eieio-object-name obj)) (error "%S" (car (cdr tableerror))))) ;; Clear the dirty bit. diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el index 77fd10fc7aa..91b1e34b690 100644 --- a/lisp/cedet/semantic/db-find.el +++ b/lisp/cedet/semantic/db-find.el @@ -130,12 +130,12 @@ (declare-function ede-current-project "ede") (defvar semanticdb-find-throttle-custom-list - '(repeat (radio (const 'local) - (const 'project) - (const 'unloaded) - (const 'system) - (const 'recursive) - (const 'omniscience))) + '(set (const local) + (const project) + (const unloaded) + (const system) + (const recursive) + (const omniscience)) "Customization values for semanticdb find throttle. See `semanticdb-find-throttle' for details.") @@ -244,7 +244,7 @@ This class will cache data derived during various searches.") (let ((tab-idx (semanticdb-get-table-index tab))) ;; Not a full reset? (when (oref tab-idx type-cache) - (require 'db-typecache) + (require 'semantic/db-typecache) (semanticdb-typecache-notify-reset (oref tab-idx type-cache))) ))) @@ -919,7 +919,7 @@ but should be good enough for debugging assertions." (if (< (length result) 2) (concat "#<FIND RESULT " (mapconcat (lambda (a) - (concat "(" (object-name (car a) ) " . " + (concat "(" (eieio-object-name (car a) ) " . " "#<TAG LIST " (number-to-string (length (cdr a))) ">)")) result " ") @@ -1285,7 +1285,7 @@ associated with that tag should be loaded into a buffer." (semanticdb-find-tags-collector (lambda (table tags) (semanticdb-find-tags-external-children-of-type-method table type tags)) - path find-file-match)) + path find-file-match t)) (defun semanticdb-find-tags-subclasses-of-type (type &optional path find-file-match) diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el index a6088231c61..8d9cfcccd7d 100644 --- a/lisp/cedet/semantic/db.el +++ b/lisp/cedet/semantic/db.el @@ -190,7 +190,7 @@ If one doesn't exist, create it." (oref obj index) (let ((idx nil)) (setq idx (funcall semanticdb-default-find-index-class - (concat (object-name obj) " index") + (concat (eieio-object-name obj) " index") ;; Fill in the defaults :table obj )) @@ -469,7 +469,7 @@ other than :table." (let ((cache (oref table cache)) (obj nil)) (while (and (not obj) cache) - (if (eq (object-class-fast (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 +520,7 @@ other than :table." (let ((cache (oref db cache)) (obj nil)) (while (and (not obj) cache) - (if (eq (object-class-fast (car cache)) desired-class) + (if (eq (eieio--object-class (car cache)) desired-class) (setq obj (car cache))) (setq cache (cdr cache))) (if obj @@ -899,7 +899,7 @@ If file does not have tags available, and DONTLOAD is nil, then load the tags for FILE, and create a new table object for it. DONTLOAD does not affect the creation of new database objects." ;; (message "Object Translate: %s" file) - (when (and file (file-exists-p file)) + (when (and file (file-exists-p file) (file-regular-p file)) (let* ((default-directory (file-name-directory file)) (tab (semanticdb-file-table-object-from-hash file)) (fullfile nil)) diff --git a/lisp/cedet/semantic/decorate/include.el b/lisp/cedet/semantic/decorate/include.el index 3a08db2b0d0..0451ad44fe8 100644 --- a/lisp/cedet/semantic/decorate/include.el +++ b/lisp/cedet/semantic/decorate/include.el @@ -797,7 +797,7 @@ Argument EVENT describes the event that caused this function to be called." (dolist (p path) (if (slot-boundp p 'tags) (princ (format "\n %s :\t%d tags, %d are includes. %s" - (object-name-string p) + (eieio-object-name-string p) (length (oref p tags)) (length (semantic-find-tags-by-class 'include p)) @@ -810,7 +810,7 @@ Argument EVENT describes the event that caused this function to be called." " Needs to be parsed.") (t "")))) (princ (format "\n %s :\tUnparsed" - (object-name-string p)))) + (eieio-object-name-string p)))) ))) ))) diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el index fc791f52da1..3487e615168 100644 --- a/lisp/cedet/semantic/decorate/mode.el +++ b/lisp/cedet/semantic/decorate/mode.el @@ -64,6 +64,14 @@ add items to this list." "Return the STYLE's highlighter function." (intern (format "%s-highlight" style))) +(defsubst semantic-decorate-style-predicate-default (style) + "Return the STYLE's predicate function." + (intern (format "%s-p-default" style))) + +(defsubst semantic-decorate-style-highlighter-default (style) + "Return the STYLE's highlighter function." + (intern (format "%s-highlight-default" style))) + ;;; Base decoration API ;; (defsubst semantic-decoration-p (object) @@ -265,8 +273,6 @@ minor mode is enabled." (semantic-make-local-hook 'semantic-after-toplevel-cache-change-hook) (add-hook 'semantic-after-toplevel-cache-change-hook 'semantic-decorate-tags-after-full-reparse nil t) - ;; Decorate includes by default - (require 'semantic/decorate/include) ;; Add decorations to available tags. The above hooks ensure ;; that new tags will be decorated when they become available. (semantic-decorate-add-decorations (semantic-fetch-available-tags))) @@ -325,6 +331,8 @@ Return non-nil if the decoration style is enabled." (flag (if arg (> (prefix-numeric-value arg) 0) (not (cdr style))))) + (when (null style) + (error "Unknown decoration style %s" name)) (unless (eq (cdr style) flag) ;; Store the new flag. (setcdr style flag) @@ -368,7 +376,8 @@ DOC is a documentation string describing the decoration style NAME. It is appended to auto-generated doc strings. An Optional list of FLAGS can also be specified. Flags are: :enabled <value> - specify the default enabled value for NAME. - + :load <value> - specify a feature (as a string) with the rest of + the definition for decoration mode NAME. This defines two new overload functions respectively called `NAME-p' and `NAME-highlight', for which you must provide a default @@ -386,9 +395,14 @@ To add other kind of decorations on a tag, `NAME-highlight' must use decoration API found in this library." (let ((predicate (semantic-decorate-style-predicate name)) (highlighter (semantic-decorate-style-highlighter name)) + (predicatedef (semantic-decorate-style-predicate-default name)) + (highlighterdef (semantic-decorate-style-highlighter-default name)) (defaultenable (if (plist-member flags :enabled) (plist-get flags :enabled) t)) + (loadfile (if (plist-member flags :load) + (plist-get flags :load) + nil)) ) `(progn ;; Clear the menu cache so that new items are added when @@ -408,7 +422,19 @@ decoration API found in this library." (add-to-list 'semantic-decoration-styles (cons ',(symbol-name name) ,defaultenable)) - ))) + ;; If there is a load file, then create the autload tokens for + ;; those functions to load the token, but only if the fsym + ;; doesn't exist yet. + (when (stringp ,loadfile) + (unless (fboundp ',predicatedef) + (autoload ',predicatedef ',loadfile "Return non-nil to decorate TAG." + nil 'function)) + + (unless (fboundp ',highlighterdef) + (autoload ',highlighterdef ',loadfile "Decorate TAG." + nil 'function)) + )) + )) ;;; Predefined decoration styles ;; @@ -514,6 +540,16 @@ Use a primary decoration." (semantic-set-tag-face tag 'semantic-decoration-on-protected-members-face)) +;;; Decoration Modes in other files +;; +(define-semantic-decoration-style semantic-decoration-on-includes + "Highlight class members that are includes. +This mode provides a nice context menu on the include statements." + :enabled t + :load "semantic/decorate/include") + + + (provide 'semantic/decorate/mode) ;; Local variables: diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el index 094832a8258..17859e232a3 100644 --- a/lisp/cedet/semantic/ede-grammar.el +++ b/lisp/cedet/semantic/ede-grammar.el @@ -146,7 +146,7 @@ Lays claim to all -by.el, and -wy.el files." (let* ((package (semantic-grammar-create-package)) (fname (progn (string-match ".*/\\(.+\\.el\\)" package) (match-string 1 package))) - (src (with-current-buffer fname (buffer-file-name))) + (src (ede-expand-filename obj fname)) (csrc (concat (file-name-sans-extension src) ".elc"))) (if (< emacs-major-version 24) ;; Does not have `byte-recompile-file' @@ -162,7 +162,7 @@ Lays claim to all -by.el, and -wy.el files." (setq comp (1+ comp)) (setq utd (1+ utd)))))))) (oref obj source)) - (message "All Semantic Grammar sources are up to date in %s" (object-name obj)) + (message "All Semantic Grammar sources are up to date in %s" (eieio-object-name obj)) (cons comp utd))) ;;; Makefile generation functions diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el index b0540af373d..a27eab5404c 100644 --- a/lisp/cedet/semantic/edit.el +++ b/lisp/cedet/semantic/edit.el @@ -141,8 +141,9 @@ Argument START, END, and LENGTH specify the bounds of the change." (setq semantic-unmatched-syntax-cache-check t) (let ((inhibit-point-motion-hooks t) ) - (run-hook-with-args 'semantic-change-functions start end length) - )) + (save-match-data + (run-hook-with-args 'semantic-change-functions start end length) + ))) (defun semantic-changes-in-region (start end &optional buffer) "Find change overlays which exist in whole or in part between START and END. diff --git a/lisp/cedet/semantic/find.el b/lisp/cedet/semantic/find.el index aa42a77725e..f660c69ec3d 100644 --- a/lisp/cedet/semantic/find.el +++ b/lisp/cedet/semantic/find.el @@ -313,6 +313,15 @@ TABLE is a tag table. See `semantic-something-to-tag-table'." (eq ,class (semantic-tag-class (car tags))) ,table)) +(defmacro semantic-filter-tags-by-class (class &optional table) + "Find all tags of class not in the list CLASS in TABLE. +CLASS is a list of symbols representing the class of the token, +such as 'variable, of 'function.. +TABLE is a tag table. See `semantic-something-to-tag-table'." + `(semantic--find-tags-by-macro + (not (memq (semantic-tag-class (car tags)) ,class)) + ,table)) + (defmacro semantic-find-tags-by-type (type &optional table) "Find all tags of with a type TYPE in TABLE. TYPE is a string or tag representing a data type as defined in the diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index ba4570e692b..ce658cd5d54 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -48,8 +48,7 @@ (require 'semantic/find) (require 'semantic/db)) -(declare-function semantic-grammar-wy--install-parser - "semantic/gram-wy-fallback") +(declare-function semantic-grammar-wy--install-parser "semantic/grammar-wy") ;;;; @@ -1485,7 +1484,10 @@ expression then Lisp symbols are completed." (interactive) (if (semantic-grammar-in-lisp-p) ;; We are in lisp code. Do lisp completion. - (lisp-complete-symbol) + (let ((completion-at-point-functions + (append '(lisp-completion-at-point) + completion-at-point-functions))) + (completion-at-point)) ;; We are not in lisp code. Do rule completion. (let* ((nonterms (semantic-find-tags-by-class 'nonterminal (current-buffer))) (sym (car (semantic-ctxt-current-symbol))) @@ -1910,4 +1912,8 @@ Optional argument COLOR determines if color is added to the text." (provide 'semantic/grammar) +;; Local variables: +;; generated-autoload-load-name: "semantic/grammar" +;; End: + ;;; semantic/grammar.el ends here diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el index 9899ab974f7..6c223c2b9f2 100644 --- a/lisp/cedet/semantic/idle.el +++ b/lisp/cedet/semantic/idle.el @@ -434,16 +434,27 @@ datasets." (defun semantic-idle-scheduler-work-parse-neighboring-files () "Parse all the files in similar directories to buffers being edited." - ;; Let's check to see if EDE matters. - (let ((ede-auto-add-method 'never)) - (dolist (a auto-mode-alist) - (when (eq (cdr a) major-mode) - (dolist (file (directory-files default-directory t (car a) t)) - (semantic-throw-on-input 'parsing-mode-buffers) - (save-excursion - (semanticdb-file-table-object file) - )))) - )) + ;; Let's tell EDE to ignore all the files we're about to load + (let ((ede-auto-add-method 'never) + (matching-auto-mode-patterns nil)) + ;; Collect all patterns matching files of the same mode we edit. + (mapc (lambda (pat) (and (eq (cdr pat) major-mode) + (push (car pat) matching-auto-mode-patterns))) + auto-mode-alist) + ;; Loop over all files, and if one matches our mode, we force its + ;; table to load. + (dolist (file (directory-files default-directory t ".*" t)) + (catch 'found + (mapc (lambda (pat) + (semantic-throw-on-input 'parsing-mode-buffers) + ;; We use string-match instead of passing the pattern + ;; into directory files, because some patterns don't + ;; work with directory files. + (and (string-match pat file) + (save-excursion + (semanticdb-file-table-object file)) + (throw 'found t))) + matching-auto-mode-patterns))))) ;;; REPARSING @@ -840,17 +851,18 @@ visible, then highlight it." ) (cond ((semantic-overlay-p region) (with-current-buffer (semantic-overlay-buffer region) - (goto-char (semantic-overlay-start region)) - (when (pos-visible-in-window-p - (point) (get-buffer-window (current-buffer) 'visible)) - (if (< (semantic-overlay-end region) (point-at-eol)) - (pulse-momentary-highlight-overlay - region semantic-idle-symbol-highlight-face) - ;; Not the same - (pulse-momentary-highlight-region - (semantic-overlay-start region) - (point-at-eol) - semantic-idle-symbol-highlight-face))) + (save-excursion + (goto-char (semantic-overlay-start region)) + (when (pos-visible-in-window-p + (point) (get-buffer-window (current-buffer) 'visible)) + (if (< (semantic-overlay-end region) (point-at-eol)) + (pulse-momentary-highlight-overlay + region semantic-idle-symbol-highlight-face) + ;; Not the same + (pulse-momentary-highlight-region + (semantic-overlay-start region) + (point-at-eol) + semantic-idle-symbol-highlight-face)))) )) ((vectorp region) (let ((start (aref region 0)) diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el index e7049fcefa7..b4e4bc5110d 100644 --- a/lisp/cedet/semantic/java.el +++ b/lisp/cedet/semantic/java.el @@ -480,4 +480,8 @@ removed from the result list." (provide 'semantic/java) +;; Local variables: +;; generated-autoload-load-name: "semantic/java" +;; End: + ;;; semantic/java.el ends here diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index ba862479be5..feead78985c 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -437,7 +437,7 @@ PROPSPECS must be a list of (TYPE PROPERTY VALUE)." (if default (message "*Warning* default value of <%s> tokens changed to %S, was %S" - type default token)) + type token default)) (setq default token))) ;; Ensure the default matching spec is the first one. (semantic-lex-type-set type (cons default (nreverse alist)))) diff --git a/lisp/cedet/semantic/sb.el b/lisp/cedet/semantic/sb.el index e2d143b529e..accee18f257 100644 --- a/lisp/cedet/semantic/sb.el +++ b/lisp/cedet/semantic/sb.el @@ -43,6 +43,11 @@ This will replace the named bucket that would have usually occurred here." :group 'speedbar :type 'integer) +(defvar semantic-sb-filter-tags-of-class '(code) + "Tags classes to not display in speedbar. +Make this buffer local for modes that have different types of tags +that should be ignored.") + (defcustom semantic-sb-button-format-tag-function 'semantic-format-tag-abbreviate "*Function called to create the text for a but from a token." :group 'speedbar @@ -318,7 +323,7 @@ TEXT TOKEN and INDENT are the details." ;; that other timer. ;; (speedbar-set-timer dframe-update-speed) ;;(recenter) - (speedbar-maybee-jump-to-attached-frame) + (dframe-maybee-jump-to-attached-frame) (run-hooks 'speedbar-visiting-tag-hook))) (defun semantic-sb-expand-group (text token indent) @@ -405,7 +410,12 @@ Returns the tag list, or t for an error." (setq out (semantic-adopt-external-members out)) ;; Dump all the tokens into buckets. (semantic-sb-with-tag-buffer (car out) - (semantic-bucketize out))) + (semantic-bucketize out nil + (lambda (tagsin) + ;; Remove all boring tags. + (semantic-filter-tags-by-class + semantic-sb-filter-tags-of-class + tagsin))))) (error t)) t))) @@ -415,4 +425,8 @@ Returns the tag list, or t for an error." (provide 'semantic/sb) +;; Local variables: +;; generated-autoload-load-name: "semantic/sb" +;; End: + ;;; semantic/sb.el ends here diff --git a/lisp/cedet/semantic/senator.el b/lisp/cedet/semantic/senator.el index a79e70a7f61..157223ff192 100644 --- a/lisp/cedet/semantic/senator.el +++ b/lisp/cedet/semantic/senator.el @@ -727,7 +727,13 @@ kill ring." (semantic-fetch-tags) (let ((ft (semantic-obtain-foreign-tag))) (when ft - (set-register register ft) + (set-register + register (registerv-make + ft + :insert-func #'semantic-insert-foreign-tag + :jump-func (lambda (v) + (switch-to-buffer (semantic-tag-buffer v)) + (goto-char (semantic-tag-start v))))) (if kill-flag (kill-region (semantic-tag-start ft) (semantic-tag-end ft)))))) diff --git a/lisp/cedet/semantic/sort.el b/lisp/cedet/semantic/sort.el index 6b58689524c..b32e11290ac 100644 --- a/lisp/cedet/semantic/sort.el +++ b/lisp/cedet/semantic/sort.el @@ -522,7 +522,7 @@ See `semantic-tag-external-member-children' for details." (semanticdb-minor-mode-p) (require 'semantic/db-find)) (let ((m (semanticdb-find-tags-external-children-of-type - (semantic-tag-name tag)))) + (semantic-tag-name tag) tag))) (if m (apply #'append (mapcar #'cdr m)))) (semantic--find-tags-by-function `(lambda (tok) diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el index 2391e59e1f4..c1f0a092afc 100644 --- a/lisp/cedet/semantic/symref/list.el +++ b/lisp/cedet/semantic/symref/list.el @@ -178,12 +178,12 @@ Display the references in`semantic-symref-results-mode'." (defcustom semantic-symref-auto-expand-results nil "Non-nil to expand symref results on buffer creation." - :group 'semantic-symref + :group 'semantic-symref-results-mode :type 'boolean) (defcustom semantic-symref-results-mode-hook nil "Hook run when `semantic-symref-results-mode' starts." - :group 'semantic-symref + :group 'semantic-symref-results-mode :type 'hook) (defvar semantic-symref-current-results nil @@ -217,7 +217,7 @@ RESULTS is an object of class `semantic-symref-results'." (defcustom semantic-symref-results-summary-function 'semantic-format-tag-prototype "*Function to use when creating items in Imenu. Some useful functions are found in `semantic-format-tag-functions'." - :group 'semantic-symref + :group 'semantic-symref-results-mode :type semantic-format-tag-custom-list) (defun semantic-symref-results-dump (results) diff --git a/lisp/cedet/semantic/tag-ls.el b/lisp/cedet/semantic/tag-ls.el index 7e5913334ea..bc7be980998 100644 --- a/lisp/cedet/semantic/tag-ls.el +++ b/lisp/cedet/semantic/tag-ls.el @@ -146,36 +146,42 @@ are the same. IGNORABLE-ATTRIBUTES are tag attributes that can be ignored. See `semantic-tag-similar-p' for details." - (let* ((ignore (append ignorable-attributes semantic-tag-similar-ignorable-attributes)) - (A1 (and (semantic--tag-similar-names-p tag1 tag2 (memq :name ignore)) - (semantic--tag-similar-types-p tag1 tag2) - (semantic-tag-of-class-p tag1 (semantic-tag-class tag2)))) - (attr1 (semantic-tag-attributes tag1)) - (attr2 (semantic-tag-attributes tag2)) - (A2 t) - (A3 t) - ) - ;; Test if there are non-ignorable attributes in A2 which are not present in A1 - (while (and A2 attr2) - (let ((a (car attr2))) - (unless (or (eq a :type) (memq a ignore)) - (setq A2 (semantic-tag-get-attribute tag1 a))) - (setq attr2 (cdr (cdr attr2))))) - (while (and A2 attr1 A3) - (let ((a (car attr1))) - - (cond ((or (eq a :type) ;; already tested above. - (memq a ignore)) ;; Ignore them... - nil) - - (t - (setq A3 - (semantic--tag-attribute-similar-p - a (car (cdr attr1)) (semantic-tag-get-attribute tag2 a) - ignorable-attributes))) - )) - (setq attr1 (cdr (cdr attr1)))) - (and A1 A2 A3))) + (or + ;; Tags are similar if they have the exact same lisp object + ;; Added for performance when testing a relatively common case in some uses + ;; of this code. + (eq tag1 tag2) + ;; More complex similarity test. + (let* ((ignore (append ignorable-attributes semantic-tag-similar-ignorable-attributes)) + (A1 (and (semantic--tag-similar-names-p tag1 tag2 (memq :name ignore)) + (semantic--tag-similar-types-p tag1 tag2) + (semantic-tag-of-class-p tag1 (semantic-tag-class tag2)))) + (attr1 (semantic-tag-attributes tag1)) + (attr2 (semantic-tag-attributes tag2)) + (A2 t) + (A3 t) + ) + ;; Test if there are non-ignorable attributes in A2 which are not present in A1 + (while (and A2 attr2) + (let ((a (car attr2))) + (unless (or (eq a :type) (memq a ignore)) + (setq A2 (semantic-tag-get-attribute tag1 a))) + (setq attr2 (cdr (cdr attr2))))) + (while (and A2 attr1 A3) + (let ((a (car attr1))) + + (cond ((or (eq a :type) ;; already tested above. + (memq a ignore)) ;; Ignore them... + nil) + + (t + (setq A3 + (semantic--tag-attribute-similar-p + a (car (cdr attr1)) (semantic-tag-get-attribute tag2 a) + ignorable-attributes))) + )) + (setq attr1 (cdr (cdr attr1)))) + (and A1 A2 A3)))) ;;; FULL NAMES ;; diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el index 6b3341f83ac..48a83f2cc79 100644 --- a/lisp/cedet/semantic/wisent/comp.el +++ b/lisp/cedet/semantic/wisent/comp.el @@ -3548,6 +3548,7 @@ See also `wisent-compile-grammar' for more details on AUTOMATON." ;; Local variables: ;; byte-compile-warnings: (not lexical) +;; generated-autoload-load-name: "semantic/wisent/comp" ;; End: ;;; semantic/wisent/comp.el ends here diff --git a/lisp/cedet/semantic/wisent/grammar.el b/lisp/cedet/semantic/wisent/grammar.el index d7edec8c4b8..109d5ae7dfb 100644 --- a/lisp/cedet/semantic/wisent/grammar.el +++ b/lisp/cedet/semantic/wisent/grammar.el @@ -523,4 +523,8 @@ Menu items are appended to the common grammar menu.") (provide 'semantic/wisent/grammar) +;; Local variables: +;; generated-autoload-load-name: "semantic/wisent/grammar" +;; End: + ;;; semantic/wisent/grammar.el ends here diff --git a/lisp/cedet/semantic/wisent/javat-wy.el b/lisp/cedet/semantic/wisent/javat-wy.el index f082358c4f5..1156cb5792c 100644 --- a/lisp/cedet/semantic/wisent/javat-wy.el +++ b/lisp/cedet/semantic/wisent/javat-wy.el @@ -28,6 +28,8 @@ ;;; Prologue ;; +(declare-function semantic-parse-region "semantic" + (start end &optional nonterminal depth returnonerror)) ;;; Declarations ;; diff --git a/lisp/cedet/semantic/wisent/js-wy.el b/lisp/cedet/semantic/wisent/js-wy.el index 817afa861d4..2e331b1c4d9 100644 --- a/lisp/cedet/semantic/wisent/js-wy.el +++ b/lisp/cedet/semantic/wisent/js-wy.el @@ -64,6 +64,8 @@ ;;; Prologue ;; +(declare-function semantic-parse-region "semantic" + (start end &optional nonterminal depth returnonerror)) ;;; Declarations ;; diff --git a/lisp/cedet/semantic/wisent/python-wy.el b/lisp/cedet/semantic/wisent/python-wy.el index 836fe232d56..bfa96ff1a88 100644 --- a/lisp/cedet/semantic/wisent/python-wy.el +++ b/lisp/cedet/semantic/wisent/python-wy.el @@ -81,8 +81,12 @@ ;;; Prologue ;; -(declare-function wisent-python-reconstitute-function-tag "semantic/wisent/python") -(declare-function wisent-python-reconstitute-class-tag "semantic/wisent/python") +(declare-function wisent-python-reconstitute-function-tag + "semantic/wisent/python" (tag suite)) +(declare-function wisent-python-reconstitute-class-tag "semantic/wisent/python" + (tag)) +(declare-function semantic-parse-region "semantic" + (start end &optional nonterminal depth returnonerror)) ;;; Declarations ;; diff --git a/lisp/cedet/semantic/wisent/python.el b/lisp/cedet/semantic/wisent/python.el index 8ca398ef271..719868f7635 100644 --- a/lisp/cedet/semantic/wisent/python.el +++ b/lisp/cedet/semantic/wisent/python.el @@ -485,6 +485,20 @@ Return a list as per `semantic-ctxt-current-symbol'. Return nil if there is nothing relevant." nil) +;;; Tag Formatting +;; +(define-mode-local-override semantic-format-tag-abbreviate python-mode (tag &optional parent color) + "Format an abbreviated tag for python. +Shortens 'code' tags, but passes through for others." + (cond ((semantic-tag-of-class-p tag 'code) + ;; Just take the first line. + (let ((name (semantic-tag-name tag))) + (when (string-match "\n" name) + (setq name (substring name 0 (match-beginning 0)))) + name)) + (t + (semantic-format-tag-abbreviate-default tag parent color)))) + ;;; Enable Semantic in `python-mode'. ;; diff --git a/lisp/cedet/semantic/wisent/wisent.el b/lisp/cedet/semantic/wisent/wisent.el index 32788381b23..8a3318cd00f 100644 --- a/lisp/cedet/semantic/wisent/wisent.el +++ b/lisp/cedet/semantic/wisent/wisent.el @@ -475,4 +475,8 @@ automaton has only one entry point." (provide 'semantic/wisent/wisent) +;; Local variables: +;; generated-autoload-load-name: "semantic/wisent/wisent" +;; End: + ;;; semantic/wisent/wisent.el ends here diff --git a/lisp/cedet/srecode/args.el b/lisp/cedet/srecode/args.el index b91f96f611d..6bc78295fa7 100644 --- a/lisp/cedet/srecode/args.el +++ b/lisp/cedet/srecode/args.el @@ -26,6 +26,7 @@ ;; a set of simple arguments for srecode templates. (require 'srecode/dictionary) +(require 'ede) ;;; Code: @@ -157,6 +158,30 @@ do not contain any text from preceding or following text." (srecode-dictionary-show-section dict "RCS") ))) +;;; :project ARGUMENT HANDLING +;; +;; When the :project argument is required, fill the dictionary with +;; information that the current project (from EDE) might know +(defun srecode-semantic-handle-:project (dict) + "Add macros into the dictionary DICT based on the current ede project." + (let* ((bfn (buffer-file-name)) + (dir (file-name-directory bfn))) + (if (ede-toplevel) + (let* ((projecttop (ede-toplevel-project default-directory)) + (relfname (file-relative-name bfn projecttop)) + (reldir (file-relative-name dir projecttop)) + ) + (srecode-dictionary-set-value dict "PROJECT_FILENAME" relfname) + (srecode-dictionary-set-value dict "PROJECT_DIRECTORY" reldir) + (srecode-dictionary-set-value dict "PROJECT_NAME" (ede-name (ede-toplevel))) + (srecode-dictionary-set-value dict "PROJECT_VERSION" (oref (ede-toplevel) :version)) + ) + ;; If there is no EDE project, then put in some base values. + (srecode-dictionary-set-value dict "PROJECT_FILENAME" bfn) + (srecode-dictionary-set-value dict "PROJECT_DIRECTORY" dir) + (srecode-dictionary-set-value dict "PROJECT_NAME" "N/A") + (srecode-dictionary-set-value dict "PROJECT_VERSION" "1.0")))) + ;;; :system ARGUMENT HANDLING ;; ;; When a :system argument is required, fill the dictionary with diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el index 170b99c1fd2..542fd49f8e5 100644 --- a/lisp/cedet/srecode/compile.el +++ b/lisp/cedet/srecode/compile.el @@ -200,10 +200,11 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." "Compile a semantic recode template file into a mode-local variable." (interactive) (unless (semantic-active-p) - (error "You have to activate semantic-mode to compile SRecode templates.")) + (error "You have to activate semantic-mode to compile SRecode templates")) (require 'srecode/insert) - (message "Compiling template %s..." - (file-name-nondirectory (buffer-file-name))) + (when (called-interactively-p 'interactive) + (message "Compiling template %s..." + (file-name-nondirectory (buffer-file-name)))) (let ((tags (semantic-fetch-tags)) (tag nil) (class nil) @@ -288,10 +289,11 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." ) ;; Continue (setq tags (cdr tags))) - + ;; MSG - Before install since nreverse whacks our list. - (message "%d templates compiled for %s" - (length table) mode) + (when (called-interactively-p 'interactive) + (message "%d templates compiled for %s" + (length table) mode)) ;; ;; APPLY TO MODE @@ -316,12 +318,14 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." (if (stringp project) (setq priority (+ 50 defaultdelta)) (setq priority (+ 80 defaultdelta)))) - (message "Templates %s has estimated priority of %d" - (file-name-nondirectory (buffer-file-name)) - priority)) - (message "Compiling templates %s priority %d... done!" - (file-name-nondirectory (buffer-file-name)) - priority)) + (when (called-interactively-p 'interactive) + (message "Templates %s has estimated priority of %d" + (file-name-nondirectory (buffer-file-name)) + priority))) + (when (called-interactively-p 'interactive) + (message "Compiling templates %s priority %d... done!" + (file-name-nondirectory (buffer-file-name)) + priority))) ;; Save it up! (srecode-compile-template-table table mode priority application framework project vars) @@ -510,12 +514,12 @@ to the inserter constructor." ;;(message "Compile: %s %S" name props) (if (not key) (apply 'srecode-template-inserter-variable name props) - (let ((classes (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. (while (and (not new) classes) - (setq classes (append classes (class-children (car classes)))) + (setq classes (append classes (eieio-class-children (car classes)))) ;; Do we have a match? (when (and (not (class-abstract-p (car classes))) (equal (oref (car classes) key) key)) @@ -594,7 +598,7 @@ A list of defined variables VARS provides a variable table." (defmethod srecode-dump ((tmp srecode-template)) "Dump the contents of the SRecode template tmp." (princ "== Template \"") - (princ (object-name-string tmp)) + (princ (eieio-object-name-string tmp)) (princ "\" in context ") (princ (oref tmp context)) (princ "\n") @@ -640,12 +644,12 @@ Argument INDENT specifies the indentation level for the list." (defmethod srecode-dump ((ins srecode-template-inserter) indent) "Dump the state of the SRecode template inserter INS." (princ "INS: \"") - (princ (object-name-string ins)) + (princ (eieio-object-name-string ins)) (when (oref ins :secondname) (princ "\" : \"") (princ (oref ins :secondname))) (princ "\" type \"") - (let* ((oc (symbol-name (object-class ins))) + (let* ((oc (symbol-name (eieio-object-class ins))) (junk (string-match "srecode-template-inserter-" oc)) (on (if junk (substring oc (match-end 0)) diff --git a/lisp/cedet/srecode/cpp.el b/lisp/cedet/srecode/cpp.el index 94b394a1631..fd500b6d9a3 100644 --- a/lisp/cedet/srecode/cpp.el +++ b/lisp/cedet/srecode/cpp.el @@ -70,8 +70,7 @@ HEADER - Shown section if in a header file." (srecode-dictionary-show-section dict "NOTHEADER")) ;; Strip out bad characters - (while (string-match "\\.\\| " fsym) - (setq fsym (replace-match "_" t t fsym))) + (setq fsym (replace-regexp-in-string "[^a-zA-Z0-9_]" "_" fsym)) (srecode-dictionary-set-value dict "FILENAME_SYMBOL" fsym) ) ) diff --git a/lisp/cedet/srecode/dictionary.el b/lisp/cedet/srecode/dictionary.el index bac05666726..bbc791f09d8 100644 --- a/lisp/cedet/srecode/dictionary.el +++ b/lisp/cedet/srecode/dictionary.el @@ -175,7 +175,7 @@ associated with a buffer or parent." ((srecode-dictionary-child-p buffer-or-parent) (setq parent buffer-or-parent buffer (oref buffer-or-parent buffer) - origin (concat (object-name buffer-or-parent) " in " + origin (concat (eieio-object-name buffer-or-parent) " in " (if buffer (buffer-name buffer) "no buffer"))) (when buffer @@ -454,12 +454,12 @@ If you subclass `srecode-dictionary-compound-value' then this method could return nil, but if it does that, it must insert the value itself using `princ', or by detecting if the current standard out is a buffer, and using `insert'." - (object-name cp)) + (eieio-object-name cp)) (defmethod srecode-dump ((cp srecode-dictionary-compound-value) &optional indent) "Display information about this compound value." - (princ (object-name cp)) + (princ (eieio-object-name cp)) ) (defmethod srecode-compound-toString ((cp srecode-dictionary-compound-variable) @@ -654,7 +654,7 @@ STATE is the current compiler state." 4))) (while entry (princ " --> SUBDICTIONARY ") - (princ (object-name dict)) + (princ (eieio-object-name dict)) (princ "\n") (srecode-dump (car entry) newindent) (setq entry (cdr entry)) diff --git a/lisp/cedet/srecode/fields.el b/lisp/cedet/srecode/fields.el index 652702ea8f2..ea856f3a394 100644 --- a/lisp/cedet/srecode/fields.el +++ b/lisp/cedet/srecode/fields.el @@ -447,4 +447,8 @@ PRE-LEN is used in the after mode for the length of the changed text." (provide 'srecode/fields) +;; Local variables: +;; generated-autoload-load-name: "srecode/fields" +;; End: + ;;; srecode/fields.el ends here diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el index 466efae3b9c..0d647bb56c5 100644 --- a/lisp/cedet/srecode/insert.el +++ b/lisp/cedet/srecode/insert.el @@ -809,7 +809,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." (srecode-insert-report-error dict "Only section dictionaries allowed for `%s'" - (object-name-string sti))) + (eieio-object-name-string sti))) ;; Output the code from the sub-template. (srecode-insert-method (slot-value sti slot) dict)) @@ -866,7 +866,7 @@ Return the remains of INPUT." (let* ((out (srecode-compile-split-code tag input STATE (oref ins :object-name)))) (oset ins template (srecode-template - (object-name-string ins) + (eieio-object-name-string ins) :context nil :args nil :code (cdr out))) diff --git a/lisp/cedet/srecode/java.el b/lisp/cedet/srecode/java.el index db4d2deee28..1b8922c2746 100644 --- a/lisp/cedet/srecode/java.el +++ b/lisp/cedet/srecode/java.el @@ -27,6 +27,7 @@ (require 'srecode/dictionary) (require 'semantic/find) +(require 'ede) ;;;###autoload (defun srecode-semantic-handle-:java (dict) @@ -42,9 +43,24 @@ FILENAME_AS_CLASS - file converted to a Java class name." ) (while (string-match "\\.\\| " fpak) (setq fpak (replace-match "_" t t fpak))) - (if (string-match "src/" dir) - (setq dir (substring dir (match-end 0))) - (setq dir (file-name-nondirectory (directory-file-name dir)))) + ;; 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)) + (while (and (not res) + (setq pth (expand-file-name (car pths)))) + (when (string-match pth dir) + (setq res (substring dir (match-end 0)))) + (setq pths (cdr pths))) + (setq dir res))) + ;; 2) a simple heuristic + ((string-match "src/" dir) + (setq dir (substring dir (match-end 0)))) + ;; 3) outer directory as a fallback + (t (setq dir (file-name-nondirectory (directory-file-name dir))))) (setq dir (directory-file-name dir)) (while (string-match "/" dir) (setq dir (replace-match "." t t dir))) diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el index cbe602f3299..1dd9ba4cf47 100644 --- a/lisp/cedet/srecode/map.el +++ b/lisp/cedet/srecode/map.el @@ -363,6 +363,9 @@ Return non-nil if the map changed." (let ((semantic-init-hook nil)) (semantic-new-buffer-fcn)) ) + ;; Force semantic to be enabled in this buffer. + (unless (semantic-active-p) + (semantic-new-buffer-fcn)) (semantic-fetch-tags) (let* ((mode-tag diff --git a/lisp/cedet/srecode/mode.el b/lisp/cedet/srecode/mode.el index 8c4a53ec891..e8e1c78198e 100644 --- a/lisp/cedet/srecode/mode.el +++ b/lisp/cedet/srecode/mode.el @@ -225,7 +225,7 @@ MENU-DEF is the menu to bind this into." (ctxtcons (assoc ctxt alltabs)) (bind (if (slot-boundp temp 'binding) (oref temp binding))) - (name (object-name-string temp))) + (name (eieio-object-name-string temp))) (when (not ctxtcons) (if (string= context ctxt) diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el index 455895c003d..2f43dc3872b 100644 --- a/lisp/cedet/srecode/srt-mode.el +++ b/lisp/cedet/srecode/srt-mode.el @@ -187,7 +187,7 @@ we can tell font lock about them.") "Keymap used in srecode mode.") ;;;###autoload -(define-derived-mode srecode-template-mode fundamental-mode "SRecorder" +(define-derived-mode srecode-template-mode fundamental-mode "SRecode" "Major-mode for writing SRecode macros." (set (make-local-variable 'comment-start) ";;") (set (make-local-variable 'comment-end) "") @@ -232,7 +232,7 @@ we can tell font lock about them.") "Provide help for working with macros in a template." (interactive) (let* ((root 'srecode-template-inserter) - (chl (aref (class-v root) class-children)) + (chl (eieio--class-children (class-v root))) (ess (srecode-template-get-escape-start)) (ees (srecode-template-get-escape-end)) ) @@ -248,7 +248,7 @@ we can tell font lock about them.") (showexample t) ) (setq chl (cdr chl)) - (setq chl (append (aref (class-v C) class-children) chl)) + (setq chl (append (eieio--class-children (class-v C)) chl)) (catch 'skip (when (eq C 'srecode-template-inserter-section-end) diff --git a/lisp/cedet/srecode/srt-wy.el b/lisp/cedet/srecode/srt-wy.el index 5560d35a70c..450f57d943c 100644 --- a/lisp/cedet/srecode/srt-wy.el +++ b/lisp/cedet/srecode/srt-wy.el @@ -131,6 +131,10 @@ ((SET symbol insertable-string-list newline) (wisent-raw-tag (semantic-tag-new-variable $2 nil $3))) + ((SET symbol number newline) + (wisent-raw-tag + (semantic-tag-new-variable $2 nil + (list $3)))) ((SHOW symbol newline) (wisent-raw-tag (semantic-tag-new-variable $2 nil t)))) @@ -290,8 +294,8 @@ It ignores whitespace, newlines and comments." srecode-template-separator-block srecode-template-wy--<keyword>-keyword-analyzer srecode-template-property-analyzer - srecode-template-wy--<symbol>-regexp-analyzer srecode-template-wy--<number>-regexp-analyzer + srecode-template-wy--<symbol>-regexp-analyzer srecode-template-wy--<string>-sexp-analyzer srecode-template-wy--<punctuation>-string-analyzer semantic-lex-default-action diff --git a/lisp/cedet/srecode/srt.el b/lisp/cedet/srecode/srt.el index 3875246cb37..1fad31dafd6 100644 --- a/lisp/cedet/srecode/srt.el +++ b/lisp/cedet/srecode/srt.el @@ -69,6 +69,7 @@ DEFAULT is the default if RET is hit." nil initial (or hist 'srecode-read-major-mode-history)) ) +;;;###autoload (defun srecode-semantic-handle-:srt (dict) "Add macros into the dictionary DICT based on the current SRT file. Adds the following: @@ -104,4 +105,9 @@ MODE - The mode of this buffer. If not declared yet, guess." (provide 'srecode/srt) +;; Local variables: +;; generated-autoload-file: "loaddefs.el" +;; generated-autoload-load-name: "srecode/srt" +;; End: + ;;; srecode/srt.el ends here diff --git a/lisp/cedet/srecode/table.el b/lisp/cedet/srecode/table.el index 802740ba063..26163bd1e51 100644 --- a/lisp/cedet/srecode/table.el +++ b/lisp/cedet/srecode/table.el @@ -251,7 +251,7 @@ Use PREDICATE is the same as for the `sort' function." (defmethod srecode-dump ((tab srecode-template-table)) "Dump the contents of the SRecode template table TAB." (princ "Template Table for ") - (princ (object-name-string tab)) + (princ (eieio-object-name-string tab)) (princ "\nPriority: ") (prin1 (oref tab :priority)) (when (oref tab :application) diff --git a/lisp/comint.el b/lisp/comint.el index 93db4e24f2a..592f63fa683 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -148,10 +148,11 @@ "Completion facilities in comint." :group 'comint) -(defgroup comint-source nil - "Source finding facilities in comint." - :prefix "comint-" - :group 'comint) +;; Unused. +;;; (defgroup comint-source nil +;;; "Source finding facilities in comint." +;;; :prefix "comint-" +;;; :group 'comint) (defvar comint-prompt-regexp "^" "Regexp to recognize prompts in the inferior process. @@ -213,7 +214,7 @@ This mirrors the optional behavior of tcsh (its autoexpand and histlist). If the value is `input', then the expansion is seen on input. If the value is `history', then the expansion is only when inserting into the buffer's input ring. See also `comint-magic-space' and -`comint-dynamic-complete'. +`completion-at-point'. This variable is buffer-local." :type '(choice (const :tag "off" nil) @@ -350,7 +351,7 @@ This variable is buffer-local." '("password" "Password" "passphrase" "Passphrase" "pass phrase" "Pass phrase" "Response")) "\\(?:\\(?:, try\\)? *again\\| (empty for no passphrase)\\| (again)\\)?\ -\\(?: for [^:]+\\)?:\\s *\\'") +\\(?: for .+\\)?:\\s *\\'") "Regexp matching prompts for passwords in the inferior process. This is used by `comint-watch-for-password-prompt'." :version "24.1" @@ -371,7 +372,7 @@ text matching `comint-prompt-regexp', depending on the value of '(comint-c-a-p-replace-by-expanded-history comint-filename-completion) "List of functions called to perform completion. Works like `completion-at-point-functions'. -See also `comint-dynamic-complete'. +See also `completion-at-point'. This is a good thing to set in mode hooks.") @@ -616,7 +617,7 @@ Input ring expansion is controlled by the variable `comint-input-autoexpand', and addition is controlled by the variable `comint-input-ignoredups'. Commands with no default key bindings include `send-invisible', -`comint-dynamic-complete', `comint-dynamic-list-filename-completions', and +`completion-at-point', `comint-dynamic-list-filename-completions', and `comint-magic-space'. Input to, and output from, the subprocess can cause the window to scroll to @@ -631,10 +632,10 @@ to continue it. Entry to this mode runs the hooks on `comint-mode-hook'." (setq mode-line-process '(":%s")) - (set (make-local-variable 'window-point-insertion-type) t) - (set (make-local-variable 'comint-last-input-start) (point-min-marker)) - (set (make-local-variable 'comint-last-input-end) (point-min-marker)) - (set (make-local-variable 'comint-last-output-start) (make-marker)) + (setq-local window-point-insertion-type t) + (setq-local comint-last-input-start (point-min-marker)) + (setq-local comint-last-input-end (point-min-marker)) + (setq-local comint-last-output-start (make-marker)) (make-local-variable 'comint-last-prompt-overlay) (make-local-variable 'comint-prompt-regexp) ; Don't set; default (make-local-variable 'comint-input-ring-size) ; ...to global val. @@ -676,17 +677,15 @@ Entry to this mode runs the hooks on `comint-mode-hook'." (make-local-variable 'comint-file-name-chars) (make-local-variable 'comint-file-name-quote-list) ;; dir tracking on remote files - (set (make-local-variable 'comint-file-name-prefix) - (or (file-remote-p default-directory) "")) - (make-local-variable 'comint-accum-marker) - (setq comint-accum-marker (make-marker)) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(nil t)) + (setq-local comint-file-name-prefix + (or (file-remote-p default-directory) "")) + (setq-local comint-accum-marker (make-marker)) + (setq-local font-lock-defaults '(nil t)) (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) (add-hook 'isearch-mode-hook 'comint-history-isearch-setup nil t) (add-hook 'completion-at-point-functions 'comint-completion-at-point nil t) ;; This behavior is not useful in comint buffers, and is annoying - (set (make-local-variable 'next-line-add-newlines) nil)) + (setq-local next-line-add-newlines nil)) (defun comint-check-proc (buffer) "Return non-nil if there is a living process associated w/buffer BUFFER. @@ -778,8 +777,7 @@ series of processes in the same Comint buffer. The hook (open-network-stream name buffer (car command) (cdr command)) (comint-exec-1 name buffer command switches)))) (set-process-filter proc 'comint-output-filter) - (make-local-variable 'comint-ptyp) - (setq comint-ptyp process-connection-type) ; t if pty, nil if pipe. + (setq-local comint-ptyp process-connection-type) ; t if pty, nil if pipe. ;; Jump to the end, and set the process mark. (goto-char (point-max)) (set-marker (process-mark proc) (point)) @@ -1191,7 +1189,9 @@ If N is negative, find the next or Nth next match." (setq comint-stored-incomplete-input (funcall comint-get-old-input))) (setq comint-input-ring-index pos) - (message "History item: %d" (1+ pos)) + (unless isearch-mode + (let ((message-log-max nil)) ; Do not write to *Messages*. + (message "History item: %d" (1+ pos)))) (comint-delete-input) (insert (ring-ref comint-input-ring pos))))) @@ -1414,8 +1414,7 @@ If nil, Isearch operates on the whole comint buffer." (let ((comint-history-isearch t)) (isearch-backward-regexp))) -(defvar comint-history-isearch-message-overlay nil) -(make-variable-buffer-local 'comint-history-isearch-message-overlay) +(defvar-local comint-history-isearch-message-overlay nil) (defun comint-history-isearch-setup () "Set up a comint for using Isearch to search the input history. @@ -1425,14 +1424,14 @@ Intended to be added to `isearch-mode-hook' in `comint-mode'." ;; Point is at command line. (comint-after-pmark-p))) (setq isearch-message-prefix-add "history ") - (set (make-local-variable 'isearch-search-fun-function) - 'comint-history-isearch-search) - (set (make-local-variable 'isearch-message-function) - 'comint-history-isearch-message) - (set (make-local-variable 'isearch-wrap-function) - 'comint-history-isearch-wrap) - (set (make-local-variable 'isearch-push-state-function) - 'comint-history-isearch-push-state) + (setq-local isearch-search-fun-function + #'comint-history-isearch-search) + (setq-local isearch-message-function + #'comint-history-isearch-message) + (setq-local isearch-wrap-function + #'comint-history-isearch-wrap) + (setq-local isearch-push-state-function + #'comint-history-isearch-push-state) (add-hook 'isearch-mode-end-hook 'comint-history-isearch-end nil t))) (defun comint-history-isearch-end () @@ -1540,8 +1539,11 @@ the function `isearch-message'." (overlay-put comint-history-isearch-message-overlay 'evaporate t)) (overlay-put comint-history-isearch-message-overlay 'display (isearch-message-prefix c-q-hack ellipsis)) - ;; And clear any previous isearch message. - (message ""))) + (if (and comint-input-ring-index (not ellipsis)) + ;; Display the current history index. + (message "History item: %d" (1+ comint-input-ring-index)) + ;; Or clear a previous isearch message. + (message "")))) (defun comint-history-isearch-wrap () "Wrap the input history search when search fails. @@ -2585,10 +2587,8 @@ text matching `comint-prompt-regexp'." (comint-next-prompt (- n))) ;; State used by `comint-insert-previous-argument' when cycling. -(defvar comint-insert-previous-argument-last-start-pos nil) -(make-variable-buffer-local 'comint-insert-previous-argument-last-start-pos) -(defvar comint-insert-previous-argument-last-index nil) -(make-variable-buffer-local 'comint-insert-previous-argument-last-index) +(defvar-local comint-insert-previous-argument-last-start-pos nil) +(defvar-local comint-insert-previous-argument-last-index nil) ;; Needs fixing: ;; make comint-arguments understand negative indices as bash does @@ -2892,7 +2892,7 @@ its response can be seen." ;; Useful completion functions, courtesy of the Ergo group. ;; Six commands: -;; comint-dynamic-complete Complete or expand command, filename, +;; completion-at-point Complete or expand command, filename, ;; history at point. ;; comint-dynamic-complete-filename Complete filename at point. ;; comint-dynamic-list-filename-completions List completions in help buffer. @@ -2901,7 +2901,7 @@ its response can be seen." ;; These are not installed in the comint-mode keymap. But they are ;; available for people who want them. Shell-mode installs them: -;; (define-key shell-mode-map "\t" 'comint-dynamic-complete) +;; (define-key shell-mode-map "\t" 'completion-at-point) ;; (define-key shell-mode-map "\M-?" ;; 'comint-dynamic-list-filename-completions))) ;; @@ -3315,8 +3315,8 @@ Typing SPC flushes the completions buffer." ;; Read the next key, to process SPC. (let (key first) (if (with-current-buffer (get-buffer "*Completions*") - (set (make-local-variable 'comint-displayed-dynamic-completions) - completions) + (setq-local comint-displayed-dynamic-completions + completions) (setq key (read-key-sequence nil) first (aref key 0)) (and (consp first) (consp (event-start first)) @@ -3491,11 +3491,6 @@ buffer. The idea is that this regular expression should match a prompt string, and that there ought to be at least one copy of your prompt string in the process buffer already.") -(defvar comint-redirect-original-filter-function nil - "The process filter that was in place when redirection is started. -When redirection is completed, the process filter is restored to -this value.") - (defvar comint-redirect-subvert-readonly nil "Non-nil means `comint-redirect' can insert into read-only buffers. This works by binding `inhibit-read-only' around the insertion. @@ -3529,23 +3524,17 @@ This function is called by `comint-redirect-send-command-to-process', and does not normally need to be invoked by the end user or programmer." (with-current-buffer comint-buffer - (make-local-variable 'comint-redirect-original-mode-line-process) - (setq comint-redirect-original-mode-line-process mode-line-process) + (setq-local comint-redirect-original-mode-line-process mode-line-process) - (make-local-variable 'comint-redirect-output-buffer) - (setq comint-redirect-output-buffer output-buffer) + (setq-local comint-redirect-output-buffer output-buffer) - (make-local-variable 'comint-redirect-finished-regexp) - (setq comint-redirect-finished-regexp finished-regexp) + (setq-local comint-redirect-finished-regexp finished-regexp) - (make-local-variable 'comint-redirect-echo-input) - (setq comint-redirect-echo-input echo-input) + (setq-local comint-redirect-echo-input echo-input) - (make-local-variable 'comint-redirect-completed) - (setq comint-redirect-completed nil) + (setq-local comint-redirect-completed nil) - (make-local-variable 'comint-redirect-previous-input-string) - (setq comint-redirect-previous-input-string "") + (setq-local comint-redirect-previous-input-string "") (setq mode-line-process (if mode-line-process @@ -3558,8 +3547,8 @@ and does not normally need to be invoked by the end user or programmer." ;; Release the last redirected string (setq comint-redirect-previous-input-string nil) ;; Restore the process filter - (set-process-filter (get-buffer-process (current-buffer)) - comint-redirect-original-filter-function) + (remove-function (process-filter (get-buffer-process (current-buffer))) + #'comint-redirect-filter) ;; Restore the mode line (setq mode-line-process comint-redirect-original-mode-line-process) ;; Set the completed flag @@ -3569,7 +3558,7 @@ and does not normally need to be invoked by the end user or programmer." ;; that it really occurs. (defalias 'comint-redirect-remove-redirection 'comint-redirect-cleanup) -(defun comint-redirect-filter (process input-string) +(defun comint-redirect-filter (orig-filter process input-string) "Filter function which redirects output from PROCESS to a buffer or buffers. The variable `comint-redirect-output-buffer' says which buffer(s) to place output in. @@ -3583,9 +3572,8 @@ end user." (comint-redirect-preoutput-filter input-string) ;; If we have to echo output, give it to the original filter function (and comint-redirect-echo-input - comint-redirect-original-filter-function - (funcall comint-redirect-original-filter-function - process input-string))))) + orig-filter + (funcall orig-filter process input-string))))) (defun comint-redirect-preoutput-filter (input-string) @@ -3701,10 +3689,8 @@ If NO-DISPLAY is non-nil, do not show the output buffer." comint-prompt-regexp ; Finished Regexp echo) ; Echo input - ;; Set the filter - (setq comint-redirect-original-filter-function ; Save the old filter - (process-filter proc)) - (set-process-filter proc 'comint-redirect-filter) + ;; Set the filter. + (add-function :around (process-filter proc) #'comint-redirect-filter) ;; Send the command (process-send-string (current-buffer) (concat command "\n")) @@ -3812,7 +3798,7 @@ REGEXP-GROUP is the regular expression group in REGEXP to use." ;; (setq shell-mode-map (copy-keymap comint-mode-map)) ;; (define-key shell-mode-map "\C-c\C-f" 'shell-forward-command) ;; (define-key shell-mode-map "\C-c\C-b" 'shell-backward-command) -;; (define-key shell-mode-map "\t" 'comint-dynamic-complete) +;; (define-key shell-mode-map "\t" 'completion-at-point) ;; (define-key shell-mode-map "\M-?" ;; 'comint-dynamic-list-filename-completions))) ;; @@ -3823,8 +3809,7 @@ REGEXP-GROUP is the regular expression group in REGEXP to use." ;; (setq major-mode 'shell-mode) ;; (setq mode-name "Shell") ;; (use-local-map shell-mode-map) -;; (make-local-variable 'shell-directory-stack) -;; (setq shell-directory-stack nil) +;; (setq-local shell-directory-stack nil) ;; (add-hook 'comint-input-filter-functions 'shell-directory-tracker) ;; (run-mode-hooks 'shell-mode-hook)) ;; diff --git a/lisp/completion.el b/lisp/completion.el index 974d59c9af5..3fbc3c05fb4 100644 --- a/lisp/completion.el +++ b/lisp/completion.el @@ -2342,6 +2342,7 @@ With a prefix argument ARG, enable the mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil." :global t + :group 'completion ;; This is always good, not specific to dynamic-completion-mode. (define-key function-key-map [C-return] [?\C-\r]) diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el index 60b427344ea..a7718ffb920 100644 --- a/lisp/cus-dep.el +++ b/lisp/cus-dep.el @@ -36,38 +36,52 @@ ldefs-boot\\|cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)" "Regexp matching file names not to scan for `custom-make-dependencies'.") -(autoload 'autoload-rubric "autoload") +(require 'autoload) + +;; Hack workaround for bug#14384. +;; Define defcustom-mh as an alias for defcustom, etc. +;; Only do this in batch mode to avoid messing up a normal Emacs session. +;; Alternative would be to load mh-e when making cus-load. +;; (Would be better to split just the necessary parts of mh-e into a +;; separate file and only load that.) +(when (and noninteractive) + (mapc (lambda (e) (let ((sym (intern (format "%s-mh" e)))) + (or (fboundp sym) + (defalias sym e)))) + '(defcustom defface defgroup))) (defun custom-make-dependencies () "Batch function to extract custom dependencies from .el files. Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" (let ((enable-local-eval nil) + (enable-local-variables :safe) subdir) (with-temp-buffer ;; Use up command-line-args-left else Emacs can try to open ;; the args as directories after we are done. (while (setq subdir (pop command-line-args-left)) (message "Directory %s" subdir) - (let ((files (directory-files subdir nil "\\`[^=].*\\.el\\'")) + (let ((files (directory-files subdir nil "\\`[^=.].*\\.el\\'")) (default-directory (expand-file-name subdir)) - (preloaded (concat "\\`" - (regexp-opt (mapcar - 'file-name-base - preloaded-file-list) t) + (preloaded (concat "\\`\\(\\./+\\)?" + (regexp-opt preloaded-file-list t) "\\.el\\'"))) (dolist (file files) (unless (or (string-match custom-dependencies-no-scan-regexp file) - (string-match preloaded file) + (string-match preloaded (format "%s/%s" subdir file)) (not (file-exists-p file))) (erase-buffer) + (kill-all-local-variables) (insert-file-contents file) + (hack-local-variables) (goto-char (point-min)) (string-match "\\`\\(.*\\)\\.el\\'" file) - (let ((name (file-name-nondirectory (match-string 1 file))) + (let ((name (or generated-autoload-load-name ; see bug#5277 + (file-name-nondirectory (match-string 1 file)))) (load-file-name file)) (if (save-excursion (re-search-forward - (concat "(provide[ \t\n]+\\('\\|(quote[ \t\n]\\)[ \t\n]*" + (concat "(\\(cc-\\)?provide[ \t\n]+\\('\\|(quote[ \t\n]\\)[ \t\n]*" (regexp-quote name) "[ \t\n)]") nil t)) (setq name (intern name))) @@ -75,12 +89,30 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" (while (re-search-forward "^(def\\(custom\\|face\\|group\\)" nil t) (beginning-of-line) - (let ((expr (read (current-buffer)))) + (let ((type (match-string 1)) + (expr (read (current-buffer)))) (condition-case nil (let ((custom-dont-initialize t)) - (eval expr) - (put (nth 1 expr) 'custom-where name)) - (error nil)))) + ;; Eval to get the 'custom-group, -tag, + ;; -version, group-documentation etc properties. + (put (nth 1 expr) 'custom-where name) + (eval expr)) + ;; Eval failed for some reason. Eg maybe the + ;; defcustom uses something defined earlier + ;; in the file (we haven't loaded the file). + ;; In most cases, we can still get the :group. + (error + (ignore-errors + (let ((group (cadr (memq :group expr)))) + (and group + (eq (car group) 'quote) + (custom-add-to-group + (cadr group) + (nth 1 expr) + (intern (format "custom-%s" + (if (equal type "custom") + "variable" + type))))))))))) (error nil))))))))) (message "Generating %s..." generated-custom-dependencies-file) (set-buffer (find-file-noselect generated-custom-dependencies-file)) @@ -89,36 +121,32 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" (insert (autoload-rubric generated-custom-dependencies-file "custom dependencies" t)) (search-backward " ") - (mapatoms (lambda (symbol) - (let ((members (get symbol 'custom-group)) - where found) - (when members - (dolist (member - ;; So x and no-x builds won't differ. - (sort (mapcar 'car members) 'string<)) - (setq where (get member 'custom-where)) - (unless (or (null where) - (member where found)) - (push where found))) - (when found - (insert "(put '" (symbol-name symbol) - " 'custom-loads '") - (prin1 (nreverse found) (current-buffer)) - (insert ")\n")))))) + (let (alist) + (mapatoms (lambda (symbol) + (let ((members (get symbol 'custom-group)) + where found) + (when members + (dolist (member (mapcar 'car members)) + (setq where (get member 'custom-where)) + (unless (or (null where) + (member where found)) + (push where found))) + (when found + (push (cons (symbol-name symbol) + (with-output-to-string + (prin1 (sort found 'string<)))) alist)))))) + (dolist (e (sort alist (lambda (e1 e2) (string< (car e1) (car e2))))) + (insert "(put '" (car e) " 'custom-loads '" (cdr e) ")\n"))) (insert "\ -;; These are for handling :version. We need to have a minimum of -;; information so `customize-changed-options' could do its job. + +;; The remainder of this file is for handling :version. +;; We provide a minimum of information so that `customize-changed-options' +;; can do its job. ;; For groups we set `custom-version', `group-documentation' and ;; `custom-tag' (which are shown in the customize buffer), so we ;; don't have to load the file containing the group. -;; `custom-versions-load-alist' is an alist that has as car a version -;; number and as elts the files that have variables or faces that -;; contain that version. These files should be loaded before showing -;; the customization buffer that `customize-changed-options' -;; generates. - ;; This macro is used so we don't modify the information about ;; variables and groups if it's already set. (We don't know when ;; " (file-name-nondirectory generated-custom-dependencies-file) @@ -129,7 +157,8 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" (put ,symbol ,propname ,value))) ") - (let ((version-alist nil)) + (let ((version-alist nil) + groups) (mapatoms (lambda (symbol) (let ((version (get symbol 'custom-version)) where) @@ -147,28 +176,36 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" (push where (cdr (assoc version version-alist)))) (push (list version where) version-alist))) ;; This is a group - (insert "(custom-put-if-not '" (symbol-name symbol) - " 'custom-version ") - (prin1 version (current-buffer)) - (insert ")\n") - (insert "(custom-put-if-not '" (symbol-name symbol)) - (insert " 'group-documentation ") - (prin1 (get symbol 'group-documentation) (current-buffer)) - (insert ")\n") - (when (get symbol 'custom-tag) - (insert "(custom-put-if-not '" (symbol-name symbol)) - (insert " 'custom-tag ") - (prin1 (get symbol 'custom-tag) (current-buffer)) - (insert ")\n")) - )))))) + (push (list (symbol-name symbol) + (with-output-to-string (prin1 version)) + (with-output-to-string + (prin1 (get symbol 'group-documentation))) + (if (get symbol 'custom-tag) + (with-output-to-string + (prin1 (get symbol 'custom-tag))))) + groups))))))) + (dolist (e (sort groups (lambda (e1 e2) (string< (car e1) (car e2))))) + (insert "(custom-put-if-not '" (car e) " 'custom-version '" + (nth 1 e) ")\n") + (insert "(custom-put-if-not '" (car e) " 'group-documentation " + (nth 2 e) ")\n") + (if (nth 3 e) + (insert "(custom-put-if-not '" (car e) " 'custom-tag " + (nth 3 e) ")\n"))) (insert "\n(defvar custom-versions-load-alist " (if version-alist "'" "")) - (prin1 version-alist (current-buffer)) - (insert "\n \"For internal use by custom.\")\n")) + (prin1 (sort version-alist (lambda (e1 e2) (version< (car e1) (car e2)))) + (current-buffer)) + (insert "\n \"For internal use by custom. +This is an alist whose members have as car a version string, and as +elements the files that have variables or faces that contain that +version. These files should be loaded before showing the customization +buffer that `customize-changed-options' generates.\")\n\n")) (save-buffer) (message "Generating %s...done" generated-custom-dependencies-file)) +(provide 'cus-dep) ;;; cus-dep.el ends here diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index d19e2ded00c..d4966078e1d 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1319,7 +1319,8 @@ If OTHER-WINDOW is non-nil, display in another window. Interactively, when point is on text which has a face specified, suggest to customize that face, if it's customizable." - (interactive (list (read-face-name "Customize face" "all faces" t))) + (interactive (list (read-face-name "Customize face" + (or (face-at-point t t) "all faces") t))) (if (member face '(nil "")) (setq face (face-list))) (if (and (listp face) (null (cdr face))) @@ -1350,7 +1351,8 @@ If FACE is actually a face-alias, customize the face it is aliased to. Interactively, when point is on text which has a face specified, suggest to customize that face, if it's customizable." - (interactive (list (read-face-name "Customize face" "all faces" t))) + (interactive (list (read-face-name "Customize face" + (or (face-at-point t t) "all faces") t))) (customize-face face t)) (defalias 'customize-customized 'customize-unsaved) @@ -4529,7 +4531,15 @@ This function does not save the buffer." (princ " '(") (prin1 symbol) (princ " ") - (prin1 (car value)) + (let ((val (prin1-to-string (car value)))) + (if (< (length val) 60) + (insert val) + (newline-and-indent) + (let ((beginning-of-val (point))) + (insert val) + (save-excursion + (goto-char beginning-of-val) + (indent-pp-sexp 1))))) (when (or now requests comment) (princ " ") (prin1 now) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 2e442b6c944..cf94b6300dd 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -252,7 +252,9 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (use-file-dialog menu boolean "22.1") (focus-follows-mouse frames boolean "20.3") ;; fontset.c - (vertical-centering-font-regexp display regexp) + ;; FIXME nil is the initial value, fontset.el setqs it. + (vertical-centering-font-regexp display + (choice (const nil) regexp)) ;; frame.c (default-frame-alist frames (repeat (cons :format "%v" @@ -447,7 +449,8 @@ since it could result in memory overflow and make Emacs crash." (other :tag "Always (t)" :value t)) "24.3") ;; xdisp.c - (show-trailing-whitespace whitespace-faces boolean nil + ;; The whitespace group is for whitespace.el. + (show-trailing-whitespace editing-basics boolean nil :safe booleanp) (scroll-step windows integer) (scroll-conservatively windows integer) diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index cc1046eddc5..dbe4fa42d8e 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -263,7 +263,7 @@ interactively, this defaults to the current value of VAR." (defun custom-theme-add-face (face &optional spec) "Add a widget for FACE (a symbol) to the *New Custom Theme* buffer. SPEC, if non-nil, should be a face spec to which to set the widget." - (interactive (list (read-face-name "Face name" nil nil) nil)) + (interactive (list (read-face-name "Face name" (face-at-point t)))) (unless (or (facep face) spec) (error "`%s' has no face definition" face)) (let ((entry (assq face custom-theme-faces))) diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 2aea0a96215..774ee92a146 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -753,7 +753,7 @@ relevant to POS." (insert " by these characters:\n") (while (and (<= from to) (setq glyph (lgstring-glyph gstring from))) - (insert (format " %c (#x%d)\n" + (insert (format " %c (#x%x)\n" (lglyph-char glyph) (lglyph-char glyph))) (setq from (1+ from))))) (insert " by the rule:\n\t(") diff --git a/lisp/desktop.el b/lisp/desktop.el index 1151bd434bc..8e66a9b81a3 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -189,6 +189,19 @@ determine where the desktop is saved." :group 'desktop :version "22.1") +(defcustom desktop-auto-save-timeout nil + "Number of seconds between auto-saves of the desktop. +Zero or nil means disable timer-based auto-saving." + :type '(choice (const :tag "Off" nil) + (integer :tag "Seconds")) + :set (lambda (symbol value) + (set-default symbol value) + (condition-case nil + (desktop-auto-save-set-timer) + (error nil))) + :group 'desktop + :version "24.4") + (defcustom desktop-load-locked-desktop 'ask "Specifies whether the desktop should be loaded if locked. Possible values are: @@ -539,6 +552,10 @@ DIRNAME omitted or nil means use `desktop-dirname'." (defvar desktop-delay-hook nil "Hooks run after all buffers are loaded; intended for internal use.") +(defvar desktop-file-checksum nil + "Checksum of the last auto-saved contents of the desktop file. +Used to avoid writing contents unchanged between auto-saves.") + ;; ---------------------------------------------------------------------------- ;; Desktop file conflict detection (defvar desktop-file-modtime nil @@ -697,83 +714,69 @@ is nil, ask the user where to save the desktop." ll))) ;; ---------------------------------------------------------------------------- -(defun desktop-internal-v2s (value) - "Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE. -TXT is a string that when read and evaluated yields VALUE. +(defun desktop--v2s (value) + "Convert VALUE to a pair (QUOTE . SEXP); (eval SEXP) gives VALUE. +SEXP is an sexp that when evaluated yields VALUE. QUOTE may be `may' (value may be quoted), `must' (value must be quoted), or nil (value must not be quoted)." (cond ((or (numberp value) (null value) (eq t value) (keywordp value)) - (cons 'may (prin1-to-string value))) + (cons 'may value)) ((stringp value) (let ((copy (copy-sequence value))) (set-text-properties 0 (length copy) nil copy) - ;; Get rid of text properties because we cannot read them - (cons 'may (prin1-to-string copy)))) + ;; Get rid of text properties because we cannot read them. + (cons 'may copy))) ((symbolp value) - (cons 'must (prin1-to-string value))) + (cons 'must value)) ((vectorp value) - (let* ((special nil) - (pass1 (mapcar - (lambda (el) - (let ((res (desktop-internal-v2s el))) - (if (null (car res)) - (setq special t)) - res)) - value))) + (let* ((pass1 (mapcar #'desktop--v2s value)) + (special (assq nil pass1))) (if special - (cons nil (concat "(vector " - (mapconcat (lambda (el) - (if (eq (car el) 'must) - (concat "'" (cdr el)) - (cdr el))) - pass1 - " ") - ")")) - (cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]"))))) + (cons nil `(vector + ,@(mapcar (lambda (el) + (if (eq (car el) 'must) + `',(cdr el) (cdr el))) + pass1))) + (cons 'may `[,@(mapcar #'cdr pass1)])))) ((consp value) (let ((p value) newlist use-list* anynil) (while (consp p) - (let ((q.txt (desktop-internal-v2s (car p)))) - (or anynil (setq anynil (null (car q.txt)))) - (setq newlist (cons q.txt newlist))) + (let ((q.sexp (desktop--v2s (car p)))) + (push q.sexp newlist)) (setq p (cdr p))) - (if p - (let ((last (desktop-internal-v2s p))) - (or anynil (setq anynil (null (car last)))) - (or anynil - (setq newlist (cons '(must . ".") newlist))) - (setq use-list* t) - (setq newlist (cons last newlist)))) - (setq newlist (nreverse newlist)) - (if anynil + (when p + (let ((last (desktop--v2s p))) + (setq use-list* t) + (push last newlist))) + (if (assq nil newlist) (cons nil - (concat (if use-list* "(desktop-list* " "(list ") - (mapconcat (lambda (el) - (if (eq (car el) 'must) - (concat "'" (cdr el)) - (cdr el))) - newlist - " ") - ")")) + `(,(if use-list* 'desktop-list* 'list) + ,@(mapcar (lambda (el) + (if (eq (car el) 'must) + `',(cdr el) (cdr el))) + (nreverse newlist)))) (cons 'must - (concat "(" (mapconcat 'cdr newlist " ") ")"))))) + `(,@(mapcar #'cdr + (nreverse (if use-list* (cdr newlist) newlist))) + ,@(if use-list* (cdar newlist))))))) ((subrp value) - (cons nil (concat "(symbol-function '" - (substring (prin1-to-string value) 7 -1) - ")"))) + (cons nil `(symbol-function + ',(intern-soft (substring (prin1-to-string value) 7 -1))))) ((markerp value) - (let ((pos (prin1-to-string (marker-position value))) - (buf (prin1-to-string (buffer-name (marker-buffer value))))) - (cons nil (concat "(let ((mk (make-marker)))" - " (add-hook 'desktop-delay-hook" - " (list 'lambda '() (list 'set-marker mk " - pos " (get-buffer " buf ")))) mk)")))) - (t ; save as text - (cons 'may "\"Unprintable entity\"")))) + (let ((pos (marker-position value)) + (buf (buffer-name (marker-buffer value)))) + (cons nil + `(let ((mk (make-marker))) + (add-hook 'desktop-delay-hook + `(lambda () + (set-marker ,mk ,,pos (get-buffer ,,buf)))) + mk)))) + (t ; Save as text. + (cons 'may "Unprintable entity")))) ;; ---------------------------------------------------------------------------- (defun desktop-value-to-string (value) @@ -781,9 +784,11 @@ QUOTE may be `may' (value may be quoted), Not all types of values are supported." (let* ((print-escape-newlines t) (float-output-format nil) - (quote.txt (desktop-internal-v2s value)) - (quote (car quote.txt)) - (txt (cdr quote.txt))) + (quote.sexp (desktop--v2s value)) + (quote (car quote.sexp)) + (txt + (let ((print-quoted t)) + (prin1-to-string (cdr quote.sexp))))) (if (eq quote 'must) (concat "'" txt) txt))) @@ -854,11 +859,12 @@ DIRNAME must be the directory in which the desktop file will be saved." ;; ---------------------------------------------------------------------------- ;;;###autoload -(defun desktop-save (dirname &optional release) +(defun desktop-save (dirname &optional release auto-save) "Save the desktop in a desktop file. Parameter DIRNAME specifies where to save the desktop file. Optional parameter RELEASE says whether we're done with this desktop. -See also `desktop-base-file-name'." +If AUTO-SAVE is non-nil, compare the saved contents to the one last saved, +and don't save the buffer if they are the same." (interactive "DDirectory to save desktop file in: ") (setq desktop-dirname (file-name-as-directory (expand-file-name dirname))) (save-excursion @@ -918,10 +924,17 @@ See also `desktop-base-file-name'." (insert ")\n\n")))) (setq default-directory desktop-dirname) - (let ((coding-system-for-write 'emacs-mule)) - (write-region (point-min) (point-max) (desktop-full-file-name) nil 'nomessage)) - ;; We remember when it was modified (which is presumably just now). - (setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name))))))))) + ;; If auto-saving, avoid writing if nothing has changed since the last write. + ;; Don't check 300 characters of the header that contains the timestamp. + (let ((checksum (and auto-save (md5 (current-buffer) + (+ (point-min) 300) (point-max) + 'emacs-mule)))) + (unless (and auto-save (equal checksum desktop-file-checksum)) + (let ((coding-system-for-write 'emacs-mule)) + (write-region (point-min) (point-max) (desktop-full-file-name) nil 'nomessage)) + (setq desktop-file-checksum checksum) + ;; We remember when it was modified (which is presumably just now). + (setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name))))))))))) ;; ---------------------------------------------------------------------------- ;;;###autoload @@ -1075,6 +1088,37 @@ directory DIRNAME." (message "Desktop saved in %s" (abbreviate-file-name desktop-dirname))) ;; ---------------------------------------------------------------------------- +;; Auto-Saving. +(defvar desktop-auto-save-timer nil) + +(defun desktop-auto-save () + "Save the desktop periodically. +Called by the timer created in `desktop-auto-save-set-timer'." + (when (and desktop-save-mode + (integerp desktop-auto-save-timeout) + (> desktop-auto-save-timeout 0) + ;; Avoid desktop saving during lazy loading. + (not desktop-lazy-timer) + ;; Save only to own desktop file. + (eq (emacs-pid) (desktop-owner)) + desktop-dirname) + (desktop-save desktop-dirname nil t)) + (desktop-auto-save-set-timer)) + +(defun desktop-auto-save-set-timer () + "Reset the auto-save timer. +Cancel any previous timer. When `desktop-auto-save-timeout' is a positive +integer, start a new timer to call `desktop-auto-save' in that many seconds." + (when desktop-auto-save-timer + (cancel-timer desktop-auto-save-timer) + (setq desktop-auto-save-timer nil)) + (when (and (integerp desktop-auto-save-timeout) + (> desktop-auto-save-timeout 0)) + (setq desktop-auto-save-timer + (run-with-timer desktop-auto-save-timeout nil + 'desktop-auto-save)))) + +;; ---------------------------------------------------------------------------- ;;;###autoload (defun desktop-revert () "Revert to the last loaded desktop." @@ -1327,8 +1371,12 @@ If there are no buffers left to create, kill the timer." (setq desktop-save-mode nil))) (when desktop-save-mode (desktop-read) + (desktop-auto-save-set-timer) (setq inhibit-startup-screen t)))) +;; So we can restore vc-dir buffers. +(autoload 'vc-dir-mode "vc-dir" nil t) + (provide 'desktop) ;;; desktop.el ends here diff --git a/lisp/dframe.el b/lisp/dframe.el index 7f3a586ada3..21b508512d3 100644 --- a/lisp/dframe.el +++ b/lisp/dframe.el @@ -243,9 +243,6 @@ Local to those buffers, as a function called that created it.") "Return non-nil if FRAME is currently available." (and frame (frame-live-p frame) (frame-visible-p frame))) -(defvar x-sensitive-text-pointer-shape) -(defvar x-pointer-shape) - (defun dframe-frame-mode (arg frame-var cache-var buffer-var frame-name local-mode-fn &optional @@ -681,7 +678,7 @@ Optionally select that frame if necessary." "Non-nil means that `dframe-message' should just return a string.") (defun dframe-message (fmt &rest args) - "Like message, but for use in a dedicated frame. + "Like `message', but for use in a dedicated frame. Argument FMT is the format string, and ARGS are the arguments for message." (save-selected-window (if dframe-suppress-message-flag diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index f6ff32b0b01..7cb63f6b012 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -2491,18 +2491,16 @@ a file name. Otherwise, it searches the whole buffer without restrictions." :group 'dired :version "23.1") -(defvar dired-isearch-filter-predicate-orig nil) - (defun dired-isearch-filenames-toggle () "Toggle file names searching on or off. When on, Isearch skips matches outside file names using the predicate `dired-isearch-filter-filenames' that matches only at file names. When off, it uses the original predicate." (interactive) - (setq isearch-filter-predicate - (if (eq isearch-filter-predicate 'dired-isearch-filter-filenames) - dired-isearch-filter-predicate-orig - 'dired-isearch-filter-filenames)) + (setq isearch-filter-predicates + (if (memq 'dired-isearch-filter-filenames isearch-filter-predicates) + (delq 'dired-isearch-filter-filenames isearch-filter-predicates) + (cons 'dired-isearch-filter-filenames isearch-filter-predicates))) (setq isearch-success t isearch-adjusted t) (isearch-update)) @@ -2513,29 +2511,27 @@ Intended to be added to `isearch-mode-hook'." (when (or (eq dired-isearch-filenames t) (and (eq dired-isearch-filenames 'dwim) (get-text-property (point) 'dired-filename))) - (setq isearch-message-prefix-add "filename ") - (define-key isearch-mode-map "\M-sf" 'dired-isearch-filenames-toggle) - (setq dired-isearch-filter-predicate-orig - (default-value 'isearch-filter-predicate)) - (setq-default isearch-filter-predicate 'dired-isearch-filter-filenames) + (define-key isearch-mode-map "\M-sff" 'dired-isearch-filenames-toggle) + (add-hook 'isearch-filter-predicates 'dired-isearch-filter-filenames nil t) (add-hook 'isearch-mode-end-hook 'dired-isearch-filenames-end nil t))) (defun dired-isearch-filenames-end () "Clean up the Dired file name search after terminating isearch." (setq isearch-message-prefix-add nil) - (define-key isearch-mode-map "\M-sf" nil) - (setq-default isearch-filter-predicate dired-isearch-filter-predicate-orig) + (define-key isearch-mode-map "\M-sff" nil) + (remove-hook 'isearch-filter-predicates 'dired-isearch-filter-filenames t) (remove-hook 'isearch-mode-end-hook 'dired-isearch-filenames-end t)) (defun dired-isearch-filter-filenames (beg end) - "Test whether the current search hit is a visible file name. + "Test whether the current search hit is a file name. Return non-nil if the text from BEG to END is part of a file -name (has the text property `dired-filename') and is visible." - (and (isearch-filter-visible beg end) - (if dired-isearch-filenames - (text-property-not-all (min beg end) (max beg end) - 'dired-filename nil) - t))) +name (has the text property `dired-filename')." + (if dired-isearch-filenames + (text-property-not-all (min beg end) (max beg end) + 'dired-filename nil) + t)) + +(put 'dired-isearch-filter-filenames 'isearch-message-prefix "filename ") ;;;###autoload (defun dired-isearch-filenames () diff --git a/lisp/dired.el b/lisp/dired.el index f03e0aca475..5b6a78759db 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -3864,7 +3864,7 @@ Ask means pop up a menu for the user to select one of copy, move or link." ;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command ;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown ;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff -;;;;;; dired-diff) "dired-aux" "dired-aux.el" "d6a694b6d13fa948465fde52a9ffb3ba") +;;;;;; dired-diff) "dired-aux" "dired-aux.el" "8f5af3aa4eee1b3448525896fa6f39a3") ;;; Generated autoloads from dired-aux.el (autoload 'dired-diff "dired-aux" "\ diff --git a/lisp/doc-view.el b/lisp/doc-view.el index ee77f397746..e4434c3a0d8 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -1,6 +1,5 @@ ;;; doc-view.el --- View PDF/PostScript/DVI files in Emacs -*- lexical-binding: t -*- - ;; Copyright (C) 2007-2013 Free Software Foundation, Inc. ;; ;; Author: Tassilo Horn <tsdh@gnu.org> @@ -306,6 +305,9 @@ of the page moves to the previous page." ;;;; Internal Variables +(defvar-local doc-view--current-converter-processes nil + "Only used internally.") + (defun doc-view-new-window-function (winprops) ;; (message "New window %s for buf %s" (car winprops) (current-buffer)) (cl-assert (or (eq t (car winprops)) @@ -325,53 +327,35 @@ of the page moves to the previous page." (cl-assert (eq t (car winprops))) (delete-overlay ol)) (image-mode-window-put 'overlay ol winprops) - (when (windowp (car winprops)) - (if (stringp (get-char-property (point-min) 'display)) - ;; We're not already displaying an image, so this is the - ;; initial window showing the document. - (run-with-timer nil nil - (lambda () - ;; In case a conversion is running, the - ;; refresh will happen as defined by - ;; `doc-view-conversion-refresh-interval'. - (unless doc-view-current-converter-processes - (with-selected-window (car winprops) - (doc-view-goto-page 1))))) - ;; We've split the window showing the document. All we need - ;; to do is selecting the new window to make the image appear - ;; there, too. - (run-with-timer nil nil - (lambda () - (save-window-excursion - (select-window (car winprops))))))))) - -(defvar doc-view-current-files nil + (when (and (windowp (car winprops)) + (stringp (overlay-get ol 'display)) + (null doc-view--current-converter-processes)) + ;; We're not displaying an image yet, so let's do so. This happens when + ;; the buffer is displayed for the first time. + ;; 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))))) + +(defvar-local doc-view--current-files nil "Only used internally.") -(make-variable-buffer-local 'doc-view-current-files) -(defvar doc-view-current-converter-processes nil +(defvar-local doc-view--current-timer nil "Only used internally.") -(make-variable-buffer-local 'doc-view-current-converter-processes) -(defvar doc-view-current-timer nil +(defvar-local doc-view--current-cache-dir nil "Only used internally.") -(make-variable-buffer-local 'doc-view-current-timer) -(defvar doc-view-current-cache-dir nil +(defvar-local doc-view--current-search-matches nil "Only used internally.") -(make-variable-buffer-local 'doc-view-current-cache-dir) -(defvar doc-view-current-search-matches nil +(defvar doc-view--pending-cache-flush nil "Only used internally.") -(make-variable-buffer-local 'doc-view-current-search-matches) -(defvar doc-view-pending-cache-flush nil +(defvar doc-view--previous-major-mode nil "Only used internally.") -(defvar doc-view-previous-major-mode nil - "Only used internally.") - -(defvar doc-view-buffer-file-name nil +(defvar doc-view--buffer-file-name nil "Only used internally. The file name used for conversion. Normally it's the same as `buffer-file-name', but for remote files, compressed files and @@ -499,7 +483,7 @@ Typically \"page-%s.png\".") (defmacro doc-view-current-slice () `(image-mode-window-get 'slice)) (defun doc-view-last-page-number () - (length doc-view-current-files)) + (length doc-view--current-files)) (defun doc-view-goto-page (page) "View the page given by PAGE." @@ -510,7 +494,7 @@ Typically \"page-%s.png\".") (when (and (> page len) ;; As long as the converter is running, we don't know ;; how many pages will be available. - (null doc-view-current-converter-processes)) + (null doc-view--current-converter-processes)) (setq page len))) (setf (doc-view-current-page) page (doc-view-current-info) @@ -518,31 +502,31 @@ Typically \"page-%s.png\".") (propertize (format "Page %d of %d." page len) 'face 'bold) ;; Tell user if converting isn't finished yet - (if doc-view-current-converter-processes + (if doc-view--current-converter-processes " (still converting...)\n" "\n") ;; Display context infos if this page matches the last search - (when (and doc-view-current-search-matches - (assq page doc-view-current-search-matches)) + (when (and doc-view--current-search-matches + (assq page doc-view--current-search-matches)) (concat (propertize "Search matches:\n" 'face 'bold) (let ((contexts "")) (dolist (m (cdr (assq page - doc-view-current-search-matches))) + doc-view--current-search-matches))) (setq contexts (concat contexts " - \"" m "\"\n"))) contexts))))) ;; Update the buffer - ;; We used to find the file name from doc-view-current-files but + ;; We used to find the file name from doc-view--current-files but ;; that's not right if the pages are not generated sequentially - ;; or if the page isn't in doc-view-current-files yet. + ;; or if the page isn't in doc-view--current-files yet. (let ((file (expand-file-name (format doc-view--image-file-pattern page) - (doc-view-current-cache-dir)))) + (doc-view--current-cache-dir)))) (doc-view-insert-image file :pointer 'arrow) (when (and (not (file-exists-p file)) - doc-view-current-converter-processes) + doc-view--current-converter-processes) ;; The PNG file hasn't been generated yet. (funcall doc-view-single-page-converter-function - doc-view-buffer-file-name file page + doc-view--buffer-file-name file page (let ((win (selected-window))) (lambda () (and (eq (current-buffer) (window-buffer win)) @@ -647,13 +631,13 @@ at the top edge of the page moves to the previous page." (defun doc-view-kill-proc () "Kill the current converter process(es)." (interactive) - (while (consp doc-view-current-converter-processes) + (while (consp doc-view--current-converter-processes) (ignore-errors ;; Some entries might not be processes, and maybe ;; some are dead already? - (kill-process (pop doc-view-current-converter-processes)))) - (when doc-view-current-timer - (cancel-timer doc-view-current-timer) - (setq doc-view-current-timer nil)) + (kill-process (pop doc-view--current-converter-processes)))) + (when doc-view--current-timer + (cancel-timer doc-view--current-timer) + (setq doc-view--current-timer nil)) (setq mode-line-process nil)) (defun doc-view-kill-proc-and-buffer () @@ -693,21 +677,21 @@ at the top edge of the page moves to the previous page." (format "Unable to use temporary directory %s: %s" dir (mapconcat 'identity (cdr error) " ")))))))) -(defun doc-view-current-cache-dir () +(defun doc-view--current-cache-dir () "Return the directory where the png files of the current doc should be saved. It's a subdirectory of `doc-view-cache-directory'." - (if doc-view-current-cache-dir - doc-view-current-cache-dir + (if doc-view--current-cache-dir + doc-view--current-cache-dir ;; Try and make sure doc-view-cache-directory exists and is safe. (doc-view-make-safe-dir doc-view-cache-directory) ;; Now compute the subdirectory to use. - (setq doc-view-current-cache-dir + (setq doc-view--current-cache-dir (file-name-as-directory (expand-file-name (concat (subst-char-in-string ?% ?_ ;; bug#13679 - (file-name-nondirectory doc-view-buffer-file-name)) + (file-name-nondirectory doc-view--buffer-file-name)) "-" - (let ((file doc-view-buffer-file-name)) + (let ((file doc-view--buffer-file-name)) (with-temp-buffer (set-buffer-multibyte nil) (insert-file-contents-literally file) @@ -857,8 +841,8 @@ Should be invoked when the cached images aren't up-to-date." (interactive) (doc-view-kill-proc) ;; Clear the old cached files - (when (file-exists-p (doc-view-current-cache-dir)) - (delete-directory (doc-view-current-cache-dir) 'recursive)) + (when (file-exists-p (doc-view--current-cache-dir)) + (delete-directory (doc-view--current-cache-dir) 'recursive)) (kill-local-variable 'doc-view-last-page-number) (doc-view-initiate-display)) @@ -872,22 +856,22 @@ Should be invoked when the cached images aren't up-to-date." event)) (when (buffer-live-p (process-get proc 'buffer)) (with-current-buffer (process-get proc 'buffer) - (setq doc-view-current-converter-processes - (delq proc doc-view-current-converter-processes)) + (setq doc-view--current-converter-processes + (delq proc doc-view--current-converter-processes)) (setq mode-line-process - (if doc-view-current-converter-processes - (format ":%s" (car doc-view-current-converter-processes)))) + (if doc-view--current-converter-processes + (format ":%s" (car doc-view--current-converter-processes)))) (funcall (process-get proc 'callback)))))) (defun doc-view-start-process (name program args callback) ;; Make sure the process is started in an existing directory, (rather than ;; some file-name-handler-managed dir, for example). - (let* ((default-directory (if (file-readable-p default-directory) - default-directory + (let* ((default-directory (or (unhandled-file-name-directory + default-directory) (expand-file-name "~/"))) (proc (apply 'start-process name doc-view-conversion-buffer program args))) - (push proc doc-view-current-converter-processes) + (push proc doc-view--current-converter-processes) (setq mode-line-process (list (format ":%s" proc))) (set-process-sentinel proc 'doc-view-sentinel) (process-put proc 'buffer (current-buffer)) @@ -950,7 +934,7 @@ If PAGE is nil, convert the whole document." The converted PDF is put into the current cache directory, and it is named like ODF with the extension turned to pdf." (doc-view-start-process "odf->pdf" doc-view-odf->pdf-converter-program - (list "-f" "pdf" "-o" (doc-view-current-cache-dir) odf) + (list "-f" "pdf" "-o" (doc-view--current-cache-dir) odf) callback)) (defun doc-view-odf->pdf-converter-soffice (odf callback) @@ -968,7 +952,7 @@ is named like ODF with the extension turned to pdf." (concat "-env:UserInstallation=file://" tmp-user-install-dir) "--headless" "--convert-to" "pdf" - "--outdir" (doc-view-current-cache-dir) odf) + "--outdir" (doc-view--current-cache-dir) odf) (lambda () (delete-directory tmp-user-install-dir t) (funcall callback))))) @@ -988,16 +972,16 @@ is named like ODF with the extension turned to pdf." ;; serves as a witness that the conversion is complete. (write-region (prin1-to-string resolution) nil (expand-file-name "resolution.el" - (doc-view-current-cache-dir)) + (doc-view--current-cache-dir)) nil 'silently) - (when doc-view-current-timer - (cancel-timer doc-view-current-timer) - (setq doc-view-current-timer nil)) + (when doc-view--current-timer + (cancel-timer doc-view--current-timer) + (setq doc-view--current-timer nil)) (doc-view-display (current-buffer) 'force)))) ;; Update the displayed pages as soon as they're done generating. (when doc-view-conversion-refresh-interval - (setq doc-view-current-timer + (setq doc-view--current-timer (run-at-time "1 secs" doc-view-conversion-refresh-interval 'doc-view-display (current-buffer))))) @@ -1026,7 +1010,7 @@ Start by converting PAGES, and then the rest." ;; not sufficient. (dolist (win (get-buffer-window-list (current-buffer) nil 'visible)) (with-selected-window win - (when (stringp (get-char-property (point-min) 'display)) + (when (stringp (overlay-get (doc-view-current-overlay) 'display)) (doc-view-goto-page (doc-view-current-page))))) ;; Convert the rest of the pages. (doc-view-pdf/ps->png pdf png))))))) @@ -1042,20 +1026,20 @@ Start by converting PAGES, and then the rest." (defun doc-view-current-cache-doc-pdf () "Return the name of the doc.pdf in the current cache dir. This file exists only if the current document isn't a PDF or PS file already." - (expand-file-name "doc.pdf" (doc-view-current-cache-dir))) + (expand-file-name "doc.pdf" (doc-view--current-cache-dir))) (defun doc-view-doc->txt (txt callback) "Convert the current document to text and call CALLBACK when done." - (make-directory (doc-view-current-cache-dir) t) + (make-directory (doc-view--current-cache-dir) t) (pcase doc-view-doc-type (`pdf ;; Doc is a PDF, so convert it to TXT - (doc-view-pdf->txt doc-view-buffer-file-name txt callback)) + (doc-view-pdf->txt doc-view--buffer-file-name txt callback)) (`ps ;; Doc is a PS, so convert it to PDF (which will be converted to ;; TXT thereafter). (let ((pdf (doc-view-current-cache-doc-pdf))) - (doc-view-ps->pdf doc-view-buffer-file-name pdf + (doc-view-ps->pdf doc-view--buffer-file-name pdf (lambda () (doc-view-pdf->txt pdf txt callback))))) (`dvi ;; Doc is a DVI. This means that a doc.pdf already exists in its @@ -1088,39 +1072,39 @@ Start by converting PAGES, and then the rest." pages)) (defun doc-view-convert-current-doc () - "Convert `doc-view-buffer-file-name' to a set of png files, one file per page. + "Convert `doc-view--buffer-file-name' to a set of png files, one file per page. Those files are saved in the directory given by the function -`doc-view-current-cache-dir'." +`doc-view--current-cache-dir'." ;; Let stale files still display while we recompute the new ones, so only ;; flush the cache when the conversion is over. One of the reasons why it ;; is important to keep displaying the stale page is so that revert-buffer ;; preserves the horizontal/vertical scroll settings (which are otherwise - ;; resets during the redisplay). - (setq doc-view-pending-cache-flush t) + ;; reset during the redisplay). + (setq doc-view--pending-cache-flush t) (let ((png-file (expand-file-name (format doc-view--image-file-pattern "%d") - (doc-view-current-cache-dir)))) - (make-directory (doc-view-current-cache-dir) t) + (doc-view--current-cache-dir)))) + (make-directory (doc-view--current-cache-dir) t) (pcase doc-view-doc-type (`dvi ;; DVI files have to be converted to PDF before Ghostscript can process ;; it. (let ((pdf (doc-view-current-cache-doc-pdf))) - (doc-view-dvi->pdf doc-view-buffer-file-name pdf + (doc-view-dvi->pdf doc-view--buffer-file-name pdf (lambda () (doc-view-pdf/ps->png pdf png-file))))) (`odf ;; ODF files have to be converted to PDF before Ghostscript can ;; process it. (let ((pdf (doc-view-current-cache-doc-pdf)) (opdf (expand-file-name - (concat (file-name-base doc-view-buffer-file-name) + (concat (file-name-base doc-view--buffer-file-name) ".pdf") - doc-view-current-cache-dir)) + doc-view--current-cache-dir)) (png-file png-file)) ;; The unoconv tool only supports an output directory, but no ;; file name. It's named like the input file with the ;; extension replaced by pdf. - (funcall doc-view-odf->pdf-converter-function doc-view-buffer-file-name + (funcall doc-view-odf->pdf-converter-function doc-view--buffer-file-name (lambda () ;; Rename to doc.pdf (rename-file opdf pdf) @@ -1128,10 +1112,10 @@ Those files are saved in the directory given by the function ((or `pdf `djvu) (let ((pages (doc-view-active-pages))) ;; Convert doc to bitmap images starting with the active pages. - (doc-view-document->bitmap doc-view-buffer-file-name png-file pages))) + (doc-view-document->bitmap doc-view--buffer-file-name png-file pages))) (_ ;; Convert to PNG images. - (doc-view-pdf/ps->png doc-view-buffer-file-name png-file))))) + (doc-view-pdf/ps->png doc-view--buffer-file-name png-file))))) ;;;; Slicing @@ -1182,7 +1166,7 @@ dragging it to its bottom-right corner. See also (doc (let ((cache-doc (doc-view-current-cache-doc-pdf))) (if (file-exists-p cache-doc) cache-doc - doc-view-buffer-file-name))) + doc-view--buffer-file-name))) (o (shell-command-to-string (concat doc-view-ghostscript-program " -dSAFER -dBATCH -dNOPAUSE -q -sDEVICE=bbox " @@ -1266,9 +1250,9 @@ After calling this function whole pages will be visible again." (defun doc-view-insert-image (file &rest args) "Insert the given png FILE. ARGS is a list of image descriptors." - (when doc-view-pending-cache-flush + (when doc-view--pending-cache-flush (clear-image-cache) - (setq doc-view-pending-cache-flush nil)) + (setq doc-view--pending-cache-flush nil)) (let ((ol (doc-view-current-overlay))) ;; Only insert the image if the buffer is visible. (when (window-live-p (overlay-get ol 'window)) @@ -1302,7 +1286,7 @@ ARGS is a list of image descriptors." (list (cons 'slice slice) image) image)) ;; We're trying to display a page that doesn't exist. - (doc-view-current-converter-processes + (doc-view--current-converter-processes ;; Maybe the page doesn't exist *yet*. "Cannot display this page (yet)!") (t @@ -1325,7 +1309,7 @@ ARGS is a list of image descriptors." (defun doc-view-sort (a b) "Return non-nil if A should be sorted before B. -Predicate for sorting `doc-view-current-files'." +Predicate for sorting `doc-view--current-files'." (or (< (length a) (length b)) (and (= (length a) (length b)) (string< a b)))) @@ -1335,24 +1319,24 @@ Predicate for sorting `doc-view-current-files'." If FORCE is non-nil, start viewing even if the document does not have the page we want to view." (with-current-buffer buffer - (let ((prev-pages doc-view-current-files)) - (setq doc-view-current-files - (sort (directory-files (doc-view-current-cache-dir) t + (let ((prev-pages doc-view--current-files)) + (setq doc-view--current-files + (sort (directory-files (doc-view--current-cache-dir) t (format doc-view--image-file-pattern "[0-9]+") t) 'doc-view-sort)) - (unless (eq (length prev-pages) (length doc-view-current-files)) + (unless (eq (length prev-pages) (length doc-view--current-files)) (force-mode-line-update)) (dolist (win (or (get-buffer-window-list buffer nil t) (list t))) (let* ((page (doc-view-current-page win)) (pagefile (expand-file-name (format doc-view--image-file-pattern page) - (doc-view-current-cache-dir)))) + (doc-view--current-cache-dir)))) (when (or force (and (not (member pagefile prev-pages)) - (member pagefile doc-view-current-files))) + (member pagefile doc-view--current-files))) (if (windowp win) (with-selected-window win (cl-assert (eq (current-buffer) buffer) t) @@ -1387,9 +1371,9 @@ For now these keys are useful: (defun doc-view-open-text () "Open a buffer with the current doc's contents as text." (interactive) - (if doc-view-current-converter-processes + (if doc-view--current-converter-processes (message "DocView: please wait till conversion finished.") - (let ((txt (expand-file-name "doc.txt" (doc-view-current-cache-dir)))) + (let ((txt (expand-file-name "doc.txt" (doc-view--current-cache-dir)))) (if (file-readable-p txt) (let ((name (concat "Text contents of " (file-name-nondirectory buffer-file-name))) @@ -1479,25 +1463,25 @@ till now do that first. If BACKWARD is non-nil, jump to the previous match." (interactive "P") (if (and (not new-query) - doc-view-current-search-matches) + doc-view--current-search-matches) (if backward (doc-view-search-previous-match 1) (doc-view-search-next-match 1)) ;; New search, so forget the old results. - (setq doc-view-current-search-matches nil) + (setq doc-view--current-search-matches nil) (let ((txt (expand-file-name "doc.txt" - (doc-view-current-cache-dir)))) + (doc-view--current-cache-dir)))) (if (file-readable-p txt) (progn - (setq doc-view-current-search-matches + (setq doc-view--current-search-matches (doc-view-search-internal (read-from-minibuffer "Regexp: ") txt)) (message "DocView: search yielded %d matches." (doc-view-search-no-of-matches - doc-view-current-search-matches))) + doc-view--current-search-matches))) ;; We must convert to TXT first! - (if doc-view-current-converter-processes + (if doc-view--current-converter-processes (message "DocView: please wait till conversion finished.") (doc-view-doc->txt txt (lambda () (doc-view-search nil)))))))) @@ -1506,28 +1490,28 @@ If BACKWARD is non-nil, jump to the previous match." (interactive "p") (let* ((next-pages (doc-view-remove-if (lambda (i) (<= (car i) (doc-view-current-page))) - doc-view-current-search-matches)) + doc-view--current-search-matches)) (page (car (nth (1- arg) next-pages)))) (if page (doc-view-goto-page page) (when (and - doc-view-current-search-matches + doc-view--current-search-matches (y-or-n-p "No more matches after current page. Wrap to first match? ")) - (doc-view-goto-page (caar doc-view-current-search-matches)))))) + (doc-view-goto-page (caar doc-view--current-search-matches)))))) (defun doc-view-search-previous-match (arg) "Go to the ARGth previous matching page." (interactive "p") (let* ((prev-pages (doc-view-remove-if (lambda (i) (>= (car i) (doc-view-current-page))) - doc-view-current-search-matches)) + doc-view--current-search-matches)) (page (car (nth (1- arg) (nreverse prev-pages))))) (if page (doc-view-goto-page page) (when (and - doc-view-current-search-matches + doc-view--current-search-matches (y-or-n-p "No more matches before current page. Wrap to last match? ")) - (doc-view-goto-page (caar (last doc-view-current-search-matches))))))) + (doc-view-goto-page (caar (last doc-view--current-search-matches))))))) ;;;; User interface commands and the mode @@ -1535,13 +1519,13 @@ If BACKWARD is non-nil, jump to the previous match." (defun doc-view-already-converted-p () "Return non-nil if the current doc was already converted." - (and (file-exists-p (doc-view-current-cache-dir)) + (and (file-exists-p (doc-view--current-cache-dir)) ;; Check that the resolution info is there, otherwise it means ;; the conversion is incomplete. (file-readable-p (expand-file-name "resolution.el" - (doc-view-current-cache-dir))) + (doc-view--current-cache-dir))) (> (length (directory-files - (doc-view-current-cache-dir) + (doc-view--current-cache-dir) nil (format doc-view--image-file-pattern "[0-9]+"))) 0))) @@ -1555,8 +1539,9 @@ If BACKWARD is non-nil, jump to the previous match." (progn (message "DocView: using cached files!") ;; Load the saved resolution. - (let* ((res-file (expand-file-name "resolution.el" - (doc-view-current-cache-dir))) + (let* ((res-file + (expand-file-name "resolution.el" + (doc-view--current-cache-dir))) (res (with-temp-buffer (when (file-readable-p res-file) @@ -1574,7 +1559,7 @@ If BACKWARD is non-nil, jump to the previous match." (message "%s" (concat "No PNG support is available, or some conversion utility for " - (file-name-extension doc-view-buffer-file-name) + (file-name-extension doc-view--buffer-file-name) " files is missing.")) (when (and (executable-find doc-view-pdftotext-program) (y-or-n-p @@ -1633,13 +1618,14 @@ If BACKWARD is non-nil, jump to the previous match." ((looking-at "%PDF") '(pdf)) ((looking-at "\367\002") '(dvi)) ((looking-at "AT&TFORM") '(djvu)))))) - (setq-local doc-view-doc-type - (car (or (doc-view-intersection name-types content-types) - (when (and name-types content-types) - (error "Conflicting types: name says %s but content says %s" - name-types content-types)) - name-types content-types - (error "Cannot determine the document type")))))) + (setq-local + doc-view-doc-type + (car (or (doc-view-intersection name-types content-types) + (when (and name-types content-types) + (error "Conflicting types: name says %s but content says %s" + name-types content-types)) + name-types content-types + (error "Cannot determine the document type")))))) (defun doc-view-set-up-single-converter () "Find the right single-page converter for the current document type" @@ -1651,6 +1637,27 @@ If BACKWARD is non-nil, jump to the previous match." (setq-local doc-view--image-type type) (setq-local doc-view--image-file-pattern (concat "page-%s." extension)))) +;; desktop.el integration + +(defun doc-view-desktop-save-buffer (_desktop-dirname) + `((page . ,(doc-view-current-page)) + (slice . ,(doc-view-current-slice)))) + +(declare-function desktop-restore-file-buffer "desktop" + (buffer-filename buffer-name buffer-misc)) + +(defun doc-view-restore-desktop-buffer (file name misc) + (let ((page (cdr (assq 'page misc))) + (slice (cdr (assq 'slice misc)))) + (desktop-restore-file-buffer file name misc) + (with-selected-window (or (get-buffer-window (current-buffer) 0) + (selected-window)) + (doc-view-goto-page page) + (when slice (apply 'doc-view-set-slice slice))))) + +(add-to-list 'desktop-buffer-mode-handlers + '(doc-view-mode . doc-view-restore-desktop-buffer)) + ;;;###autoload (defun doc-view-mode () "Major mode in DocView buffers. @@ -1670,11 +1677,11 @@ toggle between displaying the document or editing it as text. (doc-view-fallback-mode) (let* ((prev-major-mode (if (derived-mode-p 'doc-view-mode) - doc-view-previous-major-mode + doc-view--previous-major-mode (unless (eq major-mode 'fundamental-mode) major-mode)))) (kill-all-local-variables) - (setq-local doc-view-previous-major-mode prev-major-mode)) + (setq-local doc-view--previous-major-mode prev-major-mode)) (dolist (var doc-view-saved-settings) (set (make-local-variable (car var)) (cdr var))) @@ -1686,29 +1693,30 @@ toggle between displaying the document or editing it as text. (doc-view-make-safe-dir doc-view-cache-directory) ;; Handle compressed files, remote files, files inside archives - (setq-local doc-view-buffer-file-name - (cond - (jka-compr-really-do-compress - ;; FIXME: there's a risk of name conflicts here. - (expand-file-name - (file-name-nondirectory - (file-name-sans-extension buffer-file-name)) - doc-view-cache-directory)) - ;; Is the file readable by local processes? - ;; We used to use `file-remote-p' but it's unclear what it's - ;; supposed to return nil for things like local files accessed via - ;; `su' or via file://... - ((let ((file-name-handler-alist nil)) - (not (and buffer-file-name (file-readable-p buffer-file-name)))) - ;; FIXME: there's a risk of name conflicts here. - (expand-file-name - (if buffer-file-name - (file-name-nondirectory buffer-file-name) - (buffer-name)) - doc-view-cache-directory)) - (t buffer-file-name))) - (when (not (string= doc-view-buffer-file-name buffer-file-name)) - (write-region nil nil doc-view-buffer-file-name)) + (setq-local doc-view--buffer-file-name + (cond + (jka-compr-really-do-compress + ;; FIXME: there's a risk of name conflicts here. + (expand-file-name + (file-name-nondirectory + (file-name-sans-extension buffer-file-name)) + doc-view-cache-directory)) + ;; Is the file readable by local processes? + ;; We used to use `file-remote-p' but it's unclear what it's + ;; supposed to return nil for things like local files accessed + ;; via `su' or via file://... + ((let ((file-name-handler-alist nil)) + (not (and buffer-file-name + (file-readable-p buffer-file-name)))) + ;; FIXME: there's a risk of name conflicts here. + (expand-file-name + (if buffer-file-name + (file-name-nondirectory buffer-file-name) + (buffer-name)) + doc-view-cache-directory)) + (t buffer-file-name))) + (when (not (string= doc-view--buffer-file-name buffer-file-name)) + (write-region nil nil doc-view--buffer-file-name)) (add-hook 'change-major-mode-hook (lambda () @@ -1717,6 +1725,9 @@ toggle between displaying the document or editing it as text. nil t) (add-hook 'clone-indirect-buffer-hook 'doc-view-clone-buffer-hook nil t) (add-hook 'kill-buffer-hook 'doc-view-kill-proc nil t) + (when (and (boundp 'desktop-save-mode) + desktop-save-mode) + (setq-local desktop-save-buffer 'doc-view-desktop-save-buffer)) (remove-overlays (point-min) (point-max) 'doc-view t) ;Just in case. ;; Keep track of display info ([vh]scroll, page number, overlay, @@ -1756,8 +1767,8 @@ toggle between displaying the document or editing it as text. '(doc-view-resolution image-mode-winprops-alist))))) (remove-overlays (point-min) (point-max) 'doc-view t) - (if doc-view-previous-major-mode - (funcall doc-view-previous-major-mode) + (if doc-view--previous-major-mode + (funcall doc-view--previous-major-mode) (let ((auto-mode-alist (rassq-delete-all 'doc-view-mode-maybe diff --git a/lisp/dos-vars.el b/lisp/dos-vars.el index e6ddd0b9b30..e335bf737c1 100644 --- a/lisp/dos-vars.el +++ b/lisp/dos-vars.el @@ -43,4 +43,6 @@ in `standard-display-table' as appropriate for your codepage, if :type '(hook) :version "20.3.3") +(provide 'dos-vars) + ;;; dos-vars.el ends here diff --git a/lisp/electric.el b/lisp/electric.el index 58b8e10cb71..86997d4aac7 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -302,6 +302,27 @@ This can be convenient for people who find it easier to hit ) than C-f." :version "24.1" :type 'boolean) +(defcustom electric-pair-inhibit-predicate + #'electric-pair-default-inhibit + "Predicate to prevent insertion of a matching pair. +The function is called with a single char (the opening char just inserted). +If it returns non-nil, then `electric-pair-mode' will not insert a matching +closer." + :version "24.4" + :type '(choice + (const :tag "Default" electric-pair-default-inhibit) + (const :tag "Always pair" ignore) + function)) + +(defun electric-pair-default-inhibit (char) + (or + ;; I find it more often preferable not to pair when the + ;; same char is next. + (eq char (char-after)) + (eq char (char-before (1- (point)))) + ;; I also find it often preferable not to pair next to a word. + (eq (char-syntax (following-char)) ?w))) + (defun electric-pair-syntax (command-event) (and electric-pair-mode (let ((x (assq command-event electric-pair-pairs))) @@ -351,12 +372,7 @@ This can be convenient for people who find it easier to hit ) than C-f." ;; Insert matching pair. ((not (or (not (memq syntax `(?\( ?\" ?\$))) overwrite-mode - ;; I find it more often preferable not to pair when the - ;; same char is next. - (eq last-command-event (char-after)) - (eq last-command-event (char-before (1- (point)))) - ;; I also find it often preferable not to pair next to a word. - (eq (char-syntax (following-char)) ?w))) + (funcall electric-pair-inhibit-predicate last-command-event))) (save-excursion (insert closer)))))) (defun electric-pair-will-use-region () diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index edaecd7ff19..dbb4a239f02 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -52,7 +52,10 @@ FormFeed character.") (defvar generated-autoload-load-name nil "Load name for `autoload' statements generated from autoload cookies. -If nil, this defaults to the file name, sans extension.") +If nil, this defaults to the file name, sans extension. +Typically, you need to set this when the directory containing the file +is not in `load-path'. +This also affects the generated cus-load.el file.") ;;;###autoload (put 'generated-autoload-load-name 'safe-local-variable 'stringp) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5db1793a407..c910acdbc14 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -289,10 +289,11 @@ Elements of the list may be: obsolete obsolete variables and functions. noruntime functions that may not be defined at runtime (typically defined only under `eval-when-compile'). - cl-functions calls to runtime functions from the CL package (as - distinguished from macros and aliases). + cl-functions calls to runtime functions (as distinguished from macros and + aliases) from the old CL package (not the newer cl-lib). interactive-only commands that normally shouldn't be called from Lisp code. + lexical global/dynamic variables lacking a prefix. make-local calls to make-variable-buffer-local that may be incorrect. mapcar mapcar called for effect. constants let-binding of, or assignment to, constants/nonvariables. @@ -1978,7 +1979,7 @@ and will be removed soon. See (elisp)Backquote in the manual.")) (widen) (delete-char delta)))) -(defun byte-compile-insert-header (filename outbuffer) +(defun byte-compile-insert-header (_filename outbuffer) "Insert a header at the start of OUTBUFFER. Call from the source buffer." (let ((dynamic-docstrings byte-compile-dynamic-docstrings) @@ -1997,11 +1998,7 @@ Call from the source buffer." ;; >4 byte x version %d (insert ";ELC" 23 "\000\000\000\n" - ";;; Compiled by " - (or (and (boundp 'user-mail-address) user-mail-address) - (concat (user-login-name) "@" (system-name))) - " on " (current-time-string) "\n" - ";;; from file " filename "\n" + ";;; Compiled\n" ";;; in Emacs version " emacs-version "\n" ";;; with" (cond @@ -2217,13 +2214,15 @@ list that represents a doc string reference. (when (and (consp (nth 1 form)) (eq (car (nth 1 form)) 'quote) (consp (cdr (nth 1 form))) - (symbolp (nth 1 (nth 1 form))) - ;; Don't add it if it's already defined. Otherwise, it might - ;; hide the actual definition. - (not (fboundp (nth 1 (nth 1 form))))) - (push (cons (nth 1 (nth 1 form)) - (cons 'autoload (cdr (cdr form)))) - byte-compile-function-environment) + (symbolp (nth 1 (nth 1 form)))) + ;; Don't add it if it's already defined. Otherwise, it might + ;; hide the actual definition. However, do remove any entry from + ;; byte-compile-noruntime-functions, in case we have an autoload + ;; of foo-func following an (eval-when-compile (require 'foo)). + (unless (fboundp (nth 1 (nth 1 form))) + (push (cons (nth 1 (nth 1 form)) + (cons 'autoload (cdr (cdr form)))) + byte-compile-function-environment)) ;; If an autoload occurs _before_ the first call to a function, ;; byte-compile-callargs-warn does not add an entry to ;; byte-compile-unresolved-functions. Here we mimic the logic @@ -2231,11 +2230,14 @@ list that represents a doc string reference. ;; autoload comes _after_ the function call. ;; Alternatively, similar logic could go in ;; byte-compile-warn-about-unresolved-functions. - (or (memq (nth 1 (nth 1 form)) byte-compile-noruntime-functions) - (setq byte-compile-unresolved-functions - (delq (assq (nth 1 (nth 1 form)) - byte-compile-unresolved-functions) - byte-compile-unresolved-functions)))) + (if (memq (nth 1 (nth 1 form)) byte-compile-noruntime-functions) + (setq byte-compile-noruntime-functions + (delq (nth 1 (nth 1 form)) byte-compile-noruntime-functions) + byte-compile-noruntime-functions) + (setq byte-compile-unresolved-functions + (delq (assq (nth 1 (nth 1 form)) + byte-compile-unresolved-functions) + byte-compile-unresolved-functions)))) (if (stringp (nth 3 form)) form ;; No doc string, so we can compile this as a normal form. diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index a259985df99..032eced7592 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el @@ -470,7 +470,7 @@ See `chart-sort-matchlist' for more details." (progn (chart-sort-matchlist s2 s1 pred) (setq s (oref s2 data))) - (error "Sorting of chart %s not supported" (object-name c)))) + (error "Sorting of chart %s not supported" (eieio-object-name c)))) (if (eq (oref c direction) 'horizontal) (oset (oref c y-axis) items s) (oset (oref c x-axis) items s) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index b154e722707..6540a8e9f14 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -2066,7 +2066,8 @@ If the offending word is in a piece of quoted text, then it is skipped." ;;; Ispell engine ;; -(eval-when-compile (require 'ispell)) +(defvar ispell-process) +(declare-function ispell-buffer-local-words "ispell" ()) (defun checkdoc-ispell-init () "Initialize Ispell process (default version) with Lisp words. @@ -2074,19 +2075,14 @@ The words used are from `checkdoc-ispell-lisp-words'. If `ispell' cannot be loaded, then set `checkdoc-spellcheck-documentation-flag' to nil." (require 'ispell) - (if (not (symbol-value 'ispell-process)) ;Silence byteCompiler - (condition-case nil - (progn - (ispell-buffer-local-words) - ;; This code copied in part from ispell.el Emacs 19.34 - (let ((w checkdoc-ispell-lisp-words)) - (while w - (process-send-string - ;; Silence byte compiler - (symbol-value 'ispell-process) - (concat "@" (car w) "\n")) - (setq w (cdr w))))) - (error (setq checkdoc-spellcheck-documentation-flag nil))))) + (unless ispell-process + (condition-case nil + (progn + (ispell-buffer-local-words) + ;; This code copied in part from ispell.el Emacs 19.34 + (dolist (w checkdoc-ispell-lisp-words) + (process-send-string ispell-process (concat "@" w "\n")))) + (error (setq checkdoc-spellcheck-documentation-flag nil))))) (defun checkdoc-ispell-docstring-engine (end) "Run the Ispell tools on the doc string between point and END. @@ -2187,14 +2183,13 @@ News agents may remove it" ;;; Comment checking engine ;; -(eval-when-compile - ;; We must load this to: - ;; a) get symbols for compile and - ;; b) determine if we have lm-history symbol which doesn't always exist - (require 'lisp-mnt)) - (defvar generate-autoload-cookie) +(eval-when-compile (require 'lisp-mnt)) ; expand silly defsubsts +(declare-function lm-summary "lisp-mnt" (&optional file)) +(declare-function lm-section-start "lisp-mnt" (header &optional after)) +(declare-function lm-section-end "lisp-mnt" (header)) + (defun checkdoc-file-comments-engine () "Return a message list if this file does not match the Emacs standard. This checks for style only, such as the first line, Commentary:, diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 34892bf2fef..70ad1283cb2 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -597,8 +597,11 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (macroexp-let2 nil d def (funcall do `(cl-getf ,getter ,k ,d) (lambda (v) - (funcall setter - `(cl--set-getf ,getter ,k ,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, diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el index 599cf3ac345..bbfe9ec6424 100644 --- a/lisp/emacs-lisp/cl-indent.el +++ b/lisp/emacs-lisp/cl-indent.el @@ -809,4 +809,6 @@ optional\\|rest\\|key\\|allow-other-keys\\|aux\\|whole\\|body\\|environment\ ;(put 'defclass 'common-lisp-indent-function '((&whole 2 &rest (&whole 2 &rest 1) &rest (&whole 2 &rest 1))) ;(put 'defgeneric 'common-lisp-indent-function 'defun) +(provide 'cl-indent) + ;;; cl-indent.el ends here diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 8ab2abec67e..af19db63f30 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -11,7 +11,7 @@ ;;;;;; cl--map-overlays cl--map-intervals cl--map-keymap-recursively ;;;;;; cl-notevery cl-notany cl-every cl-some cl-mapcon cl-mapcan ;;;;;; cl-mapl cl-mapc cl-maplist cl-map cl--mapcar-many cl-equalp -;;;;;; cl-coerce) "cl-extra" "cl-extra.el" "c5730f2a706cb1efc5fec0a790d3ca72") +;;;;;; cl-coerce) "cl-extra" "cl-extra.el" "011111887a1f353218e59e14d0b09c68") ;;; Generated autoloads from cl-extra.el (autoload 'cl-coerce "cl-extra" "\ @@ -267,7 +267,7 @@ including `cl-block' and `cl-eval-when'. ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp ;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*) -;;;;;; "cl-macs" "cl-macs.el" "8a90c81a400a2846e7b4c3da07626d94") +;;;;;; "cl-macs" "cl-macs.el" "b839ad3781c4f2f849df0639b4eba166") ;;; Generated autoloads from cl-macs.el (autoload 'cl--compiler-macro-list* "cl-macs" "\ @@ -417,17 +417,35 @@ This is compatible with Common Lisp, but note that `defun' and (autoload 'cl-loop "cl-macs" "\ The Common Lisp `loop' macro. -Valid clauses are: - for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, - for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR, - for VAR across ARRAY, repeat NUM, with VAR = INIT, while COND, until COND, - always COND, never COND, thereis COND, collect EXPR into VAR, - append EXPR into VAR, nconc EXPR into VAR, sum EXPR into VAR, - count EXPR into VAR, maximize EXPR into VAR, minimize EXPR into VAR, - if COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...], - unless COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...], - do EXPRS..., initially EXPRS..., finally EXPRS..., return EXPR, - finally return EXPR, named NAME. +Valid clauses include: + For clauses: + for VAR from/upfrom/downfrom EXPR1 to/upto/downto/above/below EXPR2 by EXPR3 + for VAR = EXPR1 then EXPR2 + for VAR in/on/in-ref LIST by FUNC + for VAR across/across-ref ARRAY + for VAR being: + the elements of/of-ref SEQUENCE [using (index VAR2)] + the symbols [of OBARRAY] + the hash-keys/hash-values of HASH-TABLE [using (hash-values/hash-keys V2)] + the key-codes/key-bindings/key-seqs of KEYMAP [using (key-bindings VAR2)] + the overlays/intervals [of BUFFER] [from POS1] [to POS2] + the frames/buffers + the windows [of FRAME] + Iteration clauses: + repeat INTEGER + while/until/always/never/thereis CONDITION + Accumulation clauses: + collect/append/nconc/concat/vconcat/count/sum/maximize/minimize FORM + [into VAR] + Miscellaneous clauses: + with VAR = INIT + if/when/unless COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...] + named NAME + initially/finally [do] EXPRS... + do EXPRS... + [finally] return EXPR + +For more details, see Info node `(cl)Loop Facility'. \(fn CLAUSE...)" nil t) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index e9cc200baaa..4aae2c6efe5 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -765,17 +765,35 @@ This is compatible with Common Lisp, but note that `defun' and ;;;###autoload (defmacro cl-loop (&rest loop-args) "The Common Lisp `loop' macro. -Valid clauses are: - for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, - for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR, - for VAR across ARRAY, repeat NUM, with VAR = INIT, while COND, until COND, - always COND, never COND, thereis COND, collect EXPR into VAR, - append EXPR into VAR, nconc EXPR into VAR, sum EXPR into VAR, - count EXPR into VAR, maximize EXPR into VAR, minimize EXPR into VAR, - if COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...], - unless COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...], - do EXPRS..., initially EXPRS..., finally EXPRS..., return EXPR, - finally return EXPR, named NAME. +Valid clauses include: + For clauses: + for VAR from/upfrom/downfrom EXPR1 to/upto/downto/above/below EXPR2 by EXPR3 + for VAR = EXPR1 then EXPR2 + for VAR in/on/in-ref LIST by FUNC + for VAR across/across-ref ARRAY + for VAR being: + the elements of/of-ref SEQUENCE [using (index VAR2)] + the symbols [of OBARRAY] + the hash-keys/hash-values of HASH-TABLE [using (hash-values/hash-keys V2)] + the key-codes/key-bindings/key-seqs of KEYMAP [using (key-bindings VAR2)] + the overlays/intervals [of BUFFER] [from POS1] [to POS2] + the frames/buffers + the windows [of FRAME] + Iteration clauses: + repeat INTEGER + while/until/always/never/thereis CONDITION + Accumulation clauses: + collect/append/nconc/concat/vconcat/count/sum/maximize/minimize FORM + [into VAR] + Miscellaneous clauses: + with VAR = INIT + if/when/unless COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...] + named NAME + initially/finally [do] EXPRS... + do EXPRS... + [finally] return EXPR + +For more details, see Info node `(cl)Loop Facility'. \(fn CLAUSE...)" (declare (debug (&rest &or diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el index e1e1847dd59..b8e327625e7 100644 --- a/lisp/emacs-lisp/crm.el +++ b/lisp/emacs-lisp/crm.el @@ -263,7 +263,8 @@ Completion is available on a per-element basis. For example, if the contents of the minibuffer are 'alice,bob,eve' and point is between 'l' and 'i', pressing TAB operates on the element 'alice'. -The return value of this function is a list of the read strings. +The return value of this function is a list of the read strings +with empty strings removed. See the documentation for `completing-read' for details on the arguments: PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST, DEF, and @@ -287,7 +288,7 @@ INHERIT-INPUT-METHOD." prompt initial-input map nil hist def inherit-input-method))) (and def (string-equal input "") (setq input def)) - ;; Ignore empty strings in the list of return values. + ;; Remove empty strings in the list of read strings. (split-string input crm-separator t))) (remove-hook 'choose-completion-string-functions 'crm--choose-completion-string))) diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 684f9d90878..96c223c9e18 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -192,12 +192,11 @@ See Info node `(elisp)Derived Modes' for more details." parent child docstring syntax abbrev)) `(progn - (unless (get ',hook 'variable-documentation) - (put ',hook 'variable-documentation - (purecopy ,(format "Hook run when entering %s mode. + (defvar ,hook nil + ,(format "Hook run after entering %s mode. No problems result if this variable is not bound. `add-hook' automatically binds it. (This is true for all hook variables.)" - name)))) + name)) (unless (boundp ',map) (put ',map 'definition-name ',child)) (with-no-warnings (defvar ,map (make-sparse-keymap))) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index abe7b1ea741..ed10080cc35 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -296,6 +296,12 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. ;; up-to-here. :autoload-end + (defvar ,hook nil + ,(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)) + ;; Define the minor-mode keymap. ,(unless (symbolp keymap) ;nil is also a symbol. `(defvar ,keymap-sym @@ -419,6 +425,13 @@ See `%s' for more information on %s." ;; up-to-here. :autoload-end + ;; MODE-set-explicitly is set in MODE-set-explicitly and cleared by + ;; kill-all-local-variables. + (defvar-local ,MODE-set-explicitly nil) + (defun ,MODE-set-explicitly () + (setq ,MODE-set-explicitly t)) + (put ',MODE-set-explicitly 'definition-name ',global-mode) + ;; A function which checks whether MODE has been disabled in the major ;; mode hook which has just been run. (add-hook ',minor-MODE-hook ',MODE-set-explicitly) @@ -451,13 +464,7 @@ See `%s' for more information on %s." (defun ,MODE-cmhh () (add-to-list ',MODE-buffers (current-buffer)) (add-hook 'post-command-hook ',MODE-check-buffers)) - (put ',MODE-cmhh 'definition-name ',global-mode) - ;; MODE-set-explicitly is set in MODE-set-explicitly and cleared by - ;; kill-all-local-variables. - (defvar-local ,MODE-set-explicitly nil) - (defun ,MODE-set-explicitly () - (setq ,MODE-set-explicitly t)) - (put ',MODE-set-explicitly 'definition-name ',global-mode)))) + (put ',MODE-cmhh 'definition-name ',global-mode)))) ;;; ;;; easy-mmode-defmap diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 52e12013fd3..867f079ce5f 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -54,6 +54,7 @@ (require 'macroexp) (eval-when-compile (require 'cl-lib)) +(eval-when-compile (require 'pcase)) ;;; Options @@ -2072,11 +2073,6 @@ expressions; a `progn' form will be returned enclosing these forms." (defvar edebug-active nil) ;; Non-nil when edebug is active -;;; add minor-mode-alist entry -(or (assq 'edebug-active minor-mode-alist) - (setq minor-mode-alist (cons (list 'edebug-active " *Debugging*") - minor-mode-alist))) - (defvar edebug-stack nil) ;; Stack of active functions evaluated via edebug. ;; Should be nil at the top level. @@ -2715,8 +2711,7 @@ MSG is printed after `::::} '." ;; Start up a recursive edit inside of edebug. ;; The current buffer is the edebug-buffer, which is put into edebug-mode. ;; Assume that none of the variables below are buffer-local. - (let ((edebug-buffer-read-only buffer-read-only) - ;; match-data must be done in the outside buffer + (let (;; match-data must be done in the outside buffer (edebug-outside-match-data (with-current-buffer edebug-outside-buffer ; in case match buffer different (match-data))) @@ -2730,8 +2725,6 @@ MSG is printed after `::::} '." ;; during a recursive-edit edebug-inside-windows - (edebug-outside-map (current-local-map)) - ;; Save the outside value of executing macro. (here??) (edebug-outside-executing-macro executing-kbd-macro) (edebug-outside-pre-command-hook @@ -2804,10 +2797,9 @@ MSG is printed after `::::} '." (not (memq arg-mode '(after error)))) (message "Break")) - (setq buffer-read-only t) (setq signal-hook-function nil) - (edebug-mode) + (edebug-mode 1) (unwind-protect (recursive-edit) ; <<<<<<<<<< Recursive edit @@ -2828,10 +2820,7 @@ MSG is printed after `::::} '." (set-buffer edebug-buffer) (if (memq edebug-execution-mode '(go Go-nonstop)) (edebug-overlay-arrow)) - (setq buffer-read-only edebug-buffer-read-only) - (use-local-map edebug-outside-map) - (remove-hook 'kill-buffer-hook 'edebug-kill-buffer t) - ) + (edebug-mode -1)) ;; gotta have a buffer to let its buffer local variables be set (get-buffer-create " bogus edebug buffer")) ));; inner let @@ -3773,7 +3762,9 @@ be installed in `emacs-lisp-mode-map'.") (interactive) (describe-function 'edebug-mode)) -(defun edebug-mode () +(defvar edebug--mode-saved-vars nil) + +(define-minor-mode edebug-mode "Mode for Emacs Lisp buffers while in Edebug. In addition to all Emacs Lisp commands (except those that modify the @@ -3807,17 +3798,32 @@ Options: `edebug-on-signal' `edebug-unwrap-results' `edebug-global-break-condition'" + :lighter " *Debugging*" + :keymap edebug-mode-map ;; If the user kills the buffer in which edebug is currently active, ;; exit to top level, because the edebug command loop can't usefully ;; continue running in such a case. - (add-hook 'kill-buffer-hook 'edebug-kill-buffer nil t) - (use-local-map edebug-mode-map)) + ;; + (if (not edebug-mode) + (progn + (while edebug--mode-saved-vars + (let ((setting (pop edebug--mode-saved-vars))) + (if (consp setting) + (set (car setting) (cdr setting)) + (kill-local-variable setting)))) + (remove-hook 'kill-buffer-hook 'edebug-kill-buffer t)) + (pcase-dolist (`(,var . ,val) '((buffer-read-only . t))) + (push + (if (local-variable-p var) (cons var (symbol-value var)) var) + edebug--mode-saved-vars) + (set (make-local-variable var) val)) + ;; Append `edebug-kill-buffer' to the hook to avoid interfering with + ;; other entries that are unguarded against deleted buffer. + (add-hook 'kill-buffer-hook 'edebug-kill-buffer t t))) (defun edebug-kill-buffer () "Used on `kill-buffer-hook' when Edebug is operating in a buffer of Lisp code." - (let (kill-buffer-hook) - (kill-buffer (current-buffer))) - (top-level)) + (run-with-timer 0 nil #'top-level)) ;;; edebug eval list mode @@ -4140,7 +4146,7 @@ reinstrument it." It is removed when you hit any char." ;; This seems not to work with Emacs 18.59. It undoes too far. (interactive) - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (undo-boundary) (edebug-display-freq-count) (setq unread-command-events diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index c8ae3f4bf1a..21190446624 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -31,6 +31,7 @@ ;;; Code: (require 'eieio) +(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib! ;;; eieio-instance-inheritor ;; diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el new file mode 100644 index 00000000000..da475638bb7 --- /dev/null +++ b/lisp/emacs-lisp/eieio-core.el @@ -0,0 +1,2264 @@ +;;; eieio-core.el --- Core implementation for eieio + +;; Copyright (C) 1995-1996, 1998-2013 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Version: 1.4 +;; 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: +;; +;; The "core" part of EIEIO is the implementation for the object +;; system (such as eieio-defclass, or eieio-defmethod) but not the +;; base classes for the object system, which are defined in EIEIO. +;; +;; See the commentary for eieio.el for more about EIEIO itself. + +;;; 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))) + +;;; +;; A few functions that are better in the official EIEIO src, but +;; used from the core. +(declare-function slot-unbound "eieio") +(declare-function slot-missing "eieio") +(declare-function child-of-class-p "eieio") + + +;;; +;; Variable declarations. +;; +(defvar eieio-hook nil + "This hook is executed, then cleared each time `defclass' is called.") + +(defvar eieio-error-unsupported-class-tags nil + "Non-nil to throw an error if an encountered tag is unsupported. +This may prevent classes from CLOS applications from being used with EIEIO +since EIEIO does not support all CLOS tags.") + +(defvar eieio-skip-typecheck nil + "If non-nil, skip all slot typechecking. +Set this to t permanently if a program is functioning well to get a +small speed increase. This variable is also used internally to handle +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.") + +(defconst eieio-unbound + (if (and (boundp 'eieio-unbound) (symbolp eieio-unbound)) + eieio-unbound + (make-symbol "unbound")) + "Uninterned symbol representing an unbound slot in an object.") + +;; This is a bootstrap for eieio-default-superclass so it has a value +;; 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. + +(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)) + +(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) + +;;; +;; 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. + )) + + +;;; Important macros used internally in eieio. +;; +(defmacro eieio--check-type (type obj) + (unless (symbolp obj) + (error "eieio--check-type wants OBJ to be a variable")) + `(if (not ,(cond + ((eq 'or (car-safe type)) + `(or ,@(mapcar (lambda (type) `(,type ,obj)) (cdr type)))) + (t `(,type ,obj)))) + (signal 'wrong-type-argument (list ',type ,obj)))) + +(defmacro class-v (class) + "Internal: Return the class vector from the CLASS symbol." + ;; 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." + ;; 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." + (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) + "Return from LIST the found OPTION, or nil if it doesn't exist." + `(car-safe (cdr (memq ,option ,list)))) + +(defmacro 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)) + +(defmacro 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))) +(defalias 'object-p 'eieio-object-p) + +(defmacro class-abstract-p (class) + "Return non-nil if CLASS is abstract. +Abstract classes cannot be instantiated." + `(class-option ,class :abstract)) + +(defmacro 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)) + + + +;;; +;; Class Creation + +(defvar eieio-defclass-autoload-map (make-vector 7 nil) + "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) + "Create autoload symbols for the EIEIO class CNAME. +SUPERCLASSES are the superclasses that CNAME inherits from. +DOC is the docstring for CNAME. +This function creates a mock-class for CNAME and adds it into +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)) + ) + (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! + + + ;; Does our parent exist? + (if (not (class-p SC)) + + ;; 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) + + )))) + +(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)))))) + +(defun eieio-defclass (cname superclasses slots options-and-doc) + ;; FIXME: Most of this should be moved to the `defclass' macro. + "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. +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 + ;; or add definitions when eieio is loaded or something like that. + (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))) + (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 + ;; method table breakage, particularly when the users is only + ;; 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 pname + (progn + (while pname + (if (and (car pname) (symbolp (car pname))) + (if (not (class-p (car pname))) + ;; bad class + (error "Given parent class %s is not a class" (car pname)) + ;; 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)))))) + ;; Get custom groups, and store them into our local copy. + (mapc (lambda (g) (pushnew g groups :test #'equal)) + (class-option (car pname) :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))) + ;; 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))) ) + ;; 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) + )) + + ;; 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)))) + + ;; 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))))) + + ;; Before adding new slots, let's add all the methods and classes + ;; in from the parent class. + (eieio-copy-parents-into-subclass newc superclasses) + + ;; 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) + + ;; 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 + 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)) + ) + + (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))) + + ;; 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)) + + ;; The customgroup should be a list of symbols + (cond ((null customg) + (setq customg '(default))) + ((not (listp customg)) + (setq customg (list customg)))) + ;; The customgroup better be a symbol, or list of symbols. + (mapc (lambda (cg) + (if (not (symbolp 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 + 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))) + + ;; 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))) + + ;; 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))) + + ;; 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. + (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)) + (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))) + (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))) + ) + + ;; 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)) + + ;; Save the file location where this class is defined. + (let ((fname (if load-in-progress + load-file-name + buffer-file-name))) + (when fname + (when (string-match "\\.elc\\'" fname) + (setq fname (substring fname 0 (1- (length fname))))) + (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) + (if (memq :custom-groups options) + (setcar (cdr (memq :custom-groups options)) g) + (setq options (cons :custom-groups (cons g options))))) + + ;; Set up the options we have collected. + (setf (eieio--class-options newc) options) + + ;; if this is a superclass, clear out parent (which was set to the + ;; default superclass eieio-default-superclass) + (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 ((eieio-skip-typecheck t)) + ;; All type-checking has been done to our satisfaction + ;; before this call. Don't waste our time in this call.. + (eieio-set-defaults cache t)) + (setf (eieio--class-default-object-cache newc) cache)) + + ;; Return our new class object + ;; newc + cname + )) + +(defsubst eieio-eval-default-p (val) + "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) + "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))) + (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 + &optional defaultoverride skipnil) + "Add into NEWC attribute A. +If A already exists in NEWC, then do nothing. If it doesn't exist, +then also add in D (default), DOC, TYPE, CUST, LABEL, CUSTG, PRINT, PROT, and INIT arg. +Argument ALLOC specifies if the slot is allocated per instance, or per class. +If optional DEFAULTOVERRIDE is non-nil, then if A exists in NEWC, +we must override its value for a default. +Optional argument SKIPNIL indicates if type checking should be skipped +if default value is nil." + ;; Make sure we duplicate those items that are sequences. + (condition-case nil + (if (sequencep d) (setq d (copy-sequence d))) + ;; This copy can fail on a cons cell with a non-cons in the cdr. Let's skip it if it doesn't work. + (error nil)) + (if (sequencep type) (setq type (copy-sequence type))) + (if (sequencep cust) (setq cust (copy-sequence cust))) + (if (sequencep custg) (setq custg (copy-sequence custg))) + + ;; 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 (or (not alloc) (and (symbolp alloc) (eq alloc ':instance))) + ;; In this case, we modify the INSTANCE version of a given slot. + + (progn + + ;; 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))) + (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 + ;; attributes which must override the default value of any slot + ;; passed in by one of the parent classes. + (when defaultoverride + ;; There is a match, and we must override the old value. + (let* ((ca (eieio--class-public-a newc)) + (np (member a ca)) + (num (- (length ca) (length np))) + (dp (if np (nthcdr num (eieio--class-public-d newc)) + nil)) + (tp (if np (nth num (eieio--class-public-type newc)))) + ) + (if (not np) + (error "EIEIO internal error overriding default value for %s" + a) + ;; If type is passed in, is it the same? + (if (not (eq type t)) + (if (not (equal type tp)) + (error + "Child slot type `%s' does not match inherited type `%s' for `%s'" + 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) + (setcar dp d)) + ;; If we have a new initarg, check for it. + (when init + (let* ((inits (eieio--class-initarg-tuples newc)) + (inita (rassq a inits))) + ;; Replace the CAR of the associate INITA. + ;;(message "Initarg: %S replace %s" inita init) + (setcar inita init) + )) + + ;; PLN Tue Jun 26 11:57:06 2007 : The protection is + ;; checked and SHOULD match the superclass + ;; protection. Otherwise an error is thrown. However + ;; I wonder if a more flexible schedule might be + ;; implemented. + ;; + ;; EML - We used to have (if prot... here, + ;; but a prot of 'nil means public. + ;; + (let ((super-prot (nth num (eieio--class-protection newc))) + ) + (if (not (eq prot super-prot)) + (error "Child slot protection `%s' does not match inherited protection `%s' for `%s'" + prot super-prot a))) + ;; End original PLN + + ;; PLN Tue Jun 26 11:57:06 2007 : + ;; Do a non redundant combination of ancient custom + ;; groups and new ones. + (when custg + (let* ((groups + (nthcdr num (eieio--class-public-custom-group newc))) + (list1 (car groups)) + (list2 (if (listp custg) custg (list custg)))) + (if (< (length list1) (length list2)) + (setq list1 (prog1 list2 (setq list2 list1)))) + (dolist (elt list2) + (unless (memq elt list1) + (push elt list1))) + (setcar groups list1))) + ;; End PLN + + ;; PLN Mon Jun 25 22:44:34 2007 : If a new cust is + ;; set, simply replaces the old one. + (when cust + ;; (message "Custom type redefined to %s" cust) + (setcar (nthcdr num (eieio--class-public-custom newc)) cust)) + + ;; If a new label is specified, it simply replaces + ;; the old one. + (when label + ;; (message "Custom label redefined to %s" label) + (setcar (nthcdr num (eieio--class-public-custom-label newc)) label)) + ;; End PLN + + ;; PLN Sat Jun 30 17:24:42 2007 : when a new + ;; doc is specified, simply replaces the old one. + (when doc + ;;(message "Documentation redefined to %s" doc) + (setcar (nthcdr num (eieio--class-public-doc newc)) + doc)) + ;; End PLN + + ;; If a new printer is specified, it simply replaces + ;; the old one. + (when print + ;; (message "printer redefined to %s" print) + (setcar (nthcdr num (eieio--class-public-printer newc)) print)) + + ))) + )) + + ;; CLASS ALLOCATED SLOTS + (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) + ;; 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))) + ;; 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)))) + (when defaultoverride + ;; There is a match, and we must override the old value. + (let* ((ca (eieio--class-class-allocation-a newc)) + (np (member a ca)) + (num (- (length ca) (length np))) + (dp (if np + (nthcdr num + (eieio--class-class-allocation-values newc)) + nil)) + (tp (if np (nth num (eieio--class-class-allocation-type newc)) + nil))) + (if (not np) + (error "EIEIO internal error overriding default value for %s" + a) + ;; If type is passed in, is it the same? + (if (not (eq type t)) + (if (not (equal type tp)) + (error + "Child slot type `%s' does not match inherited type `%s' for `%s'" + type tp a))) + ;; EML - Note: the only reason to override a class bound slot + ;; 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) + (setcar dp value)) + + ;; PLN Tue Jun 26 11:57:06 2007 : The protection is + ;; checked and SHOULD match the superclass + ;; protection. Otherwise an error is thrown. However + ;; I wonder if a more flexible schedule might be + ;; implemented. + (let ((super-prot + (car (nthcdr num (eieio--class-class-allocation-protection newc))))) + (if (not (eq prot super-prot)) + (error "Child slot protection `%s' does not match inherited protection `%s' for `%s'" + prot super-prot a))) + ;; Do a non redundant combination of ancient custom groups + ;; and new ones. + (when custg + (let* ((groups + (nthcdr num (eieio--class-class-allocation-custom-group newc))) + (list1 (car groups)) + (list2 (if (listp custg) custg (list custg)))) + (if (< (length list1) (length list2)) + (setq list1 (prog1 list2 (setq list2 list1)))) + (dolist (elt list2) + (unless (memq elt list1) + (push elt list1))) + (setcar groups list1))) + + ;; PLN Sat Jun 30 17:24:42 2007 : when a new + ;; doc is specified, simply replaces the old one. + (when doc + ;;(message "Documentation redefined to %s" doc) + (setcar (nthcdr num (eieio--class-class-allocation-doc newc)) + doc)) + ;; End PLN + + ;; If a new printer is specified, it simply replaces + ;; the old one. + (when print + ;; (message "printer redefined to %s" print) + (setcar (nthcdr num (eieio--class-class-allocation-printer newc)) print)) + + )) + )) + )) + +(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 + ;; 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))) + )) + + +;;; 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) + "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))) + +(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 +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)))))) + +(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)) + slot-idx))) + (if (not (eieio-perform-slot-validation st value)) + (signal 'invalid-slot-type (list 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. +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) + value)) + + +;;; Get/Set slots in an object. +;; +(defun eieio-oref (obj slot) + "Return the value in OBJ at SLOT in the object vector." + (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))) + (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)) + ;; Oref that slot. + (aref (eieio--class-class-allocation-values (class-v 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. + (slot-missing obj slot 'oref) + ;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot)) + ) + (eieio--check-type eieio-object-p obj) + (eieio-barf-if-slot-unbound (aref obj c) obj slot 'oref)))) + + +(defun eieio-oref-default (obj slot) + "Do the work for the macro `oref-default' with similar parameters. +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))) + (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)) + ;; Oref that slot. + (aref (eieio--class-class-allocation-values (class-v 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))))) + (eieio-default-eval-maybe val)) + obj cl 'oref-default)))) + +(defun eieio-default-eval-maybe (val) + "Check VAL, and return what `oref-default' would provide." + (cond + ;; Is it a function call? If so, evaluate it. + ((eieio-eval-default-p val) + (eval val)) + ;;;; check for quoted things, and unquote them + ;;((and (consp val) (eq (car val) 'quote)) + ;; (car (cdr val))) + ;; return it verbatim + (t val))) + +(defun eieio-oset (obj slot value) + "Do the work for the macro `oset'. +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))) + (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)) + ;; 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))) + 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) + (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) + (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) + )))) + + +;;; 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) + "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 +is protected, access will be allowed if OBJ is a child of the currently +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))) + (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) + "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))) + (l1 (length a)) + (af (memq slot a)) + (l2 (length af))) + ;; Slot # is length of the total list, minus the remaining list of + ;; the found slot. + (if af (- l1 l2)))) + +;;; +;; Way to assign slots based on a list. Used for constructors, or +;; even resetting an object at run-time +;; +(defun eieio-set-defaults (obj &optional set-all) + "Take object OBJ, and reset all slots to their defaults. +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) + "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))))) + (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" + ;; Ensure CLASS is not in any position but the first in any of the + ;; element lists of REMAINING-INPUTS. + (and (not (let ((found nil)) + (while (and remaining-inputs (not found)) + (setq found (member class (cdr (car remaining-inputs))) + remaining-inputs (cdr remaining-inputs))) + found)) + class)) + +(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) + (found nil)) + (while (and tail (not found)) + (setq found (car tail) tail (cdr tail))) + (not found)) + ;; If all remaining inputs are empty lists, we are done. + (nreverse reversed-partial-result) + ;; Otherwise, we try to find the next element of the result. This + ;; is achieved by considering the first element of each + ;; (non-empty) input list and accepting a candidate if it is + ;; consistent with the rests of the input lists. + (let* ((found nil) + (tail remaining-inputs) + (next (progn + (while (and tail (not found)) + (setq found (and (car tail) + (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 + (cons next reversed-partial-result) + (mapcar (lambda (l) (if (eq (first l) next) (rest l) l)) + remaining-inputs)) + ;; The graph is inconsistent, give up + (signal 'inconsistent-class-hierarchy (list remaining-inputs)))))) + +(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 + (list class) + (append + (or + (mapcar + (lambda (x) + (eieio-class-precedence-c3 x)) + parents) + '((eieio-default-superclass))) + (list parents)))) + ) +;;; +;; Method Invocation Order: Depth First + +(defun eieio-class-precedence-dfs (class) + "Return all parents of CLASS in depth-first order." + (let* ((parents (eieio-class-parents-fast class)) + (classes (copy-sequence + (apply #'append + (list class) + (or + (mapcar + (lambda (parent) + (cons parent + (eieio-class-precedence-dfs parent))) + parents) + '((eieio-default-superclass)))))) + (tail classes)) + ;; Remove duplicates. + (while tail + (setcdr tail (delq (car tail) (cdr tail))) + (setq tail (cdr tail))) + classes)) + +;;; +;; Method Invocation Order: Breadth First +(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)))) + (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)))))))) + (cons class (nreverse result))) + ) + +;;; +;; Method Invocation Order + +(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)) + nil + (case (class-method-invocation-order class) + (:depth-first + (eieio-class-precedence-dfs class)) + (:breadth-first + (eieio-class-precedence-bfs class)) + (:c3 + (eieio-class-precedence-c3 class)))) + ) +(define-obsolete-function-alias + 'class-precedence-list 'eieio-class-precedence-list "24.4") + + +;;; CLOS generics internal function handling +;; +(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)) + ) + + (if (or (not lambdas) (not (car lambdas))) + + ;; 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))) + + ;; Do the regular implementation here. + + (run-hook-with-args 'eieio-pre-method-execution-functions + lambdas) + + (setq lastval (apply (car lambdas) newargs)) + (setq rval lastval + rvalever 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)))) + + +;;; +;; 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))))) + + +;;; 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) + +;;; eieio-core.el ends here diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el index 7daa24257a1..d3ae8b191e1 100644 --- a/lisp/emacs-lisp/eieio-datadebug.el +++ b/lisp/emacs-lisp/eieio-datadebug.el @@ -80,38 +80,39 @@ 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) - prefix) + prefix) "Insert the slots of OBJ into the current DDEBUG buffer." - (data-debug-insert-thing (eieio-object-name-string obj) - prefix - "Name: ") - (let* ((cl (eieio-object-class obj)) - (cv (class-v cl))) - (data-debug-insert-thing (class-constructor cl) - prefix - "Class: ") - ;; Loop over all the public slots - (let ((publa (eieio--class-public-a cv)) - ) - (while publa - (if (slot-boundp obj (car publa)) - (let* ((i (class-slot-initarg cl (car publa))) - (v (eieio-oref obj (car publa)))) - (data-debug-insert-thing - v prefix (concat - (if i (symbol-name i) - (symbol-name (car publa))) - " "))) - ;; Unbound case - (let ((i (class-slot-initarg cl (car publa)))) - (data-debug-insert-custom - "#unbound" prefix - (concat (if i (symbol-name i) - (symbol-name (car publa))) - " ") - 'font-lock-keyword-face)) - ) - (setq publa (cdr publa)))))) + (let ((inhibit-read-only t)) + (data-debug-insert-thing (eieio-object-name-string obj) + prefix + "Name: ") + (let* ((cl (eieio-object-class obj)) + (cv (class-v cl))) + (data-debug-insert-thing (class-constructor cl) + prefix + "Class: ") + ;; Loop over all the public slots + (let ((publa (eieio--class-public-a cv)) + ) + (while publa + (if (slot-boundp obj (car publa)) + (let* ((i (class-slot-initarg cl (car publa))) + (v (eieio-oref obj (car publa)))) + (data-debug-insert-thing + v prefix (concat + (if i (symbol-name i) + (symbol-name (car publa))) + " "))) + ;; Unbound case + (let ((i (class-slot-initarg cl (car publa)))) + (data-debug-insert-custom + "#unbound" prefix + (concat (if i (symbol-name i) + (symbol-name (car publa))) + " ") + 'font-lock-keyword-face)) + ) + (setq publa (cdr publa))))))) ;;; Augment the Data debug thing display list. (data-debug-add-specialized-thing (lambda (thing) (object-p thing)) diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index 29ad980991b..27f97b31ebe 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -795,9 +795,9 @@ Argument INDENT is the depth of indentation." (defun eieio-describe-class-sb (text token indent) "Describe the class TEXT in TOKEN. INDENT is the current indentation level." - (speedbar-with-attached-buffer + (dframe-with-attached-buffer (eieio-describe-class token)) - (speedbar-maybee-jump-to-attached-frame)) + (dframe-maybee-jump-to-attached-frame)) (provide 'eieio-opt) diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el index c230226eae4..e964263754f 100644 --- a/lisp/emacs-lisp/eieio-speedbar.el +++ b/lisp/emacs-lisp/eieio-speedbar.el @@ -230,9 +230,9 @@ object edit buffer doing an in-place edit. If your object represents some other item, override this method and take the appropriate action." (require 'eieio-custom) - (speedbar-with-attached-buffer + (dframe-with-attached-buffer (eieio-customize-object object)) - (speedbar-maybee-jump-to-attached-frame)) + (dframe-maybee-jump-to-attached-frame)) ;;; Class definitions diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 37b1ec5fa94..3cdf1f078bd 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -54,223 +54,7 @@ (interactive) (message eieio-version)) -(eval-and-compile -;; About the above. EIEIO must process its own code when it compiles -;; itself, thus, by eval-and-compiling ourselves, we solve the problem. - -;; 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)) - - ) - - -;;; -;; Variable declarations. -;; - -(defvar eieio-hook nil - "This hook is executed, then cleared each time `defclass' is called.") - -(defvar eieio-error-unsupported-class-tags nil - "Non-nil to throw an error if an encountered tag is unsupported. -This may prevent classes from CLOS applications from being used with EIEIO -since EIEIO does not support all CLOS tags.") - -(defvar eieio-skip-typecheck nil - "If non-nil, skip all slot typechecking. -Set this to t permanently if a program is functioning well to get a -small speed increase. This variable is also used internally to handle -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.") - -(defconst eieio-unbound - (if (and (boundp 'eieio-unbound) (symbolp eieio-unbound)) - eieio-unbound - (make-symbol "unbound")) - "Uninterned symbol representing an unbound slot in an object.") - -;; This is a bootstrap for eieio-default-superclass so it has a value -;; while it is being built itself. -(defvar eieio-default-superclass nil)) - -(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)) - -(eval-and-compile -;; 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. - )) - - -;;; Important macros used in eieio. -;; -(defmacro class-v (class) - "Internal: Return the class vector from the CLASS symbol." - ;; No check: If eieio gets this far, it's 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." - ;; 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))) - -(defmacro 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))) -(defalias 'object-p 'eieio-object-p) - -(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) - "Return from LIST the found OPTION, or nil if it doesn't exist." - `(car-safe (cdr (memq ,option ,list)))) - -(defmacro 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)) - -(defmacro class-abstract-p (class) - "Return non-nil if CLASS is abstract. -Abstract classes cannot be instantiated." - `(class-option ,class :abstract)) - -(defmacro 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)) +(require 'eieio-core) ;;; Defining a new class @@ -331,829 +115,8 @@ 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'." - ;; We must `eval-and-compile' this so that when we byte compile - ;; an eieio program, there is no need to load it ahead of time. - ;; It also provides lots of nice debugging errors at compile time. - `(eval-and-compile - (eieio-defclass ',name ',superclass ',slots ',options-and-doc))) - -(defvar eieio-defclass-autoload-map (make-vector 7 nil) - "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) - "Create autoload symbols for the EIEIO class CNAME. -SUPERCLASSES are the superclasses that CNAME inherits from. -DOC is the docstring for CNAME. -This function creates a mock-class for CNAME and adds it into -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)) - ) - (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! - - - ;; Does our parent exist? - (if (not (class-p SC)) - - ;; 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) - - )))) - -(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)))))) - -(defmacro eieio--check-type (type obj) - (unless (symbolp obj) - (error "eieio--check-type wants OBJ to be a variable")) - `(if (not ,(cond - ((eq 'or (car-safe type)) - `(or ,@(mapcar (lambda (type) `(,type ,obj)) (cdr type)))) - (t `(,type ,obj)))) - (signal 'wrong-type-argument (list ',type ,obj)))) - -(defun eieio-defclass (cname superclasses slots options-and-doc) - ;; FIXME: Most of this should be moved to the `defclass' macro. - "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. -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 - ;; or add definitions when eieio is loaded or something like that. - (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))) - (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 - ;; method table breakage, particularly when the users is only - ;; 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 pname - (progn - (while pname - (if (and (car pname) (symbolp (car pname))) - (if (not (class-p (car pname))) - ;; bad class - (error "Given parent class %s is not a class" (car pname)) - ;; 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)))))) - ;; Get custom groups, and store them into our local copy. - (mapc (lambda (g) (add-to-list 'groups g)) - (class-option (car pname) :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))) - ;; 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))) ) - ;; 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) - )) - - ;; 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)))) - - ;; 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))))) - - ;; Before adding new slots, let's add all the methods and classes - ;; in from the parent class. - (eieio-copy-parents-into-subclass newc superclasses) - - ;; 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) - - ;; 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 - 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)) - ) - - (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))) - - ;; 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)) - - ;; The customgroup should be a list of symbols - (cond ((null customg) - (setq customg '(default))) - ((not (listp customg)) - (setq customg (list customg)))) - ;; The customgroup better be a symbol, or list of symbols. - (mapc (lambda (cg) - (if (not (symbolp 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 - prot initarg alloc 'defaultoverride skip-nil) - - ;; We need to id the group, and store them in a group list attribute. - (mapc (lambda (cg) (add-to-list 'groups cg)) 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))) - - ;; 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))) - - ;; 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))) - - ;; 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. - (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)) - (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))) - (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))) - ) - - ;; 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)) - - ;; Save the file location where this class is defined. - (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))))) - (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) (add-to-list 'g cg)) groups) - (if (memq :custom-groups options) - (setcar (cdr (memq :custom-groups options)) g) - (setq options (cons :custom-groups (cons g options))))) - - ;; Set up the options we have collected. - (setf (eieio--class-options newc) options) - - ;; if this is a superclass, clear out parent (which was set to the - ;; default superclass eieio-default-superclass) - (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 ((eieio-skip-typecheck t)) - ;; All type-checking has been done to our satisfaction - ;; before this call. Don't waste our time in this call.. - (eieio-set-defaults cache t)) - (setf (eieio--class-default-object-cache newc) cache)) - - ;; Return our new class object - ;; newc - cname - )) + `(eieio-defclass ',name ',superclass ',slots ',options-and-doc)) -(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))) - (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 - &optional defaultoverride skipnil) - "Add into NEWC attribute A. -If A already exists in NEWC, then do nothing. If it doesn't exist, -then also add in D (default), DOC, TYPE, CUST, LABEL, CUSTG, PRINT, PROT, and INIT arg. -Argument ALLOC specifies if the slot is allocated per instance, or per class. -If optional DEFAULTOVERRIDE is non-nil, then if A exists in NEWC, -we must override its value for a default. -Optional argument SKIPNIL indicates if type checking should be skipped -if default value is nil." - ;; Make sure we duplicate those items that are sequences. - (condition-case nil - (if (sequencep d) (setq d (copy-sequence d))) - ;; This copy can fail on a cons cell with a non-cons in the cdr. Let's skip it if it doesn't work. - (error nil)) - (if (sequencep type) (setq type (copy-sequence type))) - (if (sequencep cust) (setq cust (copy-sequence cust))) - (if (sequencep custg) (setq custg (copy-sequence custg))) - - ;; 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 (or (not alloc) (and (symbolp alloc) (eq alloc ':instance))) - ;; In this case, we modify the INSTANCE version of a given slot. - - (progn - - ;; 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))) - (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 - ;; attributes which must override the default value of any slot - ;; passed in by one of the parent classes. - (when defaultoverride - ;; There is a match, and we must override the old value. - (let* ((ca (eieio--class-public-a newc)) - (np (member a ca)) - (num (- (length ca) (length np))) - (dp (if np (nthcdr num (eieio--class-public-d newc)) - nil)) - (tp (if np (nth num (eieio--class-public-type newc)))) - ) - (if (not np) - (error "EIEIO internal error overriding default value for %s" - a) - ;; If type is passed in, is it the same? - (if (not (eq type t)) - (if (not (equal type tp)) - (error - "Child slot type `%s' does not match inherited type `%s' for `%s'" - 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) - (setcar dp d)) - ;; If we have a new initarg, check for it. - (when init - (let* ((inits (eieio--class-initarg-tuples newc)) - (inita (rassq a inits))) - ;; Replace the CAR of the associate INITA. - ;;(message "Initarg: %S replace %s" inita init) - (setcar inita init) - )) - - ;; PLN Tue Jun 26 11:57:06 2007 : The protection is - ;; checked and SHOULD match the superclass - ;; protection. Otherwise an error is thrown. However - ;; I wonder if a more flexible schedule might be - ;; implemented. - ;; - ;; EML - We used to have (if prot... here, - ;; but a prot of 'nil means public. - ;; - (let ((super-prot (nth num (eieio--class-protection newc))) - ) - (if (not (eq prot super-prot)) - (error "Child slot protection `%s' does not match inherited protection `%s' for `%s'" - prot super-prot a))) - ;; End original PLN - - ;; PLN Tue Jun 26 11:57:06 2007 : - ;; Do a non redundant combination of ancient custom - ;; groups and new ones. - (when custg - (let* ((groups - (nthcdr num (eieio--class-public-custom-group newc))) - (list1 (car groups)) - (list2 (if (listp custg) custg (list custg)))) - (if (< (length list1) (length list2)) - (setq list1 (prog1 list2 (setq list2 list1)))) - (dolist (elt list2) - (unless (memq elt list1) - (push elt list1))) - (setcar groups list1))) - ;; End PLN - - ;; PLN Mon Jun 25 22:44:34 2007 : If a new cust is - ;; set, simply replaces the old one. - (when cust - ;; (message "Custom type redefined to %s" cust) - (setcar (nthcdr num (eieio--class-public-custom newc)) cust)) - - ;; If a new label is specified, it simply replaces - ;; the old one. - (when label - ;; (message "Custom label redefined to %s" label) - (setcar (nthcdr num (eieio--class-public-custom-label newc)) label)) - ;; End PLN - - ;; PLN Sat Jun 30 17:24:42 2007 : when a new - ;; doc is specified, simply replaces the old one. - (when doc - ;;(message "Documentation redefined to %s" doc) - (setcar (nthcdr num (eieio--class-public-doc newc)) - doc)) - ;; End PLN - - ;; If a new printer is specified, it simply replaces - ;; the old one. - (when print - ;; (message "printer redefined to %s" print) - (setcar (nthcdr num (eieio--class-public-printer newc)) print)) - - ))) - )) - - ;; CLASS ALLOCATED SLOTS - (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) - ;; 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))) - ;; 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)))) - (when defaultoverride - ;; There is a match, and we must override the old value. - (let* ((ca (eieio--class-class-allocation-a newc)) - (np (member a ca)) - (num (- (length ca) (length np))) - (dp (if np - (nthcdr num - (eieio--class-class-allocation-values newc)) - nil)) - (tp (if np (nth num (eieio--class-class-allocation-type newc)) - nil))) - (if (not np) - (error "EIEIO internal error overriding default value for %s" - a) - ;; If type is passed in, is it the same? - (if (not (eq type t)) - (if (not (equal type tp)) - (error - "Child slot type `%s' does not match inherited type `%s' for `%s'" - type tp a))) - ;; EML - Note: the only reason to override a class bound slot - ;; 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) - (setcar dp value)) - - ;; PLN Tue Jun 26 11:57:06 2007 : The protection is - ;; checked and SHOULD match the superclass - ;; protection. Otherwise an error is thrown. However - ;; I wonder if a more flexible schedule might be - ;; implemented. - (let ((super-prot - (car (nthcdr num (eieio--class-class-allocation-protection newc))))) - (if (not (eq prot super-prot)) - (error "Child slot protection `%s' does not match inherited protection `%s' for `%s'" - prot super-prot a))) - ;; Do a non redundant combination of ancient custom groups - ;; and new ones. - (when custg - (let* ((groups - (nthcdr num (eieio--class-class-allocation-custom-group newc))) - (list1 (car groups)) - (list2 (if (listp custg) custg (list custg)))) - (if (< (length list1) (length list2)) - (setq list1 (prog1 list2 (setq list2 list1)))) - (dolist (elt list2) - (unless (memq elt list1) - (push elt list1))) - (setcar groups list1))) - - ;; PLN Sat Jun 30 17:24:42 2007 : when a new - ;; doc is specified, simply replaces the old one. - (when doc - ;;(message "Documentation redefined to %s" doc) - (setcar (nthcdr num (eieio--class-class-allocation-doc newc)) - doc)) - ;; End PLN - - ;; If a new printer is specified, it simply replaces - ;; the old one. - (when print - ;; (message "printer redefined to %s" print) - (setcar (nthcdr num (eieio--class-class-allocation-printer newc)) print)) - - )) - )) - )) - -(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 - ;; 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))) - )) ;;; CLOS style implementation of object creators. ;; @@ -1187,17 +150,6 @@ a string." ;;; CLOS methods and generics ;; - -(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))) - (defmacro defgeneric (method args &optional doc-string) "Create a generic function METHOD. DOC-STRING is the base documentation for this class. A generic @@ -1209,115 +161,6 @@ top level documentation to a method." `(eieio--defalias ',method (eieio--defgeneric-init-form ',method ,doc-string))) -(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 ((scoped-class ',class) - (eieio-generic-call-next-method-list nil) - (eieio-generic-call-key method-primary) - (eieio-generic-call-methodname ',method) - (eieio-generic-call-arglst local-args) - ) - ,(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)) - (defmacro defmethod (method &rest args) "Create a new METHOD through `defgeneric' with ARGS. @@ -1358,139 +201,6 @@ Summary: (format "Generically created method `%s'." method))) (eieio--defmethod ',method ',key ',class #',code)))) -(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) - "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))) - -(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 -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)))))) - -(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)) - slot-idx))) - (if (not (eieio-perform-slot-validation st value)) - (signal 'invalid-slot-type (list 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. -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) - value)) - ;;; Get/Set slots in an object. ;; (defmacro oref (obj slot) @@ -1499,28 +209,6 @@ Slot is the name of the slot when created by `defclass' or the label created by the :initarg tag." `(eieio-oref ,obj (quote ,slot))) -(defun eieio-oref (obj slot) - "Return the value in OBJ at SLOT in the object vector." - (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))) - (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)) - ;; Oref that slot. - (aref (eieio--class-class-allocation-values (class-v 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. - (slot-missing obj slot 'oref) - ;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot)) - ) - (eieio--check-type eieio-object-p obj) - (eieio-barf-if-slot-unbound (aref obj c) obj slot 'oref)))) - (defalias 'slot-value 'eieio-oref) (defalias 'set-slot-value 'eieio-oset) @@ -1531,45 +219,6 @@ tag. SLOT can be the slot name, or the tag specified by the :initarg tag in the `defclass' call." `(eieio-oref-default ,obj (quote ,slot))) -(defun eieio-oref-default (obj slot) - "Do the work for the macro `oref-default' with similar parameters. -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))) - (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)) - ;; Oref that slot. - (aref (eieio--class-class-allocation-values (class-v 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))))) - (eieio-default-eval-maybe val)) - obj cl 'oref-default)))) - -(defsubst eieio-eval-default-p (val) - "Whether the default value VAL should be evaluated for use." - (and (consp val) (symbolp (car val)) (fboundp (car val)))) - -(defun eieio-default-eval-maybe (val) - "Check VAL, and return what `oref-default' would provide." - (cond - ;; Is it a function call? If so, evaluate it. - ((eieio-eval-default-p val) - (eval val)) - ;;;; check for quoted things, and unquote them - ;;((and (consp val) (eq (car val) 'quote)) - ;; (car (cdr val))) - ;; return it verbatim - (t val))) - ;;; Handy CLOS macros ;; (defmacro with-slots (spec-list object &rest body) @@ -1607,13 +256,6 @@ variable name of the same name as the slot." (define-obsolete-function-alias 'object-class-fast #'eieio--object-class "24.4") -(defun eieio-class-name (class) "Return a Lisp like symbol name for 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") - (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." @@ -1650,10 +292,6 @@ If EXTRA, include that in the string returned to represent the symbol." (define-obsolete-function-alias 'object-class-name 'eieio-object-class-name "24.4") -(defmacro eieio-class-parents-fast (class) - "Return parent classes to CLASS with no check." - `(eieio--class-parent (class-v ,class))) - (defun eieio-class-parents (class) "Return parent classes to CLASS. (overload of variable). @@ -1662,130 +300,14 @@ The CLOS function `class-direct-superclasses' is aliased to this function." (eieio-class-parents-fast class)) (define-obsolete-function-alias 'class-parents #'eieio-class-parents "24.4") -(defmacro eieio-class-children-fast (class) "Return child classes to CLASS with no check." - `(eieio--class-children (class-v ,class))) - (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)) (define-obsolete-function-alias 'class-children #'eieio-class-children "24.4") -(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)) - (while (and remaining-inputs (not found)) - (setq found (member class (cdr (car remaining-inputs))) - remaining-inputs (cdr remaining-inputs))) - found)) - class)) - -(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) - (found nil)) - (while (and tail (not found)) - (setq found (car tail) tail (cdr tail))) - (not found)) - ;; If all remaining inputs are empty lists, we are done. - (nreverse reversed-partial-result) - ;; Otherwise, we try to find the next element of the result. This - ;; is achieved by considering the first element of each - ;; (non-empty) input list and accepting a candidate if it is - ;; consistent with the rests of the input lists. - (let* ((found nil) - (tail remaining-inputs) - (next (progn - (while (and tail (not found)) - (setq found (and (car tail) - (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 - (cons next reversed-partial-result) - (mapcar (lambda (l) (if (eq (first l) next) (rest l) l)) - remaining-inputs)) - ;; The graph is inconsistent, give up - (signal 'inconsistent-class-hierarchy (list remaining-inputs)))))) - -(defun eieio-class-precedence-dfs (class) - "Return all parents of CLASS in depth-first order." - (let* ((parents (eieio-class-parents-fast class)) - (classes (copy-sequence - (apply #'append - (list class) - (or - (mapcar - (lambda (parent) - (cons parent - (eieio-class-precedence-dfs parent))) - parents) - '((eieio-default-superclass)))))) - (tail classes)) - ;; Remove duplicates. - (while tail - (setcdr tail (delq (car tail) (cdr tail))) - (setq tail (cdr tail))) - classes)) - -(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)))) - (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)))))))) - (cons class (nreverse result))) - ) - -(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 - (list class) - (append - (or - (mapcar - (lambda (x) - (eieio-class-precedence-c3 x)) - parents) - '((eieio-default-superclass))) - (list parents)))) - ) - -(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)) - nil - (case (class-method-invocation-order class) - (:depth-first - (eieio-class-precedence-dfs class)) - (:breadth-first - (eieio-class-precedence-bfs class)) - (:c3 - (eieio-class-precedence-c3 class)))) - ) -(define-obsolete-function-alias - 'class-precedence-list 'eieio-class-precedence-list "24.4") - ;; Official CLOS functions. (define-obsolete-function-alias 'class-direct-superclasses #'eieio-class-parents "24.4") @@ -1797,10 +319,6 @@ method invocation orders of the involved classes." `(car (eieio-class-parents ,class))) (define-obsolete-function-alias 'class-parent #'eieio-class-parent "24.4") -(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)) - (defun same-class-p (obj class) "Return t if OBJ is of class-type CLASS." (eieio--check-type class-p class) (eieio--check-type eieio-object-p obj) @@ -1848,29 +366,6 @@ SLOT is the slot name as specified in `defclass' or the tag created with in the :initarg slot. VALUE can be any Lisp object." `(eieio-oset ,obj (quote ,slot) ,value)) -(defun eieio-oset (obj slot value) - "Do the work for the macro `oset'. -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))) - (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)) - ;; 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))) - 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) - (aset obj c value)))) - (defmacro oset-default (class slot value) "Set the default slot in CLASS for SLOT to VALUE. The default value is usually set with the :initform tag during class @@ -1878,32 +373,6 @@ creation. This allows users to change the default behavior of classes after they are created." `(eieio-oset-default ,class (quote ,slot) ,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) - (eieio--check-type symbolp slot) - (let* ((scoped-class class) - (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) - ))) - ;;; CLOS queries into classes and slots ;; (defun slot-boundp (object slot) @@ -2019,337 +488,9 @@ If SLOT is unbound, do nothing." (if (not (slot-boundp object slot)) nil (eieio-oset object slot (delete item (eieio-oref object slot))))) - -;;; 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 `scoped-class' is the class that defines SLOT -so that we can protect private slots." - (let ((par (eieio-class-parents 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) - "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 -is protected, access will be allowed if OBJ is a child of the currently -`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))) - (if (integerp fsi) - (cond - ((not (get fsym 'protection)) - (+ 3 fsi)) - ((and (eq (get fsym 'protection) 'protected) - (bound-and-true-p scoped-class) - (or (child-of-class-p class 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 (bound-and-true-p scoped-class) - (eieio-slot-originating-class-p 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) - "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))) - (l1 (length a)) - (af (memq slot a)) - (l2 (length af))) - ;; Slot # is length of the total list, minus the remaining list of - ;; the found slot. - (if af (- l1 l2)))) - -;;; CLOS generics internal function handling -;; -(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's 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) - (let* ((scoped-class (cdr (car lambdas))) - (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! - (let* ((rval nil) (lastval nil) (rvalever nil) - (scoped-class (cdr lambdas)) - (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)) - ) - - (if (or (not lambdas) (not (car lambdas))) - - ;; 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))) - - ;; Do the regular implementation here. - - (run-hook-with-args 'eieio-pre-method-execution-functions - lambdas) - - (setq lastval (apply (car lambdas) newargs)) - (setq rval lastval - rvalever 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)))) +;;; +;; Method Calling Functions (defun next-method-p () "Return non-nil if there is a next method. @@ -2367,7 +508,7 @@ If REPLACEMENT-ARGS is non-nil, then use them instead of arguments passed in at the top level. Use `next-method-p' to find out if there is a next method to call." - (if (not (bound-and-true-p scoped-class)) + (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)) @@ -2381,231 +522,10 @@ Use `next-method-p' to find out if there is a next method to call." (let* ((eieio-generic-call-next-method-list (cdr eieio-generic-call-next-method-list)) (eieio-generic-call-arglst newargs) - (scoped-class (cdr next)) (fcn (car next)) ) - (apply fcn newargs) - )))) - -;;; -;; 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)) - (add-to-list 'loc - (list class fname)) - (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))))) - -;;; -;; Way to assign slots based on a list. Used for constructors, or -;; even resetting an object at run-time -;; -(defun eieio-set-defaults (obj &optional set-all) - "Take object OBJ, and reset all slots to their defaults. -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." - (let ((scoped-class (eieio--object-class obj)) - (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) - "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))))) - (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))) - - -;;; 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") + (eieio--with-scoped-class (cdr next) + (apply fcn newargs)) )))) ;;; Here are some CLOS items that need the CL package ;; @@ -2678,7 +598,7 @@ Called from the constructor routine.") (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." - (let ((scoped-class (eieio--object-class obj))) + (eieio--with-scoped-class (eieio--object-class obj) (while slots (let ((rn (eieio-initarg-to-attribute (eieio--object-class obj) (car slots)))) @@ -2700,27 +620,27 @@ call `shared-initialize' yourself, or you can call `call-next-method' to have this constructor called automatically. If these steps are 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* ((scoped-class (class-v (eieio--object-class this))) - (slot (eieio--class-public-a scoped-class)) - (defaults (eieio--class-public-d scoped-class))) - (while slot - ;; For each slot, see if we need to evaluate it. - ;; - ;; Paul Landes said in an email: - ;; > CL evaluates it if it can, and otherwise, leaves it as - ;; > the quoted thing as you already have. This is by the - ;; > Sonya E. Keene book and other things I've look at on the - ;; > web. - (let ((dflt (eieio-default-eval-maybe (car defaults)))) - (when (not (eq dflt (car defaults))) - (eieio-oset this (car slot) dflt) )) - ;; Next. - (setq slot (cdr slot) - defaults (cdr defaults)))) - ;; Shared initialize will parse our slots for us. - (shared-initialize this 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))) + (slot (eieio--class-public-a this-class)) + (defaults (eieio--class-public-d this-class))) + (while slot + ;; For each slot, see if we need to evaluate it. + ;; + ;; Paul Landes said in an email: + ;; > CL evaluates it if it can, and otherwise, leaves it as + ;; > the quoted thing as you already have. This is by the + ;; > Sonya E. Keene book and other things I've look at on the + ;; > web. + (let ((dflt (eieio-default-eval-maybe (car defaults)))) + (when (not (eq dflt (car defaults))) + (eieio-oset this (car slot) dflt) )) + ;; Next. + (setq slot (cdr slot) + defaults (cdr defaults)))) + ;; Shared initialize will parse our slots for us. + (shared-initialize this slots)) (defgeneric slot-missing (object slot-name operation &optional new-value) "Method invoked when an attempt to access a slot in OBJECT fails.") @@ -2940,102 +860,6 @@ This may create or delete slots, but does not affect the return value of `eq'." (error "EIEIO: `change-class' is unimplemented")) -) - -;;; 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") - ;;; Interfacing with edebug ;; (defun eieio-edebug-prin1-to-string (object &optional noescape) diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 5a6b486dcd0..4efbdcb22cb 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -146,6 +146,10 @@ directly. Instead, use `eldoc-add-command' and `eldoc-remove-command'.") "Idle time delay currently in use by timer. This is used to determine if `eldoc-idle-delay' is changed by the user.") +(defvar eldoc-message-function 'eldoc-minibuffer-message + "The function used by `eldoc-message' to display messages. +It should receive the same arguments as `message'.") + ;;;###autoload (define-minor-mode eldoc-mode @@ -170,6 +174,20 @@ expression point is on." (remove-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area))) ;;;###autoload +(define-minor-mode eldoc-post-insert-mode nil + :group 'eldoc :lighter (:eval (if eldoc-mode "" + (concat eldoc-minor-mode-string "|i"))) + (setq eldoc-last-message nil) + (let ((prn-info (lambda () + (unless eldoc-mode + (eldoc-print-current-symbol-info))))) + (if eldoc-post-insert-mode + (add-hook 'post-self-insert-hook prn-info nil t) + (remove-hook 'post-self-insert-hook prn-info t)))) + +(add-hook 'eval-expression-minibuffer-setup-hook 'eldoc-post-insert-mode) + +;;;###autoload (defun turn-on-eldoc-mode () "Unequivocally turn on ElDoc mode (see command `eldoc-mode')." (interactive) @@ -180,14 +198,46 @@ expression point is on." (or (and eldoc-timer (memq eldoc-timer timer-idle-list)) (setq eldoc-timer - (run-with-idle-timer eldoc-idle-delay t - 'eldoc-print-current-symbol-info))) + (run-with-idle-timer + eldoc-idle-delay t + (lambda () (and eldoc-mode (eldoc-print-current-symbol-info)))))) ;; If user has changed the idle delay, update the timer. (cond ((not (= eldoc-idle-delay eldoc-current-idle-delay)) (setq eldoc-current-idle-delay eldoc-idle-delay) (timer-set-idle-time eldoc-timer eldoc-idle-delay t)))) +(defvar eldoc-mode-line-string nil) +(put 'eldoc-mode-line-string 'risky-local-variable t) + +(defun eldoc-minibuffer-message (format-string &rest args) + "Display messages in the mode-line when in the minibuffer. +Otherwise work like `message'." + (if (minibufferp) + (progn + (with-current-buffer + (window-buffer + (or (window-in-direction 'above (minibuffer-window)) + (minibuffer-selected-window) + (get-largest-window))) + (unless (and (listp mode-line-format) + (assq 'eldoc-mode-line-string mode-line-format)) + (setq mode-line-format + (list "" '(eldoc-mode-line-string + (" " eldoc-mode-line-string " ")) + mode-line-format)))) + (add-hook 'minibuffer-exit-hook + (lambda () (setq eldoc-mode-line-string nil)) + nil t) + (cond + ((null format-string) + (setq eldoc-mode-line-string nil)) + ((stringp format-string) + (setq eldoc-mode-line-string + (apply 'format format-string args)))) + (force-mode-line-update)) + (apply 'message format-string args))) + (defun eldoc-message (&rest args) (let ((omessage eldoc-last-message)) (setq eldoc-last-message @@ -203,8 +253,9 @@ expression point is on." ;; they are Legion. ;; Emacs way of preventing log messages. (let ((message-log-max nil)) - (cond (eldoc-last-message (message "%s" eldoc-last-message)) - (omessage (message nil))))) + (cond (eldoc-last-message + (funcall eldoc-message-function "%s" eldoc-last-message)) + (omessage (funcall eldoc-message-function nil))))) eldoc-last-message) ;; This function goes on pre-command-hook for XEmacs or when using idle @@ -236,11 +287,7 @@ expression point is on." (defun eldoc-display-message-no-interference-p () (and eldoc-mode (not executing-kbd-macro) - (not (and (boundp 'edebug-active) edebug-active)) - ;; Having this mode operate in an active minibuffer/echo area causes - ;; interference with what's going on there. - (not cursor-in-echo-area) - (not (eq (selected-window) (minibuffer-window))))) + (not (and (boundp 'edebug-active) edebug-active)))) ;;;###autoload @@ -262,7 +309,7 @@ Emacs Lisp mode) that support ElDoc.") (defun eldoc-print-current-symbol-info () (condition-case err - (and (eldoc-display-message-p) + (and (or (eldoc-display-message-p) eldoc-post-insert-mode) (if eldoc-documentation-function (eldoc-message (funcall eldoc-documentation-function)) (let* ((current-symbol (eldoc-current-symbol)) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 7df3acccbc9..656cb0a6a14 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -464,6 +464,7 @@ FORM-DESCRIPTION-FORM before it has called INNER-FORM." "Evaluate FORM. If it returns nil, abort the current test as failed. Returns the value of FORM." + (declare (debug t)) (ert--expand-should `(should ,form) form (lambda (inner-form form-description-form _value-var) `(unless ,inner-form @@ -473,6 +474,7 @@ Returns the value of FORM." "Evaluate FORM. If it returns non-nil, abort the current test as failed. Returns nil." + (declare (debug t)) (ert--expand-should `(should-not ,form) form (lambda (inner-form form-description-form _value-var) `(unless (not ,inner-form) @@ -520,6 +522,7 @@ non-nil, the error matches TYPE if it is an element of TYPE. If the error matches, returns (ERROR-SYMBOL . DATA) from the error. If not, or if no error was signaled, abort the test as failed." + (declare (debug t)) (unless type (setq type ''error)) (ert--expand-should `(should-error ,form ,@keys) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 4ebaa0a49d5..02b020fa241 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -266,6 +266,7 @@ font-lock keywords will not be case sensitive." (defvar lisp-mode-shared-map (let ((map (make-sparse-keymap))) + (set-keymap-parent map prog-mode-map) (define-key map "\e\C-q" 'indent-sexp) (define-key map "\177" 'backward-delete-char-untabify) ;; This gets in the way when viewing a Lisp file in view-mode. As @@ -394,7 +395,7 @@ font-lock keywords will not be case sensitive." :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 minibuffer")) + :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 @@ -772,7 +773,7 @@ If CHAR is not a character, return nil." (defun eval-last-sexp-1 (eval-last-sexp-arg-internal) - "Evaluate sexp before point; print value in minibuffer. + "Evaluate sexp before point; print value in the echo area. With argument, print output into current buffer." (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t))) ;; Setup the lexical environment if lexical-binding is enabled. @@ -808,6 +809,7 @@ With argument, print output into current buffer." (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 @@ -825,7 +827,7 @@ POS specifies the starting position where EXP was found and defaults to point." `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp))))) (defun eval-last-sexp (eval-last-sexp-arg-internal) - "Evaluate sexp before point; print value in minibuffer. + "Evaluate sexp before point; print value in the echo area. Interactively, with prefix argument, print output into current buffer. Truncates long output according to the value of the variables `eval-expression-print-length' and `eval-expression-print-level'. @@ -891,14 +893,13 @@ Reinitialize the face according to the `defface' specification." (defun eval-defun-2 () "Evaluate defun that point is in or before. -The value is displayed in the minibuffer. +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.\) -With argument, insert value in current buffer after the defun. Return the result of evaluation." ;; FIXME: the print-length/level bindings should only be applied while ;; printing, not while evaluating. @@ -950,11 +951,11 @@ 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 minibuffer. If not +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 minibuffer. This display is controlled by the variables +the echo area. This display is controlled by the variables `eval-expression-print-length' and `eval-expression-print-level', which see." (interactive "P") @@ -1436,6 +1437,8 @@ Any non-integer value means do not use a different value of :type '(choice (integer) (const :tag "Use the current `fill-column'" t)) :group 'lisp) +(put 'emacs-lisp-docstring-fill-column 'safe-local-variable + (lambda (x) (or (eq x t) (integerp x)))) (defun lisp-fill-paragraph (&optional justify) "Like \\[fill-paragraph], but handle Emacs Lisp comments and docstrings. diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 22fb6ad1809..a31bef2391d 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -1,4 +1,4 @@ -;;; lisp.el --- Lisp editing commands for Emacs +;;; lisp.el --- Lisp editing commands for Emacs -*- lexical-binding:t -*- ;; Copyright (C) 1985-1986, 1994, 2000-2013 Free Software Foundation, ;; Inc. @@ -46,6 +46,12 @@ This affects `insert-parentheses' and `insert-pair'." :group 'lisp) (defvar forward-sexp-function nil + ;; FIXME: + ;; - for some uses, we may want a "sexp-only" version, which only + ;; jumps over a well-formed sexp, rather than some dwimish thing + ;; like jumping from an "else" back up to its "if". + ;; - for up-list, we could use the "sexp-only" behavior as well + ;; to treat the dwimish halfsexp as a form of "up-list" step. "If non-nil, `forward-sexp' delegates to this function. Should take the same arguments and behave similarly to `forward-sexp'.") @@ -256,9 +262,9 @@ is called as a function to find the defun's beginning." ;; convention, fallback on the old implementation. (wrong-number-of-arguments (if (> arg 0) - (dotimes (i arg) + (dotimes (_ arg) (funcall beginning-of-defun-function)) - (dotimes (i (- arg)) + (dotimes (_ (- arg)) (funcall end-of-defun-function)))))) ((or defun-prompt-regexp open-paren-in-column-0-is-defun-start) @@ -436,7 +442,7 @@ 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) +(defun narrow-to-defun (&optional _arg) "Make text outside current defun invisible. The defun visible is the one that contains point or follows point. Optional ARG is ignored." @@ -618,9 +624,10 @@ character." ;; "Unbalanced parentheses", but those may not be so ;; accurate/helpful, e.g. quotes may actually be ;; mismatched. - (error "Unmatched bracket or quote")))) + (user-error "Unmatched bracket or quote")))) (defun field-complete (table &optional predicate) + (declare (obsolete completion-in-region "24.4")) (let ((minibuffer-completion-table table) (minibuffer-completion-predicate predicate) ;; This made sense for lisp-complete-symbol, but for @@ -645,6 +652,7 @@ considered. If the symbol starts just after an open-parenthesis, only symbols with function definitions are considered. Otherwise, all symbols with function definitions, values or properties are considered." + (declare (obsolete completion-at-point "24.4")) (interactive) (let* ((data (lisp-completion-at-point predicate)) (plist (nthcdr 3 data))) @@ -654,10 +662,96 @@ considered." (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data) (plist-get plist :predicate)))))) - -(defun lisp-completion-at-point (&optional 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))))) + (`(,_ . ,_) + (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 (car (read-from-string + (concat txt "lisp--witness--lisp" closer)))) + (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))))) + +(defun lisp-completion-at-point (&optional _predicate) "Function used for `completion-at-point-functions' in `emacs-lisp-mode'." - ;; FIXME: the `end' could be after point? (with-syntax-table emacs-lisp-mode-syntax-table (let* ((pos (point)) (beg (condition-case nil @@ -666,25 +760,6 @@ considered." (skip-syntax-forward "'") (point)) (scan-error pos))) - (predicate - (or predicate - (save-excursion - (goto-char beg) - (if (not (eq (char-before) ?\()) - (lambda (sym) ;why not just nil ? -sm - (or (boundp sym) (fboundp sym) - (symbol-plist sym))) - ;; Looks like a funcall position. Let's double check. - (if (condition-case nil - (progn (up-list -2) (forward-char 1) - (eq (char-after) ?\()) - (error nil)) - ;; If the first element of the parent list is an open - ;; paren we are probably not in a funcall position. - ;; Maybe a `let' varlist or something. - nil - ;; Else, we assume that a function name is expected. - 'fboundp))))) (end (unless (or (eq beg (point-max)) (member (char-syntax (char-after beg)) '(?\" ?\( ?\)))) @@ -694,12 +769,57 @@ considered." (forward-sexp 1) (when (>= (point) pos) (point))) - (scan-error pos))))) + (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-in-turn + lisp--local-variables-completion-table + obarray) ;Could be anything. + :annotation-function + (lambda (str) (if (fboundp (intern-soft str)) " <f>"))) + ;; 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 + (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)))) + (_ (list nil obarray #'fboundp)))))))) (when end - (list beg end obarray - :predicate predicate - :annotation-function - (unless (eq predicate 'fboundp) - (lambda (str) (if (fboundp (intern-soft str)) " <f>")))))))) + (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/nadvice.el b/lisp/emacs-lisp/nadvice.el index 0632c7d2fc0..c08d671e7eb 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -41,10 +41,13 @@ '((:around "\300\301\302\003#\207" 5) (:before "\300\301\002\"\210\300\302\002\"\207" 4) (:after "\300\302\002\"\300\301\003\"\210\207" 5) + (:override "\300\301\"\207" 4) (:after-until "\300\302\002\"\206\013\000\300\301\002\"\207" 4) (:after-while "\300\302\002\"\205\013\000\300\301\002\"\207" 4) (:before-until "\300\301\002\"\206\013\000\300\302\002\"\207" 4) - (:before-while "\300\301\002\"\205\013\000\300\302\002\"\207" 4)) + (:before-while "\300\301\002\"\205\013\000\300\302\002\"\207" 4) + (:filter-args "\300\302\301!\"\207" 5) + (:filter-return "\301\300\302\"!\207" 5)) "List of descriptions of how to add a function. Each element has the form (WHERE BYTECODE STACK) where: WHERE is a keyword indicating where the function is added. @@ -158,12 +161,13 @@ WHERE is a symbol to select an entry in `advice--where-alist'." (advice--make-1 (nth 1 desc) (nth 2 desc) function main props))) -(defun advice--member-p (function definition) +(defun advice--member-p (function name definition) (let ((found nil)) (while (and (not found) (advice--p definition)) (if (or (equal function (advice--car definition)) - (equal function (cdr (assq 'name (advice--props definition))))) - (setq found t) + (when name + (equal name (cdr (assq 'name (advice--props definition)))))) + (setq found definition) (setq definition (advice--cdr definition)))) found)) @@ -207,7 +211,6 @@ WHERE is a symbol to select an entry in `advice--where-alist'." ;;;###autoload (defmacro add-function (where place function &optional props) ;; TODO: - ;; - obsolete with-wrapper-hook (mostly requires buffer-local support). ;; - provide some kind of control over ordering. E.g. debug-on-entry, ELP ;; and tracing want to stay first. ;; - maybe let `where' specify some kind of predicate and use it @@ -226,18 +229,20 @@ call OLDFUN here: `:before' (lambda (&rest r) (apply FUNCTION r) (apply OLDFUN r)) `:after' (lambda (&rest r) (prog1 (apply OLDFUN r) (apply FUNCTION r))) `:around' (lambda (&rest r) (apply FUNCTION OLDFUN r)) +`:override' (lambda (&rest r) (apply FUNCTION r)) `:before-while' (lambda (&rest r) (and (apply FUNCTION r) (apply OLDFUN r))) `:before-until' (lambda (&rest r) (or (apply FUNCTION r) (apply OLDFUN r))) `:after-while' (lambda (&rest r) (and (apply OLDFUN r) (apply FUNCTION r))) `:after-until' (lambda (&rest r) (or (apply OLDFUN r) (apply FUNCTION r))) +`:filter-args' (lambda (&rest r) (apply OLDFUN (funcall FUNCTION r))) +`:filter-return'(lambda (&rest r) (funcall FUNCTION (apply OLDFUN r))) If FUNCTION was already added, do nothing. PROPS is an alist of additional properties, among which the following have a special meaning: - `name': a string or symbol. It can be used to refer to this piece of advice. -PLACE cannot be a simple variable. Instead it should either be -\(default-value 'VAR) or (local 'VAR) depending on whether FUNCTION -should be applied to VAR buffer-locally or globally. +If PLACE is a simple variable, only its global value will be affected. +Use (local 'VAR) if you want to apply FUNCTION to VAR buffer-locally. If one of FUNCTION or OLDFUN is interactive, then the resulting function is also interactive. There are 3 cases: @@ -250,15 +255,21 @@ is also interactive. There are 3 cases: (cond ((eq 'local (car-safe place)) (setq place `(advice--buffer-local ,@(cdr place)))) ((symbolp place) - (error "Use (default-value '%S) or (local '%S)" place place))) + (setq place `(default-value ',place)))) `(advice--add-function ,where (gv-ref ,place) ,function ,props)) ;;;###autoload (defun advice--add-function (where ref function props) - (unless (advice--member-p function (gv-deref ref)) + (let ((a (advice--member-p function (cdr (assq 'name props)) + (gv-deref ref)))) + (when a + ;; The advice is already present. Remove the old one, first. + (setf (gv-deref ref) + (advice--remove-function (gv-deref ref) (advice--car a)))) (setf (gv-deref ref) (advice--make where function (gv-deref ref) props)))) +;;;###autoload (defmacro remove-function (place function) "Remove the FUNCTION piece of advice from PLACE. If FUNCTION was not added to PLACE, do nothing. @@ -396,7 +407,7 @@ of the piece of advice." "Return non-nil if ADVICE has been added to FUNCTION-NAME. Instead of ADVICE being the actual function, it can also be the `name' of the piece of advice." - (advice--member-p advice + (advice--member-p advice advice (or (get function-name 'advice--pending) (advice--strip-macro (if (fboundp function-name) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index c15c9e079fe..41b635bbe30 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -4,8 +4,9 @@ ;; Author: Tom Tromey <tromey@redhat.com> ;; Created: 10 Mar 2007 -;; Version: 1.0 +;; Version: 1.0.1 ;; Keywords: tools +;; Package-Requires: ((tabulated-list "1.0")) ;; This file is part of GNU Emacs. @@ -234,11 +235,28 @@ a package can run arbitrary code." :group 'package :version "24.1") +(defcustom package-pinned-packages nil + "An alist of packages that are pinned to a specific archive + +Each element has the form (SYM . ID). + SYM is a package, as a symbol. + ID is an archive name, as a string. This should correspond to an + entry in `package-archives'. + +If the archive of name ID does not contain the package SYM, no +other location will be considered, which will make the +package unavailable." + :type '(alist :key-type (symbol :tag "Package") + :value-type (string :tag "Archive name")) + :risky t + :group 'package + :version "24.4") + (defconst package-archive-version 1 "Version number of the package archive understood by this file. Lower version numbers than this will probably be understood as well.") -(defconst package-el-version "1.0" +(defconst package-el-version "1.0.1" "Version of package.el.") ;; We don't prime the cache since it tends to get out of date. @@ -571,7 +589,8 @@ EXTRA-PROPERTIES is currently unused." (concat ";;; " (file-name-nondirectory file) " --- automatically extracted autoloads\n" ";;\n" - ";;; Code:\n\n" + ";;; Code:\n" + "(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))\n" " \n;; Local Variables:\n" ";; version-control: never\n" ";; no-byte-compile: t\n" @@ -588,16 +607,15 @@ EXTRA-PROPERTIES is currently unused." ;;(ignore-name (concat name "-pkg.el")) (generated-autoload-file (expand-file-name auto-name pkg-dir)) (version-control 'never)) - (unless (fboundp 'autoload-ensure-default-file) - (package-autoload-ensure-default-file generated-autoload-file)) + (package-autoload-ensure-default-file generated-autoload-file) (update-directory-autoloads pkg-dir) (let ((buf (find-buffer-visiting generated-autoload-file))) (when buf (kill-buffer buf))))) (defvar tar-parse-info) (declare-function tar-untar-buffer "tar-mode" ()) -(declare-function tar-header-name "tar-mode" (tar-header)) -(declare-function tar-header-link-type "tar-mode" (tar-header)) +(declare-function tar-header-name "tar-mode" (tar-header) t) +(declare-function tar-header-link-type "tar-mode" (tar-header) t) (defun package-untar-buffer (dir) "Untar the current buffer. @@ -792,9 +810,8 @@ but version %s required" "Need package `%s-%s', but only %s is available" (symbol-name next-pkg) (package-version-join next-version) (package-version-join (package-desc-vers (cdr pkg-desc))))) - ;; Only add to the transaction if we don't already have it. - (unless (memq next-pkg package-list) - (push next-pkg package-list)) + ;; Move to front, so it gets installed early enough (bug#14082). + (setq package-list (cons next-pkg (delq next-pkg package-list))) (setq package-list (package-compute-transaction package-list (package-desc-reqs @@ -857,8 +874,13 @@ Also, add the originating archive to the end of the package vector." (version (package-desc-vers (cdr package))) (entry (cons name (vconcat (cdr package) (vector archive)))) - (existing-package (assq name package-archive-contents))) - (cond ((not existing-package) + (existing-package (assq name package-archive-contents)) + (pinned-to-archive (assoc name package-pinned-packages))) + (cond ((and pinned-to-archive + ;; If pinned to another archive, skip entirely. + (not (equal (cdr pinned-to-archive) archive))) + nil) + ((not existing-package) (add-to-list 'package-archive-contents entry)) ((version-list-< (package-desc-vers (cdr existing-package)) version) diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el index b12fba17027..d0e3c5763b5 100644 --- a/lisp/emacs-lisp/shadow.el +++ b/lisp/emacs-lisp/shadow.el @@ -207,101 +207,79 @@ the earlier. For example, suppose `load-path' is set to -\(\"/usr/gnu/emacs/site-lisp\" \"/usr/gnu/emacs/share/emacs/19.30/lisp\"\) +\(\"/usr/share/emacs/site-lisp\" \"/usr/share/emacs/24.3/lisp\") and that each of these directories contains a file called XXX.el. Then XXX.el in the site-lisp directory is referred to by all of: -\(require 'XXX\), \(autoload .... \"XXX\"\), \(load-library \"XXX\"\) etc. +\(require 'XXX), (autoload .... \"XXX\"), (load-library \"XXX\") etc. -The first XXX.el file prevents Emacs from seeing the second \(unless -the second is loaded explicitly via `load-file'\). +The first XXX.el file prevents Emacs from seeing the second (unless +the second is loaded explicitly via `load-file'). When not intended, such shadowings can be the source of subtle problems. For example, the above situation may have arisen because the XXX package was not distributed with versions of Emacs prior to -19.30. An Emacs maintainer downloaded XXX from elsewhere and installed +24.3. A system administrator downloaded XXX from elsewhere and installed it. Later, XXX was updated and included in the Emacs distribution. -Unless the Emacs maintainer checks for this, the new version of XXX -will be hidden behind the old \(which may no longer work with the new -Emacs version\). +Unless the system administrator checks for this, the new version of XXX +will be hidden behind the old (which may no longer work with the new +Emacs version). This function performs these checks and flags all possible shadowings. Because a .el file may exist without a corresponding .elc -\(or vice-versa\), these suffixes are essentially ignored. A file -XXX.elc in an early directory \(that does not contain XXX.el\) is +\(or vice-versa), these suffixes are essentially ignored. A file +XXX.elc in an early directory (that does not contain XXX.el) is considered to shadow a later file XXX.el, and vice-versa. Shadowings are located by calling the (non-interactive) companion function, `load-path-shadows-find'." (interactive) - (let* ((path (copy-sequence load-path)) - (tem path) - toplevs) - ;; If we can find simple.el in two places, - (dolist (tt tem) - (if (or (file-exists-p (expand-file-name "simple.el" tt)) - (file-exists-p (expand-file-name "simple.el.gz" tt))) - (setq toplevs (cons tt toplevs)))) - (if (> (length toplevs) 1) - ;; Cut off our copy of load-path right before - ;; the last directory which has simple.el in it. - ;; This avoids loads of duplications between the source dir - ;; and the dir where these files were copied by installation. - (let ((break (car toplevs))) - (setq tem path) - (while tem - (if (eq (nth 1 tem) break) - (progn - (setcdr tem nil) - (setq tem nil))) - (setq tem (cdr tem))))) - - (let* ((shadows (load-path-shadows-find path)) - (n (/ (length shadows) 2)) - (msg (format "%s Emacs Lisp load-path shadowing%s found" - (if (zerop n) "No" (concat "\n" (number-to-string n))) - (if (= n 1) " was" "s were")))) - (with-temp-buffer - (while shadows - (insert (format "%s hides %s\n" (car shadows) - (car (cdr shadows)))) - (setq shadows (cdr (cdr shadows)))) - (if stringp - (buffer-string) - (if (called-interactively-p 'interactive) - ;; We are interactive. - ;; Create the *Shadows* buffer and display shadowings there. - (let ((string (buffer-string))) - (with-current-buffer (get-buffer-create "*Shadows*") - (display-buffer (current-buffer)) - (load-path-shadows-mode) ; run after-change-major-mode-hook - (let ((inhibit-read-only t)) - (erase-buffer) - (insert string) - (insert msg "\n") - (while (re-search-backward "\\(^.*\\) hides \\(.*$\\)" - nil t) - (dotimes (i 2) - (make-button (match-beginning (1+ i)) - (match-end (1+ i)) - 'type 'load-path-shadows-find-file - 'shadow-file - (match-string (1+ i))))) - (goto-char (point-max))))) - ;; We are non-interactive, print shadows via message. - (unless (zerop n) - (message "This site has duplicate Lisp libraries with the same name. + (let* ((shadows (load-path-shadows-find load-path)) + (n (/ (length shadows) 2)) + (msg (format "%s Emacs Lisp load-path shadowing%s found" + (if (zerop n) "No" (concat "\n" (number-to-string n))) + (if (= n 1) " was" "s were")))) + (with-temp-buffer + (while shadows + (insert (format "%s hides %s\n" (car shadows) + (car (cdr shadows)))) + (setq shadows (cdr (cdr shadows)))) + (if stringp + (buffer-string) + (if (called-interactively-p 'interactive) + ;; We are interactive. + ;; Create the *Shadows* buffer and display shadowings there. + (let ((string (buffer-string))) + (with-current-buffer (get-buffer-create "*Shadows*") + (display-buffer (current-buffer)) + (load-path-shadows-mode) ; run after-change-major-mode-hook + (let ((inhibit-read-only t)) + (erase-buffer) + (insert string) + (insert msg "\n") + (while (re-search-backward "\\(^.*\\) hides \\(.*$\\)" + nil t) + (dotimes (i 2) + (make-button (match-beginning (1+ i)) + (match-end (1+ i)) + 'type 'load-path-shadows-find-file + 'shadow-file + (match-string (1+ i))))) + (goto-char (point-max))))) + ;; We are non-interactive, print shadows via message. + (unless (zerop n) + (message "This site has duplicate Lisp libraries with the same name. If a locally-installed Lisp library overrides a library in the Emacs release, that can cause trouble, and you should probably remove the locally-installed version unless you know what you are doing.\n") - (goto-char (point-min)) - ;; Mimic the previous behavior of using lots of messages. - ;; I think one single message would look better... - (while (not (eobp)) - (message "%s" (buffer-substring (line-beginning-position) - (line-end-position))) - (forward-line 1)) - (message "%s" msg)))))))) + (goto-char (point-min)) + ;; Mimic the previous behavior of using lots of messages. + ;; I think one single message would look better... + (while (not (eobp)) + (message "%s" (buffer-substring (line-beginning-position) + (line-end-position))) + (forward-line 1)) + (message "%s" msg))))))) (provide 'shadow) diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 18cc0e811ce..a88b9d70930 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -1021,6 +1021,88 @@ This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'. (let ((blink-matching-check-function #'smie-blink-matching-check)) (blink-matching-open)))))))) +(defface smie-matching-block-highlight '((t (:inherit highlight))) + "Face used to highlight matching block." + :group 'smie) + +(defvar smie--highlight-matching-block-overlay nil) +(defvar-local smie--highlight-matching-block-lastpos -1) + +(defun smie-highlight-matching-block () + (when (and smie-closer-alist + (/= (point) smie--highlight-matching-block-lastpos)) + (unless (overlayp smie--highlight-matching-block-overlay) + (setq smie--highlight-matching-block-overlay + (make-overlay (point) (point)))) + (setq smie--highlight-matching-block-lastpos (point)) + (let ((beg-of-tok + (lambda (&optional start) + "Move to the beginning of current token at START." + (let* ((token) + (start (or start (point))) + (beg (progn + (funcall smie-backward-token-function) + (forward-comment (point-max)) + (point))) + (end (progn + (setq token (funcall smie-forward-token-function)) + (forward-comment (- (point))) + (point)))) + (if (and (<= beg start) (<= start end) + (or (assoc token smie-closer-alist) + (rassoc token smie-closer-alist))) + (progn (goto-char beg) token) + (goto-char start) + nil)))) + (highlight + (lambda (beg end) + (move-overlay smie--highlight-matching-block-overlay + beg end (current-buffer)) + (overlay-put smie--highlight-matching-block-overlay + 'face 'smie-matching-block-highlight)))) + (overlay-put smie--highlight-matching-block-overlay 'face nil) + (unless (nth 8 (syntax-ppss)) + (save-excursion + (condition-case nil + (let ((token + (or (funcall beg-of-tok) + (funcall beg-of-tok + (prog1 (point) + (funcall smie-forward-token-function)))))) + (cond + ((assoc token smie-closer-alist) ; opener + (forward-sexp 1) + (let ((end (point)) + (closer (funcall smie-backward-token-function))) + (when (rassoc closer smie-closer-alist) + (funcall highlight (point) end)))) + ((rassoc token smie-closer-alist) ; closer + (funcall smie-forward-token-function) + (forward-sexp -1) + (let ((beg (point)) + (opener (funcall smie-forward-token-function))) + (when (assoc opener smie-closer-alist) + (funcall highlight beg (point))))))) + (scan-error))))))) + +(defvar smie--highlight-matching-block-timer nil) + +;;;###autoload +(define-minor-mode smie-highlight-matching-block-mode nil + :global t :group 'smie + (when (timerp smie--highlight-matching-block-timer) + (cancel-timer smie--highlight-matching-block-timer)) + (setq smie--highlight-matching-block-timer nil) + (if smie-highlight-matching-block-mode + (progn + (remove-hook 'post-self-insert-hook #'smie-blink-matching-open 'local) + (setq smie--highlight-matching-block-timer + (run-with-idle-timer 0.2 t #'smie-highlight-matching-block))) + (when smie--highlight-matching-block-overlay + (delete-overlay smie--highlight-matching-block-overlay) + (setq smie--highlight-matching-block-overlay nil)) + (kill-local-variable 'smie--highlight-matching-block-lastpos))) + ;;; The indentation engine. (defcustom smie-indent-basic 4 @@ -1067,9 +1149,10 @@ the beginning of a line." (save-excursion (<= (line-end-position) (progn - (when (zerop (length (funcall smie-forward-token-function))) - ;; Could be an open-paren. - (forward-char 1)) + (and (zerop (length (funcall smie-forward-token-function))) + (not (eobp)) + ;; Could be an open-paren. + (forward-char 1)) (skip-chars-forward " \t") (or (eolp) (and (looking-at comment-start-skip) @@ -1277,7 +1360,12 @@ BASE-POS is the position relative to which offsets should be applied." ((looking-at "\\s(\\|\\s)\\(\\)") (forward-char 1) (cons (buffer-substring (1- (point)) (point)) - (if (match-end 1) '(0 nil) '(nil 0))))))) + (if (match-end 1) '(0 nil) '(nil 0)))) + ((looking-at "\\s\"") + (forward-sexp 1) + nil) + ((eobp) nil) + (t (error "Bumped into unknown token"))))) (defun smie-indent-backward-token () "Skip token backward and return it, along with its levels." @@ -1289,7 +1377,12 @@ BASE-POS is the position relative to which offsets should be applied." ((memq (setq class (syntax-class (syntax-after (1- (point))))) '(4 5)) (forward-char -1) (cons (buffer-substring (point) (1+ (point))) - (if (eq class 4) '(nil 0) '(0 nil))))))) + (if (eq class 4) '(nil 0) '(0 nil)))) + ((eq class 7) + (backward-sexp 1) + nil) + ((bobp) nil) + (t (error "Bumped into unknown token"))))) (defun smie-indent-virtual () ;; We used to take an optional arg (with value :not-hanging) to specify that @@ -1350,8 +1443,11 @@ should not be computed on the basis of the following token." (if (and (< pos (line-beginning-position)) ;; Make sure `token' also *starts* on another line. (save-excursion - (smie-indent-backward-token) - (< pos (line-beginning-position)))) + (let ((endpos (point))) + (goto-char pos) + (forward-line 1) + (and (equal res (smie-indent-forward-token)) + (eq (point) endpos))))) nil (goto-char pos) res))))) @@ -1473,13 +1569,21 @@ should not be computed on the basis of the following token." (save-excursion (forward-comment (point-max)) (skip-chars-forward " \t\r\n") - ;; FIXME: We assume here that smie-indent-calculate will compute the - ;; indentation of the next token based on text before the comment, but - ;; this is not guaranteed, so maybe we should let - ;; smie-indent-calculate return some info about which buffer position - ;; was used as the "indentation base" and check that this base is - ;; before `pos'. - (smie-indent-calculate)))) + (unless + ;; Don't align with a closer, since the comment is "within" the + ;; closed element. Don't align with EOB either. + (save-excursion + (let ((next (funcall smie-forward-token-function))) + (or (if (zerop (length next)) + (or (eobp) (eq (car (syntax-after (point))) 5))) + (rassoc next smie-closer-alist)))) + ;; FIXME: We assume here that smie-indent-calculate will compute the + ;; indentation of the next token based on text before the comment, + ;; but this is not guaranteed, so maybe we should let + ;; smie-indent-calculate return some info about which buffer + ;; position was used as the "indentation base" and check that this + ;; base is before `pos'. + (smie-indent-calculate))))) (defun smie-indent-comment-continue () ;; indentation of comment-continue lines. @@ -1628,37 +1732,45 @@ to which that point should be aligned, if we were to reindent it.") (save-excursion (indent-line-to indent)) (indent-line-to indent))))) -(defun smie-auto-fill () +(defun smie-auto-fill (do-auto-fill) (let ((fc (current-fill-column))) - (while (and fc (> (current-column) fc)) - (or (unless (or (nth 8 (save-excursion - (syntax-ppss (line-beginning-position)))) - (nth 8 (syntax-ppss))) - (save-excursion - (let ((end (point)) - (bsf (progn (beginning-of-line) + (when (and fc (> (current-column) fc)) + ;; The loop below presumes BOL is outside of strings or comments. Also, + ;; sometimes we prefer to fill the comment than the code around it. + (unless (or (nth 8 (save-excursion + (syntax-ppss (line-beginning-position)))) + (nth 4 (save-excursion + (move-to-column fc) + (syntax-ppss)))) + (while + (and (with-demoted-errors + (save-excursion + (let ((end (point)) + (bsf nil) ;Best-so-far. + (gain 0)) + (beginning-of-line) + (while (progn (smie-indent-forward-token) - (point))) - (gain 0) - curcol) - (while (and (<= (point) end) - (<= (setq curcol (current-column)) fc)) - ;; FIXME? `smie-indent-calculate' can (and often will) - ;; return a result that actually depends on the - ;; presence/absence of a newline, so the gain computed here - ;; may not be accurate, but in practice it seems to works - ;; well enough. - (let* ((newcol (smie-indent-calculate)) - (newgain (- curcol newcol))) - (when (> newgain gain) - (setq gain newgain) - (setq bsf (point)))) - (smie-indent-forward-token)) - (when (> gain 0) - (goto-char bsf) - (newline-and-indent) - 'done)))) - (do-auto-fill))))) + (and (<= (point) end) + (<= (current-column) fc))) + ;; FIXME? `smie-indent-calculate' can (and often + ;; does) return a result that actually depends on the + ;; presence/absence of a newline, so the gain computed + ;; here may not be accurate, but in practice it seems + ;; to work well enough. + (skip-chars-forward " \t") + (let* ((newcol (smie-indent-calculate)) + (newgain (- (current-column) newcol))) + (when (> newgain gain) + (setq gain newgain) + (setq bsf (point))))) + (when (> gain 0) + (goto-char bsf) + (newline-and-indent) + 'done)))) + (> (current-column) fc)))) + (when (> (current-column) fc) + (funcall do-auto-fill))))) (defun smie-setup (grammar rules-function &rest keywords) @@ -1668,12 +1780,11 @@ RULES-FUNCTION is a set of indentation rules for use on `smie-rules-function'. KEYWORDS are additional arguments, which can use the following keywords: - :forward-token FUN - :backward-token FUN" - (set (make-local-variable 'smie-rules-function) rules-function) - (set (make-local-variable 'smie-grammar) grammar) - (set (make-local-variable 'indent-line-function) 'smie-indent-line) - (set (make-local-variable 'normal-auto-fill-function) 'smie-auto-fill) - (set (make-local-variable 'forward-sexp-function) - 'smie-forward-sexp-command) + (setq-local smie-rules-function rules-function) + (setq-local smie-grammar grammar) + (setq-local indent-line-function #'smie-indent-line) + (add-function :around (local 'normal-auto-fill-function) #'smie-auto-fill) + (setq-local forward-sexp-function #'smie-forward-sexp-command) (while keywords (let ((k (pop keywords)) (v (pop keywords))) @@ -1685,29 +1796,26 @@ KEYWORDS are additional arguments, which can use the following keywords: (_ (message "smie-setup: ignoring unknown keyword %s" k))))) (let ((ca (cdr (assq :smie-closer-alist grammar)))) (when ca - (set (make-local-variable 'smie-closer-alist) ca) + (setq-local smie-closer-alist ca) ;; Only needed for interactive calls to blink-matching-open. - (set (make-local-variable 'blink-matching-check-function) - #'smie-blink-matching-check) - (add-hook 'post-self-insert-hook - #'smie-blink-matching-open 'append 'local) - (set (make-local-variable 'smie-blink-matching-triggers) - (append smie-blink-matching-triggers - ;; Rather than wait for SPC to blink, try to blink as - ;; soon as we type the last char of a block ender. - (let ((closers (sort (mapcar #'cdr smie-closer-alist) - #'string-lessp)) - (triggers ()) - closer) - (while (setq closer (pop closers)) - (unless (and closers - ;; FIXME: this eliminates prefixes of other - ;; closers, but we should probably - ;; eliminate prefixes of other keywords - ;; as well. - (string-prefix-p closer (car closers))) - (push (aref closer (1- (length closer))) triggers))) - (delete-dups triggers))))))) + (setq-local blink-matching-check-function #'smie-blink-matching-check) + (unless smie-highlight-matching-block-mode + (add-hook 'post-self-insert-hook + #'smie-blink-matching-open 'append 'local)) + ;; Setup smie-blink-matching-triggers. Rather than wait for SPC to + ;; blink, try to blink as soon as we type the last char of a block ender. + (let ((closers (sort (mapcar #'cdr smie-closer-alist) #'string-lessp)) + (triggers ()) + closer) + (while (setq closer (pop closers)) + (unless + ;; FIXME: this eliminates prefixes of other closers, but we + ;; should probably eliminate prefixes of other keywords as well. + (and closers (string-prefix-p closer (car closers))) + (push (aref closer (1- (length closer))) triggers))) + (setq-local smie-blink-matching-triggers + (append smie-blink-matching-triggers + (delete-dups triggers))))))) (provide 'smie) diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index bf2c8308bb5..3e850320133 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -56,12 +56,13 @@ ;; syntax-ppss-flush-cache since that would not only flush the cache but also ;; reset syntax-propertize--done which should not be done in this case). "Mode-specific function to apply `syntax-table' text properties. -The value of this variable is a function to be called by Font -Lock mode, prior to performing syntactic fontification on a -stretch of text. It is given two arguments, START and END: the -start and end of the text to be fontified. Major modes can -specify a custom function to apply `syntax-table' properties to -override the default syntax table in special cases. +It is the work horse of `syntax-propertize', which is called by things like +Font-Lock and indentation. + +It is given two arguments, START and END: the start and end of the text to +which `syntax-table' might need to be applied. Major modes can use this to +override the buffer's syntax table for special syntactic constructs that +cannot be handled just by the buffer's syntax-table. The specified function may call `syntax-ppss' on any position before END, but it should not call `syntax-ppss-flush-cache', @@ -99,7 +100,7 @@ Put first the functions more likely to cause a change and cheaper to compute.") (setq beg (or (previous-single-property-change beg 'syntax-multiline) (point-min)))) ;; - (when (get-text-property end 'font-lock-multiline) + (when (get-text-property end 'syntax-multiline) (setq end (or (text-property-any end (point-max) 'syntax-multiline nil) (point-max)))) diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index da487e463e2..5660ac8c4cc 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -4,6 +4,7 @@ ;; Author: Chong Yidong <cyd@stupidchicken.com> ;; Keywords: extensions, lisp +;; Version: 1.0 ;; This file is part of GNU Emacs. @@ -519,12 +520,11 @@ printer is `tabulated-list-print-entry', but a mode that keeps data in an ewoc may instead specify a printer function (e.g., one that calls `ewoc-enter-last'), with `tabulated-list-print-entry' as the ewoc pretty-printer." - (setq truncate-lines t) - (setq buffer-read-only t) - (set (make-local-variable 'revert-buffer-function) - 'tabulated-list-revert) - (set (make-local-variable 'glyphless-char-display) - tabulated-list-glyphless-char-display)) + (setq-local truncate-lines t) + (setq-local buffer-read-only t) + (setq-local buffer-undo-list t) + (setq-local revert-buffer-function #'tabulated-list-revert) + (setq-local glyphless-char-display tabulated-list-glyphless-char-display)) (put 'tabulated-list-mode 'mode-class 'special) diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el index f6bd26e9f34..a5619583145 100644 --- a/lisp/emacs-lisp/testcover.el +++ b/lisp/emacs-lisp/testcover.el @@ -100,14 +100,14 @@ current global map. The macro `lambda' is self-evaluating, hence always returns the same value (the function it defines may return varying values when called)." :group 'testcover - :type 'hook) + :type '(repeat symbol)) (defcustom testcover-noreturn-functions '(error noreturn throw signal) "Subset of `testcover-1value-functions' -- these never return. We mark them as having returned nil just before calling them." :group 'testcover - :type 'hook) + :type '(repeat symbol)) (defcustom testcover-compose-functions '(+ - * / = append length list make-keymap make-sparse-keymap @@ -118,7 +118,7 @@ calls to one of the `testcover-1value-functions', so if that's true then no brown splotch is shown for these. This list is quite incomplete! Most side-effect-free functions should be here." :group 'testcover - :type 'hook) + :type '(repeat symbol)) (defcustom testcover-progn-functions '(define-key fset function goto-char mapc overlay-put progn @@ -132,7 +132,7 @@ brown splotch is shown for these if the last argument is a constant or a call to one of the `testcover-1value-functions'. This list is probably incomplete!" :group 'testcover - :type 'hook) + :type '(repeat symbol)) (defcustom testcover-prog1-functions '(prog1 unwind-protect) @@ -140,7 +140,7 @@ incomplete!" brown splotch is shown for these if the first argument is a constant or a call to one of the `testcover-1value-functions'." :group 'testcover - :type 'hook) + :type '(repeat symbol)) (defcustom testcover-potentially-1value-functions '(add-hook and beep or remove-hook unless when) diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index 8b019d0a785..0aa31f717ed 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -27,27 +27,34 @@ ;;; Code: -;; Layout of a timer vector: -;; [triggered-p high-seconds low-seconds usecs repeat-delay -;; function args idle-delay psecs] -;; triggered-p is nil if the timer is active (waiting to be triggered), -;; t if it is inactive ("already triggered", in theory) - (eval-when-compile (require 'cl-lib)) (cl-defstruct (timer - (:constructor nil) - (:copier nil) - (:constructor timer-create ()) - (:type vector) - (:conc-name timer--)) + (:constructor nil) + (:copier nil) + (:constructor timer-create ()) + (:type vector) + (:conc-name timer--)) + ;; nil if the timer is active (waiting to be triggered), + ;; non-nil if it is inactive ("already triggered", in theory). (triggered t) - high-seconds low-seconds usecs repeat-delay function args idle-delay psecs) + ;; Time of next trigger: for normal timers, absolute time, for idle timers, + ;; time relative to idle-start. + high-seconds low-seconds usecs + ;; For normal timers, time between repetitions, or nil. For idle timers, + ;; non-nil iff repeated. + repeat-delay + function args ;What to do when triggered. + idle-delay ;If non-nil, this is an idle-timer. + psecs) (defun timerp (object) "Return t if OBJECT is a timer." (and (vectorp object) (= (length object) 9))) +(defsubst timer--check (timer) + (or (timerp timer) (signal 'wrong-type-argument (list #'timerp timer)))) + ;; Pseudo field `time'. (defun timer--time (timer) (list (timer--high-seconds timer) @@ -57,17 +64,17 @@ (gv-define-simple-setter timer--time (lambda (timer time) - (or (timerp timer) (error "Invalid timer")) + (timer--check timer) (setf (timer--high-seconds timer) (pop time)) (let ((low time) (usecs 0) (psecs 0)) (if (consp time) - (progn - (setq low (pop time)) - (if time - (progn - (setq usecs (pop time)) - (if time - (setq psecs (car time))))))) + (progn + (setq low (pop time)) + (if time + (progn + (setq usecs (pop time)) + (if time + (setq psecs (car time))))))) (setf (timer--low-seconds timer) low) (setf (timer--usecs timer) usecs) (setf (timer--psecs timer) psecs)))) @@ -83,15 +90,13 @@ fire repeatedly that many seconds apart." timer) (defun timer-set-idle-time (timer secs &optional repeat) + ;; FIXME: Merge with timer-set-time. "Set the trigger idle time of TIMER to SECS. SECS may be an integer, floating point number, or the internal time format returned by, e.g., `current-idle-time'. If optional third argument REPEAT is non-nil, make the timer fire each time Emacs is idle for that many seconds." - (if (consp secs) - (setf (timer--time timer) secs) - (setf (timer--time timer) '(0 0 0)) - (timer-inc-time timer secs)) + (setf (timer--time timer) (if (consp secs) secs (seconds-to-time secs))) (setf (timer--repeat-delay timer) repeat) timer) @@ -119,7 +124,7 @@ of SECS seconds since the epoch. SECS may be a fraction." (floor (mod next-sec-psec 1000000))))) (defun timer-relative-time (time secs &optional usecs psecs) - "Advance TIME by SECS seconds and optionally USECS nanoseconds + "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) @@ -134,7 +139,7 @@ floating point number." (time-less-p (timer--time t1) (timer--time t2))) (defun timer-inc-time (timer secs &optional usecs psecs) - "Increment the time set in TIMER by SECS seconds, USECS nanoseconds, + "Increment the time set in TIMER by SECS seconds, USECS microseconds, and PSECS picoseconds. SECS may be a fraction. If USECS or PSECS are omitted, they are treated as zero." (setf (timer--time timer) @@ -156,8 +161,7 @@ fire repeatedly that many seconds apart." (defun timer-set-function (timer function &optional args) "Make TIMER call FUNCTION with optional ARGS when triggering." - (or (timerp timer) - (error "Invalid timer")) + (timer--check timer) (setf (timer--function timer) function) (setf (timer--args timer) args) timer) @@ -181,9 +185,10 @@ fire repeatedly that many seconds apart." (setcdr reuse-cell timers)) (setq reuse-cell (cons timer timers))) ;; Insert new timer after last which possibly means in front of queue. - (cond (last (setcdr last reuse-cell)) - (idle (setq timer-idle-list reuse-cell)) - (t (setq timer-list reuse-cell))) + (setf (cond (last (cdr last)) + (idle timer-idle-list) + (t timer-list)) + reuse-cell) (setf (timer--triggered timer) triggered-p) (setf (timer--idle-delay timer) idle) nil) @@ -223,8 +228,7 @@ timer will fire right away." (defun cancel-timer (timer) "Remove TIMER from the list of active timers." - (or (timerp timer) - (error "Invalid timer")) + (timer--check timer) (setq timer-list (delq timer timer-list)) (setq timer-idle-list (delq timer timer-idle-list)) nil) @@ -283,40 +287,47 @@ This function is called, by name, directly by the C code." (setq timer-event-last-1 timer-event-last) (setq timer-event-last timer) (let ((inhibit-quit t)) - (if (timerp timer) - (let (retrigger cell) - ;; Delete from queue. Record the cons cell that was used. - (setq cell (cancel-timer-internal timer)) - ;; Re-schedule if requested. - (if (timer--repeat-delay timer) - (if (timer--idle-delay timer) - (timer-activate-when-idle timer nil cell) - (timer-inc-time timer (timer--repeat-delay timer) 0) - ;; If real time has jumped forward, - ;; 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)) - (timer--repeat-delay timer)))) - (if (> repeats timer-max-repeats) - (timer-inc-time timer (* (timer--repeat-delay timer) - repeats))))) - (timer-activate timer t cell) - (setq retrigger t))) - ;; Run handler. - ;; We do this after rescheduling so that the handler function - ;; can cancel its own timer successfully with cancel-timer. - (condition-case-unless-debug err - ;; Timer functions should not change the current buffer. - ;; If they do, all kinds of nasty surprises can happen, - ;; and it can be hellish to track down their source. - (save-current-buffer - (apply (timer--function timer) (timer--args timer))) - (error (message "Error in timer: %S" err))) - (if retrigger - (setf (timer--triggered timer) nil))) - (error "Bogus timer event")))) + (timer--check timer) + (let ((retrigger nil) + (cell + ;; Delete from queue. Record the cons cell that was used. + (cancel-timer-internal timer))) + ;; Re-schedule if requested. + (if (timer--repeat-delay timer) + (if (timer--idle-delay timer) + (timer-activate-when-idle timer nil cell) + (timer-inc-time timer (timer--repeat-delay timer) 0) + ;; If real time has jumped forward, + ;; 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)) + (timer--repeat-delay timer)))) + (if (> repeats timer-max-repeats) + (timer-inc-time timer (* (timer--repeat-delay timer) + repeats))))) + ;; Place it back on the timer-list before running + ;; timer--function, so it can cancel-timer itself. + (timer-activate timer t cell) + (setq retrigger t))) + ;; Run handler. + (condition-case-unless-debug err + ;; Timer functions should not change the current buffer. + ;; If they do, all kinds of nasty surprises can happen, + ;; and it can be hellish to track down their source. + (save-current-buffer + (apply (timer--function timer) (timer--args timer))) + (error (message "Error running timer%s: %S" + (if (symbolp (timer--function timer)) + (format " `%s'" (timer--function timer)) "") + err))) + (when (and retrigger + ;; If the timer's been canceled, don't "retrigger" it + ;; since it might still be in the copy of timer-list kept + ;; by keyboard.c:timer_check (bug#14156). + (memq timer timer-list)) + (setf (timer--triggered timer) nil))))) ;; This function is incompatible with the one in levents.el. (defun timeout-event-p (event) @@ -527,6 +538,12 @@ If the user does not answer after SECONDS seconds, return DEFAULT-VALUE." secs (if (string-match-p "\\`[0-9.]+\\'" string) (string-to-number string))))) + +(defun internal-timer-start-idle () + "Mark all idle-time timers as once again candidates for running." + (dolist (timer timer-idle-list) + (if (timerp timer) ;; FIXME: Why test? + (setf (timer--triggered timer) nil)))) (provide 'timer) diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el index 09c4969cf18..f605c2865c0 100644 --- a/lisp/emacs-lisp/trace.el +++ b/lisp/emacs-lisp/trace.el @@ -157,6 +157,17 @@ (defvar inhibit-trace nil "If non-nil, all tracing is temporarily inhibited.") +;;;###autoload +(defun trace-values (&rest values) + "Helper function to get internal values. +You can call this function to add internal values in the trace buffer." + (unless inhibit-trace + (with-current-buffer trace-buffer + (goto-char (point-max)) + (insert + (trace-entry-message + 'trace-values trace-level values ""))))) + (defun trace-entry-message (function level args context) "Generate a string that describes that FUNCTION has been entered. LEVEL is the trace level, ARGS is the list of arguments passed to FUNCTION, @@ -189,6 +200,18 @@ some global variables)." (defvar trace--timer nil) +(defun trace--display-buffer (buf) + (unless (or trace--timer + (get-buffer-window buf 'visible)) + (setq trace--timer + ;; Postpone the display to some later time, in case we + ;; can't actually do it now. + (run-with-timer 0 nil + (lambda () + (setq trace--timer nil) + (display-buffer buf nil 0)))))) + + (defun trace-make-advice (function buffer background context) "Build the piece of advice to be added to trace FUNCTION. FUNCTION is the name of the traced function. @@ -203,15 +226,7 @@ be printed along with the arguments in the trace." (unless inhibit-trace (with-current-buffer trace-buffer (set (make-local-variable 'window-point-insertion-type) t) - (unless (or background trace--timer - (get-buffer-window trace-buffer 'visible)) - (setq trace--timer - ;; Postpone the display to some later time, in case we - ;; can't actually do it now. - (run-with-timer 0 nil - (lambda () - (setq trace--timer nil) - (display-buffer trace-buffer))))) + (unless background (trace--display-buffer trace-buffer)) (goto-char (point-max)) ;; Insert a separator from previous trace output: (if (= trace-level 1) (insert trace-separator)) @@ -224,7 +239,7 @@ be printed along with the arguments in the trace." (unless inhibit-trace (let ((ctx (funcall context))) (with-current-buffer trace-buffer - (unless background (display-buffer trace-buffer)) + (unless background (trace--display-buffer trace-buffer)) (goto-char (point-max)) (insert (trace-exit-message @@ -247,7 +262,17 @@ be printed along with the arguments in the trace." (defun trace--read-args (prompt) (cons - (intern (completing-read prompt obarray 'fboundp t)) + (let ((default (function-called-at-point)) + (beg (string-match ":[ \t]*\\'" prompt))) + (intern (completing-read (if default + (format + "%s (default %s)%s" + (substring prompt 0 beg) + default + (if beg (substring prompt beg) ": ")) + prompt) + obarray 'fboundp t nil nil + (if default (symbol-name default))))) (when current-prefix-arg (list (read-buffer "Output to buffer: " trace-buffer) diff --git a/lisp/emulation/cua-gmrk.el b/lisp/emulation/cua-gmrk.el index d2901bb966c..78665624946 100644 --- a/lisp/emulation/cua-gmrk.el +++ b/lisp/emulation/cua-gmrk.el @@ -25,10 +25,8 @@ ;;; Code: -(eval-when-compile - (require 'cua-base) - (require 'cua-rect) - ) +(require 'cua-base) +(require 'cua-rect) ;;; Global Marker diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index 220469b1ed9..16d109c6360 100644 --- a/lisp/emulation/cua-rect.el +++ b/lisp/emulation/cua-rect.el @@ -31,8 +31,7 @@ ;;; Code: -(eval-when-compile - (require 'cua-base)) +(require 'cua-base) ;;; Rectangle support diff --git a/lisp/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el index 5ddb9513f0a..138e3e6d0da 100644 --- a/lisp/emulation/edt-mapper.el +++ b/lisp/emulation/edt-mapper.el @@ -96,6 +96,10 @@ ;;; Code: +;; Otherwise it just hangs. This seems preferable. +(if noninteractive + (error "edt-mapper cannot be loaded in batch mode")) + ;;; ;;; Decide Emacs Variant, GNU Emacs or XEmacs (aka Lucid Emacs). ;;; Determine Window System, and X Server Vendor (if appropriate). diff --git a/lisp/emulation/tpu-edt.el b/lisp/emulation/tpu-edt.el index 4305e2d3af3..1ec0ecc943c 100644 --- a/lisp/emulation/tpu-edt.el +++ b/lisp/emulation/tpu-edt.el @@ -983,7 +983,7 @@ and the total number of lines in the buffer." With a prefix argument ARG, enable the mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil." - :global t + :global t :group 'tpu (if tpu-edt-mode (tpu-edt-on) (tpu-edt-off))) (defalias 'TPU-EDT-MODE 'tpu-edt-mode) @@ -2440,7 +2440,7 @@ If FILE is nil, try to load a default file. The default file names are ;;;### (autoloads (tpu-set-cursor-bound tpu-set-cursor-free tpu-set-scroll-margins -;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "fcc961b0b1e88f7fc9018b02742c27a8") +;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "ae3bca6f21640b5713a7c58c40f30847") ;;; Generated autoloads from tpu-extras.el (autoload 'tpu-cursor-free-mode "tpu-extras" "\ diff --git a/lisp/emulation/tpu-extras.el b/lisp/emulation/tpu-extras.el index 30143a0fa96..7cdba4d6e6b 100644 --- a/lisp/emulation/tpu-extras.el +++ b/lisp/emulation/tpu-extras.el @@ -436,6 +436,8 @@ A repeat count means scroll that many sections." (interactive) (tpu-cursor-free-mode -1)) +(provide 'tpu-extras) + ;; Local Variables: ;; generated-autoload-file: "tpu-edt.el" ;; End: diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index d0c0a4b4019..b2e476befd4 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -3781,9 +3781,9 @@ If MAJOR-MODE is set, set the macros only in that major mode." "///" 'vi-state [2 (meta x) v i p e r - t o g g l e - s e a r c h - s t y l e return] scope) - ;; XEmacs has no called-interactively-p - ;; (if (called-interactively-p 'interactive) - (if (interactive-p) + (if (if (featurep 'xemacs) + (interactive-p) + (called-interactively-p 'interactive)) (message "// and /// now toggle case-sensitivity and regexp search"))) (viper-unrecord-kbd-macro "//" 'vi-state) @@ -3806,10 +3806,9 @@ With a prefix argument, unsets the macro." "%%%" 'vi-state [(meta x) v i p e r - t o g g l e - p a r s e - s e x p - i g n o r e - c o m m e n t s return] 't) - ;; XEmacs has no called-interactively-p. And interactive-p - ;; works fine here. - ;; (if (called-interactively-p 'interactive) - (if (interactive-p) + (if (if (featurep 'xemacs) + (interactive-p) + (called-interactively-p 'interactive)) (message "%%%%%% now toggles whether comments should be parsed for matching parentheses"))) (viper-unrecord-kbd-macro "%%%" 'vi-state)))) @@ -3838,10 +3837,9 @@ the macros are set in the current major mode. "///" 'emacs-state [2 (meta x) v i p e r - t o g g l e - s e a r c h - s t y l e return] (or arg-majormode major-mode)) - ;; called-interactively-p does not work for - ;; XEmacs. interactive-p is ok here. - ;; (if (called-interactively-p 'interactive) - (if (interactive-p) + (if (if (featurep 'xemacs) + (interactive-p) + (called-interactively-p 'interactive)) (message "// and /// now toggle case-sensitivity and regexp search."))) (viper-unrecord-kbd-macro "//" 'emacs-state) @@ -4608,10 +4606,7 @@ One can use `` and '' to temporarily jump 1 step back." ;; Input Mode Indentation -;; Returns t, if the string before point matches the regexp STR. -(defsubst viper-looking-back (str) - (and (save-excursion (re-search-backward str nil t)) - (= (point) (match-end 0)))) +(define-obsolete-function-alias 'viper-looking-back 'looking-back "24.4") (defun viper-forward-indent () @@ -4625,7 +4620,7 @@ One can use `` and '' to temporarily jump 1 step back." (interactive) (if viper-cted (let ((p (point)) (c (current-column)) bol (indent t)) - (if (viper-looking-back "[0^]") + (if (looking-back "[0^]") (progn (if (eq ?^ (preceding-char)) (setq viper-preserve-indent t)) @@ -4637,7 +4632,7 @@ One can use `` and '' to temporarily jump 1 step back." (delete-region (point) p) (if indent (indent-to (- c viper-shift-width))) - (if (or (bolp) (viper-looking-back "[^ \t]")) + (if (or (bolp) (looking-back "[^ \t]")) (setq viper-cted nil))))) ;; do smart indent diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el index d469a7162b1..a2bdc28d2b5 100644 --- a/lisp/emulation/viper-ex.el +++ b/lisp/emulation/viper-ex.el @@ -39,14 +39,7 @@ (defvar viper-case-fold-search) (defvar explicit-shell-file-name) (defvar compile-command) - -;; loading happens only in non-interactive compilation -;; in order to spare non-viperized emacs from being viperized -(if noninteractive - (eval-when-compile - (if (not (featurep 'viper-cmd)) - (require 'viper-cmd)) - )) +(require 'viper-keym) ;; end pacifier (require 'viper-util) @@ -462,7 +455,7 @@ reversed." (while (and (not (eolp)) cont) ;;(re-search-forward "[^/]*/") (re-search-forward "[^/]*\\(/\\|\n\\)") - (if (not (viper-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/")) + (if (not (looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/")) (setq cont nil)))) (backward-char 1) (setq ex-token (buffer-substring (point) (mark t))) @@ -475,7 +468,7 @@ reversed." (while (and (not (eolp)) cont) ;;(re-search-forward "[^\\?]*\\?") (re-search-forward "[^\\?]*\\(\\?\\|\n\\)") - (if (not (viper-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?")) + (if (not (looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?")) (setq cont nil)) (backward-char 1) (if (not (looking-at "\n")) (forward-char 1)))) @@ -553,11 +546,13 @@ reversed." (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name)) (set-buffer viper-ex-work-buf) (goto-char (point-max))) - (cond ((viper-looking-back quit-regex1) (exit-minibuffer)) - ((viper-looking-back stay-regex) (insert " ")) - ((viper-looking-back quit-regex2) (exit-minibuffer)) + (cond ((looking-back quit-regex1) (exit-minibuffer)) + ((looking-back stay-regex) (insert " ")) + ((looking-back quit-regex2) (exit-minibuffer)) (t (insert " "))))) +(declare-function viper-tmp-insert-at-eob "viper-cmd" (msg)) + ;; complete Ex command (defun ex-cmd-complete () (interactive) @@ -568,14 +563,14 @@ reversed." save-pos (point))) (if (or (= dist 0) - (viper-looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)") - (viper-looking-back + (looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)") + (looking-back "^[ \t]*[a-zA-Z!=>&~][ \t]*[/?]*[ \t]+[a-zA-Z!=>&~]+")) ;; Preceding characters are not the ones allowed in an Ex command ;; or we have typed past command name. ;; Note: we didn't do parsing, so there can be surprises. - (if (or (viper-looking-back "[a-zA-Z!=>&~][ \t]*[/?]*[ \t]*") - (viper-looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)") + (if (or (looking-back "[a-zA-Z!=>&~][ \t]*[/?]*[ \t]*") + (looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)") (looking-at "[^ \t\n\C-m]")) nil (with-output-to-temp-buffer "*Completions*" @@ -605,6 +600,11 @@ reversed." ))) +(declare-function viper-enlarge-region "viper-cmd" (beg end)) +(declare-function viper-read-string-with-history "viper-cmd" + (prompt &optional viper-initial history-var + default keymap init-message)) + ;; Read Ex commands ;; ARG is a prefix argument. If given, the ex command runs on the region ;;(without the user having to specify the address :a,b @@ -746,7 +746,7 @@ reversed." (if (member ex-token '("global" "vglobal")) (error "Missing closing delimiter for global regexp") (goto-char (point-max)))) - (if (not (viper-looking-back + (if (not (looking-back (format "[^\\\\]\\(\\\\\\\\\\)*\\\\%c" c))) (setq cont nil) ;; we are at an escaped delimiter: unescape it and continue @@ -826,6 +826,9 @@ reversed." (if ans (setq address ans)))))) address)) +(declare-function viper-register-to-point "viper-cmd" + (char &optional enforce-buffer)) + ;; Returns an address as a point (defun viper-get-ex-address-subr (old-address dot) (let ((address nil)) @@ -960,7 +963,7 @@ reversed." (while (re-search-forward "%\\|#" nil t) (let ((data (match-data)) (char (buffer-substring (match-beginning 0) (match-end 0)))) - (if (viper-looking-back (concat "\\\\" char)) + (if (looking-back (concat "\\\\" char)) (replace-match char) (store-match-data data) (if (string= char "%") @@ -986,7 +989,7 @@ reversed." (get-buffer-create viper-ex-work-buf-name)) (skip-chars-forward " \t") (if (looking-at "!") - (if (and (not (viper-looking-back "[ \t]")) + (if (and (not (looking-back "[ \t]")) ;; read doesn't have a corresponding :r! form, so ! is ;; immediately interpreted as a shell command. (not (string= ex-token "read"))) @@ -1063,7 +1066,7 @@ reversed." (cond ((ex-cmd-accepts-multiple-files-p ex-token) (exit-minibuffer)) ;; apparently the argument to an Ex command is ;; supposed to be a shell command - ((viper-looking-back "^[ \t]*!.*") + ((looking-back "^[ \t]*!.*") (setq ex-cmdfile t) (insert " ")) (t @@ -1202,6 +1205,8 @@ reversed." (forward-line 1)) (insert (current-kill 0)))) +(declare-function viper-append-to-register "viper-cmd" (reg start end)) + ;; Ex delete command (defun ex-delete () (viper-default-ex-addresses) @@ -1238,6 +1243,7 @@ reversed." (kill-region (point) (mark t)))))) +(declare-function viper-change-state-to-vi "viper-cmd" ()) ;; Ex edit command ;; In Viper, `e' and `e!' behave identically. In both cases, the user is @@ -1308,6 +1314,8 @@ reversed." )) +(declare-function viper-backward-char-carefully "viper-cmd" (&optional arg)) + ;; Ex global command ;; This is executed in response to: ;; :global "pattern" ex-command @@ -1416,6 +1424,8 @@ reversed." (goto-char (1- point)) (beginning-of-line))) +(declare-function viper-forward-char-carefully "viper-cmd" (&optional arg)) + (defun ex-line-subr (com beg end) (cond ((string= com "join") (goto-char (min beg end)) @@ -1566,6 +1576,9 @@ reversed." (message "Autosaving all buffers that need to be saved...") (do-auto-save t)) +(declare-function viper-Put-back "viper-cmd" (arg)) +(declare-function viper-put-back "viper-cmd" (arg)) + ;; Ex put (defun ex-put () (let ((point (if (null ex-addresses) (point) (car ex-addresses)))) @@ -1589,6 +1602,8 @@ reversed." (kill-buffer (current-buffer)))) +(declare-function viper-add-newline-at-eob-if-necessary "viper-cmd" ()) + ;; Ex read command ;; ex-read doesn't support wildcards, because file completion is a better ;; mechanism. We also don't support # and % (except in :r <shell-command> @@ -1975,6 +1990,8 @@ Please contact your system administrator. " (beginning-of-line) (if opt-c (message "done")))) +(declare-function viper-change-state-to-emacs "viper-cmd" ()) + ;; Ex tag command (defun ex-tag () (let (tag) diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index 28a830a0def..76d4632f8c0 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -424,7 +424,7 @@ delete the text being replaced, as in standard Vi." ;; (defcustom viper-emacs-state-cursor-color "Magenta" (defcustom viper-emacs-state-cursor-color nil "Cursor color when Viper is in Emacs state." - :type 'string + :type '(choice (const nil) string) :group 'viper) ;; internal var, used to remember the default cursor color of emacs frames diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el index 4cae591e95e..de0155d8158 100644 --- a/lisp/emulation/viper-macs.el +++ b/lisp/emulation/viper-macs.el @@ -31,13 +31,8 @@ (defvar viper-custom-file-name) (defvar viper-current-state) (defvar viper-fast-keyseq-timeout) - -;; loading happens only in non-interactive compilation -;; in order to spare non-viperized emacs from being viperized -(if noninteractive - (eval-when-compile - (require 'viper-cmd) - )) +(require 'viper-mous) +(require 'viper-ex) ;; end pacifier (require 'viper-util) @@ -83,6 +78,8 @@ a key is a symbol, e.g., `a', `\\1', `f2', etc., or a list, e.g., ;;; Code +(declare-function viper-change-state-to-insert "viper-cmd" ()) + ;; Ex map command (defun ex-map () (let ((mod-char "") @@ -277,6 +274,8 @@ a key is a symbol, e.g., `a', `\\1', `f2', etc., or a list, e.g., )) +(declare-function viper-change-state-to-vi "viper-cmd" ()) + ;; Terminate a Vi kbd macro. ;; optional argument IGNORE, if t, indicates that we are dealing with an ;; existing macro that needs to be registered, but there is no need to diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el index 0e3cf038b73..8d54571b3f4 100644 --- a/lisp/emulation/viper-mous.el +++ b/lisp/emulation/viper-mous.el @@ -35,15 +35,8 @@ (defvar viper-s-string) (defvar viper-re-search) -;; loading happens only in non-interactive compilation -;; in order to spare non-viperized emacs from being viperized -(if noninteractive - (eval-when-compile - (require 'viper-cmd) - )) -;; end pacifier - (require 'viper-util) +;; end pacifier (defgroup viper-mouse nil @@ -140,6 +133,10 @@ considered related." (posn-point (event-start click)))) + +(declare-function viper-backward-char-carefully "viper-cmd" (&optional arg)) +(declare-function viper-forward-char-carefully "viper-cmd" (&optional arg)) + (defun viper-surrounding-word (count click-count) "Returns word surrounding point according to a heuristic. COUNT indicates how many regions to return. @@ -335,6 +332,8 @@ See `viper-surrounding-word' for the definition of a word in this case." viper-current-click-count 0)))) +(declare-function viper-forward-word "viper-cmd" (arg)) +(declare-function viper-adjust-window "viper-cmd" ()) (defun viper-mouse-click-search-word (click arg) "Find the word clicked or double-clicked on. Word may be in another window. diff --git a/lisp/epa.el b/lisp/epa.el index 852d10b1cf7..b567df5f40b 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -621,30 +621,33 @@ If SECRET is non-nil, list secret keys instead of public keys." (message "%s..." prompt)))) ;;;###autoload -(defun epa-decrypt-file (file) - "Decrypt FILE." - (interactive "fFile: ") - (setq file (expand-file-name file)) - (let* ((default-name (file-name-sans-extension file)) - (plain (expand-file-name - (read-file-name - (concat "To file (default " - (file-name-nondirectory default-name) - ") ") - (file-name-directory default-name) - default-name))) - (context (epg-make-context epa-protocol))) +(defun epa-decrypt-file (decrypt-file plain-file) + "Decrypt DECRYPT-FILE into PLAIN-FILE." + (interactive + (let (file default-name plain) + (setq file (read-file-name "File to decrypt: ")) + (setq default-name (file-name-sans-extension (expand-file-name file))) + (setq plain (expand-file-name + (read-file-name + (concat "To file (default " + (file-name-nondirectory default-name) + ") ") + (file-name-directory default-name) + default-name))) + (list file plain))) + (setq decrypt-file (expand-file-name decrypt-file)) + (let ((context (epg-make-context epa-protocol))) (epg-context-set-passphrase-callback context #'epa-passphrase-callback-function) (epg-context-set-progress-callback context (cons #'epa-progress-callback-function (format "Decrypting %s..." - (file-name-nondirectory file)))) - (message "Decrypting %s..." (file-name-nondirectory file)) - (epg-decrypt-file context file plain) - (message "Decrypting %s...wrote %s" (file-name-nondirectory file) - (file-name-nondirectory plain)) + (file-name-nondirectory decrypt-file)))) + (message "Decrypting %s..." (file-name-nondirectory decrypt-file)) + (epg-decrypt-file context decrypt-file plain-file) + (message "Decrypting %s...wrote %s" (file-name-nondirectory decrypt-file) + (file-name-nondirectory plain-file)) (if (epg-context-result-for context 'verify) (epa-display-info (epg-verify-result-to-string (epg-context-result-for context 'verify)))))) diff --git a/lisp/epg.el b/lisp/epg.el index 3f04aa2e07a..c36de7e4624 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -195,7 +195,7 @@ cipher-algorithm digest-algorithm compress-algorithm (list #'epg-passphrase-callback-function) nil - nil nil nil nil nil nil))) + nil nil nil nil nil nil nil))) (defun epg-context-protocol (context) "Return the protocol used within CONTEXT." @@ -289,6 +289,12 @@ This function is for internal use only." (signal 'wrong-type-argument (list 'epg-context-p context))) (aref (cdr context) 14)) +(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) 15)) + (defun epg-context-set-protocol (context protocol) "Set the protocol used within CONTEXT." (unless (eq (car-safe context) 'epg-context) @@ -407,6 +413,14 @@ This function is for internal use only." (signal 'wrong-type-argument (list 'epg-context-p context))) (aset (cdr context) 14 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) 15 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 @@ -1152,6 +1166,10 @@ This function is for internal use only." (if (epg-context-textmode context) '("--textmode")) (if (epg-context-output-file context) (list "--output" (epg-context-output-file context))) + (if (epg-context-pinentry-mode context) + (list "--pinentry-mode" + (symbol-name (epg-context-pinentry-mode + context)))) args)) (coding-system-for-write 'binary) (coding-system-for-read 'binary) diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index f3d54782897..76766144c18 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,33 @@ +2013-05-30 Glenn Morris <rgm@gnu.org> + + * erc-backend.el: Require erc at run-time too. + +2013-05-21 Glenn Morris <rgm@gnu.org> + + * erc-log.el (erc-network-name): Declare. + + * erc-notify.el (pcomplete--here): Declare. + (pcomplete/erc-mode/NOTIFY): Require pcomplete. + + * erc.el (erc-quit-reason-various-alist) + (erc-part-reason-various-alist): Don't mention zippy. + (erc-quit-reason, erc-part-reason): Remove zippy options. + (erc-quit-reason-zippy, erc-part-reason-zippy): Make obsolete. + If yow is not defined, fall back to -normal versions. + +2013-05-15 Glenn Morris <rgm@gnu.org> + + * erc-list.el (erc-list): + * erc-menu.el (erc-menu): + * erc-ring.el (erc-ring): Define custom groups, for define-erc-module. + + * erc-list.el: Provide a feature. + +2013-05-09 Glenn Morris <rgm@gnu.org> + + * erc-desktop-notifications.el (erc-notifications-icon): + Fix custom type. + 2013-02-13 Aidan Gauland <aidalgol@no8wireless.co.nz> * erc-match.el (erc-match-message): Fix last commit. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 3d3ac791f08..4200d4aff7f 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -102,7 +102,8 @@ ;; There's a fairly strong mutual dependency between erc.el and erc-backend.el. ;; Luckily, erc.el does not need erc-backend.el for macroexpansion whereas the ;; reverse is true: -(eval-when-compile (provide 'erc-backend) (require 'erc)) +(provide 'erc-backend) +(require 'erc) ;;;; Variables and options diff --git a/lisp/erc/erc-desktop-notifications.el b/lisp/erc/erc-desktop-notifications.el index 2cff817b34c..ac6c202b18a 100644 --- a/lisp/erc/erc-desktop-notifications.el +++ b/lisp/erc/erc-desktop-notifications.el @@ -44,7 +44,7 @@ (defcustom erc-notifications-icon nil "Icon to use for notification." :group 'erc-notifications - :type 'file) + :type '(choice (const :tag "No icon" nil) file)) (defun erc-notifications-notify (nick msg) "Notify that NICK send some MSG. diff --git a/lisp/erc/erc-list.el b/lisp/erc/erc-list.el index 3d78c1b7b9f..f11dd98ca37 100644 --- a/lisp/erc/erc-list.el +++ b/lisp/erc/erc-list.el @@ -30,6 +30,10 @@ (require 'erc) +(defgroup erc-list nil + "Support for the /list command." + :group 'erc) + ;; This is implicitly the width of the channel name column. Pick ;; something small enough that the topic has a chance of being ;; readable, but long enough that most channel names won't make for @@ -214,6 +218,8 @@ to RFC and send the LIST header (#321) at start of list transmission." "")))) (put 'erc-cmd-LIST 'do-not-parse-args t) +(provide 'erc-list) + ;;; erc-list.el ends here ;; ;; Local Variables: diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index 465babc74f7..c6ff8fa5bfe 100644 --- a/lisp/erc/erc-log.el +++ b/lisp/erc/erc-log.el @@ -378,6 +378,8 @@ This function is a possible value for `erc-generate-log-file-name-function'." ;; we need a make-safe-file-name function. (convert-standard-filename file))) +(declare-function erc-network-name "erc-networks" ()) + (defun erc-generate-log-file-name-network (buffer target nick server port) "Generates a log-file name using the network name rather than server name. This results in a file name of the form #channel!nick@network.txt. diff --git a/lisp/erc/erc-menu.el b/lisp/erc/erc-menu.el index 70c9ae65427..ab11df92063 100644 --- a/lisp/erc/erc-menu.el +++ b/lisp/erc/erc-menu.el @@ -30,6 +30,10 @@ (require 'erc) (require 'easymenu) +(defgroup erc-menu nil + "ERC menu support." + :group 'erc) + (defvar erc-menu-definition (list "ERC" ["Connect to server..." erc t] diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el index 7061b035e54..db7067eec08 100644 --- a/lisp/erc/erc-notify.el +++ b/lisp/erc/erc-notify.el @@ -235,8 +235,13 @@ with args, toggle notify status of people." (autoload 'pcomplete-erc-all-nicks "erc-pcomplete") +;; "--" is not a typo. +(declare-function pcomplete--here "pcomplete" + (&optional form stub paring form-only)) + ;;;###autoload (defun pcomplete/erc-mode/NOTIFY () + (require 'pcomplete) (pcomplete-here (pcomplete-erc-all-nicks))) (erc-notify-install-message-catalogs) diff --git a/lisp/erc/erc-ring.el b/lisp/erc/erc-ring.el index ac5aaf23bc3..b4244eaa4a6 100644 --- a/lisp/erc/erc-ring.el +++ b/lisp/erc/erc-ring.el @@ -38,6 +38,10 @@ (require 'comint) (require 'ring) +(defgroup erc-ring nil + "An input ring for ERC." + :group 'erc) + ;;;###autoload (autoload 'erc-ring-mode "erc-ring" nil t) (define-erc-module ring nil "Stores input in a ring so that previous commands and messages can diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 042ad09decf..b2724b9737f 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -899,13 +899,12 @@ If no elements match, then the empty string is used. As an example: (setq erc-quit-reason-various-alist - '((\"zippy\" erc-quit-reason-zippy) - (\"xmms\" dme:now-playing) + '((\"xmms\" dme:now-playing) (\"version\" erc-quit-reason-normal) (\"home\" \"Gone home !\") (\"^$\" \"Default Reason\"))) -If the user types \"/quit zippy\", then a Zippy the Pinhead quotation -will be used as the quit message." +If the user types \"/quit home\", then \"Gone home !\" will be used +as the quit message." :group 'erc-quit-and-part :type '(repeat (list regexp (choice (string) (function))))) @@ -923,13 +922,12 @@ If no elements match, then the empty string is used. As an example: (setq erc-part-reason-various-alist - '((\"zippy\" erc-part-reason-zippy) - (\"xmms\" dme:now-playing) + '((\"xmms\" dme:now-playing) (\"version\" erc-part-reason-normal) (\"home\" \"Gone home !\") (\"^$\" \"Default Reason\"))) -If the user types \"/part zippy\", then a Zippy the Pinhead quotation -will be used as the part message." +If the user types \"/part home\", then \"Gone home !\" will be used +as the part message." :group 'erc-quit-and-part :type '(repeat (list regexp (choice (string) (function))))) @@ -940,7 +938,6 @@ The function is passed a single argument, the string typed by the user after \"/quit\"." :group 'erc-quit-and-part :type '(choice (const erc-quit-reason-normal) - (const erc-quit-reason-zippy) (const erc-quit-reason-various) (symbol))) @@ -951,7 +948,6 @@ The function is passed a single argument, the string typed by the user after \"/PART\"." :group 'erc-quit-and-part :type '(choice (const erc-part-reason-normal) - (const erc-part-reason-zippy) (const erc-part-reason-various) (symbol))) @@ -3398,7 +3394,11 @@ If S is non-nil, it will be used as the quit reason." If S is non-nil, it will be used as the quit reason." (or s - (erc-replace-regexp-in-string "\n" "" (yow)))) + (if (fboundp 'yow) + (erc-replace-regexp-in-string "\n" "" (yow)) + (erc-quit-reason-normal)))) + +(make-obsolete 'erc-quit-reason-zippy "it will be removed." "24.4") (defun erc-quit-reason-various (s) "Choose a quit reason based on S (a string)." @@ -3425,7 +3425,11 @@ If S is non-nil, it will be used as the quit reason." If S is non-nil, it will be used as the quit reason." (or s - (erc-replace-regexp-in-string "\n" "" (yow)))) + (if (fboundp 'yow) + (erc-replace-regexp-in-string "\n" "" (yow)) + (erc-part-reason-normal)))) + +(make-obsolete 'erc-part-reason-zippy "it will be removed." "24.4") (defun erc-part-reason-various (s) "Choose a part reason based on S (a string)." diff --git a/lisp/eshell/em-alias.el b/lisp/eshell/em-alias.el index aa89177c2de..a46b48c01b3 100644 --- a/lisp/eshell/em-alias.el +++ b/lisp/eshell/em-alias.el @@ -90,8 +90,6 @@ ;;; Code: -(eval-when-compile - (require 'esh-util)) (require 'eshell) ;;;###autoload diff --git a/lisp/eshell/em-banner.el b/lisp/eshell/em-banner.el index 44928b14e11..8c3eebf3510 100644 --- a/lisp/eshell/em-banner.el +++ b/lisp/eshell/em-banner.el @@ -39,11 +39,11 @@ ;;; Code: (eval-when-compile - (require 'cl-lib) - (require 'esh-mode) - (require 'eshell)) + (require 'cl-lib)) (require 'esh-util) +(require 'esh-mode) +(require 'eshell) ;;;###autoload (progn diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el index d795b8226ca..c440bd0a928 100644 --- a/lisp/eshell/em-basic.el +++ b/lisp/eshell/em-basic.el @@ -59,9 +59,7 @@ ;;; Code: -(eval-when-compile - (require 'esh-util)) - +(require 'esh-util) (require 'eshell) (require 'esh-opt) diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index 91311deffcf..7120f639a70 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -68,11 +68,14 @@ ;; with sufficient pointers to locate the relevant help text. ;;; Code: +(require 'pcomplete) + +(require 'esh-mode) +(require 'esh-util) (eval-when-compile (require 'cl-lib) (require 'eshell)) -(require 'esh-util) ;;;###autoload (progn @@ -240,10 +243,14 @@ to writing a completion function." ;;; Functions: +(defun eshell-complete-lisp-symbol () + "Try to complete the text around point as a Lisp symbol." + (interactive) + (let ((completion-at-point-functions '(lisp-completion-at-point))) + (completion-at-point))) + (defun eshell-cmpl-initialize () "Initialize the completions module." - (unless (fboundp 'pcomplete) - (load "pcmpl-auto" t t)) (set (make-local-variable 'pcomplete-command-completion-function) eshell-command-completion-function) (set (make-local-variable 'pcomplete-command-name-function) @@ -278,17 +285,17 @@ to writing a completion function." eshell-cmpl-restore-window-delay) (set (make-local-variable 'pcomplete-use-paring) eshell-cmpl-use-paring) - ;; `pcomplete-arg-quote-list' should only be set after all the + ;; `comint-file-name-quote-list' should only be set after all the ;; load-hooks for any other extension modules have been run, which ;; is true at the time `eshell-mode-hook' is run (add-hook 'eshell-mode-hook (function (lambda () - (set (make-local-variable 'pcomplete-arg-quote-list) + (set (make-local-variable 'comint-file-name-quote-list) eshell-special-chars-outside-quoting))) nil t) (add-hook 'pcomplete-quote-arg-hook 'eshell-quote-backslash nil t) - (define-key eshell-mode-map [(meta tab)] 'lisp-complete-symbol) - (define-key eshell-mode-map [(meta control ?i)] 'lisp-complete-symbol) + (define-key eshell-mode-map [(meta tab)] 'eshell-complete-lisp-symbol) + (define-key eshell-mode-map [(meta control ?i)] 'eshell-complete-lisp-symbol) (define-key eshell-command-map [(meta ?h)] 'eshell-completion-help) (define-key eshell-command-map [tab] 'pcomplete-expand-and-complete) (define-key eshell-command-map [(control ?i)] @@ -346,7 +353,7 @@ to writing a completion function." (setq begin (1+ (cadr delim)) args (eshell-parse-arguments begin end))) ((eq (car delim) ?\() - (lisp-complete-symbol) + (eshell-complete-lisp-symbol) (throw 'pcompleted t)) (t (insert-and-inherit "\t") diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index c93bbe9ecb1..106ca152c90 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -207,7 +207,8 @@ Thus, this does not include the current directory.") (when eshell-cd-on-directory (make-local-variable 'eshell-interpreter-alist) (setq eshell-interpreter-alist - (cons (cons 'eshell-lone-directory-p + (cons (cons (lambda (file args) + (eshell-lone-directory-p file)) 'eshell-dirs-substitute-cd) eshell-interpreter-alist))) diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index 5a21f463f0b..a58c7730ded 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el @@ -49,8 +49,8 @@ ;;; Code: -(eval-when-compile (require 'eshell)) (require 'esh-util) +(eval-when-compile (require 'eshell)) ;;;###autoload (progn @@ -119,7 +119,8 @@ This option slows down recursive glob processing by quite a bit." "*" "+")) (+ pos 2)) (cons "*" (1+ pos)))))) "An alist for translation of extended globbing characters." - :type '(repeat (cons character (choice regexp function))) + :type '(alist :key-type character + :value-type (choice string function)) :group 'eshell-glob) ;;; Functions: diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index 62d3ae125e9..694fe71a95c 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -189,21 +189,18 @@ element, regardless of any text on the command line. In that case, (defvar eshell-matching-input-from-input-string "") (defvar eshell-save-history-index nil) -(defvar eshell-isearch-map nil) - -(unless eshell-isearch-map - (setq eshell-isearch-map (copy-keymap isearch-mode-map)) - (define-key eshell-isearch-map [(control ?m)] 'eshell-isearch-return) - (define-key eshell-isearch-map [return] 'eshell-isearch-return) - (define-key eshell-isearch-map [(control ?r)] 'eshell-isearch-repeat-backward) - (define-key eshell-isearch-map [(control ?s)] 'eshell-isearch-repeat-forward) - (define-key eshell-isearch-map [(control ?g)] 'eshell-isearch-abort) - (define-key eshell-isearch-map [backspace] 'eshell-isearch-delete-char) - (define-key eshell-isearch-map [delete] 'eshell-isearch-delete-char) - (defvar eshell-isearch-cancel-map) - (define-prefix-command 'eshell-isearch-cancel-map) - (define-key eshell-isearch-map [(control ?c)] 'eshell-isearch-cancel-map) - (define-key eshell-isearch-cancel-map [(control ?c)] 'eshell-isearch-cancel)) +(defvar eshell-isearch-map + (let ((map (copy-keymap isearch-mode-map))) + (define-key map [(control ?m)] 'eshell-isearch-return) + (define-key map [return] 'eshell-isearch-return) + (define-key map [(control ?r)] 'eshell-isearch-repeat-backward) + (define-key map [(control ?s)] 'eshell-isearch-repeat-forward) + (define-key map [(control ?g)] 'eshell-isearch-abort) + (define-key map [backspace] 'eshell-isearch-delete-char) + (define-key map [delete] 'eshell-isearch-delete-char) + (define-key map "\C-c\C-c" 'eshell-isearch-cancel) + map) + "Keymap used in isearch in Eshell.") (defvar eshell-rebind-keys-alist) diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index 73ed617b871..41db4cd03d1 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -26,10 +26,10 @@ ;;; Code: -(eval-when-compile (require 'eshell)) (require 'cl-lib) (require 'esh-util) (require 'esh-opt) +(eval-when-compile (require 'eshell)) ;;;###autoload (progn @@ -334,6 +334,8 @@ instead." (defvar ange-cache) (defvar dired-flag) +(declare-function eshell-glob-regexp "em-glob" (pattern)) + (defun eshell-do-ls (&rest args) "Implementation of \"ls\" in Lisp, passing ARGS." (funcall flush-func -1) @@ -552,7 +554,7 @@ relative to that directory." (expand-file-name dir))) (cdr dirinfo))) ":\n")) (let ((entries (eshell-directory-files-and-attributes - dir nil (and (not show-all) + dir nil (and (not (or show-all show-almost-all)) eshell-ls-exclude-hidden "\\`[^.]") t ;; Asking for UID and GID as @@ -565,9 +567,9 @@ relative to that directory." (setq entries (cl-remove-if (lambda (entry) - (member (caar entry) '("." ".."))) + (member (car entry) '("." ".."))) entries))) - (when (and (not show-all) + (when (and (not (or show-all show-almost-all)) eshell-ls-exclude-regexp) (while (and entries (string-match eshell-ls-exclude-regexp (caar entries))) diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el index 13bdb2e4a03..3a7f46ebe83 100644 --- a/lisp/eshell/em-pred.el +++ b/lisp/eshell/em-pred.el @@ -46,6 +46,8 @@ ;;; Code: +(require 'esh-util) +(require 'esh-arg) (eval-when-compile (require 'eshell)) ;;;###autoload diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el index c1c4d4730f9..18731121c4e 100644 --- a/lisp/eshell/em-prompt.el +++ b/lisp/eshell/em-prompt.el @@ -26,6 +26,7 @@ ;;; Code: +(require 'esh-mode) (eval-when-compile (require 'eshell)) ;;;###autoload @@ -122,6 +123,7 @@ arriving, or after." (add-text-properties 0 (length prompt) '(read-only t face eshell-prompt + front-sticky (face read-only) rear-nonsticky (face read-only)) prompt)) (eshell-interactive-print prompt))) diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el index 42a5c36cab3..341191fc62f 100644 --- a/lisp/eshell/em-rebind.el +++ b/lisp/eshell/em-rebind.el @@ -23,6 +23,7 @@ ;;; Code: +(require 'esh-mode) (eval-when-compile (require 'eshell)) ;;;###autoload diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el index 711b2e21468..13ae6941dde 100644 --- a/lisp/eshell/em-script.el +++ b/lisp/eshell/em-script.el @@ -61,7 +61,7 @@ This includes when running `eshell-command'." "Initialize the script parsing code." (make-local-variable 'eshell-interpreter-alist) (setq eshell-interpreter-alist - (cons '((lambda (file) + (cons '((lambda (file args) (string= (file-name-nondirectory file) "eshell")) . eshell/source) eshell-interpreter-alist)) diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el index de244a2fb88..aa9038aafb9 100644 --- a/lisp/eshell/em-smart.el +++ b/lisp/eshell/em-smart.el @@ -68,6 +68,7 @@ ;;; Code: +(require 'esh-mode) (eval-when-compile (require 'eshell)) ;;;###autoload diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el index e659bce0568..0501544789d 100644 --- a/lisp/eshell/em-term.el +++ b/lisp/eshell/em-term.el @@ -31,6 +31,8 @@ ;;; Code: +(require 'esh-util) +(require 'esh-ext) (eval-when-compile (require 'eshell)) (require 'term) @@ -63,6 +65,43 @@ which commands are considered visual in nature." :type '(repeat string) :group 'eshell-term) +(defcustom eshell-visual-subcommands + nil + "An alist of the form + + ((COMMAND1 SUBCOMMAND1 SUBCOMMAND2...) + (COMMAND2 SUBCOMMAND1 ...)) + +of commands with subcommands that present their output in a +visual fashion. A likely entry is + + (\"git\" \"log\" \"diff\" \"show\") + +because git shows logs and diffs using a pager by default." + :type '(repeat (cons (string :tag "Command") + (repeat (string :tag "Subcommand")))) + :version "24.4" + :group 'eshell-term) + +(defcustom eshell-visual-options + nil + "An alist of the form + + ((COMMAND1 OPTION1 OPTION2...) + (COMMAND2 OPTION1 ...)) + +of commands with options that present their output in a visual +fashion. For example, a sensible entry would be + + (\"git\" \"--help\") + +because \"git <command> --help\" shows the command's +documentation with a pager." + :type '(repeat (cons (string :tag "Command") + (repeat (string :tag "Option")))) + :version "24.4" + :group 'eshell-term) + ;; If you change this from term-term-name, you need to ensure that the ;; value you choose exists in the system's terminfo database. (Bug#12485) (defcustom eshell-term-name term-term-name @@ -75,8 +114,10 @@ used." (defcustom eshell-escape-control-x t "If non-nil, allow <C-x> to be handled by Emacs key in visual buffers. -See the variable `eshell-visual-commands'. If this variable is set to -nil, <C-x> will send that control character to the invoked process." +See the variables `eshell-visual-commands', +`eshell-visual-subcommands', and `eshell-visual-options'. If +this variable is set to nil, <C-x> will send that control +character to the invoked process." :type 'boolean :group 'eshell-term) @@ -91,9 +132,14 @@ nil, <C-x> will send that control character to the invoked process." (make-local-variable 'eshell-interpreter-alist) (setq eshell-interpreter-alist (cons (cons (function - (lambda (command) - (member (file-name-nondirectory command) - eshell-visual-commands))) + (lambda (command args) + (let ((command (file-name-nondirectory command))) + (or (member command eshell-visual-commands) + (member (car args) + (cdr (assoc command eshell-visual-subcommands))) + (cl-intersection args + (cdr (assoc command eshell-visual-options)) + :test 'string=))))) 'eshell-exec-visual) eshell-interpreter-alist))) @@ -102,7 +148,7 @@ nil, <C-x> will send that control character to the invoked process." ARGS are passed to the program. At the moment, no piping of input is allowed." (let* (eshell-interpreter-alist - (interp (eshell-find-interpreter (car args))) + (interp (eshell-find-interpreter (car args) (cdr args))) (program (car interp)) (args (eshell-flatten-list (eshell-stringify-list (append (cdr interp) diff --git a/lisp/eshell/em-tramp.el b/lisp/eshell/em-tramp.el new file mode 100644 index 00000000000..fb816b76a7d --- /dev/null +++ b/lisp/eshell/em-tramp.el @@ -0,0 +1,145 @@ +;;; em-tramp.el --- Eshell features that require TRAMP + +;; Copyright (C) 1999-2013 Free Software Foundation, Inc. + +;; Author: Aidan Gauland <aidalgol@no8wireless.co.nz> + +;; 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: + +;; Eshell features that require TRAMP. + +;;; Code: + +(require 'esh-util) + +(eval-when-compile + (require 'esh-mode) + (require 'eshell) + (require 'tramp)) + +;;;###autoload +(progn + (defgroup eshell-tramp nil + "This module defines commands that use TRAMP in a way that is + not transparent to the user. So far, this includes only the + built-in su and sudo commands, which are not compatible with + the full, external su and sudo commands, and require the user + to understand how to use the TRAMP sudo method." + :tag "TRAMP Eshell features" + :group 'eshell-module)) + +(defun eshell-tramp-initialize () + "Initialize the TRAMP-using commands code." + (when (eshell-using-module 'eshell-cmpl) + (add-hook 'pcomplete-try-first-hook + 'eshell-complete-host-reference nil t)) + (make-local-variable 'eshell-complex-commands) + (setq eshell-complex-commands + (append '("su" "sudo") + eshell-complex-commands))) + +(autoload 'eshell-parse-command "esh-cmd") + +(defun eshell/su (&rest args) + "Alias \"su\" to call TRAMP. + +Uses the system su through TRAMP's su method." + (setq args (eshell-stringify-list (eshell-flatten-list args))) + (let ((orig-args (copy-tree args))) + (eshell-eval-using-options + "su" args + '((?h "help" nil nil "show this usage screen") + (?l "login" nil login "provide a login environment") + (? nil nil login "provide a login environment") + :usage "[- | -l | --login] [USER] +Become another USER during a login session.") + (throw 'eshell-replace-command + (let ((user "root") + (host (or (file-remote-p default-directory 'host) + "localhost")) + (dir (or (file-remote-p default-directory 'localname) + (expand-file-name default-directory))) + (prefix (file-remote-p default-directory))) + (dolist (arg args) + (if (string-equal arg "-") (setq login t) (setq user arg))) + ;; `eshell-eval-using-options' does not handle "-". + (if (member "-" orig-args) (setq login t)) + (if login (setq dir "~/")) + (if (and prefix + (or + (not (string-equal + "su" (file-remote-p default-directory 'method))) + (not (string-equal + user (file-remote-p default-directory 'user))))) + (eshell-parse-command + "cd" (list (format "%s|su:%s@%s:%s" + (substring prefix 0 -1) user host dir))) + (eshell-parse-command + "cd" (list (format "/su:%s@%s:%s" user host dir))))))))) + +(put 'eshell/su 'eshell-no-numeric-conversions t) + +(defun eshell/sudo (&rest args) + "Alias \"sudo\" to call Tramp. + +Uses the system sudo through TRAMP's sudo method." + (setq args (eshell-stringify-list (eshell-flatten-list args))) + (let ((orig-args (copy-tree args))) + (eshell-eval-using-options + "sudo" args + '((?h "help" nil nil "show this usage screen") + (?u "user" t user "execute a command as another USER") + :show-usage + :usage "[(-u | --user) USER] COMMAND +Execute a COMMAND as the superuser or another USER.") + (throw 'eshell-external + (let ((user (or user "root")) + (host (or (file-remote-p default-directory 'host) + "localhost")) + (dir (or (file-remote-p default-directory 'localname) + (expand-file-name default-directory))) + (prefix (file-remote-p default-directory))) + ;; `eshell-eval-using-options' reads options of COMMAND. + (while (and (stringp (car orig-args)) + (member (car orig-args) '("-u" "--user"))) + (setq orig-args (cddr orig-args))) + (let ((default-directory + (if (and prefix + (or + (not + (string-equal + "sudo" + (file-remote-p default-directory 'method))) + (not + (string-equal + user + (file-remote-p default-directory 'user))))) + (format "%s|sudo:%s@%s:%s" + (substring prefix 0 -1) user host dir) + (format "/sudo:%s@%s:%s" user host dir)))) + (eshell-named-command (car orig-args) (cdr orig-args)))))))) + +(put 'eshell/sudo 'eshell-no-numeric-conversions t) + +(provide 'em-tramp) + +;; Local Variables: +;; generated-autoload-file: "esh-groups.el" +;; End: + +;;; em-tramp.el ends here diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 94508d71592..af54d875cb0 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -148,7 +148,7 @@ Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine." (make-local-variable 'eshell-complex-commands) (setq eshell-complex-commands (append '("grep" "egrep" "fgrep" "agrep" "glimpse" "locate" - "cat" "time" "cp" "mv" "make" "du" "diff" "su" "sudo") + "cat" "time" "cp" "mv" "make" "du" "diff") eshell-complex-commands))) (defalias 'eshell/date 'current-time-string) @@ -532,8 +532,10 @@ Rename SOURCE to DEST, or move SOURCE(s) to DIRECTORY. "don't change anything on disk") (?p "preserve" nil preserve "preserve file attributes if possible") - (?R "recursive" nil em-recursive + (?r "recursive" nil em-recursive "copy directories recursively") + (?R nil nil em-recursive + "as for -r") (?v "verbose" nil em-verbose "explain what is being done") (nil "help" nil nil "show this usage screen") @@ -1038,85 +1040,6 @@ Show wall-clock time elapsed during execution of COMMAND.") (put 'eshell/occur 'eshell-no-numeric-conversions t) -(defun eshell/su (&rest args) - "Alias \"su\" to call Tramp." - (require 'tramp) - (setq args (eshell-stringify-list (eshell-flatten-list args))) - (let ((orig-args (copy-tree args))) - (eshell-eval-using-options - "su" args - '((?h "help" nil nil "show this usage screen") - (?l "login" nil login "provide a login environment") - (? nil nil login "provide a login environment") - :usage "[- | -l | --login] [USER] -Become another USER during a login session.") - (throw 'eshell-replace-command - (let ((user "root") - (host (or (file-remote-p default-directory 'host) - "localhost")) - (dir (or (file-remote-p default-directory 'localname) - (expand-file-name default-directory))) - (prefix (file-remote-p default-directory))) - (dolist (arg args) - (if (string-equal arg "-") (setq login t) (setq user arg))) - ;; `eshell-eval-using-options' does not handle "-". - (if (member "-" orig-args) (setq login t)) - (if login (setq dir "~/")) - (if (and prefix - (or - (not (string-equal - "su" (file-remote-p default-directory 'method))) - (not (string-equal - user (file-remote-p default-directory 'user))))) - (eshell-parse-command - "cd" (list (format "%s|su:%s@%s:%s" - (substring prefix 0 -1) user host dir))) - (eshell-parse-command - "cd" (list (format "/su:%s@%s:%s" user host dir))))))))) - -(put 'eshell/su 'eshell-no-numeric-conversions t) - -(defun eshell/sudo (&rest args) - "Alias \"sudo\" to call Tramp." - (require 'tramp) - (setq args (eshell-stringify-list (eshell-flatten-list args))) - (let ((orig-args (copy-tree args))) - (eshell-eval-using-options - "sudo" args - '((?h "help" nil nil "show this usage screen") - (?u "user" t user "execute a command as another USER") - :show-usage - :usage "[(-u | --user) USER] COMMAND -Execute a COMMAND as the superuser or another USER.") - (throw 'eshell-external - (let ((user (or user "root")) - (host (or (file-remote-p default-directory 'host) - "localhost")) - (dir (or (file-remote-p default-directory 'localname) - (expand-file-name default-directory))) - (prefix (file-remote-p default-directory))) - ;; `eshell-eval-using-options' reads options of COMMAND. - (while (and (stringp (car orig-args)) - (member (car orig-args) '("-u" "--user"))) - (setq orig-args (cddr orig-args))) - (let ((default-directory - (if (and prefix - (or - (not - (string-equal - "sudo" - (file-remote-p default-directory 'method))) - (not - (string-equal - user - (file-remote-p default-directory 'user))))) - (format "%s|sudo:%s@%s:%s" - (substring prefix 0 -1) user host dir) - (format "/sudo:%s@%s:%s" user host dir)))) - (eshell-named-command (car orig-args) (cdr orig-args)))))))) - -(put 'eshell/sudo 'eshell-no-numeric-conversions t) - (provide 'em-unix) ;; Local Variables: diff --git a/lisp/eshell/em-xtra.el b/lisp/eshell/em-xtra.el index 7c559772dd3..c4cab522cf2 100644 --- a/lisp/eshell/em-xtra.el +++ b/lisp/eshell/em-xtra.el @@ -23,6 +23,7 @@ ;;; Code: +(require 'esh-util) (eval-when-compile (require 'eshell) (require 'pcomplete)) @@ -40,6 +41,8 @@ naturally accessible within Emacs." ;;; Functions: +(autoload 'eshell-parse-command "esh-cmd") + (defun eshell/expr (&rest args) "Implementation of expr, using the calc package." (if (not (fboundp 'calc-eval)) diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index 73f7fc557e5..d7dfd27d8d3 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -27,7 +27,7 @@ (provide 'esh-arg) -(eval-when-compile (require 'eshell)) +(require 'esh-mode) (defgroup eshell-arg nil "Argument parsing involves transforming the arguments passed on the diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el index 3fe48b26e27..474e536de2e 100644 --- a/lisp/eshell/esh-ext.el +++ b/lisp/eshell/esh-ext.el @@ -33,10 +33,12 @@ (provide 'esh-ext) +(require 'esh-util) + (eval-when-compile (require 'cl-lib) + (require 'esh-io) (require 'esh-cmd)) -(require 'esh-util) (require 'esh-opt) (defgroup eshell-ext nil @@ -103,6 +105,8 @@ wholly ignored." :type '(choice file (const nil)) :group 'eshell-ext) +(autoload 'eshell-parse-command "esh-cmd") + (defsubst eshell-invoke-batch-file (&rest args) "Invoke a .BAT or .CMD file on DOS/Windows systems." ;; since CMD.EXE can't handle forward slashes in the initial @@ -121,9 +125,10 @@ Each member is a cons cell of the form: (MATCH . INTERPRETER) -MATCH should be a regexp, which is matched against the command name, -or a function. If either returns a non-nil value, then INTERPRETER -will be used for that command. +MATCH should be a regexp, which is matched against the command +name, or a function of arity 2 receiving the COMMAND and its +ARGS (a list). If either returns a non-nil value, then +INTERPRETER will be used for that command. If INTERPRETER is a string, it will be called as the command name, with the original command name passed as the first argument, with all @@ -179,6 +184,8 @@ This bypasses all Lisp functions and aliases." (error "%s: external command not found" (substring command 1)))))) +(autoload 'eshell-close-handles "esh-io") + (defun eshell-remote-command (command args) "Insert output from a remote COMMAND, using ARGS. A remote command is something that executes on a different machine. @@ -209,6 +216,7 @@ causing the user to wonder if anything's really going on..." (setq args (eshell-stringify-list (eshell-flatten-list args))) (let ((interp (eshell-find-interpreter command + args ;; `eshell-find-interpreter' does not work correctly ;; for Tramp file name syntax. But we don't need to ;; know the interpreter in that case, therefore the @@ -261,7 +269,7 @@ Return nil, or a list of the form: (list (match-string 1) file))))))) -(defun eshell-find-interpreter (file &optional no-examine-p) +(defun eshell-find-interpreter (file args &optional no-examine-p) "Find the command interpreter with which to execute FILE. If NO-EXAMINE-P is non-nil, FILE will not be inspected for a script line of the form #!<interp>." @@ -271,8 +279,9 @@ line of the form #!<interp>." (dolist (possible eshell-interpreter-alist) (cond ((functionp (car possible)) - (and (funcall (car possible) file) - (throw 'found (cdr possible)))) + (let ((fn (car possible))) + (and (funcall fn file args) + (throw 'found (cdr possible))))) ((stringp (car possible)) (and (string-match (car possible) file) (throw 'found (cdr possible)))) @@ -306,7 +315,7 @@ line of the form #!<interp>." (setq interp (eshell-script-interpreter fullname)) (if interp (setq interp - (cons (car (eshell-find-interpreter (car interp) t)) + (cons (car (eshell-find-interpreter (car interp) args t)) (cdr interp))))) (or interp (list fullname))))))) diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 66172c8f662..4edb47e4758 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -58,9 +58,11 @@ (provide 'esh-io) +(require 'esh-arg) +(require 'esh-util) + (eval-when-compile - (require 'cl-lib) - (require 'eshell)) + (require 'cl-lib)) (defgroup eshell-io nil "Eshell's I/O management code provides a scheme for treating many @@ -465,6 +467,8 @@ after all printing is over with no argument." (eshell-print object) (eshell-print "\n")) +(autoload 'eshell-output-filter "esh-mode") + (defun eshell-output-object-to-target (object target) "Insert OBJECT into TARGET. Returns what was actually sent, or nil if nothing was sent." diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index c22d7c16e98..ee857cf20f3 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -60,7 +60,7 @@ (provide 'esh-mode) -(eval-when-compile (require 'esh-util)) +(require 'esh-util) (require 'esh-module) (require 'esh-cmd) (require 'esh-io) diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index 6044759f8df..33625433022 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el @@ -25,13 +25,14 @@ (provide 'esh-opt) -(eval-when-compile (require 'esh-ext)) - -(defgroup eshell-opt nil - "The options processing code handles command argument parsing for -Eshell commands implemented in Lisp." - :tag "Command options processing" - :group 'eshell) +(require 'esh-ext) + +;; Unused. +;;; (defgroup eshell-opt nil +;;; "The options processing code handles command argument parsing for +;;; Eshell commands implemented in Lisp." +;;; :tag "Command options processing" +;;; :group 'eshell) ;;; User Functions: diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index aa630dc87aa..171d70c0772 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -25,9 +25,7 @@ (provide 'esh-proc) -(eval-when-compile - (require 'eshell) - (require 'esh-util)) +(require 'esh-cmd) (defgroup eshell-proc nil "When Eshell invokes external commands, it always does so diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index f9b86219e9b..dd344eb50a2 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -605,10 +605,16 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable. (autoload 'parse-time-string "parse-time")) (eval-when-compile - (require 'ange-ftp nil t) - (require 'tramp nil t)) + (require 'ange-ftp nil t)) ; ange-ftp-parse-filename + +(defvar tramp-file-name-structure) +(declare-function ange-ftp-ls "ange-ftp" + (file lsargs parse &optional no-error wildcard)) +(declare-function ange-ftp-file-modtime "ange-ftp" (file)) (defun eshell-parse-ange-ls (dir) + (require 'ange-ftp) + (require 'tramp) (let ((ange-ftp-name-format (list (nth 0 tramp-file-name-structure) (nth 3 tramp-file-name-structure) diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 06858c5b986..188b8165248 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -107,11 +107,11 @@ (provide 'esh-var) -(eval-when-compile - (require 'pcomplete) - (require 'esh-util) - (require 'esh-mode)) +(require 'esh-util) +(require 'esh-cmd) (require 'esh-opt) + +(require 'pcomplete) (require 'env) (require 'ring) diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el index a76adb1fd94..9bdf8b3eb68 100644 --- a/lisp/eshell/eshell.el +++ b/lisp/eshell/eshell.el @@ -222,8 +222,7 @@ ;; things up. (eval-when-compile - (require 'cl-lib) - (require 'esh-util)) + (require 'cl-lib)) (require 'esh-util) (require 'esh-mode) @@ -318,6 +317,8 @@ buffer selected (or created)." Modules should use this variable so that they don't clutter non-interactive sessions, such as when using `eshell-command'.") +(declare-function eshell-add-input-to-history "em-hist" (input)) + ;;;###autoload (defun eshell-command (&optional command arg) "Execute the Eshell command string COMMAND. @@ -333,7 +334,8 @@ With prefix ARG, insert output into the current buffer at point." (eshell-return-exits-minibuffer)) (unless command (setq command (read-from-minibuffer "Emacs shell command: ")) - (eshell-add-input-to-history command)))) + (if (eshell-using-module 'eshell-hist) + (eshell-add-input-to-history command))))) (unless command (error "No command specified!")) ;; redirection into the current buffer is achieved by adding an diff --git a/lisp/face-remap.el b/lisp/face-remap.el index f1efc3727f5..b620d01d83e 100644 --- a/lisp/face-remap.el +++ b/lisp/face-remap.el @@ -378,7 +378,7 @@ one face is listed, that specifies an aggregate face, like in a This function makes the variable `buffer-face-mode-face' buffer local, and sets it to FACE." - (interactive (list (read-face-name "Set buffer face"))) + (interactive (list (read-face-name "Set buffer face" (face-at-point t)))) (while (and (consp specs) (null (cdr specs))) (setq specs (car specs))) (if (null specs) diff --git a/lisp/facemenu.el b/lisp/facemenu.el index e86c1c23d66..eb4554585a8 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -329,7 +329,7 @@ This command can also add FACE to the menu of faces, if `facemenu-listed-faces' says to do that." (interactive (list (progn (barf-if-buffer-read-only) - (read-face-name "Use face")) + (read-face-name "Use face" (face-at-point t))) (if (and mark-active (not current-prefix-arg)) (region-beginning)) (if (and mark-active (not current-prefix-arg)) @@ -513,12 +513,23 @@ filter out the color from the output." (* (nth 1 c-rgb) 0.7151522) (* (nth 2 c-rgb) 0.0721750)))))) +(defvar list-colors-callback nil + "Value of CALLBACK arg passed to `list-colors-display'; internal use.") + +(defun list-colors-redisplay (_ignore-auto _noconfirm) + "Redisplay the colors using `list-colors-sort'. + +This is installed as a `revert-buffer-function' in the *Colors* buffer." + (list-colors-display nil (buffer-name) list-colors-callback)) + (defun list-colors-display (&optional list buffer-name callback) "Display names of defined colors, and show what they look like. If the optional argument LIST is non-nil, it should be a list of colors to display. Otherwise, this command computes a list of colors that the current display can handle. Customize `list-colors-sort' to change the order in which colors are shown. +Type `g' or \\[revert-buffer] after customizing `list-colors-sort' +to redisplay colors in the new order. If the optional argument BUFFER-NAME is nil, it defaults to *Colors*. @@ -566,7 +577,9 @@ color. The function should accept a single argument, the color name." (erase-buffer) (list-colors-print list callback) (set-buffer-modified-p nil) - (setq truncate-lines t))) + (setq truncate-lines t) + (setq-local list-colors-callback callback) + (setq revert-buffer-function 'list-colors-redisplay))) (when callback (pop-to-buffer buffer-name) (message "Click on a color to select it."))) diff --git a/lisp/faces.el b/lisp/faces.el index 60410733514..d570140e7e6 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -297,7 +297,7 @@ X resource class for the attribute." (declare-function internal-face-x-get-resource "xfaces.c" - (resource class frame)) + (resource class &optional frame)) (declare-function internal-set-lisp-face-attribute-from-resource "xfaces.c" (face attr value &optional frame)) @@ -757,7 +757,8 @@ is specified, `:italic' is ignored." FRAME nil or not specified means change face on all frames. Argument NOERROR is ignored and retained for compatibility. Use `set-face-attribute' for finer control of the font weight." - (interactive (list (read-face-name "Make which face bold"))) + (interactive (list (read-face-name "Make which face bold" + (face-at-point t)))) (set-face-attribute face frame :weight 'bold)) @@ -765,7 +766,8 @@ Use `set-face-attribute' for finer control of the font weight." "Make the font of FACE be non-bold, if possible. FRAME nil or not specified means change face on all frames. Argument NOERROR is ignored and retained for compatibility." - (interactive (list (read-face-name "Make which face non-bold"))) + (interactive (list (read-face-name "Make which face non-bold" + (face-at-point t)))) (set-face-attribute face frame :weight 'normal)) @@ -774,7 +776,8 @@ Argument NOERROR is ignored and retained for compatibility." FRAME nil or not specified means change face on all frames. Argument NOERROR is ignored and retained for compatibility. Use `set-face-attribute' for finer control of the font slant." - (interactive (list (read-face-name "Make which face italic"))) + (interactive (list (read-face-name "Make which face italic" + (face-at-point t)))) (set-face-attribute face frame :slant 'italic)) @@ -782,7 +785,8 @@ Use `set-face-attribute' for finer control of the font slant." "Make the font of FACE be non-italic, if possible. FRAME nil or not specified means change face on all frames. Argument NOERROR is ignored and retained for compatibility." - (interactive (list (read-face-name "Make which face non-italic"))) + (interactive (list (read-face-name "Make which face non-italic" + (face-at-point t)))) (set-face-attribute face frame :slant 'normal)) @@ -791,7 +795,8 @@ Argument NOERROR is ignored and retained for compatibility." FRAME nil or not specified means change face on all frames. Argument NOERROR is ignored and retained for compatibility. Use `set-face-attribute' for finer control of font weight and slant." - (interactive (list (read-face-name "Make which face bold-italic"))) + (interactive (list (read-face-name "Make which face bold-italic" + (face-at-point t)))) (set-face-attribute face frame :weight 'bold :slant 'italic)) @@ -911,7 +916,7 @@ If FRAME is omitted or nil, it means change face on all frames. If FACE specifies neither foreground nor background color, set its foreground and background to the background and foreground of the default face. Value is FACE." - (interactive (list (read-face-name "Invert face"))) + (interactive (list (read-face-name "Invert face" (face-at-point t)))) (let ((fg (face-attribute face :foreground frame)) (bg (face-attribute face :background frame))) (if (not (and (eq fg 'unspecified) (eq bg 'unspecified))) @@ -928,87 +933,61 @@ of the default face. Value is FACE." ;;; Interactively modifying faces. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun read-face-name (prompt &optional default multiple) - "Read one or more face names, defaulting to the face(s) at point. -PROMPT should be a prompt string; it should not end in a space or -a colon. - -The optional argument DEFAULT specifies the default face name(s) -to return if the user just types RET. If its value is non-nil, -it should be a list of face names (symbols); in that case, the -default return value is the `car' of DEFAULT (if the argument -MULTIPLE is non-nil), or DEFAULT (if MULTIPLE is nil). See below -for the meaning of MULTIPLE. - -If DEFAULT is nil, the list of default face names is taken from -the `read-face-name' property of the text at point, or, if that -is nil, from the `face' property of the text at point. - -This function uses `completing-read-multiple' with \",\" as the -separator character. Thus, the user may enter multiple face -names, separated by commas. The optional argument MULTIPLE -specifies the form of the return value. If MULTIPLE is non-nil, -return a list of face names; if the user entered just one face -name, the return value would be a list of one face name. -Otherwise, return a single face name; if the user entered more -than one face name, return only the first one." - (let ((faceprop (or (get-char-property (point) 'read-face-name) - (get-char-property (point) 'face))) - (aliasfaces nil) - (nonaliasfaces nil) - faces) - ;; Try to get a face name from the buffer. - (if (memq (intern-soft (thing-at-point 'symbol)) (face-list)) - (setq faces (list (intern-soft (thing-at-point 'symbol))))) - ;; Add the named faces that the `face' property uses. - (if (and (listp faceprop) - ;; Don't treat an attribute spec as a list of faces. - (not (keywordp (car faceprop))) - (not (memq (car faceprop) '(foreground-color background-color)))) - (dolist (f faceprop) - (if (symbolp f) - (push f faces))) - (if (symbolp faceprop) - (push faceprop faces))) - (delete-dups faces) +(defvar crm-separator) ; from crm.el +(defun read-face-name (prompt &optional default multiple) + "Read one or more face names, prompting with PROMPT. +PROMPT should not end in a space or a colon. + +Return DEFAULT if the user enters the empty string. +If DEFAULT is non-nil, it should be a single face or a list of face names +\(symbols or strings). In the latter case, return the `car' of DEFAULT +\(if MULTIPLE is nil, see below), or DEFAULT (if MULTIPLE is non-nil). + +If MULTIPLE is non-nil, this function uses `completing-read-multiple' +to read multiple faces with \"[ \\t]*,[ \\t]*\" as the separator regexp +and it returns a list of face names. Otherwise, it reads and returns +a single face name." + (if (and default (not (stringp default))) + (setq default + (cond ((symbolp default) + (symbol-name default)) + (multiple + (mapconcat (lambda (f) (if (symbolp f) (symbol-name f) f)) + default ", ")) + ;; If we only want one, and the default is more than one, + ;; discard the unwanted ones. + (t (symbol-name (car default)))))) + (if (and default (not multiple)) + ;; For compatibility with `completing-read-multiple' use `crm-separator' + ;; to define DEFAULT if MULTIPLE is nil. + (setq default (car (split-string default crm-separator t)))) + + (let ((prompt (if default + (format "%s (default `%s'): " prompt default) + (format "%s: " prompt))) + aliasfaces nonaliasfaces faces) ;; Build up the completion tables. (mapatoms (lambda (s) - (if (custom-facep s) + (if (facep s) (if (get s 'face-alias) (push (symbol-name s) aliasfaces) (push (symbol-name s) nonaliasfaces))))) - - ;; If we only want one, and the default is more than one, - ;; discard the unwanted ones now. - (unless multiple - (if faces - (setq faces (list (car faces))))) - (require 'crm) - (let* ((input - ;; Read the input. - (completing-read-multiple - (if (or faces default) - (format "%s (default `%s'): " prompt - (if faces (mapconcat 'symbol-name faces ",") - default)) - (format "%s: " prompt)) - (completion-table-in-turn nonaliasfaces aliasfaces) - nil t nil 'face-name-history - (if faces (mapconcat 'symbol-name faces ",")))) - ;; Canonicalize the output. - (output - (cond ((or (equal input "") (equal input '(""))) - (or faces (unless (stringp default) default))) - ((stringp input) - (mapcar 'intern (split-string input ", *" t))) - ((listp input) - (mapcar 'intern input)) - (input)))) - ;; Return either a list of faces or just one face. - (if multiple - output - (car output))))) + (if multiple + (progn + (dolist (face (completing-read-multiple + prompt + (completion-table-in-turn nonaliasfaces aliasfaces) + nil t nil 'face-name-history default)) + ;; Ignore elements that are not faces + ;; (for example, because DEFAULT was "all faces") + (if (facep face) (push (intern face) faces))) + (nreverse faces)) + (let ((face (completing-read + prompt + (completion-table-in-turn nonaliasfaces aliasfaces) + nil t nil 'face-name-history default))) + (if (facep face) (intern face)))))) ;; Not defined without X, but behind window-system test. (defvar x-bitmap-file-path) @@ -1236,7 +1215,7 @@ and the face and its settings are obtained by querying the user." :slant (if italic-p 'italic 'normal) :underline underline :inverse-video inverse-p) - (setq face (read-face-name "Modify face")) + (setq face (read-face-name "Modify face" (face-at-point t))) (apply #'set-face-attribute face frame (read-all-face-attributes face frame)))) @@ -1248,13 +1227,13 @@ Value is a list (FACE NEW-VALUE) where FACE is the face read \(a symbol), and NEW-VALUE is value read." (cond ((eq attribute :font) (let* ((prompt "Set font-related attributes of face") - (face (read-face-name prompt)) + (face (read-face-name prompt (face-at-point t))) (font (read-face-font face frame))) (list face font))) (t (let* ((attribute-name (face-descriptive-attribute-name attribute)) (prompt (format "Set %s of face" attribute-name)) - (face (read-face-name prompt)) + (face (read-face-name prompt (face-at-point t))) (new-value (read-face-attribute face attribute frame))) (list face new-value))))) @@ -1363,7 +1342,9 @@ and FRAME defaults to the selected frame. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame." - (interactive (list (read-face-name "Describe face" 'default t))) + (interactive (list (read-face-name "Describe face" + (or (face-at-point t) 'default) + t))) (let* ((attrs '((:family . "Family") (:foundry . "Foundry") (:width . "Width") @@ -1877,23 +1858,33 @@ resulting color name in the echo area." (when msg (message "Color: `%s'" color)) color)) - -(defun face-at-point () +(defun face-at-point (&optional thing multiple) "Return the face of the character after point. If it has more than one face, return the first one. -Return nil if it has no specified face." - (let* ((faceprop (or (get-char-property (point) 'read-face-name) - (get-char-property (point) 'face) - 'default)) - (face (cond ((symbolp faceprop) faceprop) - ;; List of faces (don't treat an attribute spec). - ;; Just use the first face. - ((and (consp faceprop) (not (keywordp (car faceprop))) - (not (memq (car faceprop) - '(foreground-color background-color)))) - (car faceprop)) - (t nil)))) ; Invalid face value. - (if (facep face) face nil))) +If THING is non-nil try first to get a face name from the buffer. +IF MULTIPLE is non-nil, return a list of all faces. +Return nil if there is no face." + (let (faces) + (if thing + ;; Try to get a face name from the buffer. + (let ((face (intern-soft (thing-at-point 'symbol)))) + (if (facep face) + (push face faces)))) + ;; Add the named faces that the `read-face-name' or `face' property uses. + (let ((faceprop (or (get-char-property (point) 'read-face-name) + (get-char-property (point) 'face)))) + (cond ((facep faceprop) + (push faceprop faces)) + ((and (listp faceprop) + ;; Don't treat an attribute spec as a list of faces. + (not (keywordp (car faceprop))) + (not (memq (car faceprop) + '(foreground-color background-color)))) + (dolist (face faceprop) + (if (facep face) + (push face faces)))))) + (setq faces (delete-dups (nreverse faces))) + (if multiple faces (car faces)))) (defun foreground-color-at-point () "Return the foreground color of the character after point." @@ -2301,7 +2292,6 @@ terminal type to a different value." (t :inverse-video t)) "Basic face for highlighting trailing whitespace." :version "21.1" - :group 'whitespace-faces ; like `show-trailing-whitespace' :group 'basic-faces) (defface escape-glyph diff --git a/lisp/files.el b/lisp/files.el index 9da9ac6fd53..871a4b0548b 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -206,7 +206,7 @@ have fast storage with limited space, such as a RAM disk." (declare-function msdos-long-file-names "msdos.c") (declare-function w32-long-file-name "w32proc.c") (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) -(declare-function dired-unmark "dired" (arg)) +(declare-function dired-unmark "dired" (arg &optional interactive)) (declare-function dired-do-flagged-delete "dired" (&optional nomessage)) (declare-function dos-8+3-filename "dos-fns" (filename)) (declare-function dosified-file-name "dos-fns" (file-name)) @@ -1516,7 +1516,10 @@ expand wildcards (if any) and replace the file with multiple files." (defvar kill-buffer-hook nil "Hook run when a buffer is killed. The buffer being killed is current while the hook is running. -See `kill-buffer'.") +See `kill-buffer'. + +Note: Be careful with let-binding this hook considering it is +frequently used for cleanup.") (defun find-alternate-file (filename &optional wildcards) "Find file FILENAME, select its buffer, kill previous buffer. @@ -1983,8 +1986,7 @@ Do you want to revisit the file normally now? ") (set-buffer-multibyte nil) (setq buffer-file-coding-system 'no-conversion) (set-buffer-major-mode buf) - (make-local-variable 'find-file-literally) - (setq find-file-literally t)) + (setq-local find-file-literally t)) (after-find-file error (not nowarn))) (current-buffer)))) @@ -2172,7 +2174,7 @@ not set local variables (though we do notice a mode specified with -*-.) or from Lisp without specifying the optional argument FIND-FILE; in that case, this function acts as if `enable-local-variables' were t." (interactive) - (funcall (or (default-value 'major-mode) 'fundamental-mode)) + (fundamental-mode) (let ((enable-local-variables (or (not find-file) enable-local-variables))) ;; FIXME this is less efficient than it could be, since both ;; s-a-m and h-l-v may parse the same regions, looking for "mode:". @@ -2310,7 +2312,7 @@ since only a single case-insensitive search through the alist is made." ("\\.\\(\ arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|7z\\|\ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode) - ("\\.\\(sx[dmicw]\\|od[fgpst]\\|oxt\\)\\'" . archive-mode) ;OpenOffice.org + ("\\.oxt\\'" . archive-mode) ;(Open|Libre)Office extensions. ("\\.\\(deb\\|[oi]pk\\)\\'" . archive-mode) ; Debian/Opkg packages. ;; Mailer puts message to be edited in ;; /tmp/Re.... or Message @@ -2756,7 +2758,9 @@ we don't actually set it to the same mode the buffer already has." (if (functionp re) (funcall re) (looking-at re))))))) - (set-auto-mode-0 done keep-mode-if-same))))) + (set-auto-mode-0 done keep-mode-if-same))) + (unless done + (set-buffer-major-mode (current-buffer))))) ;; When `keep-mode-if-same' is set, we are working on behalf of ;; set-visited-file-name. In that case, if the major mode specified is the @@ -3026,6 +3030,9 @@ n -- to ignore the local variables list.") (prog1 (memq char '(?! ?\s ?y)) (quit-window t))))))) +(defconst hack-local-variable-regexp + "[ \t]*\\([^][;\"'?()\\ \t\n]+\\)[ \t]*:[ \t]*") + (defun hack-local-variables-prop-line (&optional mode-only) "Return local variables specified in the -*- line. Returns an alist of elements (VAR . VAL), where VAR is a variable @@ -3052,11 +3059,11 @@ mode, if there is one, otherwise nil." ;; (last ";" is optional). ;; If MODE-ONLY, just check for `mode'. ;; Otherwise, parse the -*- line into the RESULT alist. - (while (and (or (not mode-only) - (not result)) - (< (point) end)) - (unless (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*") - (message "Malformed mode-line") + (while (not (or (and mode-only result) + (>= (point) end))) + (unless (looking-at hack-local-variable-regexp) + (message "Malformed mode-line: %S" + (buffer-substring-no-properties (point) end)) (throw 'malformed-line nil)) (goto-char (match-end 0)) ;; There used to be a downcase here, @@ -3208,8 +3215,7 @@ local variables, but directory-local variables may still be applied." (prefix (concat "^" (regexp-quote (buffer-substring (line-beginning-position) - (match-beginning 0))))) - beg) + (match-beginning 0)))))) (forward-line 1) (let ((startpos (point)) @@ -3244,18 +3250,16 @@ local variables, but directory-local variables may still be applied." (forward-line 1)) (goto-char (point-min)) - (while (and (not (eobp)) - (or (not mode-only) - (not result))) - ;; Find the variable name; strip whitespace. - (skip-chars-forward " \t") - (setq beg (point)) - (skip-chars-forward "^:\n") - (if (eolp) (error "Missing colon in local variables entry")) - (skip-chars-backward " \t") - (let* ((str (buffer-substring beg (point))) - (var (let ((read-circle nil)) - (read str))) + (while (not (or (eobp) + (and mode-only result))) + ;; Find the variable name; + (unless (looking-at hack-local-variable-regexp) + (error "Malformed local variable line: %S" + (buffer-substring-no-properties + (point) (line-end-position)))) + (goto-char (match-end 1)) + (let* ((str (match-string 1)) + (var (intern str)) val val2) (and (equal (downcase (symbol-name var)) "mode") (setq var 'mode)) @@ -4177,23 +4181,31 @@ ignored." "Default `backup-enable-predicate' function. Checks for files in `temporary-file-directory', `small-temporary-file-directory', and /tmp." - (not (or (let ((comp (compare-strings temporary-file-directory 0 nil - name 0 nil))) - ;; Directory is under temporary-file-directory. - (and (not (eq comp t)) - (< comp (- (length temporary-file-directory))))) - (let ((comp (compare-strings "/tmp" 0 nil - name 0 nil))) - ;; Directory is under /tmp. - (and (not (eq comp t)) - (< comp (- (length "/tmp"))))) - (if small-temporary-file-directory - (let ((comp (compare-strings small-temporary-file-directory - 0 nil - name 0 nil))) - ;; Directory is under small-temporary-file-directory. - (and (not (eq comp t)) - (< comp (- (length small-temporary-file-directory))))))))) + (let ((temporary-file-directory temporary-file-directory) + caseless) + ;; On MS-Windows, file-truename will convert short 8+3 aliases to + ;; their long file-name equivalents, so compare-strings does TRT. + (if (memq system-type '(ms-dos windows-nt)) + (setq temporary-file-directory (file-truename temporary-file-directory) + name (file-truename name) + caseless t)) + (not (or (let ((comp (compare-strings temporary-file-directory 0 nil + name 0 nil caseless))) + ;; Directory is under temporary-file-directory. + (and (not (eq comp t)) + (< comp (- (length temporary-file-directory))))) + (let ((comp (compare-strings "/tmp" 0 nil + name 0 nil))) + ;; Directory is under /tmp. + (and (not (eq comp t)) + (< comp (- (length "/tmp"))))) + (if small-temporary-file-directory + (let ((comp (compare-strings small-temporary-file-directory + 0 nil + name 0 nil caseless))) + ;; Directory is under small-temporary-file-directory. + (and (not (eq comp t)) + (< comp (- (length small-temporary-file-directory)))))))))) (defun make-backup-file-name (file) "Create the non-numeric backup file name for FILE. @@ -4605,7 +4617,8 @@ Before and after saving the buffer, this function runs (insert ?\n)))) ;; Support VC version backups. (vc-before-save) - (run-hooks 'before-save-hook) + ;; Don't let errors prevent saving the buffer. + (with-demoted-errors (run-hooks 'before-save-hook)) (or (run-hook-with-args-until-success 'write-contents-functions) (run-hook-with-args-until-success 'local-write-file-hooks) (run-hook-with-args-until-success 'write-file-functions) diff --git a/lisp/find-file.el b/lisp/find-file.el index 4d1953b3c1f..9f7d877ec3b 100644 --- a/lisp/find-file.el +++ b/lisp/find-file.el @@ -245,7 +245,8 @@ the preceding slash. The star represents all the subdirectories except ("\\.hh\\'" (".cc" ".C")) ("\\.c\\'" (".h")) - ("\\.h\\'" (".c" ".cc" ".C" ".CC" ".cxx" ".cpp")) + ("\\.m\\'" (".h")) + ("\\.h\\'" (".c" ".cc" ".C" ".CC" ".cxx" ".cpp" ".m")) ("\\.C\\'" (".H" ".hh" ".h")) ("\\.H\\'" (".C" ".CC")) @@ -267,6 +268,7 @@ This list should contain the most used extensions before the others, since the search algorithm searches sequentially through each directory specified in `ff-search-directories'. If a file is not found, a new one is created with the first matching extension (`.cc' yields `.hh')." + :version "24.4" ; add .m :type '(repeat (list regexp (choice (repeat string) function))) :group 'ff) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 9436012ee59..d18aea61236 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -2290,7 +2290,7 @@ in which C preprocessor directives are used. e.g. `asm-mode' and "condition-case" "condition-case-unless-debug" "track-mouse" "eval-after-load" "eval-and-compile" "eval-when-compile" "eval-when" "eval-next-after-load" - "with-case-table" "with-category-table" + "with-case-table" "with-category-table" "with-coding-priority" "with-current-buffer" "with-demoted-errors" "with-electric-help" "with-local-quit" "with-no-warnings" @@ -2298,7 +2298,7 @@ in which C preprocessor directives are used. e.g. `asm-mode' and "with-selected-window" "with-selected-frame" "with-silent-modifications" "with-syntax-table" "with-temp-buffer" "with-temp-file" "with-temp-message" - "with-timeout" "with-timeout-handler" "with-wrapper-hook") t) + "with-timeout" "with-timeout-handler") t) "\\_>") . 1) ;; Control structures. Common Lisp forms. @@ -2323,12 +2323,12 @@ in which C preprocessor directives are used. e.g. `asm-mode' and "\\_>") . 1) ;; Exit/Feature symbols as constants. - (,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\>" + (,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\_>" "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?") (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) ;; Erroneous structures. - ("(\\(abort\\|assert\\|warn\\|check-type\\|cerror\\|error\\|signal\\)\\>" 1 font-lock-warning-face) + ("(\\(abort\\|assert\\|warn\\|check-type\\|cerror\\|error\\|signal\\)\\_>" 1 font-lock-warning-face) ;; Words inside \\[] tend to be for `substitute-command-keys'. ("\\\\\\\\\\[\\(\\(?:\\sw\\|\\s_\\)+\\)\\]" (1 font-lock-constant-face prepend)) diff --git a/lisp/format-spec.el b/lisp/format-spec.el index 1280966d737..6bb0fe9178a 100644 --- a/lisp/format-spec.el +++ b/lisp/format-spec.el @@ -44,14 +44,15 @@ the text that it generates." ((looking-at "\\([-0-9.]*\\)\\([a-zA-Z]\\)") (let* ((num (match-string 1)) (spec (string-to-char (match-string 2))) - (val (cdr (assq spec specification)))) + (val (assq spec specification))) (unless val (error "Invalid format character: `%%%c'" spec)) + (setq val (cdr val)) ;; Pad result to desired length. - (let ((text (format (concat "%" num "s") val))) + (let ((text (format (concat "%" num "s") val))) ;; Insert first, to preserve text properties. - (insert-and-inherit text) - ;; Delete the specifier body. + (insert-and-inherit text) + ;; Delete the specifier body. (delete-region (+ (match-beginning 0) (length text)) (+ (match-end 0) (length text))) ;; Delete the percent sign. diff --git a/lisp/frame.el b/lisp/frame.el index 4bf885b27b2..0f8fc523a1b 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -655,9 +655,8 @@ the new frame according to its own rules." (error "Don't know how to create a frame on window system %s" w)) (unless (get w 'window-system-initialized) - (unless x-display-name - (setq x-display-name display)) - (funcall (cdr (assq w window-system-initialization-alist))) + (funcall (cdr (assq w window-system-initialization-alist)) display) + (setq x-display-name display) (put w 'window-system-initialized t)) ;; Add parameters from `window-system-default-frame-alist'. @@ -1257,6 +1256,23 @@ bars (top, bottom, or nil)." (unless (memq vert '(left right nil)) (setq vert default-frame-scroll-bars)) (cons vert hor))) + +(defun frame-monitor-attributes (&optional frame) + "Return the attributes of the physical monitor dominating FRAME. +If FRAME is omitted, describe the currently selected frame. + +A frame is dominated by a physical monitor when either the +largest area of the frame resides in the monitor, or the monitor +is the closest to the frame if the frame does not intersect any +physical monitors. + +See `display-monitor-attributes-list' for the list of attribute +keys and their meanings." + (or frame (setq frame (selected-frame))) + (cl-loop for attributes in (display-monitor-attributes-list frame) + for frames = (cdr (assq 'frames attributes)) + if (memq frame frames) return attributes)) + ;;;; Frame/display capabilities. (defun selected-terminal () @@ -1477,6 +1493,54 @@ The value is one of the symbols `static-gray', `gray-scale', (t 'static-gray)))) +(declare-function x-display-monitor-attributes-list "xfns.c" + (&optional terminal)) +(declare-function ns-display-monitor-attributes-list "nsfns.m" + (&optional terminal)) + +(defun display-monitor-attributes-list (&optional display) + "Return a list of physical monitor attributes on DISPLAY. +Each element of the list represents the attributes of each +physical monitor. The first element corresponds to the primary +monitor. + +Attributes for a physical monitor is represented as an alist of +attribute keys and values as follows: + + geometry -- Position and size in pixels in the form of + (X Y WIDTH HEIGHT) + workarea -- Position and size of the workarea in pixels in the + form of (X Y WIDTH HEIGHT) + mm-size -- Width and height in millimeters in the form of + (WIDTH HEIGHT) + frames -- List of frames dominated by the physical monitor + name (*) -- Name of the physical monitor as a string + +where X, Y, WIDTH, and HEIGHT are integers. Keys labeled +with (*) are optional. + +A frame is dominated by a physical monitor when either the +largest area of the frame resides in the monitor, or the monitor +is the closest to the frame if the frame does not intersect any +physical monitors. Every non-tip frame (including invisible one) +in a graphical display is dominated by exactly one physical +monitor at a time, though it can span multiple (or no) physical +monitors." + (let ((frame-type (framep-on-display display))) + (cond + ((eq frame-type 'x) + (x-display-monitor-attributes-list display)) + ((eq frame-type 'ns) + (ns-display-monitor-attributes-list display)) + (t + (let ((geometry (list 0 0 (display-pixel-width display) + (display-pixel-height display)))) + `(((geometry . ,geometry) + (workarea . ,geometry) + (mm-size . (,(display-mm-width display) + ,(display-mm-height display))) + (frames . ,(frames-on-display-list display))))))))) + ;;;; Frame geometry values diff --git a/lisp/generic-x.el b/lisp/generic-x.el index d0250cb5210..946b81992f8 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -548,7 +548,6 @@ like an INI file. You can add this hook to `find-file-hook'." (compile (concat (w32-shell-name) " -c " (buffer-file-name))))) -(eval-when-compile (require 'comint)) (declare-function comint-mode "comint" ()) (declare-function comint-exec "comint" (buffer name command startfile switches)) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 870164023d5..59e3e398788 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,298 @@ +2013-06-02 David Engster <deng@randomsample.de> + + * registry.el (initialize-instance, registry-lookup) + (registry-lookup-breaks-before-lexbind, registry-lookup-secondary) + (registry-lookup-secondary-value, registry-search, registry-delete) + (registry-insert, registry-reindex, registry-size, registry-prune): Do + not wrap methods in `eval-and-compile'. This breaks due to latest + changes in EIEIO (introduction of eieio-core.el). + +2013-05-30 Glenn Morris <rgm@gnu.org> + + * nnmail.el (nnmail-fancy-expiry-target): + Also bind mail-dont-reply-to-names. + + * spam-stat.el (spam-stat-save): + No need to tweak font-lock in temp buffers. + + * shr.el (shr-put-image): Silence compiler. + +2013-05-29 Glenn Morris <rgm@gnu.org> + + * gnus-ems.el (set-process-plist): Every supported Emacs has this. + + * gnus-group.el (gnus-sequence-of-unread-articles) + (gnus-summary-add-mark, gnus-mark-article-as-read) + (gnus-group-make-articles-read): Declare. + + * gnus-sum.el (gnus-parameter-list-identifier) + (gnus-article-stop-animations, gnus-stop-downloads) + (gnus-article-only-boring-p, article-goto-body) + (gnus-flush-original-article-buffer, article-narrow-to-head) + (gnus-article-hidden-text-p, gnus-delete-wash-type) + (gnus-summary-save-in-pipe, gnus-article-show-summary): Declare. + + * gnus.el: No need to eval-and-compile autoloads. + + * gravatar.el (help-function-arglist): Autoload. + + * nnimap.el (gnus-refer-thread-use-nnir): Declare. + + * nnmail.el (nnmail-fancy-expiry-target): Maybe use mail-dont-reply-to. + + * spam.el: No need to load spam-report when compiling. + No need to eval-and-compile autoloads. + (spam-report-resend-to): Declare. + (spam-report-resend-register-routine): Require 'spam-report. + +2013-05-24 Julien Danjou <julien@danjou.info> + + * sieve.el (sieve-setup-buffer): Fix default port value in sieve buffer + setup. + +2013-05-23 Glenn Morris <rgm@gnu.org> + + * gnus-util.el (rmail-swap-buffers-maybe) + (rmail-maybe-set-message-counters, rmail-count-new-messages) + (rmail-summary-exists, rmail-show-message, rmail-summary-displayed) + (rmail-pop-to-buffer, rmail-maybe-display-summary): Declare. + + * mm-decode.el: No need to load term when compiling. + (term-mode, term-char-mode): Declare. + + * mm-util.el: No need to load jka-compr when compiling. + (jka-compr-acceptable-retval-list, jka-compr-make-temp-name): Declare. + + * nnmaildir.el: Require is automatically eval-and-compile. + (nnmail): Require at run-time too. + + * registry.el (registry-size): Move definition before use. + +2013-05-22 Daiki Ueno <ueno@gnu.org> + + * mml2015.el (mml2015-epg-sign): Make sure to insert newline after the + signed data to conform the standard. (Bug#14232) + +2013-05-20 Adam Sjøgren <asjo@koldfront.dk> + + * gnus-spec.el (gnus-parse-complex-format): Use unicode escape for left + double angle quotation mark. + +2013-05-19 Adam Sjøgren <asjo@koldfront.dk> + + * message.el (message-insert-formatted-citation-line): Handle finding + first/lastname when more than 2 names appear. + +2013-05-19 Adam Sjøgren <asjo@koldfront.dk> + + * shr.el (shr-tag-span): New function. + +2013-05-18 Glenn Morris <rgm@gnu.org> + + * message.el (message-mode): Use message-mode-abbrev-table, + with text-mode-abbrev-table as parent. (Bug#14413) + +2013-05-16 Katsumi Yamaoka <yamaoka@jpl.org> + + * message.el (message-expand-group): Decode group names. + +2013-05-16 Julien Danjou <julien@danjou.info> + + * gnus-notifications.el (gnus-notifications-notify): Use photo-file as + app-icon. + +2013-05-15 Glenn Morris <rgm@gnu.org> + + * shr-color.el (shr-color-visible-luminance-min) + (shr-color-visible-distance-min): Use shr-color group. + +2013-05-11 Glenn Morris <rgm@gnu.org> + + * gnus-vm.el: Make it loadable without VM. + (gnus-vm-make-folder, gnus-summary-save-in-vm): Require 'vm. + (vm-forward-message, vm-reply, vm-mail): Remove unused autoloads. + +2013-05-09 Glenn Morris <rgm@gnu.org> + + * mml1991.el: Make it loadable. (Bug#13456) + + * gnus-art.el (gnus-article-date-headers, gnus-blocked-images): + * gnus-async.el (gnus-async-post-fetch-function): + * gnus-gravatar.el (gnus-gravatar-size, gnus-gravatar-properties): + * gnus-html.el (gnus-html-image-cache-ttl): + * gnus-notifications.el (gnus-notifications-timeout): + * gnus-picon.el (gnus-picon-properties): + * gnus-util.el (gnus-completion-styles): + * gnus.el (gnus-other-frame-resume-function): + * message.el (message-user-organization-file) + (message-cite-reply-position): + * nnir.el (nnir-summary-line-format) + (nnir-retrieve-headers-override-function): + * shr-color.el (shr-color-visible-luminance-min): + * shr.el (shr-blocked-images): + * spam-report.el (spam-report-resend-to): + * spam.el (spam-summary-exit-behavior): Fix custom types. + + * gnus-salt.el (gnus-selected-tree-face): Fix default. + +2013-05-07 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-describe-bindings): Require help-mode + because of let-binding help-xref-following. (Bug#14356) + +2013-05-06 Tassilo Horn <tassilo@member.fsf.org> + + * message.el (message-bury, message-send-and-exit): + Revert 2013-05-04 change. + +2013-05-06 Glenn Morris <rgm@gnu.org> + + * mml2015.el (mml2015-epg-sign): Add name="signature.asc". (Bug#13465) + +2013-05-04 Thierry Volpiatto <thierry.volpiatto@gmail.com> + + * message.el (message-bury): Make `buffer' optional. + (message-send-and-exit): Don't pass `buf' so as to hide the buffer + (bug#14085). + +2013-05-04 Andrew Cohen <cohen@bu.edu> + + * gnus-sum.el (gnus-read-header): Ensure groups are prefixed when + entering into the registry. + +2013-05-01 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-util.el (gnus-emacs-completing-read): Fix a filter for XEmacs. + (Bug#14304) + +2013-04-27 Glenn Morris <rgm@gnu.org> + + * gnus.el (gnus-list-debbugs): + Use require rather than autoload. (Bug#14262) + +2013-04-27 Julien Danjou <julien@danjou.info> + + * sieve-manage.el (sieve-manage-authenticator-alist): Update the sieve + port to "sieve" now that it has an official IANA port assigned. + +2013-04-26 Katsumi Yamaoka <yamaoka@jpl.org> + + * mail-source.el (mail-source-fetch-pop, mail-source-check-pop): + Don't set the MAILHOST environment variable permanently (Bug#14271). + +2013-04-26 Glenn Morris <rgm@gnu.org> + + * message.el (message-bury): Revert 2013-03-18 change. (Bug#14117) + +2013-04-25 Andrew Cohen <cohen@bu.edu> + + * gnus-msg.el (gnus-inews-insert-gcc): Re-order conditional to work for + string values of 'gcc-self. Thanks to Saroj Thirumalai. + +2013-04-24 Andrew Cohen <cohen@bu.edu> + + * nnir.el (nnir-close-group): Make sure we are in the right group. + + * gnus-sum.el (gnus-summary-insert-articles): Force updates to the + dependency table from all newly retrieved headers. + +2013-04-16 David Edmondson <dme@dme.org> + + Support <img src="data:...">. + + * shr.el (shr-image-from-data): New function. + (shr-tag-img): Use it. + +2013-04-14 Andrew Cohen <cohen@bu.edu> + + * nnir.el (nnir-request-set-mark): Make sure we are in the right + group. + +2013-04-12 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-msg.el (gnus-msg-mail): Make it avoid using posting styles + corresponding to any existing group (Bug#14166). + +2013-04-10 Andrew Cohen <cohen@bu.edu> + + * nnir.el (number-sequence): No longer used. + (nnir-request-set-mark): New function. + (nnir-request-update-info): Improve marks updating. + (nnir-request-scan): Don't duplicate marks updating. + (gnus-group-make-nnir-group, nnir-run-imap, nnir-request-create-group): + Use 'assq rather than 'assoc. Quote anonymous function. + (nnir-request-group, nnir-close-group, gnus-summary-create-nnir-group): + Use 'gnus-group-prefixed-p. + (gnus-summary-create-nnir-group): Make sure server for method is open. + +2013-04-04 Andrew Cohen <cohen@bu.edu> + + * nnir.el (gnus-nnir-group-p): New function. + (nnir-possibly-change-group): Use it. + + * gnus-msg.el (gnus-setup-message): Use it. + +2013-04-04 Katsumi Yamaoka <yamaoka@jpl.org> + + * mml.el (mml-minibuffer-read-description): Use `default' insted of + `initial-input' for the argument name. + Suggested by Stefan Monnier <monnier@iro.umontreal.ca>. + +2013-04-03 Kevin Layer <layer@known.net> (tiny change) + + * mml.el (mml-minibuffer-read-description): Allow passing in a prefix + (used by MH-E). + +2013-04-01 Andrew Cohen <cohen@bu.edu> + + * nnir.el (nnir-request-update-mark): Improve mark updating in original + group. + + * gnus-msg.el (nnir-article-number, nnir-article-group): Autoload to + fix compilation. + +2013-03-31 Andrew Cohen <cohen@bu.edu> + + * nnir.el (nnir-method-default-engines): And another typo. + +2013-03-30 Andrew Cohen <cohen@bu.edu> + + * nnir.el (nnir-method-default-engines): Fix typo. + +2013-03-29 Andrew Cohen <cohen@bu.edu> + + * nnir.el: Define 'number-sequence for xemacs. + (gnus-summary-create-nnir-group): New function to create an nnir group + from an nnir summary buffer based on the current query. + (nnir-request-create-group): Update to allow nnir group creation based + on the current query. + +2013-03-28 Katsumi Yamaoka <yamaoka@jpl.org> + + * nndraft.el (nndraft-request-expire-articles): + Make expiry target always `delete'. + +2013-03-27 Andrew Cohen <cohen@bu.edu> + + * gnus-msg.el (gnus-setup-message): When replying from an nnir summary + buffer use the posting-style and gcc of the original article group. + (gnus-inews-insert-gcc): Don't set gcc-self for virtual groups. + + * nnir.el: Fix byte-compile warning. nnoo-define-skeleton should come + after other deffoos. + +2013-03-26 Andrew Cohen <cohen@bu.edu> + + * nnir.el: Major rewrite. Cleaner separation between searches and group + management. Marks are now shown in nnir summary buffers. Rudimentary + support for real (i.e. not ephemeral) nnir groups. + (gnus-summary-make-nnir-group): New function for initiating searches + from a summary buffer. + +2013-03-18 Sam Steingold <sds@gnu.org> + + * message.el (message-bury): Minor cleanup. + 2013-03-06 Katsumi Yamaoka <yamaoka@jpl.org> * nndir.el (nndir-request-list): Remove 2nd argument passed to @@ -67,7 +362,7 @@ 2013-01-30 Christopher Schmidt <christopher@ch.ristopher.com> * gnus-int.el (gnus-backend-trace-elapsed): New variable. - (gnus-backend-trace): Honour gnus-backend-trace. + (gnus-backend-trace): Honor gnus-backend-trace. * mml.el (mml-insert-part): Insert closing tag. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 13d9b4e5c28..23603bc7722 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1032,15 +1032,15 @@ Some of these headers are updated automatically. See `gnus-article-update-date-headers' for details." :version "24.1" :group 'gnus-article-headers - :type '(repeat - (item :tag "Universal time (UT)" :value 'ut) - (item :tag "Local time zone" :value 'local) - (item :tag "Readable English" :value 'english) - (item :tag "Elapsed time" :value 'lapsed) - (item :tag "Original and elapsed time" :value 'combined-lapsed) - (item :tag "Original date header" :value 'original) - (item :tag "ISO8601 format" :value 'iso8601) - (item :tag "User-defined" :value 'user-defined))) + :type '(set + (const :tag "Universal time (UT)" ut) + (const :tag "Local time zone" local) + (const :tag "Readable English" english) + (const :tag "Elapsed time" lapsed) + (const :tag "Original and elapsed time" combined-lapsed) + (const :tag "Original date header" original) + (const :tag "ISO8601 format" iso8601) + (const :tag "User-defined" user-defined))) (defcustom gnus-article-update-date-headers nil "A number that says how often to update the date header (in seconds). @@ -1651,7 +1651,7 @@ called with the group name as the parameter, and should return a regexp." :version "24.1" :group 'gnus-art - :type 'regexp) + :type '(choice regexp function)) ;;; Internal variables @@ -6629,11 +6629,7 @@ KEY is a string or a vector." ;;`gnus-agent-mode' in gnus-agent.el will define it. (defvar gnus-agent-summary-mode) (defvar gnus-draft-mode) -;; Calling help-buffer will autoload help-mode. (defvar help-xref-stack-item) -;; Emacs 22 doesn't load it in the batch mode. -(eval-when-compile - (autoload 'help-buffer "help-mode")) (defun gnus-article-describe-bindings (&optional prefix) "Show a list of all defined keys, and their definitions. @@ -6684,6 +6680,9 @@ then we display only bindings that start with that prefix." (with-current-buffer ,(current-buffer) (gnus-article-describe-bindings prefix))) ,prefix))) + ;; Loading `help-mode' here is necessary if `describe-bindings' + ;; is replaced with something, e.g. `helm-descbinds'. + (require 'help-mode) (with-current-buffer (let (help-xref-following) (help-buffer)) (setq help-xref-stack-item item))))) diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el index c5d64332547..d0afd1aa932 100644 --- a/lisp/gnus/gnus-async.el +++ b/lisp/gnus/gnus-async.el @@ -76,7 +76,7 @@ The function will be called narrowed to the region of the article that was fetched." :version "24.1" :group 'gnus-asynchronous - :type 'function) + :type '(choice (const nil) function)) ;;; Internal variables. diff --git a/lisp/gnus/gnus-ems.el b/lisp/gnus/gnus-ems.el index ac8bb74f1f5..4d9b5798247 100644 --- a/lisp/gnus/gnus-ems.el +++ b/lisp/gnus/gnus-ems.el @@ -221,8 +221,8 @@ 'window-inside-pixel-edges 'window-pixel-edges)) - (if (fboundp 'set-process-plist) - (progn + (if (or (featurep 'emacs) (fboundp 'set-process-plist)) + (progn ; these exist since Emacs 22.1 (defalias 'gnus-set-process-plist 'set-process-plist) (defalias 'gnus-process-plist 'process-plist) (defalias 'gnus-process-get 'process-get) diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el index 8b9c49a998c..33bcb6b1598 100644 --- a/lisp/gnus/gnus-gravatar.el +++ b/lisp/gnus/gnus-gravatar.el @@ -35,13 +35,13 @@ (defcustom gnus-gravatar-size nil "How big should gravatars be displayed. If nil, default to `gravatar-size'." - :type 'integer + :type '(choice (const nil) integer) :version "24.1" :group 'gnus-gravatar) (defcustom gnus-gravatar-properties '(:ascent center :relief 1) "List of image properties applied to Gravatar images." - :type 'list + :type 'sexp :version "24.1" :group 'gnus-gravatar) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 2c45d3c24a1..30ce184ed66 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -3591,6 +3591,8 @@ Cross references (Xref: header) of articles are ignored." (interactive "P") (gnus-group-catchup-current n 'all)) +(declare-function gnus-sequence-of-unread-articles "gnus-sum" (group)) + (defun gnus-group-catchup (group &optional all) "Mark all articles in GROUP as read. If ALL is non-nil, all articles are marked as read. @@ -4493,6 +4495,8 @@ and the second element is the address." (sort (nconc (gnus-uncompress-range (cdr m)) (copy-sequence articles)) '<) t)))))) +(declare-function gnus-summary-add-mark "gnus-sum" (article type)) + (defun gnus-add-mark (group mark article) "Mark ARTICLE in GROUP with MARK, whether the group is displayed or not." (let ((buffer (gnus-summary-buffer-name group))) @@ -4657,6 +4661,9 @@ you the groups that have both dormant articles and cached articles." (let ((gnus-group-list-option 'limit)) (gnus-group-list-plus args))) +(declare-function gnus-mark-article-as-read "gnu-sum" (article &optional mark)) +(declare-function gnus-group-make-articles-read "gnus-sum" (group articles)) + (defun gnus-group-mark-article-read (group article) "Mark ARTICLE read." (let ((buffer (gnus-summary-buffer-name group)) diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index bdf03a16587..a5625dfed80 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -45,7 +45,10 @@ "Time used to determine if we should use images from the cache." :version "24.1" :group 'gnus-art - :type 'integer) + ;; FIXME hardly the friendliest type. The allowed value is actually + ;; any time value, but we are assuming no-one cares about USEC and + ;; PSEC here. It would be better to eg make it a number of minutes. + :type '(list integer integer)) (defcustom gnus-html-image-automatic-caching t "Whether automatically cache retrieve images." diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index f7b2d8b99d9..fce9a3633c2 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -415,6 +415,11 @@ Thank you for your help in stamping out bugs. (gnus-inews-make-draft-meta-information ,(gnus-group-decoded-name gnus-newsgroup-name) ',articles))) +(autoload 'nnir-article-number "nnir" nil nil 'macro) +(autoload 'nnir-article-group "nnir" nil nil 'macro) +(autoload 'gnus-nnir-group-p "nnir") + + (defvar gnus-article-reply nil) (defmacro gnus-setup-message (config &rest forms) (let ((winconf (make-symbol "gnus-setup-message-winconf")) @@ -426,15 +431,22 @@ Thank you for your help in stamping out bugs. `(let ((,winconf (current-window-configuration)) (,winconf-name gnus-current-window-configuration) (,buffer (buffer-name (current-buffer))) - (,article gnus-article-reply) + (,article (if (and (gnus-nnir-group-p gnus-newsgroup-name) + gnus-article-reply) + (nnir-article-number gnus-article-reply) + gnus-article-reply)) (,yanked gnus-article-yanked-articles) - (,group gnus-newsgroup-name) + (,group (if (and (gnus-nnir-group-p gnus-newsgroup-name) + gnus-article-reply) + (nnir-article-group gnus-article-reply) + gnus-newsgroup-name)) (message-header-setup-hook (copy-sequence message-header-setup-hook)) (mbl mml-buffer-list) (message-mode-hook (copy-sequence message-mode-hook))) (setq mml-buffer-list nil) - (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc) + (add-hook 'message-header-setup-hook (lambda () + (gnus-inews-insert-gcc ,group))) ;; message-newsreader and message-mailer were formerly set in ;; gnus-inews-add-send-actions, but this is too late when ;; message-generate-headers-first is used. --ansel @@ -526,7 +538,8 @@ instead." (message-mail to subject other-headers continue nil yank-action send-actions return-action)) (let ((buf (current-buffer)) - (gnus-newsgroup-name (or gnus-newsgroup-name "")) + ;; Don't use posting styles corresponding to any existing group. + (gnus-newsgroup-name "") mail-buf) (gnus-setup-message 'message (message-mail to subject other-headers continue @@ -1706,7 +1719,8 @@ this is a reply." (group (when group (gnus-group-decoded-name group))) (var (or gnus-outgoing-message-group gnus-message-archive-group)) (gcc-self-val - (and group (gnus-group-find-parameter group 'gcc-self))) + (and group (not (gnus-virtual-group-p group)) + (gnus-group-find-parameter group 'gcc-self))) result (groups (cond diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el index 224b59b0512..93220ed8ddf 100644 --- a/lisp/gnus/gnus-notifications.el +++ b/lisp/gnus/gnus-notifications.el @@ -64,7 +64,8 @@ not get notifications." (defcustom gnus-notifications-timeout nil "Timeout used for notifications sent via `notifications-notify'." - :type 'integer + :type '(choice (const :tag "Server default" nil) + (integer :tag "Milliseconds")) :group 'gnus-notifications) (defvar gnus-notifications-sent nil @@ -91,12 +92,12 @@ Return a notification id if any, or t on success." :body subject :actions '("read" "Read") :on-action 'gnus-notifications-action - :app-icon (gnus-funcall-no-warning - 'image-search-load-path "gnus/gnus.png") + :app-icon (or photo-file + (gnus-funcall-no-warning + 'image-search-load-path "gnus/gnus.png")) :app-name "Gnus" :category "email.arrived" - :timeout gnus-notifications-timeout - :image-path photo-file) + :timeout gnus-notifications-timeout) (message "New message from %s: %s" from subject) ;; Don't return an id t)) diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el index 4f28f8ebc01..5402982b965 100644 --- a/lisp/gnus/gnus-picon.el +++ b/lisp/gnus/gnus-picon.el @@ -77,7 +77,7 @@ Some people may want to add \"unknown\" to this list." (defcustom gnus-picon-properties '(:color-symbols (("None" . "white"))) "List of image properties applied to picons." - :type 'list + :type 'sexp :version "24.3" :group 'gnus-picon) diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index 48b51d2c95d..6b8e105e6b8 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -385,7 +385,7 @@ lines." integer) :group 'gnus-summary-tree) -(defcustom gnus-selected-tree-face 'modeline +(defcustom gnus-selected-tree-face 'mode-line "*Face used for highlighting selected articles in the thread tree." :type 'face :group 'gnus-summary-tree) diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el index 2606b8860af..0ff8ec89ac1 100644 --- a/lisp/gnus/gnus-spec.el +++ b/lisp/gnus/gnus-spec.el @@ -441,7 +441,7 @@ characters when given a pad value." (delim (aref (match-string 2) 0))) (if (or (= delim ?\() (= delim ?\{) - (= delim ?\«)) + (= delim 171)) ; « (replace-match (concat "\"(" (cond ((= delim ?\() "mouse") ((= delim ?\{) "face") diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 93bc35af3bd..c8f593ea403 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -5492,6 +5492,8 @@ or a straight list of headers." (cdr (assq number gnus-newsgroup-scored)) (memq number gnus-newsgroup-processable)))))) +(declare-function gnus-parameter-list-identifier "gnus-art" (name) t) + (defun gnus-group-get-list-identifiers (group) "Get list identifier regexp for GROUP." (or (gnus-parameter-list-identifier group) @@ -7267,6 +7269,9 @@ If FORCE (the prefix), also save the .newsrc file(s)." (unless quit-config (setq gnus-newsgroup-name nil))))) +(declare-function gnus-article-stop-animations "gnus-art" ()) +(declare-function gnus-stop-downloads "gnus-art" ()) + (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update) (defun gnus-summary-exit-no-update (&optional no-questions) "Quit reading current newsgroup without updating read article info." @@ -7859,6 +7864,8 @@ If UNREAD is non-nil, only unread articles are selected." (and gnus-auto-select-same (gnus-summary-article-subject)))) +(declare-function gnus-article-only-boring-p "gnus-art" ()) + (defun gnus-summary-next-page (&optional lines circular stop) "Show next page of the selected article. If at the end of the current article, select the next article. @@ -8426,6 +8433,8 @@ If REVERSE (the prefix), limit to articles that don't match." (interactive "sMatch headers (regexp): \nP") (gnus-summary-limit-to-bodies match reverse t)) +(declare-function article-goto-body "gnus-art" ()) + (defun gnus-summary-limit-to-bodies (match &optional reverse headersp) "Limit the summary buffer to articles that have bodies that match MATCH. If REVERSE (the prefix), limit to articles that don't match." @@ -9556,6 +9565,8 @@ to save in." (ps-spool-buffer-with-faces) (ps-spool-buffer))))) +(declare-function gnus-flush-original-article-buffer "gnus-art" ()) + (defun gnus-summary-show-complete-article () "Show a complete version of the current article. This is only useful if you're looking at a partial version of the @@ -9679,6 +9690,10 @@ If ARG is a negative number, turn header display off." t))) (gnus-summary-show-article)) +(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)) + (defun gnus-summary-toggle-header (&optional arg) "Show the headers if they are hidden, or hide them if they are shown. If ARG is a positive number, show the entire header. @@ -11962,6 +11977,8 @@ will not be marked as saved." (gnus-set-mode-line 'summary) n)) +(declare-function gnus-summary-save-in-pipe "gnus-art" (&optional command raw)) + (defun gnus-summary-pipe-output (&optional n sym) "Pipe the current article to a subprocess. If N is a positive number, pipe the N next articles. @@ -12415,7 +12432,9 @@ If REVERSE, save parts that do not match TYPE." (not (gnus-ephemeral-group-p (car where)))) (gnus-registry-handle-action (mail-header-id header) nil - (gnus-group-prefixed-name (car where) gnus-override-method) + (gnus-group-prefixed-name + (car where) + (or gnus-override-method (gnus-find-method-for-group group))) (mail-header-subject header) (mail-header-from header))) (when (and (stringp id) @@ -12775,7 +12794,7 @@ returned." (setq gnus-newsgroup-headers (gnus-merge 'list gnus-newsgroup-headers - (gnus-fetch-headers articles) + (gnus-fetch-headers articles nil t) 'gnus-article-sort-by-number)) (setq gnus-newsgroup-articles (gnus-sorted-nunion gnus-newsgroup-articles articles)) @@ -12912,6 +12931,7 @@ If ALL is a number, fetch this number of articles." (gnus-summary-position-point)) ;;; Bookmark support for Gnus. +(declare-function gnus-article-show-summary "gnus-art" ()) (declare-function bookmark-make-record-default "bookmark" (&optional no-file no-context posn)) (declare-function bookmark-prop-get "bookmark" (bookmark prop)) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 331f9556710..0f0e9675c71 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -68,7 +68,7 @@ "Value of `completion-styles' to use when completing." :version "24.1" :group 'gnus-meta - :type 'list) + :type '(repeat symbol)) ;; Fixme: this should be a gnus variable, not nnmail-. (defvar nnmail-pathname-coding-system) @@ -1025,6 +1025,15 @@ with potentially long computations." (declare-function mm-append-to-file "mm-util" (start end filename &optional codesys inhibit)) +(declare-function rmail-swap-buffers-maybe "rmail" ()) +(declare-function rmail-maybe-set-message-counters "rmail" ()) +(declare-function rmail-count-new-messages "rmail" (&optional nomsg)) +(declare-function rmail-summary-exists "rmail" ()) +(declare-function rmail-show-message "rmail" (&optional n no-summary)) +;; Macroexpansion of rmail-select-summary: +(declare-function rmail-summary-displayed "rmail" ()) +(declare-function rmail-pop-to-buffer "rmail" (&rest args)) +(declare-function rmail-maybe-display-summary "rmail" ()) (defun gnus-output-to-rmail (filename &optional ask) "Append the current article to an Rmail file named FILENAME. @@ -1549,9 +1558,12 @@ SPEC is a predicate specifier that contains stuff like `or', `and', "Call standard `completing-read-function'." (let ((completion-styles gnus-completion-styles)) (completing-read prompt - ;; Old XEmacs (at least 21.4) expect an alist for - ;; collection. - (mapcar 'list collection) + ;; Old XEmacs (at least 21.4) expect an alist, + ;; in which the car of each element is a string, + ;; for collection. + (mapcar (lambda (elem) + (list (format "%s" (or (car-safe elem) elem)))) + collection) nil require-match initial-input history def))) (autoload 'ido-completing-read "ido") diff --git a/lisp/gnus/gnus-vm.el b/lisp/gnus/gnus-vm.el index fa39bae1763..55f99653cc4 100644 --- a/lisp/gnus/gnus-vm.el +++ b/lisp/gnus/gnus-vm.el @@ -35,12 +35,10 @@ (require 'gnus-msg) (eval-when-compile - (require 'cl) - (autoload 'vm-mode "vm") - (autoload 'vm-save-message "vm") - (autoload 'vm-forward-message "vm") - (autoload 'vm-reply "vm") - (autoload 'vm-mail "vm")) + (require 'cl)) + +(autoload 'vm-mode "vm") +(autoload 'vm-save-message "vm") (defvar gnus-vm-inhibit-window-system nil "Inhibit loading `win-vm' if using a window-system. @@ -51,10 +49,8 @@ Has to be set before gnus-vm is loaded.") (when window-system (require 'win-vm)))) -(when (not (featurep 'vm)) - (load "vm")) - (defun gnus-vm-make-folder (&optional buffer) + (require 'vm) (let ((article (or buffer (current-buffer))) (tmp-folder (generate-new-buffer " *tmp-folder*")) (start (point-min)) @@ -87,6 +83,7 @@ save those articles instead." (defun gnus-summary-save-in-vm (&optional folder) (interactive) + (require 'vm) (setq folder (gnus-read-save-file-name "Save %s in VM folder:" folder diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index ffb4694f4a8..2c2dbd90c56 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -2507,6 +2507,7 @@ Disabling the agent may result in noticeable loss of performance." :version "24.4" :group 'gnus-start :type '(choice (function-item gnus) + (function-item gnus-group-get-new-news) (function-item gnus-no-server) (function-item gnus-slave) (function-item gnus-slave-no-server))) @@ -4242,8 +4243,7 @@ parameters." (setq valids (cdr valids))) outs)) -(eval-and-compile - (autoload 'message-y-or-n-p "message" nil nil 'macro)) +(autoload 'message-y-or-n-p "message" nil nil 'macro) (defun gnus-read-group (prompt &optional default) "Prompt the user for a group name. @@ -4433,12 +4433,13 @@ prompt the user for the name of an NNTP server to use." (gnus-1 arg dont-connect slave) (gnus-final-warning))) -(eval-and-compile - (unless (fboundp 'debbugs-gnu) - (autoload 'debbugs-gnu "debbugs-gnu" "List all outstanding Emacs bugs." t))) +(declare-function debbugs-gnu "ext:debbugs-gnu" + (severities &optional packages archivedp suppress tags)) + (defun gnus-list-debbugs () "List all open Gnus bug reports." (interactive) + (require 'debbugs-gnu) (debbugs-gnu nil "gnus")) ;; Allow redefinition of Gnus functions. diff --git a/lisp/gnus/gravatar.el b/lisp/gnus/gravatar.el index bf6295aa7b8..985ed2c7b0d 100644 --- a/lisp/gnus/gravatar.el +++ b/lisp/gnus/gravatar.el @@ -103,6 +103,8 @@ If no image available, return 'error." (gravatar-create-image data nil t) 'error))) +(autoload 'help-function-arglist "help-fns") + ;;;###autoload (defun gravatar-retrieve (mail-address cb &optional cbargs) "Retrieve MAIL-ADDRESS gravatar and call CB on retrieval. diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index 9cc2e6ac09c..7da2a0a441d 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -809,6 +809,10 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) prescript-delay) (let ((from (format "%s:%s:%s" server user port)) (mail-source-string (format "pop:%s@%s" user server)) + (process-environment (if server + (cons (concat "MAILHOST=" server) + process-environment) + process-environment)) result) (when (eq authentication 'password) (setq password @@ -816,8 +820,6 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) (cdr (assoc from mail-source-password-cache)) (read-passwd (format "Password for %s at %s: " user server))))) - (when server - (setenv "MAILHOST" server)) (setq result (cond (program @@ -877,6 +879,10 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) (mail-source-bind (pop source) (let ((from (format "%s:%s:%s" server user port)) (mail-source-string (format "pop:%s@%s" user server)) + (process-environment (if server + (cons (concat "MAILHOST=" server) + process-environment) + process-environment)) result) (when (eq authentication 'password) (setq password @@ -886,8 +892,6 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) (format "Password for %s at %s: " user server)))) (unless (assoc from mail-source-password-cache) (push (cons from password) mail-source-password-cache))) - (when server - (setenv "MAILHOST" server)) (setq result (cond ;; No easy way to check whether mail is waiting for these. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index a6638097b47..c6f5d904677 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -527,7 +527,7 @@ If t, use `message-user-organization-file'." (setq orgfile f))) orgfile) "*Local news organization file." - :type 'file + :type '(choice (const nil) file) :link '(custom-manual "(message)News Headers") :group 'message-headers) @@ -1098,9 +1098,9 @@ e.g. using `gnus-posting-styles': (eval (set (make-local-variable 'message-cite-reply-position) 'above))" :version "24.1" - :type '(choice (const :tag "Reply inline" 'traditional) - (const :tag "Reply above" 'above) - (const :tag "Reply below" 'below)) + :type '(choice (const :tag "Reply inline" traditional) + (const :tag "Reply above" above) + (const :tag "Reply below" below)) :group 'message-insertion) (defcustom message-cite-style nil @@ -2939,7 +2939,6 @@ C-c M-n `message-insert-disposition-notification-to' (request receipt). C-c M-m `message-mark-inserted-region' (mark region with enclosing tags). C-c M-f `message-mark-insert-file' (insert file marked with enclosing tags). M-RET `message-newline-and-reformat' (break the line and reformat)." - (setq local-abbrev-table text-mode-abbrev-table) (set (make-local-variable 'message-reply-buffer) nil) (set (make-local-variable 'message-inserted-headers) nil) (set (make-local-variable 'message-send-actions) nil) @@ -3945,18 +3944,19 @@ See `message-citation-line-format'." (let ((i ?A) lst) (when (stringp name) ;; Guess first name and last name: - (cond ((string-match - "\\`\\(\\w\\|[-.]\\)+ \\(\\w\\|[-.]\\)+\\'" name) - (setq fname (nth 0 (split-string name "[ \t]+")) - lname (nth 1 (split-string name "[ \t]+")))) - ((string-match - "\\`\\(\\w\\|[-.]\\)+, \\(\\w\\|[-.]\\)+\\'" name) - (setq fname (nth 1 (split-string name "[ \t,]+")) - lname (nth 0 (split-string name "[ \t,]+")))) - ((string-match - "\\`\\(\\w\\|[-.]\\)+\\'" name) - (setq fname name - lname "")))) + (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))))) ;; The following letters are not used in `format-time-string': (push ?E lst) (push "<E>" lst) (push ?F lst) (push fname lst) @@ -7960,19 +7960,29 @@ those headers." (defun message-expand-group () "Expand the group name under point." - (let* ((b (save-excursion - (save-restriction - (narrow-to-region - (save-excursion - (beginning-of-line) - (skip-chars-forward "^:") - (1+ (point))) - (point)) - (skip-chars-backward "^, \t\n") (point)))) - (completion-ignore-case t) - (e (progn (skip-chars-forward "^,\t\n ") (point))) - (hashtb (and (boundp 'gnus-active-hashtb) gnus-active-hashtb))) - (message-completion-in-region e b hashtb))) + (let ((b (save-excursion + (save-restriction + (narrow-to-region + (save-excursion + (beginning-of-line) + (skip-chars-forward "^:") + (1+ (point))) + (point)) + (skip-chars-backward "^, \t\n") (point)))) + (completion-ignore-case t) + (e (progn (skip-chars-forward "^,\t\n ") (point))) + group collection) + (when (and (boundp 'gnus-active-hashtb) + gnus-active-hashtb) + (mapatoms + (lambda (symbol) + (setq group (symbol-name symbol)) + (push (if (string-match "[^\000-\177]" group) + (gnus-group-decoded-name group) + group) + collection)) + gnus-active-hashtb)) + (message-completion-in-region e b collection))) (defalias 'message-completion-in-region (if (fboundp 'completion-in-region) diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 04f325633ba..b025f7cc601 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -29,8 +29,7 @@ (require 'mail-parse) (require 'mm-bodies) -(eval-when-compile (require 'cl) - (require 'term)) +(eval-when-compile (require 'cl)) (autoload 'gnus-map-function "gnus-util") (autoload 'gnus-replace-in-string "gnus-util") @@ -813,6 +812,8 @@ external if displayed external." (declare-function gnus-configure-windows "gnus-win" (setting &optional force)) (defvar mailcap-mime-extensions) ; mailcap-mime-info autoloads +(declare-function term-mode "term" ()) +(declare-function term-char-mode "term" ()) (defun mm-display-external (handle method) "Display HANDLE using METHOD." diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index a49d308b67c..209c2949ea9 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -1508,8 +1508,8 @@ To make this function work with XEmacs, the APEL package is required." (fboundp 'coding-system-to-mime-charset))) (coding-system-to-mime-charset coding-system))))) -(eval-when-compile - (require 'jka-compr)) +(defvar jka-compr-acceptable-retval-list) +(declare-function jka-compr-make-temp-name "jka-compr" (&optional local)) (defun mm-decompress-buffer (filename &optional inplace force) "Decompress buffer's contents, depending on jka-compr. diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 3c9344a62c3..91f0e325182 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -1212,8 +1212,8 @@ If not set, `default-directory' will be used." string default))) -(defun mml-minibuffer-read-description () - (let ((description (read-string "One line description: "))) +(defun mml-minibuffer-read-description (&optional default) + (let ((description (read-string "One line description: " default))) (when (string-match "\\`[ \t]*\\'" description) (setq description nil)) description)) diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index 5af7639019a..52b8e347edf 100644 --- a/lisp/gnus/mml1991.el +++ b/lisp/gnus/mml1991.el @@ -50,6 +50,8 @@ (autoload 'message-options-get "message") (autoload 'message-options-set "message") +(require 'mml2015) + (defvar mml1991-use mml2015-use "The package used for PGP.") diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 39bce23e76c..5d122dfbe40 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -47,6 +47,9 @@ (config &optional minimum-version)) (declare-function epg-configuration "ext:epg-config" ()) +;; Maybe this should be in eg mml-sec.el (and have a different name). +;; Then mml1991 would not need to require mml2015, and mml1991-use +;; could be removed. (defvar mml2015-use (or (condition-case nil (progn @@ -1082,6 +1085,10 @@ If no one is selected, default secret key is used. " (epg-context-set-passphrase-callback context #'mml2015-epg-passphrase-callback)) + ;; Signed data must end with a newline (RFC 3156, 5). + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) (condition-case error (setq signature (epg-sign-string context (buffer-string) t) mml2015-epg-secret-key-id-list nil) @@ -1106,7 +1113,7 @@ If no one is selected, default secret key is used. " (insert (format "\n--%s\n" boundary)) (goto-char (point-max)) (insert (format "\n--%s\n" boundary)) - (insert "Content-Type: application/pgp-signature\n\n") + (insert "Content-Type: application/pgp-signature; name=\"signature.asc\"\n\n") (insert signature) (goto-char (point-max)) (insert (format "--%s--\n" boundary)) diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el index b19b56ae6ea..c9625f4c447 100644 --- a/lisp/gnus/nndraft.el +++ b/lisp/gnus/nndraft.el @@ -255,11 +255,16 @@ are generated if and only if they are also in `message-draft-headers'.") (deffoo nndraft-request-expire-articles (articles group &optional server force) (nndraft-possibly-change-group group) (let* ((nnmh-allow-delete-final t) - (nnmail-expiry-target - (or (gnus-group-find-parameter - (gnus-group-prefixed-name group (list 'nndraft server)) - 'expiry-target t) - nnmail-expiry-target)) + (nnmail-expiry-target 'delete) + ;; FIXME: If we want to move a draft message to an expiry group, + ;; there are things to have to improve: + ;; - Remove a header separator. + ;; - Encode it, including attachments, into a MIME message. + ;;(nnmail-expiry-target + ;; (or (gnus-group-find-parameter + ;; (gnus-group-prefixed-name group (list 'nndraft server)) + ;; 'expiry-target t) + ;; nnmail-expiry-target)) (res (nnoo-parent-function 'nndraft 'nnmh-request-expire-articles (list articles group server force))) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 9c18bc2cff0..8fdd69b47da 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -1642,6 +1642,7 @@ textual parts.") (setq nnimap-status-string "Read-only server") nil) +(defvar gnus-refer-thread-use-nnir) ; gnus-sum (declare-function gnus-fetch-headers "gnus-sum" (articles &optional limit force-new dependencies)) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index cf5a813c5a8..120149ae0fb 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -29,10 +29,6 @@ ;;; Commentary: -;; TODO: Documentation in the Gnus manual - -;; Where in the existing gnus manual would this fit best? - ;; What does it do? Well, it allows you to search your mail using ;; some search engine (imap, namazu, swish-e, gmane and others -- see ;; later) by typing `G G' in the Group buffer. You will then get a @@ -136,17 +132,26 @@ ;; other backend. ;; The interface between the two layers consists of the single -;; function `nnir-run-query', which just selects the appropriate -;; function for the search engine one is using. The input to -;; `nnir-run-query' is a string, representing the query as input by -;; the user. The output of `nnir-run-query' is supposed to be a -;; vector, each element of which should in turn be a three-element -;; vector. The first element should be full group name of the article, -;; the second element should be the article number, and the third -;; element should be the Retrieval Status Value (RSV) as returned from -;; the search engine. An RSV is the score assigned to the document by -;; the search engine. For Boolean search engines, the -;; RSV is always 1000 (or 1 or 100, or whatever you like). +;; function `nnir-run-query', which dispatches the search to the +;; proper search function. The argument of `nnir-run-query' is an +;; alist with two keys: 'nnir-query-spec and 'nnir-group-spec. The +;; value for 'nnir-query-spec is an alist. The only required key/value +;; pair is (query . "query") specifying the search string to pass to +;; the query engine. Individual engines may have other elements. The +;; value of 'nnir-group-spec is a list with the specification of the +;; groups/servers to search. The format of the 'nnir-group-spec is +;; (("server1" ("group11" "group12")) ("server2" ("group21" +;; "group22"))). If any of the group lists is absent then all groups +;; on that server are searched. + +;; The output of `nnir-run-query' is supposed to be a vector, each +;; element of which should in turn be a three-element vector. The +;; first element should be full group name of the article, the second +;; element should be the article number, and the third element should +;; be the Retrieval Status Value (RSV) as returned from the search +;; engine. An RSV is the score assigned to the document by the search +;; engine. For Boolean search engines, the RSV is always 1000 (or 1 +;; or 100, or whatever you like). ;; The sorting order of the articles in the summary buffer created by ;; nnir is based on the order of the articles in the above mentioned @@ -179,26 +184,21 @@ ;;; Internal Variables: -(defvar nnir-current-query nil - "Internal: stores current query (= group name).") +(defvar nnir-memo-query nil + "Internal: stores current query.") -(defvar nnir-current-server nil - "Internal: stores current server (does it ever change?).") - -(defvar nnir-current-group-marked nil - "Internal: stores current list of process-marked groups.") +(defvar nnir-memo-server nil + "Internal: stores current server.") (defvar nnir-artlist nil "Internal: stores search result.") -(defvar nnir-tmp-buffer " *nnir*" - "Internal: temporary buffer.") - (defvar nnir-search-history () "Internal: the history for querying search options in nnir") -(defvar nnir-extra-parms nil - "Internal: stores request for extra search parms") +(defconst nnir-tmp-buffer " *nnir*" + "Internal: temporary buffer.") + ;; Imap variables @@ -290,14 +290,14 @@ is `(valuefunc member)'." (autoload 'nnimap-command "nnimap") (autoload 'nnimap-possibly-change-group "nnimap") (autoload 'nnimap-make-thread-query "nnimap") - (autoload 'gnus-registry-action "gnus-registry")) + (autoload 'gnus-registry-action "gnus-registry") + (autoload 'gnus-registry-get-id-key "gnus-registry") + (autoload 'gnus-group-topic-name "gnus-topic")) + (nnoo-declare nnir) (nnoo-define-basics nnir) -(defvoo nnir-address nil - "The address of the nnir server.") - (gnus-declare-backend "nnir" 'mail 'virtual) @@ -326,7 +326,7 @@ with three items unique to nnir summary buffers: If nil this will use `gnus-summary-line-format'." :version "24.1" - :type '(string) + :type '(choice (const :tag "gnus-summary-line-format" nil) string) :group 'nnir) (defcustom nnir-retrieve-headers-override-function nil @@ -338,13 +338,13 @@ retrieved header format. If this variable is nil, or if the provided function returns nil for a search result, `gnus-retrieve-headers' will be called instead." :version "24.1" - :type '(function) + :type '(choice (const :tag "gnus-retrieve-headers" nil) function) :group 'nnir) (defcustom nnir-imap-default-search-key "whole message" "*The default IMAP search key for an nnir search. Must be one of the keys in `nnir-imap-search-arguments'. To use raw imap queries - by default set this to \"Imap\"." + by default set this to \"imap\"." :version "24.1" :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem))) nnir-imap-search-arguments)) @@ -546,17 +546,17 @@ that it is for notmuch, not Namazu." ,nnir-imap-default-search-key ; default ))) (gmane nnir-run-gmane - ((author . "Gmane Author: "))) + ((gmane-author . "Gmane Author: "))) (swish++ nnir-run-swish++ - ((group . "Swish++ Group spec: "))) + ((swish++-group . "Swish++ Group spec: "))) (swish-e nnir-run-swish-e - ((group . "Swish-e Group spec: "))) + ((swish-e-group . "Swish-e Group spec: "))) (namazu nnir-run-namazu ()) (notmuch nnir-run-notmuch ()) (hyrex nnir-run-hyrex - ((group . "Hyrex Group spec: "))) + ((hyrex-group . "Hyrex Group spec: "))) (find-grep nnir-run-find-grep ((grep-options . "Grep options: ")))) "Alist of supported search engines. @@ -576,69 +576,111 @@ needs the variables `nnir-namazu-program', Add an entry here when adding a new search engine.") -(defcustom nnir-method-default-engines - '((nnimap . imap) - (nntp . gmane)) +(defcustom nnir-method-default-engines '((nnimap . imap) (nntp . gmane)) "*Alist of default search engines keyed by server method." :version "24.1" - :type `(repeat (cons (choice (const nnimap) (const nttp) (const nnspool) + :group 'nnir + :type `(repeat (cons (choice (const nnimap) (const nntp) (const nnspool) (const nneething) (const nndir) (const nnmbox) (const nnml) (const nnmh) (const nndraft) (const nnfolder) (const nnmaildir)) (choice ,@(mapcar (lambda (elem) (list 'const (car elem))) - nnir-engines)))) - :group 'nnir) + nnir-engines))))) ;; Gnus glue. -(defun gnus-group-make-nnir-group (nnir-extra-parms &optional parms) - "Create an nnir group. Asks for query." +(defun gnus-group-make-nnir-group (nnir-extra-parms &optional specs) + "Create an nnir group. Prompt for a search query and determine +the groups to search as follows: if called from the *Server* +buffer search all groups belonging to the server on the current +line; if called from the *Group* buffer search any marked groups, +or the group on the current line, or all the groups under the +current topic. Calling with a prefix-arg prompts for additional +search-engine specific constraints. A non-nil `specs' arg must be +an alist with `nnir-query-spec' and `nnir-group-spec' keys, and +skips all prompting." (interactive "P") - (setq nnir-current-query nil - nnir-current-server nil - nnir-current-group-marked nil - nnir-artlist nil) - (let* ((query (unless parms (read-string "Query: " nil 'nnir-search-history))) - (parms (or parms (list (cons 'query query)))) - (srv (or (cdr (assq 'server parms)) (gnus-server-server-name) "nnir"))) - (add-to-list 'parms (cons 'unique-id (message-unique-id)) t) + (let* ((group-spec + (or (cdr (assq 'nnir-group-spec specs)) + (if (gnus-server-server-name) + (list (list (gnus-server-server-name))) + (nnir-categorize + (or gnus-group-marked + (if (gnus-group-group-name) + (list (gnus-group-group-name)) + (cdr (assoc (gnus-group-topic-name) gnus-topic-alist)))) + gnus-group-server)))) + (query-spec + (or (cdr (assq 'nnir-query-spec specs)) + (apply + 'append + (list (cons 'query + (read-string "Query: " nil 'nnir-search-history))) + (when nnir-extra-parms + (mapcar + (lambda (x) + (nnir-read-parms (nnir-server-to-search-engine (car x)))) + group-spec)))))) (gnus-group-read-ephemeral-group - (concat "nnir:" (prin1-to-string parms)) (list 'nnir srv) t - (cons (current-buffer) gnus-current-window-configuration) - nil))) + (concat "nnir-" (message-unique-id)) + (list 'nnir "nnir") + nil +; (cons (current-buffer) gnus-current-window-configuration) + nil + nil nil + (list + (cons 'nnir-specs (list (cons 'nnir-query-spec query-spec) + (cons 'nnir-group-spec group-spec))) + (cons 'nnir-artlist nil))))) + +(defun gnus-summary-make-nnir-group (nnir-extra-parms) + "Search a group from the summary buffer." + (interactive "P") + (gnus-warp-to-article) + (let ((spec + (list + (cons 'nnir-group-spec + (list (list + (gnus-group-server gnus-newsgroup-name) + (list gnus-newsgroup-name))))))) + (gnus-group-make-nnir-group nnir-extra-parms spec))) ;; Gnus backend interface functions. (deffoo nnir-open-server (server &optional definitions) ;; Just set the server variables appropriately. - (add-hook 'gnus-summary-mode-hook 'nnir-mode) - (nnoo-change-server 'nnir server definitions)) - -(deffoo nnir-request-group (group &optional server fast info) - "GROUP is the query string." - (nnir-possibly-change-server server) - ;; Check for cache and return that if appropriate. - (if (and (equal group nnir-current-query) - (equal gnus-group-marked nnir-current-group-marked) - (or (null server) - (equal server nnir-current-server))) - nnir-artlist - ;; Cache miss. - (setq nnir-artlist (nnir-run-query group))) - (with-current-buffer nntp-server-buffer - (setq nnir-current-query group) - (when server (setq nnir-current-server server)) - (setq nnir-current-group-marked gnus-group-marked) - (if (zerop (length nnir-artlist)) - (nnheader-report 'nnir "Search produced empty results.") - ;; Remember data for cache. - (nnheader-insert "211 %d %d %d %s\n" - (nnir-artlist-length nnir-artlist) ; total # - 1 ; first # - (nnir-artlist-length nnir-artlist) ; last # - group)))) ; group name + (let ((backend (car (gnus-server-to-method server)))) + (if backend + (nnoo-change-server backend server definitions) + (add-hook 'gnus-summary-mode-hook 'nnir-mode) + (nnoo-change-server 'nnir server definitions)))) + +(deffoo nnir-request-group (group &optional server dont-check info) + (nnir-possibly-change-group group server) + (let ((pgroup (gnus-group-guess-full-name-from-command-method group)) + length) + ;; Check for cached search result or run the query and cache the + ;; result. + (unless (and nnir-artlist dont-check) + (gnus-group-set-parameter + pgroup 'nnir-artlist + (setq nnir-artlist + (nnir-run-query + (gnus-group-get-parameter pgroup 'nnir-specs t)))) + (nnir-request-update-info pgroup (gnus-get-info pgroup))) + (with-current-buffer nntp-server-buffer + (if (zerop (setq length (nnir-artlist-length nnir-artlist))) + (progn + (nnir-close-group group) + (nnheader-report 'nnir "Search produced empty results.")) + (nnheader-insert "211 %d %d %d %s\n" + length ; total # + 1 ; first # + length ; last # + group)))) ; group name + nnir-artlist) (deffoo nnir-retrieve-headers (articles &optional group server fetch-old) (with-current-buffer nntp-server-buffer @@ -654,13 +696,7 @@ Add an entry here when adding a new search engine.") (server (gnus-group-server artgroup)) (gnus-override-method (gnus-server-to-method server)) parsefunc) - ;; (or (numberp art) - ;; (nnheader-report - ;; 'nnir - ;; "nnir-retrieve-headers doesn't grok message ids: %s" - ;; art)) - (nnir-possibly-change-server server) - ;; is this needed? + ;; (nnir-possibly-change-group nil server) (erase-buffer) (case (setq gnus-headers-retrieved-by (or @@ -694,6 +730,7 @@ Add an entry here when adding a new search engine.") 'nov))) (deffoo nnir-request-article (article &optional group server to-buffer) + (nnir-possibly-change-group group server) (if (and (stringp article) (not (eq 'nnimap (car (gnus-server-to-method server))))) (nnheader-report @@ -702,35 +739,35 @@ Add an entry here when adding a new search engine.") server) (save-excursion (let ((article article) - query) - (when (stringp article) - (setq gnus-override-method (gnus-server-to-method server)) - (setq query - (list - (cons 'query (format "HEADER Message-ID %s" article)) - (cons 'unique-id article) - (cons 'criteria "") - (cons 'shortcut t))) - (unless (and (equal query nnir-current-query) - (equal server nnir-current-server)) - (setq nnir-artlist (nnir-run-imap query server)) - (setq nnir-current-query query) - (setq nnir-current-server server)) - (setq article 1)) - (unless (zerop (length nnir-artlist)) - (let ((artfullgroup (nnir-article-group article)) - (artno (nnir-article-number article))) - (message "Requesting article %d from group %s" - artno artfullgroup) - (if to-buffer - (with-current-buffer to-buffer - (let ((gnus-article-decode-hook nil)) - (gnus-request-article-this-buffer artno artfullgroup))) - (gnus-request-article artno artfullgroup)) - (cons artfullgroup artno))))))) + query) + (when (stringp article) + (setq gnus-override-method (gnus-server-to-method server)) + (setq query + (list + (cons 'query (format "HEADER Message-ID %s" article)) + (cons 'criteria "") + (cons 'shortcut t))) + (unless (and nnir-artlist (equal query nnir-memo-query) + (equal server nnir-memo-server)) + (setq nnir-artlist (nnir-run-imap query server) + nnir-memo-query query + nnir-memo-server server)) + (setq article 1)) + (unless (zerop (nnir-artlist-length nnir-artlist)) + (let ((artfullgroup (nnir-article-group article)) + (artno (nnir-article-number article))) + (message "Requesting article %d from group %s" + artno artfullgroup) + (if to-buffer + (with-current-buffer to-buffer + (let ((gnus-article-decode-hook nil)) + (gnus-request-article-this-buffer artno artfullgroup))) + (gnus-request-article artno artfullgroup)) + (cons artfullgroup artno))))))) (deffoo nnir-request-move-article (article group server accept-form &optional last internal-move-group) + (nnir-possibly-change-group group server) (let* ((artfullgroup (nnir-article-group article)) (artno (nnir-article-number article)) (to-newsgroup (nth 1 accept-form)) @@ -751,6 +788,7 @@ Add an entry here when adding a new search engine.") (gnus-group-real-name to-newsgroup))))) (deffoo nnir-request-expire-articles (articles group &optional server force) + (nnir-possibly-change-group group server) (if force (let ((articles-by-group (nnir-categorize articles nnir-article-group nnir-article-ids)) @@ -772,22 +810,103 @@ Add an entry here when adding a new search engine.") articles)) (deffoo nnir-warp-to-article () + (nnir-possibly-change-group gnus-newsgroup-name) (let* ((cur (if (> (gnus-summary-article-number) 0) (gnus-summary-article-number) - (error "This is not a real article"))) + (error "Can't warp to a pseudo-article"))) (backend-article-group (nnir-article-group cur)) (backend-article-number (nnir-article-number cur)) (quit-config (gnus-ephemeral-group-p gnus-newsgroup-name))) - ;; first exit from the nnir summary buffer. - (gnus-summary-exit) + + ;; what should we do here? we could leave all the buffers around + ;; and assume that we have to exit from them one by one. or we can + ;; try to clean up directly + + ;;first exit from the nnir summary buffer. +; (gnus-summary-exit) ;; and if the nnir summary buffer in turn came from another ;; summary buffer we have to clean that summary up too. - (when (eq (cdr quit-config) 'summary) - (gnus-summary-exit)) + ; (when (not (eq (cdr quit-config) 'group)) +; (gnus-summary-exit)) (gnus-summary-read-group-1 backend-article-group t t nil - nil (list backend-article-number)))) + nil (list backend-article-number)))) + +(deffoo nnir-request-update-mark (group article mark) + (let ((artgroup (nnir-article-group article)) + (artnumber (nnir-article-number article))) + (gnus-request-update-mark artgroup artnumber mark))) + +(deffoo nnir-request-set-mark (group actions &optional server) + (nnir-possibly-change-group group server) + (let (mlist) + (dolist (action actions) + (destructuring-bind (range action marks) action + (let ((articles-by-group (nnir-categorize + (gnus-uncompress-range range) + nnir-article-group nnir-article-number))) + (dolist (artgroup articles-by-group) + (push (list + (car artgroup) + (list (gnus-compress-sequence + (sort (cadr artgroup) '<)) action marks)) mlist))))) + (dolist (request (nnir-categorize mlist car cadr)) + (gnus-request-set-mark (car request) (cadr request))))) + + +(deffoo nnir-request-update-info (group info &optional server) + (nnir-possibly-change-group group server) + ;; clear out all existing marks. + (gnus-info-set-marks info nil) + (gnus-info-set-read info nil) + (let ((group (gnus-group-guess-full-name-from-command-method group)) + (articles-by-group + (nnir-categorize + (gnus-uncompress-range (cons 1 (nnir-artlist-length nnir-artlist))) + nnir-article-group nnir-article-ids))) + (gnus-set-active group + (cons 1 (nnir-artlist-length nnir-artlist))) + (while (not (null articles-by-group)) + (let* ((group-articles (pop articles-by-group)) + (articleids (reverse (cadr group-articles))) + (group-info (gnus-get-info (car group-articles))) + (marks (gnus-info-marks group-info)) + (read (gnus-info-read group-info))) + (gnus-info-set-read + info + (gnus-add-to-range + (gnus-info-read info) + (delq nil + (mapcar + #'(lambda (art) + (when (gnus-member-of-range (cdr art) read) (car art))) + articleids)))) + (dolist (mark marks) + (destructuring-bind (type . range) mark + (gnus-add-marked-articles + group type + (delq nil + (mapcar + #'(lambda (art) + (when (gnus-member-of-range (cdr art) range) (car art))) + articleids))))))))) + + +(deffoo nnir-close-group (group &optional server) + (nnir-possibly-change-group group server) + (let ((pgroup (gnus-group-guess-full-name-from-command-method group))) + (when (and nnir-artlist (not (gnus-ephemeral-group-p pgroup))) + (gnus-group-set-parameter pgroup 'nnir-artlist nnir-artlist)) + (setq nnir-artlist nil) + (when (gnus-ephemeral-group-p pgroup) + (gnus-kill-ephemeral-group pgroup) + (setq gnus-ephemeral-servers + (delq (assq 'nnir gnus-ephemeral-servers) + gnus-ephemeral-servers))))) +;; (gnus-opened-servers-remove +;; (car (assoc '(nnir "nnir-ephemeral" (nnir-address "nnir")) +;; gnus-opened-servers)))) + -(nnoo-define-skeleton nnir) (defmacro nnir-add-result (dirnam artno score prefix server artlist) @@ -813,7 +932,7 @@ ready to be added to the list of search results." ;; remove trailing slash and, for nnmaildir, cur/new/tmp (setq dirnam (substring dirnam 0 - (if (string-match "^nnmaildir:" (gnus-group-server server)) + (if (string-match "\\`nnmaildir:" (gnus-group-server server)) -5 -1))) ;; Set group to dirnam without any leading dots or slashes, @@ -823,7 +942,7 @@ ready to be added to the list of search results." "[/\\]" "." t))) (vector (gnus-group-full-name group server) - (if (string-match "^nnmaildir:" (gnus-group-server server)) + (if (string-match "\\`nnmaildir:" (gnus-group-server server)) (nnmaildir-base-name-to-article-number (substring article 0 (string-match ":" article)) group nil) @@ -850,35 +969,36 @@ details on the language and supported extensions." (apply 'vconcat (catch 'found - (mapcar - (lambda (group) - (let (artlist) - (condition-case () - (when (nnimap-possibly-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))) - groups)))))) + (mapcar + #'(lambda (group) + (let (artlist) + (condition-case () + (when (nnimap-possibly-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))) + groups)))))) (defun nnir-imap-make-query (criteria qstring) "Parse the query string and criteria into an appropriate IMAP search @@ -1073,14 +1193,14 @@ Windows NT 4.0." (save-excursion (let ( (qstring (cdr (assq 'query query))) - (groupspec (cdr (assq 'group query))) + (groupspec (cdr (assq 'swish++-group query))) (prefix (nnir-read-server-parm 'nnir-swish++-remove-prefix server)) artlist ;; nnml-use-compressed-files might be any string, but probably this ;; is sufficient. Note that we can't only use the value of ;; nnml-use-compressed-files because old articles might have been ;; saved with a different value. - (article-pattern (if (string-match "^nnmaildir:" + (article-pattern (if (string-match "\\`nnmaildir:" (gnus-group-server server)) ":[0-9]+" "^[0-9]+\\(\\.[a-z0-9]+\\)?$")) @@ -1247,7 +1367,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." (defun nnir-run-hyrex (query server &optional group) (save-excursion (let ((artlist nil) - (groupspec (cdr (assq 'group query))) + (groupspec (cdr (assq 'hyrex-group query))) (qstring (cdr (assq 'query query))) (prefix (nnir-read-server-parm 'nnir-hyrex-remove-prefix server)) score artno dirnam) @@ -1323,7 +1443,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." ;; (when group ;; (error "The Namazu backend cannot search specific groups")) (save-excursion - (let ((article-pattern (if (string-match "^nnmaildir:" + (let ((article-pattern (if (string-match "\\`nnmaildir:" (gnus-group-server server)) ":[0-9]+" "^[0-9]+$")) @@ -1394,10 +1514,10 @@ actually)." (save-excursion (let ( (qstring (cdr (assq 'query query))) - (groupspec (cdr (assq 'group query))) + (groupspec (cdr (assq 'notmuch-group query))) (prefix (nnir-read-server-parm 'nnir-notmuch-remove-prefix server)) artlist - (article-pattern (if (string-match "^nnmaildir:" + (article-pattern (if (string-match "\\`nnmaildir:" (gnus-group-server server)) ":[0-9]+" "^[0-9]+$")) @@ -1467,24 +1587,23 @@ actually)." (directory (cadr (assoc sym (cddr method)))) (regexp (cdr (assoc 'query query))) (grep-options (cdr (assoc 'grep-options query))) - (grouplist (or grouplist (nnir-get-active server))) - artlist) + (grouplist (or grouplist (nnir-get-active server)))) (unless directory (error "No directory found in method specification of server %s" server)) (apply 'vconcat (mapcar (lambda (x) - (let ((group x)) + (let ((group x) + artlist) (message "Searching %s using find-grep..." (or group server)) (save-window-excursion (set-buffer (get-buffer-create nnir-tmp-buffer)) - (erase-buffer) (if (> gnus-verbose 6) (pop-to-buffer (current-buffer))) (cd directory) ; Using relative paths simplifies - ; postprocessing. + ; postprocessing. (let ((group (if (not group) "." @@ -1507,7 +1626,8 @@ actually)." (save-excursion (apply 'call-process "find" nil t - "find" group "-type" "f" "-name" "[0-9]*" "-exec" + "find" group "-maxdepth" "1" "-type" "f" + "-name" "[0-9]*" "-exec" "grep" `("-l" ,@(and grep-options (split-string grep-options "\\s-" t)) @@ -1557,8 +1677,8 @@ actually)." (error "Can't search non-gmane groups: %s" x))) groups " ")) (authorspec - (if (assq 'author query) - (format "author:%s" (cdr (assq 'author query))) "")) + (if (assq 'gmane-author query) + (format "author:%s" (cdr (assq 'gmane-author query))) "")) (search (format "%s %s %s" qstring groupspec authorspec)) (gnus-inhibit-demon t) @@ -1594,11 +1714,16 @@ actually)." ;;; Util Code: -(defun nnir-read-parms (query nnir-search-engine) +(defun gnus-nnir-group-p (group) + "Say whether GROUP is nnir or not." + (if (gnus-group-prefixed-p group) + (eq 'nnir (car (gnus-find-method-for-group group))) + (and group (string-match "^nnir" group)))) + +(defun nnir-read-parms (nnir-search-engine) "Reads additional search parameters according to `nnir-engines'." (let ((parmspec (caddr (assoc nnir-search-engine nnir-engines)))) - (append query - (mapcar 'nnir-read-parm parmspec)))) + (mapcar 'nnir-read-parm parmspec))) (defun nnir-read-parm (parmspec) "Reads a single search parameter. @@ -1612,46 +1737,23 @@ actually)." (cons sym (format (cdr mapping) result))) (cons sym (read-string prompt))))) -(autoload 'gnus-group-topic-name "gnus-topic") - -(defun nnir-run-query (query) - "Invoke appropriate search engine function (see `nnir-engines'). - If some groups were process-marked, run the query for each of the groups - and concat the results." - (let ((q (car (read-from-string query))) - (groups (if (not (string= "nnir" nnir-address)) - (list (list nnir-address)) - (nnir-categorize - (or gnus-group-marked - (if (gnus-group-group-name) - (list (gnus-group-group-name)) - (cdr (assoc (gnus-group-topic-name) - gnus-topic-alist)))) - gnus-group-server)))) - (apply 'vconcat - (mapcar - (lambda (x) - (let* ((server (car x)) - (nnir-search-engine - (or (nnir-read-server-parm 'nnir-search-engine - server t) - (cdr (assoc (car - (gnus-server-to-method server)) - nnir-method-default-engines)))) - search-func) - (setq search-func (cadr (assoc nnir-search-engine - nnir-engines))) - (if search-func - (funcall - search-func - (if nnir-extra-parms - (or (and (eq nnir-search-engine 'imap) - (assq 'criteria q) q) - (setq q (nnir-read-parms q nnir-search-engine))) - q) - server (cadr x)) - nil))) - groups)))) +(defun nnir-run-query (specs) + "Invoke appropriate search engine function (see `nnir-engines')." + (apply 'vconcat + (mapcar + (lambda (x) + (let* ((server (car x)) + (search-engine (nnir-server-to-search-engine server)) + (search-func (cadr (assoc search-engine nnir-engines)))) + (and search-func + (funcall search-func (cdr (assq 'nnir-query-spec specs)) + server (cadr x))))) + (cdr (assq 'nnir-group-spec specs))))) + +(defun nnir-server-to-search-engine (server) + (or (nnir-read-server-parm 'nnir-search-engine server t) + (cdr (assoc (car (gnus-server-to-method server)) + nnir-method-default-engines)))) (defun nnir-read-server-parm (key server &optional not-global) "Returns the parameter value corresponding to `key' for @@ -1663,36 +1765,43 @@ environment unless `not-global' is non-nil." ((and (not not-global) (boundp key)) (symbol-value key)) (t nil)))) +(defun nnir-possibly-change-group (group &optional server) + (or (not server) (nnir-server-opened server) (nnir-open-server server)) + (when (gnus-nnir-group-p group) + (setq nnir-artlist (gnus-group-get-parameter + (gnus-group-prefixed-name + (gnus-group-short-name group) '(nnir "nnir")) + 'nnir-artlist t)))) -(defun nnir-possibly-change-server (server) - (unless (and server (nnir-server-opened server)) - (nnir-open-server server))) - +(defun nnir-server-opened (&optional server) + (let ((backend (car (gnus-server-to-method server)))) + (nnoo-current-server-p (or backend 'nnir) server))) (defun nnir-search-thread (header) - "Make an nnir group based on the thread containing the article header" - (let ((parm (list - (cons 'query - (nnimap-make-thread-query header)) - (cons 'criteria "") - (cons 'server (gnus-method-to-server - (gnus-find-method-for-group - gnus-newsgroup-name)))))) - (gnus-group-make-nnir-group nil parm) + "Make an nnir group based on the thread containing the article +header. The current server will be searched. If the registry is +installed, the server that the registry reports the current +article came from is also searched." + (let* ((query + (list (cons 'query (nnimap-make-thread-query header)) + (cons 'criteria ""))) + (server + (list (list (gnus-method-to-server + (gnus-find-method-for-group gnus-newsgroup-name))))) + (registry-group (and + (gnus-bound-and-true-p 'gnus-registry-enabled) + (car (gnus-registry-get-id-key + (mail-header-id header) 'group)))) + (registry-server + (and registry-group + (gnus-method-to-server + (gnus-find-method-for-group registry-group))))) + (when registry-server (add-to-list 'server (list registry-server))) + (gnus-group-make-nnir-group nil (list + (cons 'nnir-query-spec query) + (cons 'nnir-group-spec server))) (gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header))))) -;; unused? -(defun nnir-artlist-groups (artlist) - "Returns a list of all groups in the given ARTLIST." - (let ((res nil) - (with-dups nil)) - ;; from each artitem, extract group component - (setq with-dups (mapcar 'nnir-artitem-group artlist)) - ;; remove duplicates from above - (mapc (function (lambda (x) (add-to-list 'res x))) - with-dups) - res)) - (defun nnir-get-active (srv) (let ((method (gnus-server-to-method srv)) groups) @@ -1757,6 +1866,53 @@ environment unless `not-global' is non-nil." (add-hook 'gnus-summary-article-expire-hook 'nnir-registry-action t t)))) +(defun gnus-summary-create-nnir-group () + (interactive) + (or (nnir-server-opened "") (nnir-open-server "nnir")) + (let ((name (gnus-read-group "Group name: ")) + (method '(nnir "")) + (pgroup + (gnus-group-guess-full-name-from-command-method gnus-newsgroup-name))) + (with-current-buffer gnus-group-buffer + (gnus-group-make-group + name method nil + (gnus-group-find-parameter pgroup))))) + + +(deffoo nnir-request-create-group (group &optional server args) + (message "Creating nnir group %s" group) + (let* ((group (gnus-group-prefixed-name group '(nnir "nnir"))) + (specs (assq 'nnir-specs args)) + (query-spec + (or (cdr (assq 'nnir-query-spec specs)) + (list (cons 'query + (read-string "Query: " nil 'nnir-search-history))))) + (group-spec + (or (cdr (assq 'nnir-group-spec specs)) + (list (list (read-string "Server: " nil nil))))) + (nnir-specs (list (cons 'nnir-query-spec query-spec) + (cons 'nnir-group-spec group-spec)))) + (gnus-group-set-parameter group 'nnir-specs nnir-specs) + (gnus-group-set-parameter + group 'nnir-artlist + (or (cdr (assq 'nnir-artlist args)) + (nnir-run-query nnir-specs))) + (nnir-request-update-info group (gnus-get-info group))) + t) + +(deffoo nnir-request-delete-group (group &optional force server) + t) + +(deffoo nnir-request-list (&optional server) + t) + +(deffoo nnir-request-scan (group method) + t) + +(deffoo nnir-request-close () + t) + +(nnoo-define-skeleton nnir) ;; The end. (provide 'nnir) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index a266567987d..5be449e9a6b 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -1952,9 +1952,13 @@ If TIME is nil, then return the cutoff time for oldness instead." ((and (equal header 'to-from) (or (string-match (cadr regexp-target-pair) from) (and (string-match (cadr regexp-target-pair) to) - (let ((rmail-dont-reply-to-names - (message-dont-reply-to-names))) - (equal (rmail-dont-reply-to from) ""))))) + (let* ((mail-dont-reply-to-names + (message-dont-reply-to-names)) + (rmail-dont-reply-to-names ; obsolete since 24.1 + mail-dont-reply-to-names)) + (equal (if (fboundp 'rmail-dont-reply-to) + (rmail-dont-reply-to from) + (mail-dont-reply-to from)) ""))))) (setq target (format-time-string (caddr regexp-target-pair) date))) ((and (not (equal header 'to-from)) (string-match (cadr regexp-target-pair) diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 74a693a9c61..7d33e511baa 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -63,17 +63,17 @@ (eval-and-compile (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) -(eval-and-compile - (require 'nnheader) - (require 'gnus) - (require 'gnus-util) - (require 'gnus-range) - (require 'gnus-start) - (require 'gnus-int) - (require 'message)) +(require 'nnheader) +(require 'gnus) +(require 'gnus-util) +(require 'gnus-range) +(require 'gnus-start) +(require 'gnus-int) +(require 'message) +(require 'nnmail) + (eval-when-compile - (require 'cl) - (require 'nnmail)) + (require 'cl)) (defconst nnmaildir-version "Gnus") diff --git a/lisp/gnus/registry.el b/lisp/gnus/registry.el index 9830fc30c98..37fe6440743 100644 --- a/lisp/gnus/registry.el +++ b/lisp/gnus/registry.el @@ -119,60 +119,59 @@ :type hash-table :documentation "The data hashtable."))) -(eval-and-compile - (defmethod initialize-instance :AFTER ((this registry-db) slots) - "Set value of data slot of THIS after initialization." - (with-slots (data tracker) this - (unless (member :data slots) - (setq data - (make-hash-table :size 10000 :rehash-size 2.0 :test 'equal))) - (unless (member :tracker slots) - (setq tracker (make-hash-table :size 100 :rehash-size 2.0))))) - - (defmethod registry-lookup ((db registry-db) keys) - "Search for KEYS in the registry-db THIS. +(defmethod initialize-instance :AFTER ((this registry-db) slots) + "Set value of data slot of THIS after initialization." + (with-slots (data tracker) this + (unless (member :data slots) + (setq data + (make-hash-table :size 10000 :rehash-size 2.0 :test 'equal))) + (unless (member :tracker slots) + (setq tracker (make-hash-table :size 100 :rehash-size 2.0))))) + +(defmethod registry-lookup ((db registry-db) keys) + "Search for KEYS in the registry-db THIS. Returns an alist of the key followed by the entry in a list, not a cons cell." - (let ((data (oref db :data))) - (delq nil - (mapcar - (lambda (k) - (when (gethash k data) - (list k (gethash k data)))) - keys)))) - - (defmethod registry-lookup-breaks-before-lexbind ((db registry-db) keys) - "Search for KEYS in the registry-db THIS. + (let ((data (oref db :data))) + (delq nil + (mapcar + (lambda (k) + (when (gethash k data) + (list k (gethash k data)))) + keys)))) + +(defmethod registry-lookup-breaks-before-lexbind ((db registry-db) keys) + "Search for KEYS in the registry-db THIS. Returns an alist of the key followed by the entry in a list, not a cons cell." - (let ((data (oref db :data))) - (delq nil - (loop for key in keys - when (gethash key data) - collect (list key (gethash key data)))))) - - (defmethod registry-lookup-secondary ((db registry-db) tracksym - &optional create) - "Search for TRACKSYM in the registry-db THIS. + (let ((data (oref db :data))) + (delq nil + (loop for key in keys + when (gethash key data) + collect (list key (gethash key data)))))) + +(defmethod registry-lookup-secondary ((db registry-db) tracksym + &optional create) + "Search for TRACKSYM in the registry-db THIS. When CREATE is not nil, create the secondary index hashtable if needed." - (let ((h (gethash tracksym (oref db :tracker)))) - (if h - h - (when create - (puthash tracksym - (make-hash-table :size 800 :rehash-size 2.0 :test 'equal) - (oref db :tracker)) - (gethash tracksym (oref db :tracker)))))) - - (defmethod registry-lookup-secondary-value ((db registry-db) tracksym val - &optional set) - "Search for TRACKSYM with value VAL in the registry-db THIS. + (let ((h (gethash tracksym (oref db :tracker)))) + (if h + h + (when create + (puthash tracksym + (make-hash-table :size 800 :rehash-size 2.0 :test 'equal) + (oref db :tracker)) + (gethash tracksym (oref db :tracker)))))) + +(defmethod registry-lookup-secondary-value ((db registry-db) tracksym val + &optional set) + "Search for TRACKSYM with value VAL in the registry-db THIS. When SET is not nil, set it for VAL (use t for an empty list)." - ;; either we're asked for creation or there should be an existing index - (when (or set (registry-lookup-secondary db tracksym)) - ;; set the entry if requested, - (when set - (puthash val (if (eq t set) '() set) - (registry-lookup-secondary db tracksym t))) - (gethash val (registry-lookup-secondary db tracksym))))) + ;; either we're asked for creation or there should be an existing index + (when (or set (registry-lookup-secondary db tracksym)) + ;; set the entry if requested, + (when set + (puthash val (if (eq t set) '() set) + (registry-lookup-secondary db tracksym t))) + (gethash val (registry-lookup-secondary db tracksym)))) (defun registry--match (mode entry check-list) ;; for all members @@ -194,166 +193,165 @@ When SET is not nil, set it for VAL (use t for an empty list)." (or found (registry--match mode entry (cdr-safe check-list)))))) -(eval-and-compile - (defmethod registry-search ((db registry-db) &rest spec) - "Search for SPEC across the registry-db THIS. +(defmethod registry-search ((db registry-db) &rest spec) + "Search for SPEC across the registry-db THIS. For example calling with :member '(a 1 2) will match entry '((a 3 1)). Calling with :all t (any non-nil value) will match all. Calling with :regex '\(a \"h.llo\") will match entry '((a \"hullo\" \"bye\"). The test order is to check :all first, then :member, then :regex." - (when db - (let ((all (plist-get spec :all)) - (member (plist-get spec :member)) - (regex (plist-get spec :regex))) - (loop for k being the hash-keys of (oref db :data) - using (hash-values v) - when (or - ;; :all non-nil returns all - all - ;; member matching - (and member (registry--match :member v member)) - ;; regex matching - (and regex (registry--match :regex v regex))) - collect k)))) - - (defmethod registry-delete ((db registry-db) keys assert &rest spec) - "Delete KEYS from the registry-db THIS. + (when db + (let ((all (plist-get spec :all)) + (member (plist-get spec :member)) + (regex (plist-get spec :regex))) + (loop for k being the hash-keys of (oref db :data) + using (hash-values v) + when (or + ;; :all non-nil returns all + all + ;; member matching + (and member (registry--match :member v member)) + ;; regex matching + (and regex (registry--match :regex v regex))) + collect k)))) + +(defmethod registry-delete ((db registry-db) keys assert &rest spec) + "Delete KEYS from the registry-db THIS. If KEYS is nil, use SPEC to do a search. Updates the secondary ('tracked') indices as well. With assert non-nil, errors out if the key does not exist already." - (let* ((data (oref db :data)) - (keys (or keys - (apply 'registry-search db spec))) - (tracked (oref db :tracked))) - - (dolist (key keys) - (let ((entry (gethash key data))) - (when assert - (assert entry nil - "Key %s does not exists in database" key)) - ;; clean entry from the secondary indices - (dolist (tr tracked) - ;; is this tracked symbol indexed? - (when (registry-lookup-secondary db tr) - ;; for every value in the entry under that key... - (dolist (val (cdr-safe (assq tr entry))) - (let* ((value-keys (registry-lookup-secondary-value - db tr val))) - (when (member key value-keys) - ;; override the previous value - (registry-lookup-secondary-value - db tr val - ;; with the indexed keys MINUS the current key - ;; (we pass t when the list is empty) - (or (delete key value-keys) t))))))) - (remhash key data))) - keys)) - - (defmethod registry-full ((db registry-db)) - "Checks if registry-db THIS is full." - (>= (registry-size db) - (oref db :max-hard))) - - (defmethod registry-insert ((db registry-db) key entry) - "Insert ENTRY under KEY into the registry-db THIS. -Updates the secondary ('tracked') indices as well. -Errors out if the key exists already." - - (assert (not (gethash key (oref db :data))) nil - "Key already exists in database") + (let* ((data (oref db :data)) + (keys (or keys + (apply 'registry-search db spec))) + (tracked (oref db :tracked))) + + (dolist (key keys) + (let ((entry (gethash key data))) + (when assert + (assert entry nil + "Key %s does not exists in database" key)) + ;; clean entry from the secondary indices + (dolist (tr tracked) + ;; is this tracked symbol indexed? + (when (registry-lookup-secondary db tr) + ;; for every value in the entry under that key... + (dolist (val (cdr-safe (assq tr entry))) + (let* ((value-keys (registry-lookup-secondary-value + db tr val))) + (when (member key value-keys) + ;; override the previous value + (registry-lookup-secondary-value + db tr val + ;; with the indexed keys MINUS the current key + ;; (we pass t when the list is empty) + (or (delete key value-keys) t))))))) + (remhash key data))) + keys)) + +(defmethod registry-size ((db registry-db)) + "Returns the size of the registry-db object THIS. +This is the key count of the :data slot." + (hash-table-count (oref db :data))) - (assert (not (registry-full db)) - nil - "registry max-hard size limit reached") +(defmethod registry-full ((db registry-db)) + "Checks if registry-db THIS is full." + (>= (registry-size db) + (oref db :max-hard))) - ;; store the entry - (puthash key entry (oref db :data)) +(defmethod registry-insert ((db registry-db) key entry) + "Insert ENTRY under KEY into the registry-db THIS. +Updates the secondary ('tracked') indices as well. +Errors out if the key exists already." - ;; store the secondary indices + (assert (not (gethash key (oref db :data))) nil + "Key already exists in database") + + (assert (not (registry-full db)) + nil + "registry max-hard size limit reached") + + ;; store the entry + (puthash key entry (oref db :data)) + + ;; store the secondary indices + (dolist (tr (oref db :tracked)) + ;; for every value in the entry under that key... + (dolist (val (cdr-safe (assq tr entry))) + (let* ((value-keys (registry-lookup-secondary-value db tr val))) + (pushnew key value-keys :test 'equal) + (registry-lookup-secondary-value db tr val value-keys)))) + entry) + +(defmethod registry-reindex ((db registry-db)) + "Rebuild the secondary indices of registry-db THIS." + (let ((count 0) + (expected (* (length (oref db :tracked)) (registry-size db)))) (dolist (tr (oref db :tracked)) - ;; for every value in the entry under that key... - (dolist (val (cdr-safe (assq tr entry))) - (let* ((value-keys (registry-lookup-secondary-value db tr val))) - (pushnew key value-keys :test 'equal) - (registry-lookup-secondary-value db tr val value-keys)))) - entry) - - (defmethod registry-reindex ((db registry-db)) - "Rebuild the secondary indices of registry-db THIS." - (let ((count 0) - (expected (* (length (oref db :tracked)) (registry-size db)))) - (dolist (tr (oref db :tracked)) - (let (values) - (maphash - (lambda (key v) - (incf count) - (when (and (< 0 expected) - (= 0 (mod count 1000))) - (message "reindexing: %d of %d (%.2f%%)" - count expected (/ (* 100 count) expected))) - (dolist (val (cdr-safe (assq tr v))) - (let* ((value-keys (registry-lookup-secondary-value db tr val))) - (push key value-keys) - (registry-lookup-secondary-value db tr val value-keys)))) - (oref db :data)))))) - - (defmethod registry-size ((db registry-db)) - "Returns the size of the registry-db object THIS. -This is the key count of the :data slot." - (hash-table-count (oref db :data))) - - (defmethod registry-prune ((db registry-db) &optional sortfun) - "Prunes the registry-db object THIS. + (let (values) + (maphash + (lambda (key v) + (incf count) + (when (and (< 0 expected) + (= 0 (mod count 1000))) + (message "reindexing: %d of %d (%.2f%%)" + count expected (/ (* 100 count) expected))) + (dolist (val (cdr-safe (assq tr v))) + (let* ((value-keys (registry-lookup-secondary-value db tr val))) + (push key value-keys) + (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. + (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." - (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. + (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)))) + (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))) (provide 'registry) ;;; registry.el ends here diff --git a/lisp/gnus/shr-color.el b/lisp/gnus/shr-color.el index 91b2cf79a1e..21f1fc4f004 100644 --- a/lisp/gnus/shr-color.el +++ b/lisp/gnus/shr-color.el @@ -36,14 +36,14 @@ (defcustom shr-color-visible-luminance-min 40 "Minimum luminance distance between two colors to be considered visible. Must be between 0 and 100." - :group 'shr - :type 'float) + :group 'shr-color + :type 'number) (defcustom shr-color-visible-distance-min 5 "Minimum color distance between two colors to be considered visible. This value is used to compare result for `ciede2000'. It's an absolute value without any unit." - :group 'shr + :group 'shr-color :type 'integer) (defconst shr-color-html-colors-alist diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index 5df5297ba8a..9284da4c4b3 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el @@ -52,7 +52,7 @@ fit these criteria." "Images that have URLs matching this regexp will be blocked." :version "24.1" :group 'shr - :type 'regexp) + :type '(choice (const nil) regexp)) (defcustom shr-table-horizontal-line ?\s "Character used to draw horizontal table lines." @@ -593,6 +593,17 @@ size, and full-buffer size." (put-text-property start (point) type value)))))))))) (kill-buffer image-buffer))) +(defun shr-image-from-data (data) + "Return an image from the data: URI content DATA." + (when (string-match + "\\(\\([^/;,]+\\(/[^;,]+\\)?\\)\\(;[^;,]+\\)*\\)?,\\(.*\\)" + data) + (let ((param (match-string 4 data)) + (payload (url-unhex-string (match-string 5 data)))) + (when (string-match "^.*\\(;[ \t]*base64\\)$" param) + (setq payload (base64-decode-string payload))) + payload))) + (defun shr-put-image (data alt &optional flags) "Put image DATA with a string ALT. Return image." (if (display-graphic-p) @@ -620,12 +631,13 @@ size, and full-buffer size." (overlay-put overlay 'face 'default))) (insert-image image (or alt "*"))) (put-text-property start (point) 'image-size size) - (when (if (fboundp 'image-multi-frame-p) - ;; Only animate multi-frame things that specify a - ;; delay; eg animated gifs as opposed to - ;; multi-page tiffs. FIXME? - (cdr (image-multi-frame-p image)) - (image-animated-p image)) + (when (cond ((fboundp 'image-multi-frame-p) + ;; Only animate multi-frame things that specify a + ;; delay; eg animated gifs as opposed to + ;; multi-page tiffs. FIXME? + (cdr (image-multi-frame-p image))) + ((fboundp 'image-animated-p) + (image-animated-p image))) (image-animate image nil 60))) image) (insert alt))) @@ -983,6 +995,12 @@ ones, in case fg and bg are nil." ;; Ignore zero-sized or single-pixel images. ) ((and (not shr-inhibit-images) + (string-match "\\`data:" url)) + (let ((image (shr-image-from-data (substring url (match-end 0))))) + (if image + (funcall shr-put-image-function image alt) + (insert alt)))) + ((and (not shr-inhibit-images) (string-match "\\`cid:" url)) (let ((url (substring url (match-end 0))) image) @@ -1071,6 +1089,14 @@ ones, in case fg and bg are nil." (shr-indent)) (shr-generic cont)) +(defun shr-tag-span (cont) + (let ((title (cdr (assq :title cont)))) + (shr-generic cont) + (when title + (when shr-start + (let ((overlay (shr-make-overlay shr-start (point)))) + (overlay-put overlay 'help-echo title)))))) + (defun shr-tag-h1 (cont) (shr-heading cont 'bold 'underline)) diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el index 22c1f7036bf..b96261764e5 100644 --- a/lisp/gnus/sieve-manage.el +++ b/lisp/gnus/sieve-manage.el @@ -149,9 +149,10 @@ the server support the authenticator and AUTHENTICATE is a function for doing the actual authentication." :group 'sieve-manage) -(defcustom sieve-manage-default-port 2000 +(defcustom sieve-manage-default-port "sieve" "Default port number or service name for managesieve protocol." - :type 'integer + :type '(choice integer string) + :version "24.4" :group 'sieve-manage) (defcustom sieve-manage-default-stream 'network diff --git a/lisp/gnus/sieve.el b/lisp/gnus/sieve.el index 71a4a7905a8..0e46cb66361 100644 --- a/lisp/gnus/sieve.el +++ b/lisp/gnus/sieve.el @@ -257,7 +257,7 @@ Used to bracket operations which move point in the sieve-buffer." (erase-buffer) (buffer-disable-undo) (insert "\ -Server : " server ":" (or port "2000") " +Server : " server ":" (or port sieve-manage-default-port) " ") (set (make-local-variable 'sieve-buffer-header-end) diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el index 06aae2906ca..24e1ca7bdab 100644 --- a/lisp/gnus/spam-report.el +++ b/lisp/gnus/spam-report.el @@ -81,7 +81,7 @@ The function must accept the arguments `host' and `report'." "Email address that spam articles are resent to when reporting. If not set, the user will be prompted to enter a value which will be saved for future use." - :type 'string + :type '(choice (const :tag "Prompt" nil) string) :group 'spam-report) (defvar spam-report-url-ping-temp-agent-function nil diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el index d75e8198842..135bfd48e5f 100644 --- a/lisp/gnus/spam-stat.el +++ b/lisp/gnus/spam-stat.el @@ -412,8 +412,7 @@ With a prefix argument save unconditionally." (when (or force spam-stat-dirty) (let ((coding-system-for-write spam-stat-coding-system)) (with-temp-file spam-stat-file - (let ((standard-output (current-buffer)) - (font-lock-maximum-size 0)) + (let ((standard-output (current-buffer))) (insert (format ";-*- coding: %s; -*-\n" spam-stat-coding-system)) (insert (format "(setq spam-stat-ngood %d spam-stat-nbad %d spam-stat (spam-stat-to-hash-table '(" spam-stat-ngood spam-stat-nbad)) diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index 063ba28d6eb..8d689bf26bd 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -50,7 +50,6 @@ ;;; for the definitions of group content classification and spam processors (require 'gnus) -(eval-when-compile (require 'spam-report)) (eval-when-compile (require 'hashcash)) ;; for nnimap-split-download-body-default @@ -60,11 +59,10 @@ (autoload 'query-dig "dig") ;; autoload spam-report -(eval-and-compile - (autoload 'spam-report-gmane "spam-report") - (autoload 'spam-report-gmane-spam "spam-report") - (autoload 'spam-report-gmane-ham "spam-report") - (autoload 'spam-report-resend "spam-report")) +(autoload 'spam-report-gmane "spam-report") +(autoload 'spam-report-gmane-spam "spam-report") +(autoload 'spam-report-gmane-ham "spam-report") +(autoload 'spam-report-resend "spam-report") ;; autoload gnus-registry (autoload 'gnus-registry-group-count "gnus-registry") @@ -94,14 +92,14 @@ Note that setting the `spam-use-move' or `spam-use-copy' backends on a group through group/topic parameters overrides this mechanism." :type '(choice (const - 'default - :tag "Move spam out of all groups and ham out of spam groups.") + :tag "Move spam out of all groups and ham out of spam groups" + default) (const - 'move-all - :tag "Move spam out of all groups and ham out of all groups.") + :tag "Move spam out of all groups and ham out of all groups" + move-all) (const - 'move-none - :tag "Never move spam or ham out of any groups.")) + :tag "Never move spam or ham out of any groups" + move-none)) :group 'spam) (defcustom spam-directory (nnheader-concat gnus-directory "spam/") @@ -2473,7 +2471,10 @@ With a non-nil REMOVE, remove the ADDRESSES." (defun spam-report-resend-register-ham-routine (articles) (spam-report-resend-register-routine articles t)) +(defvar spam-report-resend-to) + (defun spam-report-resend-register-routine (articles &optional ham) + (require 'spam-report) (let* ((resend-to-gp (if ham (gnus-parameter-ham-resend-to gnus-newsgroup-name) diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 38e5e8acb15..d0a82cd97b0 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -37,18 +37,18 @@ ;; ;; In program source code highlight a variable to quickly see all ;; places it is modified or referenced: -;; M-x highlight-regexp ground_contact_switches_closed RET RET +;; M-x highlight-regexp RET ground_contact_switches_closed RET RET ;; ;; In a shell or other buffer that is showing lots of program ;; output, highlight the parts of the output you're interested in: -;; M-x highlight-regexp Total execution time [0-9]+ RET hi-blue-b RET +;; M-x highlight-regexp RET Total execution time [0-9]+ RET hi-blue-b RET ;; ;; In buffers displaying tables, highlight the lines you're interested in: -;; M-x highlight-lines-matching-regexp January 2000 RET hi-black-b RET +;; M-x highlight-lines-matching-regexp RET January 2000 RET hi-black-b RET ;; ;; When writing text, highlight personal cliches. This can be ;; amusing. -;; M-x highlight-phrase as can be seen RET RET +;; M-x highlight-phrase RET as can be seen RET RET ;; ;; Setup: ;; @@ -252,6 +252,10 @@ a library is being loaded.") '(menu-item "Highlight Lines..." highlight-lines-matching-regexp :help "Highlight lines containing match of PATTERN (a regexp).")) + (define-key-after map [highlight-symbol-at-point] + '(menu-item "Highlight Symbol at Point" highlight-symbol-at-point + :help "Highlight symbol found near point without prompting.")) + (define-key-after map [unhighlight-regexp] '(menu-item "Remove Highlighting..." unhighlight-regexp :help "Remove previously entered highlighting pattern." @@ -274,6 +278,7 @@ a library is being loaded.") (define-key map "\C-xwl" 'highlight-lines-matching-regexp) (define-key map "\C-xwp" 'highlight-phrase) (define-key map "\C-xwh" 'highlight-regexp) + (define-key map "\C-xw." 'highlight-symbol-at-point) (define-key map "\C-xwr" 'unhighlight-regexp) (define-key map "\C-xwb" 'hi-lock-write-interactive-patterns) map) @@ -333,6 +338,10 @@ which can be called interactively, are: \\[highlight-lines-matching-regexp] REGEXP FACE Highlight lines containing matches of REGEXP in current buffer with FACE. +\\[highlight-symbol-at-point] + Highlight the symbol found near point without prompting, using the next + available face automatically. + \\[unhighlight-regexp] REGEXP Remove highlighting on matches of REGEXP in current buffer. @@ -389,7 +398,9 @@ versions before 22 use the following in your init file: (define-key-after menu-bar-edit-menu [hi-lock] (cons "Regexp Highlighting" hi-lock-menu)) (hi-lock-find-patterns) - (add-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook nil t)) + (add-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook nil t) + ;; Remove regexps from font-lock-keywords (bug#13891). + (add-hook 'change-major-mode-hook (lambda () (hi-lock-mode -1)) nil t)) ;; Turned off. (when (or hi-lock-interactive-patterns hi-lock-file-patterns) @@ -488,6 +499,27 @@ highlighting will not update as you type." (unless hi-lock-mode (hi-lock-mode 1)) (hi-lock-set-pattern regexp face)) +;;;###autoload +(defalias 'highlight-symbol-at-point 'hi-lock-face-symbol-at-point) +;;;###autoload +(defun hi-lock-face-symbol-at-point () + "Set face of each match of the symbol at point. +Use `find-tag-default-as-regexp' to retrieve the symbol at point. +Use non-nil `hi-lock-auto-select-face' to retrieve the next face +from `hi-lock-face-defaults' automatically. + +Use Font lock mode, if enabled, to highlight symbol at point. +Otherwise, use overlays for highlighting. If overlays are used, +the highlighting will not update as you type." + (interactive) + (let* ((regexp (hi-lock-regexp-okay + (find-tag-default-as-regexp))) + (hi-lock-auto-select-face t) + (face (hi-lock-read-face-name))) + (or (facep face) (setq face 'hi-yellow)) + (unless hi-lock-mode (hi-lock-mode 1)) + (hi-lock-set-pattern regexp face))) + (defun hi-lock-keyword->face (keyword) (cadr (cadr (cadr keyword)))) ; Keyword looks like (REGEXP (0 'FACE) ...). diff --git a/lisp/ido.el b/lisp/ido.el index 589f44175eb..8087124765c 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -765,7 +765,7 @@ Obsolete. Set 3rd element of `ido-decorations' instead." (defcustom ido-decorations '( "{" "}" " | " " | ..." "[" "]" " [No match]" " [Matched]" " [Not readable]" " [Too big]" " [Confirm]") "List of strings used by ido to display the alternatives in the minibuffer. -There are 11 elements in this list: +There are between 11 and 13 elements in this list: 1st and 2nd elements are used as brackets around the prospect list, 3rd element is the separator between prospects (ignored if `ido-separator' is set), 4th element is the string inserted at the end of a truncated list of prospects, @@ -775,7 +775,9 @@ can be completed using TAB, 8th element is displayed if there is a single match (and faces are not used), 9th element is displayed when the current directory is non-readable, 10th element is displayed when directory exceeds `ido-max-directory-size', -11th element is displayed to confirm creating new file or buffer." +11th element is displayed to confirm creating new file or buffer. +12th and 13th elements (if present) are used as brackets around the sole +remaining completion. If absent, elements 5 and 6 are used instead." :type '(repeat string) :group 'ido) @@ -3783,7 +3785,7 @@ This is to make them appear as if they were \"virtual buffers\"." (if (string-match re name) (setq matches (cons item matches))))) items)) - matches)) + (delete-consecutive-dups matches t))) (defun ido-set-matches () @@ -4579,10 +4581,12 @@ For details of keybindings, see `ido-find-file'." (string-equal (match-string 0 (ido-name (car comps))) (ido-name (car comps)))) "" - ;; when there is one match, show the matching file name in full - (concat (nth 4 ido-decorations) ;; [ ... ] - (ido-name (car comps)) - (nth 5 ido-decorations))) + ;; When there is only one match, show the matching file + ;; name in full, wrapped in [ ... ]. + (concat + (or (nth 11 ido-decorations) (nth 4 ido-decorations)) + (ido-name (car comps)) + (or (nth 12 ido-decorations) (nth 5 ido-decorations)))) (if (not ido-use-faces) (nth 7 ido-decorations)))) ;; [Matched] (t ;multiple matches (let* ((items (if (> ido-max-prospects 0) (1+ ido-max-prospects) 999)) diff --git a/lisp/ielm.el b/lisp/ielm.el index d90800873a2..4280a49af6e 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el @@ -167,7 +167,7 @@ This variable is buffer-local.") (defvar ielm-map (let ((map (make-sparse-keymap))) - (define-key map "\t" 'comint-dynamic-complete) + (define-key map "\t" 'completion-at-point) (define-key map "\C-m" 'ielm-return) (define-key map "\C-j" 'ielm-send-input) (define-key map "\e\C-x" 'eval-defun) ; for consistency with @@ -184,6 +184,13 @@ This variable is buffer-local.") "Keymap for IELM mode.") (defvaralias 'inferior-emacs-lisp-mode-map 'ielm-map) +(easy-menu-define ielm-menu ielm-map + "IELM mode menu." + '("IELM" + ["Change Working Buffer" ielm-change-working-buffer t] + ["Display Working Buffer" ielm-display-working-buffer t] + ["Print Working Buffer" ielm-print-working-buffer t])) + (defvar ielm-font-lock-keywords '(("\\(^\\*\\*\\*[^*]+\\*\\*\\*\\)\\(.*$\\)" (1 font-lock-comment-face) @@ -202,12 +209,13 @@ This variable is buffer-local.") (defun ielm-complete-symbol nil "Complete the Lisp symbol before point." - ;; A wrapper for lisp-complete symbol that returns non-nil if + ;; A wrapper for completion-at-point that returns non-nil if ;; completion has occurred (let* ((btick (buffer-modified-tick)) (cbuffer (get-buffer "*Completions*")) - (ctick (and cbuffer (buffer-modified-tick cbuffer)))) - (lisp-complete-symbol) + (ctick (and cbuffer (buffer-modified-tick cbuffer))) + (completion-at-point-functions '(lisp-completion-at-point))) + (completion-at-point) ;; completion has occurred if: (or ;; the buffer has been modified @@ -454,7 +462,7 @@ Uses the interface provided by `comint-mode' (which see). Inputs longer than one line are moved to the line following the prompt (but see variable `ielm-dynamic-multiline-inputs'). -* \\[comint-dynamic-complete] completes Lisp symbols (or filenames, within strings), +* \\[completion-at-point] completes Lisp symbols (or filenames, within strings), or indents the line if there is nothing to complete. The current working buffer may be changed (with a call to `set-buffer', @@ -491,7 +499,7 @@ Customized bindings may be defined in `ielm-map', which currently contains: (set (make-local-variable 'paragraph-start) comint-prompt-regexp) (setq comint-input-sender 'ielm-input-sender) (setq comint-process-echoes nil) - (set (make-local-variable 'comint-dynamic-complete-functions) + (set (make-local-variable 'completion-at-point-functions) '(ielm-tab comint-replace-by-expanded-history ielm-complete-filename ielm-complete-symbol)) (set (make-local-variable 'ielm-prompt-internal) ielm-prompt) @@ -499,12 +507,13 @@ Customized bindings may be defined in `ielm-map', which currently contains: (setq comint-get-old-input 'ielm-get-old-input) (set (make-local-variable 'comint-completion-addsuffix) '("/" . "")) (setq mode-line-process '(":%s on " (:eval (buffer-name ielm-working-buffer)))) + ;; Useful for `hs-minor-mode'. + (setq-local comment-start ";") + (setq-local comment-use-global-state t) (set (make-local-variable 'indent-line-function) 'ielm-indent-line) (set (make-local-variable 'ielm-working-buffer) (current-buffer)) (set (make-local-variable 'fill-paragraph-function) 'lisp-fill-paragraph) - (add-hook 'completion-at-point-functions - 'lisp-completion-at-point nil 'local) ;; Value holders (set (make-local-variable '*) nil) diff --git a/lisp/image-mode.el b/lisp/image-mode.el index ac090f020b3..30dfd045b46 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -69,13 +69,17 @@ otherwise it defaults to t, used for times when the buffer is not displayed." image-mode-winprops-alist)))) (let ((winprops (assq window image-mode-winprops-alist))) ;; For new windows, set defaults from the latest. - (unless winprops + (if winprops + ;; Move window to front. + (setq image-mode-winprops-alist + (cons winprops (delq winprops image-mode-winprops-alist))) (setq winprops (cons window (copy-alist (cdar image-mode-winprops-alist)))) + ;; Add winprops before running the hook, to avoid inf-loops if the hook + ;; triggers window-configuration-change-hook. + (setq image-mode-winprops-alist + (cons winprops image-mode-winprops-alist)) (run-hook-with-args 'image-mode-new-window-functions winprops)) - ;; Move window to front. - (setq image-mode-winprops-alist - (cons winprops (delq winprops image-mode-winprops-alist))) winprops)) (defun image-mode-window-get (prop &optional winprops) @@ -100,13 +104,16 @@ otherwise it defaults to t, used for times when the buffer is not displayed." (defun image-mode-reapply-winprops () ;; When set-window-buffer, set hscroll and vscroll to what they were ;; last time the image was displayed in this window. - (when (and (image-get-display-property) - (listp image-mode-winprops-alist)) + (when (listp image-mode-winprops-alist) + ;; Beware: this call to image-mode-winprops can't be optimized away, + ;; because it not only gets the winprops data but sets it up if needed + ;; (e.g. it's used by doc-view to display the image in a new window). (let* ((winprops (image-mode-winprops nil t)) (hscroll (image-mode-window-get 'hscroll winprops)) (vscroll (image-mode-window-get 'vscroll winprops))) - (if hscroll (set-window-hscroll (selected-window) hscroll)) - (if vscroll (set-window-vscroll (selected-window) vscroll))))) + (when (image-get-display-property) ;Only do it if we display an image! + (if hscroll (set-window-hscroll (selected-window) hscroll)) + (if vscroll (set-window-vscroll (selected-window) vscroll)))))) (defun image-mode-setup-winprops () ;; Record current scroll settings. @@ -325,9 +332,8 @@ call." ;;; Image Mode setup -(defvar image-type nil +(defvar-local image-type nil "The image type for the current Image mode buffer.") -(make-variable-buffer-local 'image-type) (defvar-local image-multi-frame nil "Non-nil if image for the current Image mode buffer has multiple frames.") @@ -397,7 +403,6 @@ call." :help "Toggle image animation"] ["Loop Animation" (lambda () (interactive) -;;; (make-variable-buffer-local 'image-animate-loop) (setq image-animate-loop (not image-animate-loop)) ;; FIXME this is a hacky way to make it affect a currently ;; animating image. @@ -457,8 +462,8 @@ to toggle between display as an image and display as text." (use-local-map image-mode-map) ;; Use our own bookmarking function for images. - (set (make-local-variable 'bookmark-make-record-function) - 'image-bookmark-make-record) + (setq-local bookmark-make-record-function + #'image-bookmark-make-record) ;; Keep track of [vh]scroll when switching buffers (image-mode-setup-winprops) @@ -557,7 +562,7 @@ on these modes." elt)) magic-fallback-mode-alist)))) (normal-mode) - (set (make-local-variable 'image-mode-previous-major-mode) major-mode))) + (setq-local image-mode-previous-major-mode major-mode))) ;; Restore `image-type' after `kill-all-local-variables' in `normal-mode'. (setq image-type previous-image-type) ;; Enable image minor mode with `C-c C-c'. @@ -637,9 +642,9 @@ was inserted." ;; is written with, e.g., C-x C-w. (if (coding-system-equal (coding-system-base buffer-file-coding-system) 'no-conversion) - (set (make-local-variable 'find-file-literally) t)) - ;; Allow navigation of large images - (set (make-local-variable 'auto-hscroll-mode) nil) + (setq-local find-file-literally t)) + ;; Allow navigation of large images. + (setq-local auto-hscroll-mode nil) (setq image-type type) (if (eq major-mode 'image-mode) (setq mode-name (format "Image[%s]" type))) diff --git a/lisp/image.el b/lisp/image.el index ec7b41bf126..804dc3af5ea 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -624,7 +624,12 @@ in which case you might want to use `image-default-frame-delay'." (setq delay image-default-frame-delay)) (cons images delay)))) -(define-obsolete-function-alias 'image-animated-p 'image-multi-frame-p "24.4") +(defun image-animated-p (image) + "Like `image-multi-frame-p', but returns nil if no delay is specified." + (let ((multi (image-multi-frame-p image))) + (and (cdr multi) multi))) + +(make-obsolete 'image-animated-p 'image-multi-frame-p "24.4") ;; "Destructively"? (defun image-animate (image &optional index limit) diff --git a/lisp/info-look.el b/lisp/info-look.el index afe4301c659..e43cd731547 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -881,8 +881,11 @@ Return nil if there is nothing appropriate in the buffer near point." (info-lookup-maybe-add-help :mode 'latex-mode :regexp "\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)" - :doc-spec '(("(latex)Command Index" nil - "`" "\\({[^}]*}\\)?'"))) + :doc-spec `((,(if (Info-find-file "latex2e" t) + ;; From http://home.gna.org/latexrefman + "(latex2e)Command Index" + "(latex)Command Index") + nil "`" "\\({[^}]*}\\)?'"))) (info-lookup-maybe-add-help :mode 'emacs-lisp-mode diff --git a/lisp/info.el b/lisp/info.el index 3792857d47a..9dc312fc697 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -158,6 +158,12 @@ A header-line does not scroll with the rest of the buffer." "Face for Info nodes in a node header." :group 'info) +(defface info-index-match + '((t :inherit match)) + "Face used to highlight matches in an index entry." + :group 'info + :version "24.4") + ;; This is a defcustom largely so that we can get the benefit ;; of custom-initialize-delay. Perhaps it would work to make it a ;; defvar and explicitly give it a standard-value property, and @@ -1524,11 +1530,14 @@ a case-insensitive match is tried." ;; Widen in case we are in the same subfile as before. (widen) (goto-char (point-min)) + ;; Skip the summary segment for `Info-search'. (if (looking-at "\^_") (forward-char 1) (search-forward "\n\^_")) + ;; Don't add the length of the skipped summary segment to + ;; the value returned to `Info-find-node-2'. (Bug#14125) (if (numberp nodepos) - (+ (- nodepos lastfilepos) (point))))) + (+ (- nodepos lastfilepos) (point-min))))) (defun Info-unescape-quotes (value) "Unescape double quotes and backslashes in VALUE." @@ -1922,7 +1931,8 @@ If DIRECTION is `backward', search in the reverse direction." (point-max))) (while (and (not give-up) (or (null found) - (not (funcall isearch-filter-predicate beg-found found)))) + (not (run-hook-with-args-until-failure + 'isearch-filter-predicates beg-found found)))) (let ((search-spaces-regexp Info-search-whitespace-regexp)) (if (if backward (re-search-backward regexp bound t) @@ -2000,7 +2010,8 @@ If DIRECTION is `backward', search in the reverse direction." (setq give-up nil found nil) (while (and (not give-up) (or (null found) - (not (funcall isearch-filter-predicate beg-found found)))) + (not (run-hook-with-args-until-failure + 'isearch-filter-predicates beg-found found)))) (let ((search-spaces-regexp Info-search-whitespace-regexp)) (if (if backward (re-search-backward regexp nil t) @@ -3057,6 +3068,38 @@ See `Info-scroll-down'." (select-window (posn-window (event-start e)))) (Info-scroll-down))) +(defun Info-next-reference-or-link (pat prop) + "Move point to the next pattern-based cross-reference or property-based link. +The next cross-reference is searched using the regexp PAT, and the next link +is searched using the text property PROP. Move point to the closest found position +of either a cross-reference found by `re-search-forward' or a link found by +`next-single-char-property-change'. Return the new position of point, or nil." + (let ((pxref (save-excursion (re-search-forward pat nil t))) + (plink (next-single-char-property-change (point) prop))) + (when (and (< plink (point-max)) (not (get-char-property plink prop))) + (setq plink (next-single-char-property-change plink prop))) + (if (< plink (point-max)) + (if (and pxref (<= pxref plink)) + (goto-char (or (match-beginning 1) (match-beginning 0))) + (goto-char plink)) + (if pxref (goto-char (or (match-beginning 1) (match-beginning 0))))))) + +(defun Info-prev-reference-or-link (pat prop) + "Move point to the previous pattern-based cross-reference or property-based link. +The previous cross-reference is searched using the regexp PAT, and the previous link +is searched using the text property PROP. Move point to the closest found position +of either a cross-reference found by `re-search-backward' or a link found by +`previous-single-char-property-change'. Return the new position of point, or nil." + (let ((pxref (save-excursion (re-search-backward pat nil t))) + (plink (previous-single-char-property-change (point) prop))) + (when (and (> plink (point-min)) (not (get-char-property plink prop))) + (setq plink (previous-single-char-property-change plink prop))) + (if (> plink (point-min)) + (if (and pxref (>= pxref plink)) + (goto-char (or (match-beginning 1) (match-beginning 0))) + (goto-char plink)) + (if pxref (goto-char (or (match-beginning 1) (match-beginning 0))))))) + (defun Info-next-reference (&optional recur count) "Move cursor to the next cross-reference or menu item in the node. If COUNT is non-nil (interactively with a prefix arg), jump over @@ -3071,14 +3114,13 @@ COUNT cross-references." (old-pt (point)) (case-fold-search t)) (or (eobp) (forward-char 1)) - (or (re-search-forward pat nil t) + (or (Info-next-reference-or-link pat 'link) (progn (goto-char (point-min)) - (or (re-search-forward pat nil t) + (or (Info-next-reference-or-link pat 'link) (progn (goto-char old-pt) (user-error "No cross references in this node"))))) - (goto-char (or (match-beginning 1) (match-beginning 0))) (if (looking-at "\\* Menu:") (if recur (user-error "No cross references in this node") @@ -3099,14 +3141,13 @@ COUNT cross-references." (let ((pat "\\*note[ \n\t]+\\([^:]+\\):\\|^\\* .*:\\|[hf]t?tps?://") (old-pt (point)) (case-fold-search t)) - (or (re-search-backward pat nil t) + (or (Info-prev-reference-or-link pat 'link) (progn (goto-char (point-max)) - (or (re-search-backward pat nil t) + (or (Info-prev-reference-or-link pat 'link) (progn (goto-char old-pt) (user-error "No cross references in this node"))))) - (goto-char (or (match-beginning 1) (match-beginning 0))) (if (looking-at "\\* Menu:") (if recur (user-error "No cross references in this node") @@ -3246,7 +3287,7 @@ Give an empty topic name to go to the Index node itself." (= (aref topic 0) ?:)) (setq topic (substring topic 1))) (let ((orignode Info-current-node) - (pattern (format "\n\\* +\\([^\n]*%s[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" + (pattern (format "\n\\* +\\([^\n]*\\(%s\\)[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" (regexp-quote topic))) node (nodes (Info-index-nodes)) (ohist-list Info-history-list) @@ -3265,12 +3306,14 @@ Give an empty topic name to go to the Index node itself." (progn (goto-char (point-min)) (while (re-search-forward pattern nil t) - (push (list (match-string-no-properties 1) - (match-string-no-properties 2) - Info-current-node - (string-to-number (concat "0" - (match-string 3)))) - matches)) + (let ((entry (match-string-no-properties 1)) + (nodename (match-string-no-properties 3)) + (line (string-to-number (concat "0" (match-string 4))))) + (add-text-properties + (- (match-beginning 2) (match-beginning 1)) + (- (match-end 2) (match-beginning 1)) + '(face info-index-match) entry) + (push (list entry nodename Info-current-node line) matches))) (setq nodes (cdr nodes) node (car nodes))) (Info-goto-node node)) (or matches @@ -3496,7 +3539,7 @@ MATCHES is a list of index matches found by `Info-apropos-matches'.") Return a list of matches where each element is in the format \((FILENAME INDEXTEXT NODENAME LINENUMBER))." (unless (string= string "") - (let ((pattern (format "\n\\* +\\([^\n]*%s[^\n]*\\):[ \t]+\\([^\n]+\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" + (let ((pattern (format "\n\\* +\\([^\n]*\\(%s\\)[^\n]*\\):[ \t]+\\([^\n]+\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" (regexp-quote string))) (ohist Info-history) (ohist-list Info-history-list) @@ -3529,12 +3572,15 @@ Return a list of matches where each element is in the format (progn (goto-char (point-min)) (while (re-search-forward pattern nil t) - (setq matches - (cons (list manual - (match-string-no-properties 1) - (match-string-no-properties 2) - (match-string-no-properties 3)) - matches))) + (let ((entry (match-string-no-properties 1)) + (nodename (match-string-no-properties 3)) + (line (match-string-no-properties 4))) + (add-text-properties + (- (match-beginning 2) (match-beginning 1)) + (- (match-end 2) (match-beginning 1)) + '(face info-index-match) entry) + (setq matches (cons (list manual entry nodename line) + matches)))) (setq nodes (cdr nodes) node (car nodes))) (Info-goto-node node)))) (error @@ -3840,7 +3886,25 @@ If FORK is non-nil, it is passed to `Info-goto-node'." ((setq node (Info-get-token (point) "File: " "File: \\([^,\n\t]*\\)")) (Info-goto-node "Top" fork)) ((setq node (Info-get-token (point) "Prev: " "Prev: \\([^,\n\t]*\\)")) - (Info-goto-node node fork))) + (Info-goto-node node fork)) + ;; footnote + ((setq node (Info-get-token (point) "(" "\\(([0-9]+)\\)")) + (let ((old-point (point)) new-point) + (save-excursion + (goto-char (point-min)) + (when (re-search-forward "^[ \t]*-+ Footnotes -+$" nil t) + (setq new-point (if (< old-point (point)) + ;; Go to footnote reference + (and (search-forward node nil t) + ;; Put point at beginning of link + (match-beginning 0)) + ;; Go to footnote definition + (search-backward node nil t))))) + (if new-point + (progn + (goto-char new-point) + (setq node t)) + (setq node nil))))) node)) (defun Info-mouse-follow-link (click) @@ -4213,8 +4277,8 @@ Advanced commands: '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 'isearch-filter-predicates) + '(Info-isearch-filter)) (set (make-local-variable 'revert-buffer-function) 'Info-revert-buffer-function) (Info-set-mode-line) @@ -4324,7 +4388,8 @@ This feature will be removed in future.") ("ietf-drums" . "emacs-mime") ("quoted-printable" . "emacs-mime") ("binhex" . "emacs-mime") ("uudecode" . "emacs-mime") ("mailcap" . "emacs-mime") ("mm" . "emacs-mime") - ("mml" . "emacs-mime")) + ("mml" . "emacs-mime") + "tramp" "dbus") "List of Info files that describe Emacs commands. An element can be a file name, or a list of the form (PREFIX . FILE) where PREFIX is a name prefix and FILE is the file to look in. @@ -4896,6 +4961,21 @@ first line or header line, and for breadcrumb links.") mouse-face highlight help-echo "mouse-2: go to this URL")))) + ;; Fontify footnotes + (goto-char (point-min)) + (when (and not-fontified-p (re-search-forward "^[ \t]*-+ Footnotes -+$" nil t)) + (let ((limit (point))) + (goto-char (point-min)) + (while (re-search-forward "\\(([0-9]+)\\)" nil t) + (add-text-properties (match-beginning 0) (match-end 0) + `(font-lock-face info-xref + link t + mouse-face highlight + help-echo + ,(if (< (point) limit) + "mouse-2: go to footnote definition" + "mouse-2: go to footnote reference")))))) + ;; Hide empty lines at the end of the node. (goto-char (point-max)) (skip-chars-backward "\n") @@ -4907,7 +4987,7 @@ first line or header line, and for breadcrumb links.") ;;; Speedbar support: ;; These functions permit speedbar to display the "tags" in the ;; current Info node. -(eval-when-compile (require 'speedbar)) +(eval-when-compile (require 'speedbar)) ; for speedbar-with-writable (declare-function speedbar-add-expansion-list "speedbar" (new-list)) (declare-function speedbar-center-buffer-smartly "speedbar" ()) @@ -4969,6 +5049,10 @@ This will add a speedbar major display mode." (speedbar-change-initial-expansion-list "Info") ) +;; speedbar loads dframe at runtime. +(declare-function dframe-select-attached-frame "dframe" (&optional frame)) +(declare-function dframe-current-frame "dframe" (frame-var desired-major-mode)) + (defun Info-speedbar-hierarchy-buttons (_directory depth &optional node) "Display an Info directory hierarchy in speedbar. DIRECTORY is the current directory in the attached frame. diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el index 39f2b79587b..7b79a1dd1f9 100644 --- a/lisp/international/ccl.el +++ b/lisp/international/ccl.el @@ -43,10 +43,11 @@ ;;; Code: -(defgroup ccl nil - "CCL (Code Conversion Language) compiler." - :prefix "ccl-" - :group 'i18n) +;; Unused. +;;; (defgroup ccl nil +;;; "CCL (Code Conversion Language) compiler." +;;; :prefix "ccl-" +;;; :group 'i18n) (defconst ccl-command-table [if branch loop break repeat write-repeat write-read-repeat diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 2e15c434e4a..c2bbb171241 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -805,6 +805,8 @@ Internal use only. Should be called at startup time." ;; These fonts require vertical centering. (setq vertical-centering-font-regexp (purecopy "gb2312\\|gbk\\|gb18030\\|jisx0208\\|jisx0212\\|ksc5601\\|cns11643\\|big5")) +(put 'vertical-centering-font-regexp 'standard-value + (list vertical-centering-font-regexp)) ;; CDAC fonts are actually smaller than their design sizes. (setq face-font-rescale-alist diff --git a/lisp/international/ja-dic-cnv.el b/lisp/international/ja-dic-cnv.el index c0fcf19d841..41a31004194 100644 --- a/lisp/international/ja-dic-cnv.el +++ b/lisp/international/ja-dic-cnv.el @@ -279,9 +279,9 @@ skkdic-okuri-nasi-entries-count (1+ skkdic-okuri-nasi-entries-count)) (setq ratio (floor (/ (* (point) 100.0) (point-max)))) - (if (/= ratio prev-ratio) + (if (/= (/ prev-ratio 10) (/ ratio 10)) (progn - (message "collected %2d%% %s ..." ratio kana) + (message "collected %2d%% ..." ratio) (setq prev-ratio ratio))) (while candidates (let ((entry (lookup-nested-alist (car candidates) @@ -304,12 +304,12 @@ (while l (let ((kana (car (car l))) (candidates (cdr (car l)))) - (setq ratio (/ (* count 1000) skkdic-okuri-nasi-entries-count) + (setq ratio (/ (* count 100) skkdic-okuri-nasi-entries-count) count (1+ count)) - (if (/= prev-ratio (/ ratio 10)) + (if (/= (/ prev-ratio 10) (/ ratio 10)) (progn - (message "processed %2d%% %s ..." (/ ratio 10) kana) - (setq prev-ratio (/ ratio 10)))) + (message "processed %2d%% ..." ratio) + (setq prev-ratio ratio))) (if (setq candidates (skkdic-reduced-candidates skkbuf kana candidates)) (progn @@ -330,16 +330,21 @@ The name of generated file is specified by the variable `ja-dic-filename'." (interactive "FSKK dictionary file: ") (message "Reading file \"%s\" ..." filename) (let* ((coding-system-for-read 'euc-japan) - (skkbuf(find-file-noselect (expand-file-name filename))) + (skkbuf (get-buffer-create " *skkdic-unannotated*")) (buf (get-buffer-create "*skkdic-work*"))) + ;; Set skkbuf to an unannotated copy of the dictionary. + (with-current-buffer skkbuf + (insert-file-contents (expand-file-name filename)) + (re-search-forward "^[^;]") + (while (re-search-forward ";[^\n/]*/" nil t) + (replace-match "/"))) ;; Setup and generate the header part of working buffer. (with-current-buffer buf (erase-buffer) (buffer-disable-undo) (insert ";;; ja-dic.el --- dictionary for Japanese input method" - " -*-coding: euc-japan; -*-\n" + " -*-coding: utf-8; -*-\n" ";;\tGenerated by the command `skkdic-convert'\n" - ";;\tDate: " (current-time-string) "\n" ";;\tOriginal SKK dictionary file: " (file-relative-name (expand-file-name filename) dirname) "\n\n" @@ -348,7 +353,6 @@ The name of generated file is specified by the variable `ja-dic-filename'." ";; Do byte-compile this file again after any modification.\n\n" ";;; Start of the header of the original SKK dictionary.\n\n") (set-buffer skkbuf) - (widen) (goto-char 1) (let (pos) (search-forward ";; okuri-ari") @@ -399,7 +403,7 @@ The name of generated file is specified by the variable `ja-dic-filename'." ;; Save the working buffer. (set-buffer buf) (set-visited-file-name (expand-file-name ja-dic-filename dirname) t) - (set-buffer-file-coding-system 'euc-japan) + (set-buffer-file-coding-system 'utf-8) (save-buffer 0)) (kill-buffer skkbuf) (switch-to-buffer buf))) @@ -429,12 +433,7 @@ To get complete usage, invoke: (setq targetdir (expand-file-name (car command-line-args-left))) (setq command-line-args-left (cdr command-line-args-left)))) (setq filename (expand-file-name (car command-line-args-left))) - (message "Converting %s to %s ..." filename ja-dic-filename) - (message "It takes around 10 minutes even on Sun SS20.") - (skkdic-convert filename targetdir) - (message "Do byte-compile the created file by:") - (message " %% emacs -batch -f batch-byte-compile %s" ja-dic-filename) - )) + (skkdic-convert filename targetdir))) (kill-emacs 0)) diff --git a/lisp/international/latin1-disp.el b/lisp/international/latin1-disp.el index 2099da00404..2eadd8f8eb5 100644 --- a/lisp/international/latin1-disp.el +++ b/lisp/international/latin1-disp.el @@ -1,4 +1,4 @@ -;;; latin1-disp.el --- display tables for other ISO 8859 on Latin-1 terminals -*-coding: iso-2022-7bit;-*- +;;; latin1-disp.el --- display tables for other ISO 8859 on Latin-1 terminals -*-coding: utf-8;-*- ;; Copyright (C) 2000-2013 Free Software Foundation, Inc. @@ -107,18 +107,18 @@ display for all of `latin1-display-sets'. See also (mapc (lambda (l) (apply 'latin1-display-char l)) - '((?\$,1rz(B ",") ;; SINGLE LOW-9 QUOTATION MARK - (?\$,1r~(B ",,") ;; DOUBLE LOW-9 QUOTATION MARK - (?\$,1s&(B "...") ;; HORIZONTAL ELLIPSIS - (?\$,1s0(B "o/oo") ;; PER MILLE SIGN - (?\$,1s9(B "<") ;; SINGLE LEFT-POINTING ANGLE QUOTATION MARK - (?\$,1r|(B "``") ;; LEFT DOUBLE QUOTATION MARK - (?\$,1r}(B "''") ;; RIGHT DOUBLE QUOTATION MARK - (?\$,1rs(B "-") ;; EN DASH - (?\$,1rt(B "--") ;; EM DASH - (?\$,1ub(B "TM") ;; TRADE MARK SIGN - (?\$,1s:(B ">") ;; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK - (?$,1s"(B ",A7(B") + '((?\‚ ",") ;; SINGLE LOW-9 QUOTATION MARK + (?\„ ",,") ;; DOUBLE LOW-9 QUOTATION MARK + (?\… "...") ;; HORIZONTAL ELLIPSIS + (?\‰ "o/oo") ;; PER MILLE SIGN + (?\‹ "<") ;; SINGLE LEFT-POINTING ANGLE QUOTATION MARK + (?\“ "``") ;; LEFT DOUBLE QUOTATION MARK + (?\†"''") ;; RIGHT DOUBLE QUOTATION MARK + (?\– "-") ;; EN DASH + (?\— "--") ;; EM DASH + (?\â„¢ "TM") ;; TRADE MARK SIGN + (?\› ">") ;; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK + (?• "·") ))) (setq latin1-display t)) (mapc #'latin1-display-reset latin1-display-sets) @@ -217,66 +217,66 @@ is. If FORCE is non-nil, set up the display regardless." (lambda (l) (or (char-displayable-p (car l)) (apply 'latin1-display-char l))) - '((?,BF(B "'C" "C'") - (?,BP(B "'D" "/D") - (?,B&(B "'S" "S'") - (?,Bf(B "'c" "c'") - (?,Bp(B "'d" "/d") - (?,BE(B "'L" "L'") - (?,Bq(B "'n" "n'") - (?,BQ(B "'N" "N'") - (?,B`(B "'r" "r'") - (?,B@(B "'R" "R'") - (?,B6(B "'s" "s'") - (?,B<(B "'z" "z'") - (?,B,(B "'Z" "Z'") - (?,B!(B "`A" "A;") - (?,BJ(B "`E" "E;") - (?,B#(B "`L" "/L") - (?,B*(B "`S" ",S") - (?,B^(B "`T" ",T") - (?,B/(B "`Z" "Z^.") - (?,B1(B "`a" "a;") - (?,B3(B "`l" "/l") - (?,Bj(B "`e" "e;") - (?,B:(B "`s" ",s") - (?,B~(B "`t" ",t") - (?,B?(B "`z" "z^.") - (?,B(B "`." "'.") - (?,BC(B "~A" "A(") - (?,BH(B "~C" "C<") - (?,BO(B "~D" "D<") - (?,BL(B "~E" "E<") - (?,Bl(B "~e" "e<") - (?,B%(B "~L" "L<") - (?,BR(B "~N" "N<") - (?,BU(B "~O" "O''") - (?,BX(B "~R" "R<") - (?,B)(B "~S" "S<") - (?,B+(B "~T" "T<") - (?,B[(B "~U" "U''") - (?,B.(B "~Z" "Z<") - (?,Bc(B "~a" "a(}") - (?,Bh(B "~c" "c<") - (?,Bo(B "~d" "d<") - (?,B5(B "~l" "l<") - (?,Br(B "~n" "n<") - (?,Bu(B "~o" "o''") - (?,Bx(B "~r" "r<") - (?,B9(B "~s" "s<") - (?,B;(B "~t" "t<") - (?,B{(B "~u" "u''") - (?,B>(B "~z" "z<") - (?,B7(B "~v" "'<") ; ?,B"(B in latin-pre - (?,B"(B "~~" "'(") - (?,By(B "uu" "u^0") - (?,BY(B "UU" "U^0") - (?,BD(B "\"A") - (?,Bd(B "\"a") - (?,BK(B "\"E" "E:") - (?,Bk(B "\"e") - (?,B=(B "''" "'") - (?,B7(B "'<") ; Lynx's rendering of caron + '((?Ć "'C" "C'") + (?Ä "'D" "/D") + (?Åš "'S" "S'") + (?ć "'c" "c'") + (?Ä‘ "'d" "/d") + (?Ĺ "'L" "L'") + (?Å„ "'n" "n'") + (?Ń "'N" "N'") + (?Å• "'r" "r'") + (?Å” "'R" "R'") + (?Å› "'s" "s'") + (?ź "'z" "z'") + (?Ź "'Z" "Z'") + (?Ä„ "`A" "A;") + (?Ę "`E" "E;") + (?Å "`L" "/L") + (?Åž "`S" ",S") + (?Å¢ "`T" ",T") + (?Å» "`Z" "Z^.") + (?Ä… "`a" "a;") + (?Å‚ "`l" "/l") + (?Ä™ "`e" "e;") + (?ÅŸ "`s" ",s") + (?Å£ "`t" ",t") + (?ż "`z" "z^.") + (?Ë™ "`." "'.") + (?Ä‚ "~A" "A(") + (?ÄŒ "~C" "C<") + (?ÄŽ "~D" "D<") + (?Äš "~E" "E<") + (?Ä› "~e" "e<") + (?Ľ "~L" "L<") + (?Ň "~N" "N<") + (?Å "~O" "O''") + (?Ř "~R" "R<") + (?Å "~S" "S<") + (?Ť "~T" "T<") + (?Å° "~U" "U''") + (?Ž "~Z" "Z<") + (?ă "~a" "a(}") + (?Ä "~c" "c<") + (?Ä "~d" "d<") + (?ľ "~l" "l<") + (?ň "~n" "n<") + (?Å‘ "~o" "o''") + (?Å™ "~r" "r<") + (?Å¡ "~s" "s<") + (?Å¥ "~t" "t<") + (?ű "~u" "u''") + (?ž "~z" "z<") + (?ˇ "~v" "'<") ; ?˘ in latin-pre + (?˘ "~~" "'(") + (?ů "uu" "u^0") + (?Å® "UU" "U^0") + (?Ä "\"A") + (?ä "\"a") + (?Ë "\"E" "E:") + (?ë "\"e") + (?Ë "''" "'") + (?ˇ "'<") ; Lynx's rendering of caron ))) ((eq set 'latin-3) @@ -285,34 +285,34 @@ is. If FORCE is non-nil, set up the display regardless." (lambda (l) (or (char-displayable-p (car l)) (apply 'latin1-display-char l))) - '((?,C!(B "/H") - (?,C"(B "~`" "'(") - (?,C&(B "^H" "H^") - (?,C6(B "^h" "h^") - (?,C)(B ".I" "I^.") - (?,C*(B ",S") - (?,C+(B "~G" "G(") - (?,C,(B "^J" "J^") - (?,C/(B ".Z" "Z^.") - (?,C1(B "/h") - (?,C9(B ".i" "i^.") - (?,C:(B ",s") - (?,C;(B "~g" "g(") - (?,C<(B "^j" "j^") - (?,C?(B ".Z" "z^.") - (?,CE(B ".c" "C^.") - (?,CF(B "^C" "C^") - (?,CU(B ".G" "G^.") - (?,CX(B "^G" "G^") - (?,C](B "~U" "U(") - (?,C^(B "^S" "S^") - (?,Ce(B ".C" "c^.") - (?,Cf(B "^c" "c^") - (?,Cu(B ".g" "g^.") - (?,Cx(B "^g" "g^") - (?,C}(B "~u" "u(") - (?,C~(B "^s" "s^") - (?,C(B "/." "^.")))) + '((?Ħ "/H") + (?˘ "~`" "'(") + (?Ĥ "^H" "H^") + (?Ä¥ "^h" "h^") + (?Ä° ".I" "I^.") + (?Åž ",S") + (?Äž "~G" "G(") + (?Ä´ "^J" "J^") + (?Å» ".Z" "Z^.") + (?ħ "/h") + (?ı ".i" "i^.") + (?ÅŸ ",s") + (?ÄŸ "~g" "g(") + (?ĵ "^j" "j^") + (?ż ".Z" "z^.") + (?ÄŠ ".c" "C^.") + (?Ĉ "^C" "C^") + (?Ä ".G" "G^.") + (?Äœ "^G" "G^") + (?Ŭ "~U" "U(") + (?Åœ "^S" "S^") + (?Ä‹ ".C" "c^.") + (?ĉ "^c" "c^") + (?Ä¡ ".g" "g^.") + (?Ä "^g" "g^") + (?Å "~u" "u(") + (?Å "^s" "s^") + (?Ë™ "/." "^.")))) ((eq set 'latin-4) (latin1-display-identities set) @@ -320,55 +320,55 @@ is. If FORCE is non-nil, set up the display regardless." (lambda (l) (or (char-displayable-p (car l)) (apply 'latin1-display-char l))) - '((?,D!(B "A," "A;") - (?,D"(B "k/" "kk") - (?,D#(B "R," ",R") - (?,D%(B "I~" "?I") - (?,D&(B "L," ",L") - (?,D)(B "S~" "S<") - (?,D*(B "E-") - (?,D+(B "G," ",G") - (?,D,(B "T/" "/T") - (?,D.(B "Z~" "Z<") - (?,D1(B "a," "a;") - (?,D2(B "';") - (?,D3(B "r," ",r") - (?,D5(B "i~" "~i") - (?,D6(B "l," ",l") - (?,D7(B "'<") - (?,D9(B "s~" "s<") - (?,D:(B "e-") - (?,D;(B "g," ",g") - (?,D<(B "t/" "/t") - (?,D=(B "N/" "NG") - (?,D>(B "z~" "z<") - (?,D?(B "n/" "ng") - (?,D@(B "A-") - (?,DG(B "I," "I;") - (?,DH(B "C~" "C<") - (?,DJ(B "E," "E;") - (?,DL(B "E." "E^.") - (?,DO(B "I-") - (?,DQ(B "N," ",N") - (?,DR(B "O-") - (?,DS(B "K," ",K") - (?,DY(B "U," "U;") - (?,D](B "U~" "~U") - (?,D^(B "U-") - (?,D`(B "a-") - (?,Dg(B "i," "i;") - (?,Dh(B "c~" "c<") - (?,Dj(B "e," "e;") - (?,Dl(B "e." "e^.") - (?,Do(B "i-") - (?,Dp(B "d/" "/d") - (?,Dq(B "n," ",n") - (?,Dr(B "o-") - (?,Ds(B "k," ",k") - (?,Dy(B "u," "u;") - (?,D}(B "u~" "~u") - (?,D~(B "u-") - (?,D(B "^.")))) + '((?Ä„ "A," "A;") + (?ĸ "k/" "kk") + (?Å– "R," ",R") + (?Ĩ "I~" "?I") + (?Ä» "L," ",L") + (?Å "S~" "S<") + (?Ä’ "E-") + (?Ä¢ "G," ",G") + (?Ŧ "T/" "/T") + (?Ž "Z~" "Z<") + (?Ä… "a," "a;") + (?Ë› "';") + (?Å— "r," ",r") + (?Ä© "i~" "~i") + (?ļ "l," ",l") + (?ˇ "'<") + (?Å¡ "s~" "s<") + (?Ä“ "e-") + (?Ä£ "g," ",g") + (?ŧ "t/" "/t") + (?ÅŠ "N/" "NG") + (?ž "z~" "z<") + (?Å‹ "n/" "ng") + (?Ä€ "A-") + (?Ä® "I," "I;") + (?ÄŒ "C~" "C<") + (?Ę "E," "E;") + (?Ä– "E." "E^.") + (?Ī "I-") + (?Å… "N," ",N") + (?ÅŒ "O-") + (?Ķ "K," ",K") + (?Ų "U," "U;") + (?Ũ "U~" "~U") + (?Ū "U-") + (?Ä "a-") + (?į "i," "i;") + (?Ä "c~" "c<") + (?Ä™ "e," "e;") + (?Ä— "e." "e^.") + (?Ä« "i-") + (?Ä‘ "d/" "/d") + (?ņ "n," ",n") + (?Å "o-") + (?Ä· "k," ",k") + (?ų "u," "u;") + (?Å© "u~" "~u") + (?Å« "u-") + (?Ë™ "^.")))) ((eq set 'latin-5) (latin1-display-identities set) @@ -376,15 +376,15 @@ is. If FORCE is non-nil, set up the display regardless." (lambda (l) (or (char-displayable-p (car l)) (apply 'latin1-display-char l))) - '((?,Mp(B "~g" "g(") - (?,MP(B "~G" "G(") - (?,M](B ".I" "I^.") - (?,M~(B ",s") - (?,M^(B ",S") - (?,Mj(B "^e" "e<") ; from latin-post - (?,Ml(B ".e" "e^.") - (?,Mo(B "\"i" "i-") ; from latin-post - (?,M}(B ".i" "i.")))) + '((?ÄŸ "~g" "g(") + (?Äž "~G" "G(") + (?Ä° ".I" "I^.") + (?ÅŸ ",s") + (?Åž ",S") + (?ê "^e" "e<") ; from latin-post + (?ì ".e" "e^.") + (?ï "\"i" "i-") ; from latin-post + (?ı ".i" "i.")))) ((eq set 'latin-8) (latin1-display-identities set) @@ -392,37 +392,37 @@ is. If FORCE is non-nil, set up the display regardless." (lambda (l) (or (char-displayable-p (car l)) (apply 'latin1-display-char l))) - '((?,_!(B ".B" "B`") - (?,_"(B ".b" "b`") - (?,_%(B ".c" "c`") - (?,_$(B ".C" "C`") - (?,_&(B ".D" "D`") - (?,_+(B ".d" "d`") - (?,_8(B "`w") - (?,_((B "`W") - (?,_:(B "'w" "w'") - (?,_*(B "'W" "W'") - (?,_<(B "`y") - (?,_,(B "`Y") - (?,_1(B ".f" "f`") - (?,_0(B ".F" "F`") - (?,_3(B ".g" "g`") - (?,_2(B ".G" "G`") - (?,_5(B ".m" "m`") - (?,_4(B ".M" "M`") - (?,_9(B ".p" "p`") - (?,_7(B ".P" "P`") - (?,_?(B ".s" "s`") - (?,_;(B ".S" "S`") - (?,_>(B "\"w") - (?,_=(B "\"W") - (?,_p(B "^w" "w^") - (?,_P(B "^W" "W^") - (?,_w(B ".t" "t`") - (?,_W(B ".T" "T`") - (?,_~(B "^y" "y^") - (?,_^(B "^Y" "Y^") - (?,_/(B "\"Y")))) + '((?Ḃ ".B" "B`") + (?ḃ ".b" "b`") + (?Ä‹ ".c" "c`") + (?ÄŠ ".C" "C`") + (?Ḋ ".D" "D`") + (?ḋ ".d" "d`") + (?Ạ"`w") + (?Ẁ "`W") + (?ẃ "'w" "w'") + (?Ẃ "'W" "W'") + (?ỳ "`y") + (?Ỳ "`Y") + (?ḟ ".f" "f`") + (?Ḟ ".F" "F`") + (?Ä¡ ".g" "g`") + (?Ä ".G" "G`") + (?á¹ ".m" "m`") + (?á¹€ ".M" "M`") + (?á¹— ".p" "p`") + (?á¹– ".P" "P`") + (?ṡ ".s" "s`") + (?á¹ ".S" "S`") + (?ẅ "\"w") + (?Ẅ "\"W") + (?ŵ "^w" "w^") + (?Å´ "^W" "W^") + (?ṫ ".t" "t`") + (?Ṫ ".T" "T`") + (?Å· "^y" "y^") + (?Ŷ "^Y" "Y^") + (?Ÿ "\"Y")))) ((eq set 'latin-9) (latin1-display-identities set) @@ -430,97 +430,97 @@ is. If FORCE is non-nil, set up the display regardless." (lambda (l) (or (char-displayable-p (car l)) (apply 'latin1-display-char l))) - '((?,b((B "~s" "s<") - (?,b&(B "~S" "S<") - (?,b$(B "Euro" "E=") - (?,b8(B "~z" "z<") - (?,b4(B "~Z" "Z<") - (?,b>(B "\"Y") - (?,b=(B "oe") - (?,b<(B "OE")))) + '((?Å¡ "~s" "s<") + (?Å "~S" "S<") + (?€ "Euro" "E=") + (?ž "~z" "z<") + (?Ž "~Z" "Z<") + (?Ÿ "\"Y") + (?Å“ "oe") + (?Å’ "OE")))) ((eq set 'greek) (mapc (lambda (l) (or (char-displayable-p (car l)) (apply 'latin1-display-char l))) - '((?,F!(B "9'") - (?,F"(B "'9") - (?,F/(B "-M") - (?,F5(B "'%") - (?,F6(B "'A") - (?,F8(B "'E") - (?,F9(B "'H") - (?,F:(B "'I") - (?,F<(B "'O") - (?,F>(B "'Y") - (?,F?(B "W%") - (?,F@(B "i3") - (?,FC(B "G*") - (?,FD(B "D*") - (?,FH(B "TH") - (?,FK(B "L*") - (?,FN(B "C*") - (?,FP(B "P*") - (?,FS(B "S*") - (?,FV(B "F*") - (?,FX(B "Q*") - (?,FY(B "W*") - (?,FZ(B "\"I") - (?,F[(B "\"Y") - (?,F\(B "a%") - (?,F](B "e%") - (?,F^(B "y%") - (?,F_(B "i%") - (?,F`(B "u3") - (?,Fa(B "a*") - (?,Fb(B "b*") - (?,Fc(B "g*") - (?,Fd(B "d*") - (?,Fe(B "e*") - (?,Ff(B "z*") - (?,Fg(B "y*") - (?,Fh(B "h*") - (?,Fi(B "i*") - (?,Fj(B "k") - (?,Fk(B "l*") - (?,Fl(B "m*") - (?,Fm(B "n*") - (?,Fn(B "c*") - (?,Fp(B "p*") - (?,Fq(B "r*") - (?,Fr(B "*s") - (?,Fs(B "s*") - (?,Ft(B "t*") - (?,Fu(B "u") - (?,Fv(B "f*") - (?,Fw(B "x*") - (?,Fx(B "q*") - (?,Fy(B "w*") - (?,Fz(B "\"i") - (?,F{(B "\"u") - (?,F|(B "'o") - (?,F}(B "'u") - (?,F~(B "'w"))) + '((?‘ "9'") + (?’ "'9") + (?― "-M") + (?Î… "'%") + (?Ά "'A") + (?Έ "'E") + (?Ή "'H") + (?Ί "'I") + (?ÎŒ "'O") + (?ÎŽ "'Y") + (?Î "W%") + (?Î "i3") + (?Γ "G*") + (?Δ "D*") + (?Θ "TH") + (?Λ "L*") + (?Ξ "C*") + (?Î "P*") + (?Σ "S*") + (?Φ "F*") + (?Ψ "Q*") + (?Ω "W*") + (?Ϊ "\"I") + (?Ϋ "\"Y") + (?ά "a%") + (?Î "e%") + (?ή "y%") + (?ί "i%") + (?ΰ "u3") + (?α "a*") + (?β "b*") + (?γ "g*") + (?δ "d*") + (?ε "e*") + (?ζ "z*") + (?η "y*") + (?θ "h*") + (?ι "i*") + (?κ "k") + (?λ "l*") + (?μ "m*") + (?ν "n*") + (?ξ "c*") + (?Ï€ "p*") + (?Ï "r*") + (?Ï‚ "*s") + (?σ "s*") + (?Ï„ "t*") + (?Ï… "u") + (?φ "f*") + (?χ "x*") + (?ψ "q*") + (?ω "w*") + (?ÏŠ "\"i") + (?Ï‹ "\"u") + (?ÏŒ "'o") + (?Ï "'u") + (?ÏŽ "'w"))) (mapc (lambda (l) (or (char-displayable-p (car l)) (aset standard-display-table (car l) (string-to-vector (cadr l))))) - '((?,FA(B "A") - (?,FB(B "B") - (?,FE(B "E") - (?,FF(B "Z") - (?,FG(B "H") - (?,FI(B "I") - (?,FJ(B "J") - (?,FL(B "M") - (?,FM(B "N") - (?,FO(B "O") - (?,FQ(B "P") - (?,FT(B "T") - (?,FU(B "Y") - (?,FW(B "X") - (?,Fo(B "o")))) + '((?Α "A") + (?Î’ "B") + (?Ε "E") + (?Ζ "Z") + (?Η "H") + (?Ι "I") + (?Κ "J") + (?Îœ "M") + (?Î "N") + (?Ο "O") + (?Ρ "P") + (?Τ "T") + (?Î¥ "Y") + (?Χ "X") + (?ο "o")))) ((eq set 'hebrew) ;; Don't start with identities, since we don't have definitions @@ -537,96 +537,96 @@ is. If FORCE is non-nil, set up the display regardless." (lambda (l) (or (char-displayable-p (car l)) (aset standard-display-table (car l) (string-to-vector (cadr l))))) - '((?,H_(B "=2") - (?,H`(B "A+") - (?,Ha(B "B+") - (?,Hb(B "G+") - (?,Hc(B "D+") - (?,Hd(B "H+") - (?,He(B "W+") - (?,Hf(B "Z+") - (?,Hg(B "X+") - (?,Hh(B "Tj") - (?,Hi(B "J+") - (?,Hj(B "K%") - (?,Hk(B "K+") - (?,Hl(B "L+") - (?,Hm(B "M%") - (?,Hn(B "M+") - (?,Ho(B "N%") - (?,Hp(B "N+") - (?,Hq(B "S+") - (?,Hr(B "E+") - (?,Hs(B "P%") - (?,Ht(B "P+") - (?,Hu(B "Zj") - (?,Hv(B "ZJ") - (?,Hw(B "Q+") - (?,Hx(B "R+") - (?,Hy(B "Sh") - (?,Hz(B "T+")))) + '((?‗ "=2") + (?× "A+") + (?ב "B+") + (?×’ "G+") + (?ד "D+") + (?×” "H+") + (?ו "W+") + (?×– "Z+") + (?×— "X+") + (?ט "Tj") + (?×™ "J+") + (?ך "K%") + (?×› "K+") + (?ל "L+") + (?× "M%") + (?מ "M+") + (?ן "N%") + (?× "N+") + (?ס "S+") + (?×¢ "E+") + (?×£ "P%") + (?פ "P+") + (?×¥ "Zj") + (?צ "ZJ") + (?ק "Q+") + (?ר "R+") + (?ש "Sh") + (?ת "T+")))) ;; Arabic probably isn't so useful in the absence of Arabic ;; language support... ((eq set 'arabic) (setq set 'arabic) - (or (char-displayable-p ?,G (B) - (aset standard-display-table ?,G (B ",A (B")) - (or (char-displayable-p ?,G$(B) - (aset standard-display-table ?,G$(B ",A$(B")) - (or (char-displayable-p ?,G-(B) - (aset standard-display-table ?,G-(B ",A-(B")) + (or (char-displayable-p ? ) + (aset standard-display-table ? " ")) + (or (char-displayable-p ?¤) + (aset standard-display-table ?¤ "¤")) + (or (char-displayable-p ?Â) + (aset standard-display-table ? "Â")) (mapc (lambda (l) (or (char-displayable-p (car l)) (apply 'latin1-display-char l))) - '((?,G,(B ",+") - (?,G;(B ";+") - (?,G?(B "?+") - (?,GA(B "H'") - (?,GB(B "aM") - (?,GC(B "aH") - (?,GD(B "wH") - (?,GE(B "ah") - (?,GF(B "yH") - (?,GG(B "a+") - (?,GH(B "b+") - (?,GI(B "tm") - (?,GJ(B "t+") - (?,GK(B "tk") - (?,GL(B "g+") - (?,GM(B "hk") - (?,GN(B "x+") - (?,GO(B "d+") - (?,GP(B "dk") - (?,GQ(B "r+") - (?,GR(B "z+") - (?,GS(B "s+") - (?,GT(B "sn") - (?,GU(B "c+") - (?,GV(B "dd") - (?,GW(B "tj") - (?,GX(B "zH") - (?,GY(B "e+") - (?,GZ(B "i+") - (?,G`(B "++") - (?,Ga(B "f+") - (?,Gb(B "q+") - (?,Gc(B "k+") - (?,Gd(B "l+") - (?,Ge(B "m+") - (?,Gf(B "n+") - (?,Gg(B "h+") - (?,Gh(B "w+") - (?,Gi(B "j+") - (?,Gj(B "y+") - (?,Gk(B ":+") - (?,Gl(B "\"+") - (?,Gm(B "=+") - (?,Gn(B "/+") - (?,Go(B "'+") - (?,Gp(B "1+") - (?,Gq(B "3+") - (?,Gr(B "0+")))) + '((?ØŒ ",+") + (?Ø› ";+") + (?ØŸ "?+") + (?Ø¡ "H'") + (?Ø¢ "aM") + (?Ø£ "aH") + (?ؤ "wH") + (?Ø¥ "ah") + (?ئ "yH") + (?ا "a+") + (?ب "b+") + (?Ø© "tm") + (?ت "t+") + (?Ø« "tk") + (?ج "g+") + (?Ø "hk") + (?Ø® "x+") + (?د "d+") + (?Ø° "dk") + (?ر "r+") + (?ز "z+") + (?س "s+") + (?Ø´ "sn") + (?ص "c+") + (?ض "dd") + (?Ø· "tj") + (?ظ "zH") + (?ع "e+") + (?غ "i+") + (?Ù€ "++") + (?Ù "f+") + (?Ù‚ "q+") + (?Ùƒ "k+") + (?Ù„ "l+") + (?Ù… "m+") + (?Ù† "n+") + (?Ù‡ "h+") + (?Ùˆ "w+") + (?Ù‰ "j+") + (?ÙŠ "y+") + (?Ù‹ ":+") + (?ÙŒ "\"+") + (?Ù "=+") + (?ÙŽ "/+") + (?Ù "'+") + (?Ù "1+") + (?Ù‘ "3+") + (?Ù’ "0+")))) ((eq set 'cyrillic) (setq set 'cyrillic-iso) @@ -634,105 +634,105 @@ is. If FORCE is non-nil, set up the display regardless." (lambda (l) (or (char-displayable-p (car l)) (apply 'latin1-display-char l))) - '((?,L"(B "Dj") - (?,L#(B "Gj") - (?,L$(B "IE") - (?,L)(B "Lj") - (?,L*(B "Nj") - (?,L+(B "Ts") - (?,L,(B "Kj") - (?,L.(B "V%") - (?,L/(B "Dzh") - (?,L1(B "B=") - (?,L3(B ",Ab(B") - (?,L4(B "D") - (?,L6(B "Z%") - (?,L7(B "3") - (?,L8(B "U") - (?,L9(B "J=") - (?,L;(B "L=") - (?,L?(B "P=") - (?,LC(B "Y") - (?,LD(B ",Ah(B") - (?,LF(B "C=") - (?,LG(B "C%") - (?,LH(B "S%") - (?,LI(B "Sc") - (?,LJ(B "=\"") - (?,LK(B "Y=") - (?,LL(B "%\"") - (?,LM(B "Ee") - (?,LN(B "Yu") - (?,LO(B "Ya") - (?,LQ(B "b") - (?,LR(B "v=") - (?,LS(B "g=") - (?,LT(B "g") - (?,LV(B "z%") - (?,LW(B "z=") - (?,LX(B "u") - (?,LY(B "j=") - (?,LZ(B "k") - (?,L[(B "l=") - (?,L\(B "m=") - (?,L](B "n=") - (?,L_(B "n") - (?,L`(B "p") - (?,Lb(B "t=") - (?,Ld(B "f=") - (?,Lf(B "c=") - (?,Lg(B "c%") - (?,Lh(B "s%") - (?,Li(B "sc") - (?,Lj(B "='") - (?,Lk(B "y=") - (?,Ll(B "%'") - (?,Lm(B "ee") - (?,Ln(B "yu") - (?,Lo(B "ya") - (?,Lp(B "N0") - (?,Lr(B "dj") - (?,Ls(B "gj") - (?,Lt(B "ie") - (?,Ly(B "lj") - (?,Lz(B "nj") - (?,L{(B "ts") - (?,L|(B "kj") - (?,L~(B "v%") - (?,L(B "dzh"))) + '((?Ђ "Dj") + (?Ѓ "Gj") + (?Є "IE") + (?Љ "Lj") + (?Њ "Nj") + (?Ћ "Ts") + (?ÐŒ "Kj") + (?ÐŽ "V%") + (?Ð "Dzh") + (?Б "B=") + (?Г "â") + (?Д "D") + (?Ж "Z%") + (?З "3") + (?И "U") + (?Й "J=") + (?Л "L=") + (?П "P=") + (?У "Y") + (?Ф "è") + (?Ц "C=") + (?Ч "C%") + (?Ш "S%") + (?Щ "Sc") + (?Ъ "=\"") + (?Ы "Y=") + (?Ь "%\"") + (?Ð "Ee") + (?Ю "Yu") + (?Я "Ya") + (?б "b") + (?в "v=") + (?г "g=") + (?д "g") + (?ж "z%") + (?з "z=") + (?и "u") + (?й "j=") + (?к "k") + (?л "l=") + (?м "m=") + (?н "n=") + (?п "n") + (?Ñ€ "p") + (?Ñ‚ "t=") + (?Ñ„ "f=") + (?ц "c=") + (?ч "c%") + (?ш "s%") + (?щ "sc") + (?ÑŠ "='") + (?Ñ‹ "y=") + (?ÑŒ "%'") + (?Ñ "ee") + (?ÑŽ "yu") + (?Ñ "ya") + (?â„– "N0") + (?Ñ’ "dj") + (?Ñ“ "gj") + (?Ñ” "ie") + (?Ñ™ "lj") + (?Ñš "nj") + (?Ñ› "ts") + (?Ñœ "kj") + (?Ñž "v%") + (?ÑŸ "dzh"))) (mapc (lambda (l) (or (char-displayable-p (car l)) (aset standard-display-table (car l) (string-to-vector (cadr l))))) - '((?,L!(B ",AK(B") - (?,L%(B "S") - (?,L&(B "I") - (?,L'(B ",AO(B") - (?,L((B "J") - (?,Lq(B ",Ak(B") - (?,L}(B ",A'(B") - (?,L-(B "-") - (?,L0(B "A") - (?,L2(B "B") - (?,L5(B "E") - (?,L:(B "K") - (?,L<(B "M") - (?,L=(B "H") - (?,L>(B "O") - (?,L@(B "P") - (?,LA(B "C") - (?,LB(B "T") - (?,LE(B "X") - (?,LP(B "a") - (?,LU(B "e") - (?,L^(B "o") - (?,La(B "c") - (?,Lc(B "y") - (?,Le(B "x") - (?,Lu(B "s") - (?,Lv(B "i") - (?,Lw(B ",Ao(B") - (?,Lx(B "j")))) + '((?Ð "Ë") + (?Ð… "S") + (?І "I") + (?Ї "Ã") + (?Ј "J") + (?Ñ‘ "ë") + (?§ "§") + (? "-") + (?Ð "A") + (?Ð’ "B") + (?Е "E") + (?К "K") + (?Ðœ "M") + (?Ð "H") + (?О "O") + (?Ð "P") + (?С "C") + (?Т "T") + (?Ð¥ "X") + (?а "a") + (?е "e") + (?о "o") + (?Ñ "c") + (?у "y") + (?Ñ… "x") + (?Ñ• "s") + (?Ñ– "i") + (?Ñ— "ï") + (?ј "j")))) (t (error "Unsupported character set: %S" set))) @@ -773,2417 +773,2417 @@ isn't changed if the display can render Unicode characters." ;; Table derived by running Lynx on a suitable list of ;; characters in a utf-8 file, except for some added by ;; hand at the end. - '((?\$,1 (B "A") - (?\$,1 !(B "a") - (?\$,1 "(B "A") - (?\$,1 #(B "a") - (?\$,1 $(B "A") - (?\$,1 %(B "a") - (?\$,1 &(B "C") - (?\$,1 '(B "c") - (?\$,1 ((B "C") - (?\$,1 )(B "c") - (?\$,1 *(B "C") - (?\$,1 +(B "c") - (?\$,1 ,(B "C") - (?\$,1 -(B "c") - (?\$,1 .(B "D") - (?\$,1 /(B "d") - (?\$,1 0(B ",AP(B") - (?\$,1 1(B "d/") - (?\$,1 2(B "E") - (?\$,1 3(B "e") - (?\$,1 4(B "E") - (?\$,1 5(B "e") - (?\$,1 6(B "E") - (?\$,1 7(B "e") - (?\$,1 8(B "E") - (?\$,1 9(B "e") - (?\$,1 :(B "E") - (?\$,1 ;(B "e") - (?\$,1 <(B "G") - (?\$,1 =(B "g") - (?\$,1 >(B "G") - (?\$,1 ?(B "g") - (?\$,1 @(B "G") - (?\$,1 A(B "g") - (?\$,1 B(B "G") - (?\$,1 C(B "g") - (?\$,1 D(B "H") - (?\$,1 E(B "h") - (?\$,1 F(B "H/") - (?\$,1 G(B "H") - (?\$,1 H(B "I") - (?\$,1 I(B "i") - (?\$,1 J(B "I") - (?\$,1 K(B "i") - (?\$,1 L(B "I") - (?\$,1 M(B "i") - (?\$,1 N(B "I") - (?\$,1 O(B "i") - (?\$,1 P(B "I") - (?\$,1 Q(B "i") - (?\$,1 R(B "IJ") - (?\$,1 S(B "ij") - (?\$,1 T(B "J") - (?\$,1 U(B "j") - (?\$,1 V(B "K") - (?\$,1 W(B "k") - (?\$,1 X(B "kk") - (?\$,1 Y(B "L") - (?\$,1 Z(B "l") - (?\$,1 [(B "L") - (?\$,1 \(B "l") - (?\$,1 ](B "L") - (?\$,1 ^(B "l") - (?\$,1 _(B "L.") - (?\$,1 `(B "l.") - (?\$,1 a(B "L/") - (?\$,1 b(B "l/") - (?\$,1 c(B "N") - (?\$,1 d(B "n") - (?\$,1 e(B "N") - (?\$,1 f(B "n") - (?\$,1 g(B "N") - (?\$,1 h(B "n") - (?\$,1 i(B "'n") - (?\$,1 j(B "NG") - (?\$,1 k(B "N") - (?\$,1 l(B "O") - (?\$,1 m(B "o") - (?\$,1 n(B "O") - (?\$,1 o(B "o") - (?\$,1 p(B "O\"") - (?\$,1 q(B "o\"") - (?\$,1 r(B "OE") - (?\$,1 s(B "oe") - (?\$,1 t(B "R") - (?\$,1 u(B "r") - (?\$,1 v(B "R") - (?\$,1 w(B "r") - (?\$,1 x(B "R") - (?\$,1 y(B "r") - (?\$,1 z(B "S") - (?\$,1 {(B "s") - (?\$,1 |(B "S") - (?\$,1 }(B "s") - (?\$,1 ~(B "S") - (?\$,1 (B "s") - (?\$,1! (B "S") - (?\$,1!!(B "s") - (?\$,1!"(B "T") - (?\$,1!#(B "t") - (?\$,1!$(B "T") - (?\$,1!%(B "t") - (?\$,1!&(B "T/") - (?\$,1!'(B "t/") - (?\$,1!((B "U") - (?\$,1!)(B "u") - (?\$,1!*(B "U") - (?\$,1!+(B "u") - (?\$,1!,(B "U") - (?\$,1!-(B "u") - (?\$,1!.(B "U") - (?\$,1!/(B "u") - (?\$,1!0(B "U\"") - (?\$,1!1(B "u\"") - (?\$,1!2(B "U") - (?\$,1!3(B "u") - (?\$,1!4(B "W") - (?\$,1!5(B "w") - (?\$,1!6(B "Y") - (?\$,1!7(B "y") - (?\$,1!8(B "Y") - (?\$,1!9(B "Z") - (?\$,1!:(B "z") - (?\$,1!;(B "Z") - (?\$,1!<(B "z") - (?\$,1!=(B "Z") - (?\$,1!>(B "z") - (?\$,1!?(B "s1") - (?\$,1!G(B "C2") - (?\$,1!H(B "c2") - (?\$,1!Q(B "F2") - (?\$,1!R(B " f") - (?\$,1!X(B "K2") - (?\$,1!Y(B "k2") - (?\$,1!`(B "O9") - (?\$,1!a(B "o9") - (?\$,1!b(B "OI") - (?\$,1!c(B "oi") - (?\$,1!f(B "yr") - (?\$,1!o(B "U9") - (?\$,1!p(B "u9") - (?\$,1!u(B "Z/") - (?\$,1!v(B "z/") - (?\$,1!w(B "ED") - (?\$,1"-(B "A") - (?\$,1".(B "a") - (?\$,1"/(B "I") - (?\$,1"0(B "i") - (?\$,1"1(B "O") - (?\$,1"2(B "o") - (?\$,1"3(B "U") - (?\$,1"4(B "u") - (?\$,1"5(B "U:-") - (?\$,1"6(B "u:-") - (?\$,1"7(B "U:'") - (?\$,1"8(B "u:'") - (?\$,1"9(B "U:<") - (?\$,1":(B "u:<") - (?\$,1";(B "U:!") - (?\$,1"<(B "u:!") - (?\$,1">(B "A1") - (?\$,1"?(B "a1") - (?\$,1"@(B "A7") - (?\$,1"A(B "a7") - (?\$,1"B(B "A3") - (?\$,1"C(B "a3") - (?\$,1"D(B "G/") - (?\$,1"E(B "g/") - (?\$,1"F(B "G") - (?\$,1"G(B "g") - (?\$,1"H(B "K") - (?\$,1"I(B "k") - (?\$,1"J(B "O") - (?\$,1"K(B "o") - (?\$,1"L(B "O1") - (?\$,1"M(B "o1") - (?\$,1"N(B "EZ") - (?\$,1"O(B "ez") - (?\$,1"P(B "j") - (?\$,1"T(B "G") - (?\$,1"U(B "g") - (?\$,1"Z(B "AA'") - (?\$,1"[(B "aa'") - (?\$,1"\(B "AE'") - (?\$,1"](B "ae'") - (?\$,1"^(B "O/'") - (?\$,1"_(B "o/'") - (?\$,1"`(B "A!!") - (?\$,1"a(B "a!!") - (?\$,1"b(B "A)") - (?\$,1"c(B "a)") - (?\$,1"d(B "E!!") - (?\$,1"e(B "e!!") - (?\$,1"f(B "E)") - (?\$,1"g(B "e)") - (?\$,1"h(B "I!!") - (?\$,1"i(B "i!!") - (?\$,1"j(B "I)") - (?\$,1"k(B "i)") - (?\$,1"l(B "O!!") - (?\$,1"m(B "o!!") - (?\$,1"n(B "O)") - (?\$,1"o(B "o)") - (?\$,1"p(B "R!!") - (?\$,1"q(B "r!!") - (?\$,1"r(B "R)") - (?\$,1"s(B "r)") - (?\$,1"t(B "U!!") - (?\$,1"u(B "u!!") - (?\$,1"v(B "U)") - (?\$,1"w(B "u)") - (?\$,1"}(B "Z") - (?\$,1#Q(B "A") - (?\$,1#R(B "A.") - (?\$,1#S(B "b`") - (?\$,1#T(B "O") - (?\$,1#V(B "d.") - (?\$,1#W(B "d`") - (?\$,1#X(B "@<umd>") - (?\$,1#Y(B "@") - (?\$,1#Z(B "R") - (?\$,1#[(B "E") - (?\$,1#\(B "V\"") - (?\$,1#](B "R<umd>") - (?\$,1#^(B "O\"") - (?\$,1#_(B "J") - (?\$,1#`(B "g`") - (?\$,1#a(B "g") - (?\$,1#b(B "G") - (?\$,1#c(B "Q") - (?\$,1#d(B "o-") - (?\$,1#e(B "j<rnd>") - (?\$,1#f(B "h<?>") - (?\$,1#h(B "i\"") - (?\$,1#i(B "I") - (?\$,1#j(B "I") - (?\$,1#k(B "L") - (?\$,1#l(B "L") - (?\$,1#m(B "l.") - (?\$,1#n(B "z<lat>") - (?\$,1#o(B "u-") - (?\$,1#p(B "j<vel>") - (?\$,1#q(B "M") - (?\$,1#s(B "n.") - (?\$,1#t(B "n\"") - (?\$,1#u(B "@.") - (?\$,1#v(B "&.") - (?\$,1#w(B "U") - (?\$,1#y(B "r") - (?\$,1#z(B "*<lat>") - (?\$,1#{(B "r.") - (?\$,1#}(B "*.") - (?\$,1#~(B "*") - (?\$,1$ (B "R") - (?\$,1$!(B "g\"") - (?\$,1$"(B "s.") - (?\$,1$#(B "S") - (?\$,1$$(B "J`") - (?\$,1$'(B "t!") - (?\$,1$((B "t.") - (?\$,1$)(B "u\"") - (?\$,1$*(B "U") - (?\$,1$+(B "r<lbd>") - (?\$,1$,(B "V") - (?\$,1$-(B "w<vls>") - (?\$,1$.(B "l^") - (?\$,1$/(B "I.") - (?\$,1$0(B "z.") - (?\$,1$2(B "Z") - (?\$,1$4(B "?") - (?\$,1$5(B "H<vcd>") - (?\$,1$6(B "l!") - (?\$,1$7(B "c!") - (?\$,1$8(B "p!") - (?\$,1$9(B "b<trl>") - (?\$,1$;(B "G`") - (?\$,1$=(B "j") - (?\$,1$>(B "k!") - (?\$,1$?(B "L") - (?\$,1$@(B "q`") - (?\$,1$D(B "d3") - (?\$,1$F(B "ts") - (?\$,1$G(B "tS") - (?\$,1$P(B "<h>") - (?\$,1$Q(B "<?>") - (?\$,1$R(B ";") - (?\$,1$S(B "<r>") - (?\$,1$W(B "<w>") - (?\$,1$[(B ";S") - (?\$,1$\(B "`") - (?\$,1$f(B "^") - (?\$,1$g(B "'<") - (?\$,1$h(B "|") - (?\$,1$i(B "1-") - (?\$,1$k(B "1!") - (?\$,1$p(B ":") - (?\$,1$q(B ":\\") - (?\$,1$v(B "+") - (?\$,1$w(B "-") - (?\$,1$x(B "'(") - (?\$,1$y(B "'.") - (?\$,1$z(B "'0") - (?\$,1${(B "';") - (?\$,1$|(B "~") - (?\$,1$}(B "'\"") - (?\$,1%%(B "_T") - (?\$,1%&(B "_H") - (?\$,1%'(B "_M") - (?\$,1%((B "_L") - (?\$,1%)(B "_B") - (?\$,1%,(B "_v") - (?\$,1%.(B "''") - (?\$,1%@(B "`") - (?\$,1%A(B "'") - (?\$,1%B(B "^") - (?\$,1%C(B "~") - (?\$,1%D(B ",A/(B") - (?\$,1%G(B ",A7(B") - (?\$,1%H(B ",A((B") - (?\$,1%J(B ",A0(B") - (?\$,1%K(B "''") - (?\$,1%M(B "|") - (?\$,1%N(B "||") - (?\$,1%O(B "``") - (?\$,1%a(B ";") - (?\$,1%b(B ".") - (?\$,1%c(B ".") - (?\$,1%d(B "<?>") - (?\$,1%e(B "<o>") - (?\$,1%f(B ",") - (?\$,1%g(B ",A8(B") - (?\$,1%i(B "-") - (?\$,1%j(B "[") - (?\$,1%k(B "<w>") - (?\$,1%t(B "~") - (?\$,1%w(B "/") - (?\$,1%x(B "/") - (?\$,1& (B "`") - (?\$,1&!(B "'") - (?\$,1&"(B "~") - (?\$,1&$(B "'%") - (?\$,1&%(B "j3") - (?\$,1&'(B "=") - (?\$,1&@(B "~~") - (?\$,1&T(B "'") - (?\$,1&U(B ",") - (?\$,1&Z(B "j3") - (?\$,1&^(B "?%") - (?\$,1&d(B "'*") - (?\$,1&e(B "'%") - (?\$,1&f(B "A'") - (?\$,1&g(B ",A7(B") - (?\$,1&h(B "E'") - (?\$,1&i(B "Y%") - (?\$,1&j(B "I'") - (?\$,1&l(B "O'") - (?\$,1&n(B "U%") - (?\$,1&o(B "W%") - (?\$,1&p(B "i3") - (?\$,1&q(B "A") - (?\$,1&r(B "B") - (?\$,1&s(B "G") - (?\$,1&t(B "D") - (?\$,1&u(B "E") - (?\$,1&v(B "Z") - (?\$,1&w(B "Y") - (?\$,1&x(B "TH") - (?\$,1&y(B "I") - (?\$,1&z(B "K") - (?\$,1&{(B "L") - (?\$,1&|(B "M") - (?\$,1&}(B "N") - (?\$,1&~(B "C") - (?\$,1&(B "O") - (?\$,1' (B "P") - (?\$,1'!(B "R") - (?\$,1'#(B "S") - (?\$,1'$(B "T") - (?\$,1'%(B "U") - (?\$,1'&(B "F") - (?\$,1''(B "X") - (?\$,1'((B "Q") - (?\$,1')(B "W*") - (?\$,1'*(B "J") - (?\$,1'+(B "V*") - (?\$,1',(B "a'") - (?\$,1'-(B "e'") - (?\$,1'.(B "y%") - (?\$,1'/(B "i'") - (?\$,1'0(B "u3") - (?\$,1'1(B "a") - (?\$,1'2(B "b") - (?\$,1'3(B "g") - (?\$,1'4(B "d") - (?\$,1'5(B "e") - (?\$,1'6(B "z") - (?\$,1'7(B "y") - (?\$,1'8(B "th") - (?\$,1'9(B "i") - (?\$,1':(B "k") - (?\$,1';(B "l") - (?\$,1'<(B ",A5(B") - (?\$,1'=(B "n") - (?\$,1'>(B "c") - (?\$,1'?(B "o") - (?\$,1'@(B "p") - (?\$,1'A(B "r") - (?\$,1'B(B "*s") - (?\$,1'C(B "s") - (?\$,1'D(B "t") - (?\$,1'E(B "u") - (?\$,1'F(B "f") - (?\$,1'G(B "x") - (?\$,1'H(B "q") - (?\$,1'I(B "w") - (?\$,1'J(B "j") - (?\$,1'K(B "v*") - (?\$,1'L(B "o'") - (?\$,1'M(B "u%") - (?\$,1'N(B "w%") - (?\$,1'P(B "beta ") - (?\$,1'Q(B "theta ") - (?\$,1'R(B "upsi ") - (?\$,1'U(B "phi ") - (?\$,1'V(B "pi ") - (?\$,1'W(B "k.") - (?\$,1'Z(B "T3") - (?\$,1'[(B "t3") - (?\$,1'\(B "M3") - (?\$,1'](B "m3") - (?\$,1'^(B "K3") - (?\$,1'_(B "k3") - (?\$,1'`(B "P3") - (?\$,1'a(B "p3") - (?\$,1'p(B "kappa ") - (?\$,1'q(B "rho ") - (?\$,1's(B "J") - (?\$,1't(B "'%") - (?\$,1'u(B "j3") - (?\$,1(!(B "IO") - (?\$,1("(B "D%") - (?\$,1(#(B "G%") - (?\$,1($(B "IE") - (?\$,1(%(B "DS") - (?\$,1(&(B "II") - (?\$,1('(B "YI") - (?\$,1(((B "J%") - (?\$,1()(B "LJ") - (?\$,1(*(B "NJ") - (?\$,1(+(B "Ts") - (?\$,1(,(B "KJ") - (?\$,1(.(B "V%") - (?\$,1(/(B "DZ") - (?\$,1(0(B "A") - (?\$,1(1(B "B") - (?\$,1(2(B "V") - (?\$,1(3(B "G") - (?\$,1(4(B "D") - (?\$,1(5(B "E") - (?\$,1(6(B "ZH") - (?\$,1(7(B "Z") - (?\$,1(8(B "I") - (?\$,1(9(B "J") - (?\$,1(:(B "K") - (?\$,1(;(B "L") - (?\$,1(<(B "M") - (?\$,1(=(B "N") - (?\$,1(>(B "O") - (?\$,1(?(B "P") - (?\$,1(@(B "R") - (?\$,1(A(B "S") - (?\$,1(B(B "T") - (?\$,1(C(B "U") - (?\$,1(D(B "F") - (?\$,1(E(B "H") - (?\$,1(F(B "C") - (?\$,1(G(B "CH") - (?\$,1(H(B "SH") - (?\$,1(I(B "SCH") - (?\$,1(J(B "\"") - (?\$,1(K(B "Y") - (?\$,1(L(B "'") - (?\$,1(M(B "`E") - (?\$,1(N(B "YU") - (?\$,1(O(B "YA") - (?\$,1(P(B "a") - (?\$,1(Q(B "b") - (?\$,1(R(B "v") - (?\$,1(S(B "g") - (?\$,1(T(B "d") - (?\$,1(U(B "e") - (?\$,1(V(B "zh") - (?\$,1(W(B "z") - (?\$,1(X(B "i") - (?\$,1(Y(B "j") - (?\$,1(Z(B "k") - (?\$,1([(B "l") - (?\$,1(\(B "m") - (?\$,1(](B "n") - (?\$,1(^(B "o") - (?\$,1(_(B "p") - (?\$,1(`(B "r") - (?\$,1(a(B "s") - (?\$,1(b(B "t") - (?\$,1(c(B "u") - (?\$,1(d(B "f") - (?\$,1(e(B "h") - (?\$,1(f(B "c") - (?\$,1(g(B "ch") - (?\$,1(h(B "sh") - (?\$,1(i(B "sch") - (?\$,1(j(B "\"") - (?\$,1(k(B "y") - (?\$,1(l(B "'") - (?\$,1(m(B "`e") - (?\$,1(n(B "yu") - (?\$,1(o(B "ya") - (?\$,1(q(B "io") - (?\$,1(r(B "d%") - (?\$,1(s(B "g%") - (?\$,1(t(B "ie") - (?\$,1(u(B "ds") - (?\$,1(v(B "ii") - (?\$,1(w(B "yi") - (?\$,1(x(B "j%") - (?\$,1(y(B "lj") - (?\$,1(z(B "nj") - (?\$,1({(B "ts") - (?\$,1(|(B "kj") - (?\$,1(~(B "v%") - (?\$,1((B "dz") - (?\$,1)"(B "Y3") - (?\$,1)#(B "y3") - (?\$,1)*(B "O3") - (?\$,1)+(B "o3") - (?\$,1)2(B "F3") - (?\$,1)3(B "f3") - (?\$,1)4(B "V3") - (?\$,1)5(B "v3") - (?\$,1)@(B "C3") - (?\$,1)A(B "c3") - (?\$,1)P(B "G3") - (?\$,1)Q(B "g3") - (?\$,1*4(B "AE") - (?\$,1*5(B "ae") - (?\$,1,T(B "i") - (?\$,1,W(B "a") - (?\$,1,X(B "o") - (?\$,1,\(B "u") - (?\$,1,_(B "h") - (?\$,1,b(B ":") - (?\$,1,p(B "#") - (?\$,1,q(B "B+") - (?\$,1,r(B "G+") - (?\$,1,s(B "D+") - (?\$,1,t(B "H+") - (?\$,1,u(B "W+") - (?\$,1,v(B "Z+") - (?\$,1,w(B "X+") - (?\$,1,x(B "Tj") - (?\$,1,y(B "J+") - (?\$,1,z(B "K%") - (?\$,1,{(B "K+") - (?\$,1,|(B "L+") - (?\$,1,}(B "M%") - (?\$,1,~(B "M+") - (?\$,1,(B "N%") - (?\$,1- (B "N+") - (?\$,1-!(B "S+") - (?\$,1-"(B "E+") - (?\$,1-#(B "P%") - (?\$,1-$(B "P+") - (?\$,1-%(B "Zj") - (?\$,1-&(B "ZJ") - (?\$,1-'(B "Q+") - (?\$,1-((B "R+") - (?\$,1-)(B "Sh") - (?\$,1-*(B "T+") - (?\$,1-0(B "v") - (?\$,1-1(B "oy") - (?\$,1-2(B "ey") - (?\$,1-L(B ",+") - (?\$,1-[(B ";+") - (?\$,1-_(B "?+") - (?\$,1-a(B "H'") - (?\$,1-b(B "aM") - (?\$,1-c(B "aH") - (?\$,1-d(B "wH") - (?\$,1-e(B "ah") - (?\$,1-f(B "yH") - (?\$,1-g(B "a+") - (?\$,1-h(B "b+") - (?\$,1-i(B "tm") - (?\$,1-j(B "t+") - (?\$,1-k(B "tk") - (?\$,1-l(B "g+") - (?\$,1-m(B "hk") - (?\$,1-n(B "x+") - (?\$,1-o(B "d+") - (?\$,1-p(B "dk") - (?\$,1-q(B "r+") - (?\$,1-r(B "z+") - (?\$,1-s(B "s+") - (?\$,1-t(B "sn") - (?\$,1-u(B "c+") - (?\$,1-v(B "dd") - (?\$,1-w(B "tj") - (?\$,1-x(B "zH") - (?\$,1-y(B "e+") - (?\$,1-z(B "i+") - (?\$,1. (B "++") - (?\$,1.!(B "f+") - (?\$,1."(B "q+") - (?\$,1.#(B "k+") - (?\$,1.$(B "l+") - (?\$,1.%(B "m+") - (?\$,1.&(B "n+") - (?\$,1.'(B "h+") - (?\$,1.((B "w+") - (?\$,1.)(B "j+") - (?\$,1.*(B "y+") - (?\$,1.+(B ":+") - (?\$,1.,(B "\"+") - (?\$,1.-(B "=+") - (?\$,1..(B "/+") - (?\$,1./(B "'+") - (?\$,1.0(B "1+") - (?\$,1.1(B "3+") - (?\$,1.2(B "0+") - (?\$,1.@(B "0a") - (?\$,1.A(B "1a") - (?\$,1.B(B "2a") - (?\$,1.C(B "3a") - (?\$,1.D(B "4a") - (?\$,1.E(B "5a") - (?\$,1.F(B "6a") - (?\$,1.G(B "7a") - (?\$,1.H(B "8a") - (?\$,1.I(B "9a") - (?\$,1.P(B "aS") - (?\$,1.^(B "p+") - (?\$,1.a(B "hH") - (?\$,1.f(B "tc") - (?\$,1.x(B "zj") - (?\$,1/$(B "v+") - (?\$,1//(B "gf") - (?\$,1/p(B "0a") - (?\$,1/q(B "1a") - (?\$,1/r(B "2a") - (?\$,1/s(B "3a") - (?\$,1/t(B "4a") - (?\$,1/u(B "5a") - (?\$,1/v(B "6a") - (?\$,1/w(B "7a") - (?\$,1/x(B "8a") - (?\$,1/y(B "9a") - (?\$,1M@(B "he") - (?\$,1MA(B "hu") - (?\$,1MB(B "hi") - (?\$,1MC(B "ha") - (?\$,1MD(B "hE") - (?\$,1ME(B "h") - (?\$,1MF(B "ho") - (?\$,1MH(B "le") - (?\$,1MI(B "lu") - (?\$,1MJ(B "li") - (?\$,1MK(B "la") - (?\$,1ML(B "lE") - (?\$,1MM(B "l") - (?\$,1MN(B "lo") - (?\$,1MO(B "lWa") - (?\$,1MP(B "He") - (?\$,1MQ(B "Hu") - (?\$,1MR(B "Hi") - (?\$,1MS(B "Ha") - (?\$,1MT(B "HE") - (?\$,1MU(B "H") - (?\$,1MV(B "Ho") - (?\$,1MW(B "HWa") - (?\$,1MX(B "me") - (?\$,1MY(B "mu") - (?\$,1MZ(B "mi") - (?\$,1M[(B "ma") - (?\$,1M\(B "mE") - (?\$,1M](B "m") - (?\$,1M^(B "mo") - (?\$,1M_(B "mWa") - (?\$,1M`(B "`se") - (?\$,1Ma(B "`su") - (?\$,1Mb(B "`si") - (?\$,1Mc(B "`sa") - (?\$,1Md(B "`sE") - (?\$,1Me(B "`s") - (?\$,1Mf(B "`so") - (?\$,1Mg(B "`sWa") - (?\$,1Mh(B "re") - (?\$,1Mi(B "ru") - (?\$,1Mj(B "ri") - (?\$,1Mk(B "ra") - (?\$,1Ml(B "rE") - (?\$,1Mm(B "r") - (?\$,1Mn(B "ro") - (?\$,1Mo(B "rWa") - (?\$,1Mp(B "se") - (?\$,1Mq(B "su") - (?\$,1Mr(B "si") - (?\$,1Ms(B "sa") - (?\$,1Mt(B "sE") - (?\$,1Mu(B "s") - (?\$,1Mv(B "so") - (?\$,1Mw(B "sWa") - (?\$,1Mx(B "xe") - (?\$,1My(B "xu") - (?\$,1Mz(B "xi") - (?\$,1M{(B "xa") - (?\$,1M|(B "xE") - (?\$,1M}(B "xa") - (?\$,1M~(B "xo") - (?\$,1M(B "xWa") - (?\$,1N (B "qe") - (?\$,1N!(B "qu") - (?\$,1N"(B "qi") - (?\$,1N#(B "qa") - (?\$,1N$(B "qE") - (?\$,1N%(B "q") - (?\$,1N&(B "qo") - (?\$,1N((B "qWe") - (?\$,1N*(B "qWi") - (?\$,1N+(B "qWa") - (?\$,1N,(B "qWE") - (?\$,1N-(B "qW") - (?\$,1N0(B "Qe") - (?\$,1N1(B "Qu") - (?\$,1N2(B "Qi") - (?\$,1N3(B "Qa") - (?\$,1N4(B "QE") - (?\$,1N5(B "Q") - (?\$,1N6(B "Qo") - (?\$,1N8(B "QWe") - (?\$,1N:(B "QWi") - (?\$,1N;(B "QWa") - (?\$,1N<(B "QWE") - (?\$,1N=(B "QW") - (?\$,1N@(B "be") - (?\$,1NA(B "bu") - (?\$,1NB(B "bi") - (?\$,1NC(B "ba") - (?\$,1ND(B "bE") - (?\$,1NE(B "b") - (?\$,1NF(B "bo") - (?\$,1NG(B "bWa") - (?\$,1NH(B "ve") - (?\$,1NI(B "vu") - (?\$,1NJ(B "vi") - (?\$,1NK(B "va") - (?\$,1NL(B "vE") - (?\$,1NM(B "v") - (?\$,1NN(B "vo") - (?\$,1NO(B "vWa") - (?\$,1NP(B "te") - (?\$,1NQ(B "tu") - (?\$,1NR(B "ti") - (?\$,1NS(B "ta") - (?\$,1NT(B "tE") - (?\$,1NU(B "t") - (?\$,1NV(B "to") - (?\$,1NW(B "tWa") - (?\$,1NX(B "ce") - (?\$,1NY(B "cu") - (?\$,1NZ(B "ci") - (?\$,1N[(B "ca") - (?\$,1N\(B "cE") - (?\$,1N](B "c") - (?\$,1N^(B "co") - (?\$,1N_(B "cWa") - (?\$,1N`(B "`he") - (?\$,1Na(B "`hu") - (?\$,1Nb(B "`hi") - (?\$,1Nc(B "`ha") - (?\$,1Nd(B "`hE") - (?\$,1Ne(B "`h") - (?\$,1Nf(B "`ho") - (?\$,1Nh(B "hWe") - (?\$,1Nj(B "hWi") - (?\$,1Nk(B "hWa") - (?\$,1Nl(B "hWE") - (?\$,1Nm(B "hW") - (?\$,1Np(B "na") - (?\$,1Nq(B "nu") - (?\$,1Nr(B "ni") - (?\$,1Ns(B "na") - (?\$,1Nt(B "nE") - (?\$,1Nu(B "n") - (?\$,1Nv(B "no") - (?\$,1Nw(B "nWa") - (?\$,1Nx(B "Ne") - (?\$,1Ny(B "Nu") - (?\$,1Nz(B "Ni") - (?\$,1N{(B "Na") - (?\$,1N|(B "NE") - (?\$,1N}(B "N") - (?\$,1N~(B "No") - (?\$,1N(B "NWa") - (?\$,1O (B "e") - (?\$,1O!(B "u") - (?\$,1O"(B "i") - (?\$,1O#(B "a") - (?\$,1O$(B "E") - (?\$,1O%(B "I") - (?\$,1O&(B "o") - (?\$,1O'(B "e3") - (?\$,1O((B "ke") - (?\$,1O)(B "ku") - (?\$,1O*(B "ki") - (?\$,1O+(B "ka") - (?\$,1O,(B "kE") - (?\$,1O-(B "k") - (?\$,1O.(B "ko") - (?\$,1O0(B "kWe") - (?\$,1O2(B "kWi") - (?\$,1O3(B "kWa") - (?\$,1O4(B "kWE") - (?\$,1O5(B "kW") - (?\$,1O8(B "Ke") - (?\$,1O9(B "Ku") - (?\$,1O:(B "Ki") - (?\$,1O;(B "Ka") - (?\$,1O<(B "KE") - (?\$,1O=(B "K") - (?\$,1O>(B "Ko") - (?\$,1O@(B "KWe") - (?\$,1OB(B "KWi") - (?\$,1OC(B "KWa") - (?\$,1OD(B "KWE") - (?\$,1OE(B "KW") - (?\$,1OH(B "we") - (?\$,1OI(B "wu") - (?\$,1OJ(B "wi") - (?\$,1OK(B "wa") - (?\$,1OL(B "wE") - (?\$,1OM(B "w") - (?\$,1ON(B "wo") - (?\$,1OP(B "`e") - (?\$,1OQ(B "`u") - (?\$,1OR(B "`i") - (?\$,1OS(B "`a") - (?\$,1OT(B "`E") - (?\$,1OU(B "`I") - (?\$,1OV(B "`o") - (?\$,1OX(B "ze") - (?\$,1OY(B "zu") - (?\$,1OZ(B "zi") - (?\$,1O[(B "za") - (?\$,1O\(B "zE") - (?\$,1O](B "z") - (?\$,1O^(B "zo") - (?\$,1O_(B "zWa") - (?\$,1O`(B "Ze") - (?\$,1Oa(B "Zu") - (?\$,1Ob(B "Zi") - (?\$,1Oc(B "Za") - (?\$,1Od(B "ZE") - (?\$,1Oe(B "Z") - (?\$,1Of(B "Zo") - (?\$,1Og(B "ZWa") - (?\$,1Oh(B "ye") - (?\$,1Oi(B "yu") - (?\$,1Oj(B "yi") - (?\$,1Ok(B "ya") - (?\$,1Ol(B "yE") - (?\$,1Om(B "y") - (?\$,1On(B "yo") - (?\$,1Oo(B "yWa") - (?\$,1Op(B "de") - (?\$,1Oq(B "du") - (?\$,1Or(B "di") - (?\$,1Os(B "da") - (?\$,1Ot(B "dE") - (?\$,1Ou(B "d") - (?\$,1Ov(B "do") - (?\$,1Ow(B "dWa") - (?\$,1Ox(B "De") - (?\$,1Oy(B "Du") - (?\$,1Oz(B "Di") - (?\$,1O{(B "Da") - (?\$,1O|(B "DE") - (?\$,1O}(B "D") - (?\$,1O~(B "Do") - (?\$,1O(B "DWa") - (?\$,1P (B "je") - (?\$,1P!(B "ju") - (?\$,1P"(B "ji") - (?\$,1P#(B "ja") - (?\$,1P$(B "jE") - (?\$,1P%(B "j") - (?\$,1P&(B "jo") - (?\$,1P'(B "jWa") - (?\$,1P((B "ga") - (?\$,1P)(B "gu") - (?\$,1P*(B "gi") - (?\$,1P+(B "ga") - (?\$,1P,(B "gE") - (?\$,1P-(B "g") - (?\$,1P.(B "go") - (?\$,1P0(B "gWu") - (?\$,1P2(B "gWi") - (?\$,1P3(B "gWa") - (?\$,1P4(B "gWE") - (?\$,1P5(B "gW") - (?\$,1P8(B "Ge") - (?\$,1P9(B "Gu") - (?\$,1P:(B "Gi") - (?\$,1P;(B "Ga") - (?\$,1P<(B "GE") - (?\$,1P=(B "G") - (?\$,1P>(B "Go") - (?\$,1P?(B "GWa") - (?\$,1P@(B "Te") - (?\$,1PA(B "Tu") - (?\$,1PB(B "Ti") - (?\$,1PC(B "Ta") - (?\$,1PD(B "TE") - (?\$,1PE(B "T") - (?\$,1PF(B "To") - (?\$,1PG(B "TWa") - (?\$,1PH(B "Ce") - (?\$,1PI(B "Ca") - (?\$,1PJ(B "Cu") - (?\$,1PK(B "Ca") - (?\$,1PL(B "CE") - (?\$,1PM(B "C") - (?\$,1PN(B "Co") - (?\$,1PO(B "CWa") - (?\$,1PP(B "Pe") - (?\$,1PQ(B "Pu") - (?\$,1PR(B "Pi") - (?\$,1PS(B "Pa") - (?\$,1PT(B "PE") - (?\$,1PU(B "P") - (?\$,1PV(B "Po") - (?\$,1PW(B "PWa") - (?\$,1PX(B "SWe") - (?\$,1PY(B "SWu") - (?\$,1PZ(B "SWi") - (?\$,1P[(B "SWa") - (?\$,1P\(B "SWE") - (?\$,1P](B "SW") - (?\$,1P^(B "SWo") - (?\$,1P_(B "SWa") - (?\$,1P`(B "`Sa") - (?\$,1Pa(B "`Su") - (?\$,1Pb(B "`Si") - (?\$,1Pc(B "`Sa") - (?\$,1Pd(B "`SE") - (?\$,1Pe(B "`S") - (?\$,1Pf(B "`So") - (?\$,1Ph(B "fa") - (?\$,1Pi(B "fu") - (?\$,1Pj(B "fi") - (?\$,1Pk(B "fa") - (?\$,1Pl(B "fE") - (?\$,1Pm(B "o") - (?\$,1Pn(B "fo") - (?\$,1Po(B "fWa") - (?\$,1Pp(B "pe") - (?\$,1Pq(B "pu") - (?\$,1Pr(B "pi") - (?\$,1Ps(B "pa") - (?\$,1Pt(B "pE") - (?\$,1Pu(B "p") - (?\$,1Pv(B "po") - (?\$,1Pw(B "pWa") - (?\$,1Px(B "mYa") - (?\$,1Py(B "rYa") - (?\$,1Pz(B "fYa") - (?\$,1Q (B " ") - (?\$,1Q!(B ":") - (?\$,1Q"(B "::") - (?\$,1Q#(B ",") - (?\$,1Q$(B ";") - (?\$,1Q%(B "-:") - (?\$,1Q&(B ":-") - (?\$,1Q'(B "`?") - (?\$,1Q((B ":|:") - (?\$,1Q)(B "`1") - (?\$,1Q*(B "`2") - (?\$,1Q+(B "`3") - (?\$,1Q,(B "`4") - (?\$,1Q-(B "`5") - (?\$,1Q.(B "`6") - (?\$,1Q/(B "`7") - (?\$,1Q0(B "`8") - (?\$,1Q1(B "`9") - (?\$,1Q2(B "`10") - (?\$,1Q3(B "`20") - (?\$,1Q4(B "`30") - (?\$,1Q5(B "`40") - (?\$,1Q6(B "`50") - (?\$,1Q7(B "`60") - (?\$,1Q8(B "`70") - (?\$,1Q9(B "`80") - (?\$,1Q:(B "`90") - (?\$,1Q;(B "`100") - (?\$,1Q<(B "`10000") - (?\$,1m@(B "A-0") - (?\$,1mA(B "a-0") - (?\$,1mB(B "B.") - (?\$,1mC(B "b.") - (?\$,1mD(B "B-.") - (?\$,1mE(B "b-.") - (?\$,1mF(B "B_") - (?\$,1mG(B "b_") - (?\$,1mH(B "C,'") - (?\$,1mI(B "c,'") - (?\$,1mJ(B "D.") - (?\$,1mK(B "d.") - (?\$,1mL(B "D-.") - (?\$,1mM(B "d-.") - (?\$,1mN(B "D_") - (?\$,1mO(B "d_") - (?\$,1mP(B "D,") - (?\$,1mQ(B "d,") - (?\$,1mR(B "D->") - (?\$,1mS(B "d->") - (?\$,1mT(B "E-!") - (?\$,1mU(B "e-!") - (?\$,1mV(B "E-'") - (?\$,1mW(B "e-'") - (?\$,1mX(B "E->") - (?\$,1mY(B "e->") - (?\$,1mZ(B "E-?") - (?\$,1m[(B "e-?") - (?\$,1m\(B "E,(") - (?\$,1m](B "e,(") - (?\$,1m^(B "F.") - (?\$,1m_(B "f.") - (?\$,1m`(B "G-") - (?\$,1ma(B "g-") - (?\$,1mb(B "H.") - (?\$,1mc(B "h.") - (?\$,1md(B "H-.") - (?\$,1me(B "h-.") - (?\$,1mf(B "H:") - (?\$,1mg(B "h:") - (?\$,1mh(B "H,") - (?\$,1mi(B "h,") - (?\$,1mj(B "H-(") - (?\$,1mk(B "h-(") - (?\$,1ml(B "I-?") - (?\$,1mm(B "i-?") - (?\$,1mn(B "I:'") - (?\$,1mo(B "i:'") - (?\$,1mp(B "K'") - (?\$,1mq(B "k'") - (?\$,1mr(B "K-.") - (?\$,1ms(B "k-.") - (?\$,1mt(B "K_") - (?\$,1mu(B "k_") - (?\$,1mv(B "L-.") - (?\$,1mw(B "l-.") - (?\$,1mx(B "L--.") - (?\$,1my(B "l--.") - (?\$,1mz(B "L_") - (?\$,1m{(B "l_") - (?\$,1m|(B "L->") - (?\$,1m}(B "l->") - (?\$,1m~(B "M'") - (?\$,1m(B "m'") - (?\$,1n (B "M.") - (?\$,1n!(B "m.") - (?\$,1n"(B "M-.") - (?\$,1n#(B "m-.") - (?\$,1n$(B "N.") - (?\$,1n%(B "n.") - (?\$,1n&(B "N-.") - (?\$,1n'(B "n-.") - (?\$,1n((B "N_") - (?\$,1n)(B "n_") - (?\$,1n*(B "N->") - (?\$,1n+(B "n->") - (?\$,1n,(B "O?'") - (?\$,1n-(B "o?'") - (?\$,1n.(B "O?:") - (?\$,1n/(B "o?:") - (?\$,1n0(B "O-!") - (?\$,1n1(B "o-!") - (?\$,1n2(B "O-'") - (?\$,1n3(B "o-'") - (?\$,1n4(B "P'") - (?\$,1n5(B "p'") - (?\$,1n6(B "P.") - (?\$,1n7(B "p.") - (?\$,1n8(B "R.") - (?\$,1n9(B "r.") - (?\$,1n:(B "R-.") - (?\$,1n;(B "r-.") - (?\$,1n<(B "R--.") - (?\$,1n=(B "r--.") - (?\$,1n>(B "R_") - (?\$,1n?(B "r_") - (?\$,1n@(B "S.") - (?\$,1nA(B "s.") - (?\$,1nB(B "S-.") - (?\$,1nC(B "s-.") - (?\$,1nD(B "S'.") - (?\$,1nE(B "s'.") - (?\$,1nF(B "S<.") - (?\$,1nG(B "s<.") - (?\$,1nH(B "S.-.") - (?\$,1nI(B "s.-.") - (?\$,1nJ(B "T.") - (?\$,1nK(B "t.") - (?\$,1nL(B "T-.") - (?\$,1nM(B "t-.") - (?\$,1nN(B "T_") - (?\$,1nO(B "t_") - (?\$,1nP(B "T->") - (?\$,1nQ(B "t->") - (?\$,1nR(B "U--:") - (?\$,1nS(B "u--:") - (?\$,1nT(B "U-?") - (?\$,1nU(B "u-?") - (?\$,1nV(B "U->") - (?\$,1nW(B "u->") - (?\$,1nX(B "U?'") - (?\$,1nY(B "u?'") - (?\$,1nZ(B "U-:") - (?\$,1n[(B "u-:") - (?\$,1n\(B "V?") - (?\$,1n](B "v?") - (?\$,1n^(B "V-.") - (?\$,1n_(B "v-.") - (?\$,1n`(B "W!") - (?\$,1na(B "w!") - (?\$,1nb(B "W'") - (?\$,1nc(B "w'") - (?\$,1nd(B "W:") - (?\$,1ne(B "w:") - (?\$,1nf(B "W.") - (?\$,1ng(B "w.") - (?\$,1nh(B "W-.") - (?\$,1ni(B "w-.") - (?\$,1nj(B "X.") - (?\$,1nk(B "x.") - (?\$,1nl(B "X:") - (?\$,1nm(B "x:") - (?\$,1nn(B "Y.") - (?\$,1no(B "y.") - (?\$,1np(B "Z>") - (?\$,1nq(B "z>") - (?\$,1nr(B "Z-.") - (?\$,1ns(B "z-.") - (?\$,1nt(B "Z_") - (?\$,1nu(B "z_") - (?\$,1nv(B "h_") - (?\$,1nw(B "t:") - (?\$,1nx(B "w0") - (?\$,1ny(B "y0") - (?\$,1o (B "A-.") - (?\$,1o!(B "a-.") - (?\$,1o"(B "A2") - (?\$,1o#(B "a2") - (?\$,1o$(B "A>'") - (?\$,1o%(B "a>'") - (?\$,1o&(B "A>!") - (?\$,1o'(B "a>!") - (?\$,1o((B "A>2") - (?\$,1o)(B "a>2") - (?\$,1o*(B "A>?") - (?\$,1o+(B "a>?") - (?\$,1o,(B "A>-.") - (?\$,1o-(B "a>-.") - (?\$,1o.(B "A('") - (?\$,1o/(B "a('") - (?\$,1o0(B "A(!") - (?\$,1o1(B "a(!") - (?\$,1o2(B "A(2") - (?\$,1o3(B "a(2") - (?\$,1o4(B "A(?") - (?\$,1o5(B "a(?") - (?\$,1o6(B "A(-.") - (?\$,1o7(B "a(-.") - (?\$,1o8(B "E-.") - (?\$,1o9(B "e-.") - (?\$,1o:(B "E2") - (?\$,1o;(B "e2") - (?\$,1o<(B "E?") - (?\$,1o=(B "e?") - (?\$,1o>(B "E>'") - (?\$,1o?(B "e>'") - (?\$,1o@(B "E>!") - (?\$,1oA(B "e>!") - (?\$,1oB(B "E>2") - (?\$,1oC(B "e>2") - (?\$,1oD(B "E>?") - (?\$,1oE(B "e>?") - (?\$,1oF(B "E>-.") - (?\$,1oG(B "e>-.") - (?\$,1oH(B "I2") - (?\$,1oI(B "i2") - (?\$,1oJ(B "I-.") - (?\$,1oK(B "i-.") - (?\$,1oL(B "O-.") - (?\$,1oM(B "o-.") - (?\$,1oN(B "O2") - (?\$,1oO(B "o2") - (?\$,1oP(B "O>'") - (?\$,1oQ(B "o>'") - (?\$,1oR(B "O>!") - (?\$,1oS(B "o>!") - (?\$,1oT(B "O>2") - (?\$,1oU(B "o>2") - (?\$,1oV(B "O>?") - (?\$,1oW(B "o>?") - (?\$,1oX(B "O>-.") - (?\$,1oY(B "o>-.") - (?\$,1oZ(B "O9'") - (?\$,1o[(B "o9'") - (?\$,1o\(B "O9!") - (?\$,1o](B "o9!") - (?\$,1o^(B "O92") - (?\$,1o_(B "o92") - (?\$,1o`(B "O9?") - (?\$,1oa(B "o9?") - (?\$,1ob(B "O9-.") - (?\$,1oc(B "o9-.") - (?\$,1od(B "U-.") - (?\$,1oe(B "u-.") - (?\$,1of(B "U2") - (?\$,1og(B "u2") - (?\$,1oh(B "U9'") - (?\$,1oi(B "u9'") - (?\$,1oj(B "U9!") - (?\$,1ok(B "u9!") - (?\$,1ol(B "U92") - (?\$,1om(B "u92") - (?\$,1on(B "U9?") - (?\$,1oo(B "u9?") - (?\$,1op(B "U9-.") - (?\$,1oq(B "u9-.") - (?\$,1or(B "Y!") - (?\$,1os(B "y!") - (?\$,1ot(B "Y-.") - (?\$,1ou(B "y-.") - (?\$,1ov(B "Y2") - (?\$,1ow(B "y2") - (?\$,1ox(B "Y?") - (?\$,1oy(B "y?") - (?\$,1p (B "a") - (?\$,1p!(B "ha") - (?\$,1p"(B "`a") - (?\$,1p#(B "h`a") - (?\$,1p$(B "a'") - (?\$,1p%(B "ha'") - (?\$,1p&(B "a~") - (?\$,1p'(B "ha~") - (?\$,1p((B "A") - (?\$,1p)(B "hA") - (?\$,1p*(B "`A") - (?\$,1p+(B "h`A") - (?\$,1p,(B "A'") - (?\$,1p-(B "hA'") - (?\$,1p.(B "A~") - (?\$,1p/(B "hA~") - (?\$,1p1(B "he") - (?\$,1p9(B "hE") - (?\$,1pQ(B "hi") - (?\$,1pY(B "hI") - (?\$,1pa(B "ho") - (?\$,1pi(B "hO") - (?\$,1pq(B "hu") - (?\$,1py(B "hU") - (?\$,1q(B ",,") - (?\$,1r (B "?*") - (?\$,1r!(B "?:") - (?\$,1r-(B ",!") - (?\$,1r.(B ",'") - (?\$,1r/(B "?,") - (?\$,1r=(B ";!") - (?\$,1r>(B ";'") - (?\$,1r?(B "?;") - (?\$,1rE(B "rh") - (?\$,1rL(B "Rh") - (?\$,1rM(B "!:") - (?\$,1rO(B "!*") - (?\$,1r^(B ";;") - (?\$,1r`(B " ") - (?\$,1ra(B " ") - (?\$,1rb(B " ") - (?\$,1rc(B " ") - (?\$,1rd(B " ") - (?\$,1re(B " ") - (?\$,1rf(B " ") - (?\$,1rg(B ",A (B") - (?\$,1rh(B " ") - (?\$,1ri(B " ") - (?\$,1rp(B "-") - (?\$,1rq(B "-") - (?\$,1rs(B "-") - (?\$,1rt(B "--") - (?\$,1ru(B "-") - (?\$,1rv(B "||") - (?\$,1rw(B "=2") - (?\$,1rx(B "`") - (?\$,1ry(B "'") - (?\$,1rz(B "'") - (?\$,1r{(B "'") - (?\$,1r|(B "\"") - (?\$,1r}(B "\"") - (?\$,1r~(B "\"") - (?\$,1r(B "\"") - (?\$,1s (B "/-") - (?\$,1s!(B "/=") - (?\$,1s"(B " o ") - (?\$,1s$(B ".") - (?\$,1s%(B "..") - (?\$,1s&(B "...") - (?\$,1s'(B ",A7(B") - (?\$,1s0(B " 0/00") - (?\$,1s2(B "'") - (?\$,1s3(B "''") - (?\$,1s4(B "'''") - (?\$,1s5(B "`") - (?\$,1s6(B "``") - (?\$,1s7(B "```") - (?\$,1s8(B "Ca") - (?\$,1s9(B "<") - (?\$,1s:(B ">") - (?\$,1s;(B ":X") - (?\$,1s<(B "!!") - (?\$,1s>(B "'-") - (?\$,1sC(B "-") - (?\$,1sD(B "/") - (?\$,1sH(B "?!") - (?\$,1sI(B "!?") - (?\$,1sp(B "^0") - (?\$,1st(B "^4") - (?\$,1su(B "^5") - (?\$,1sv(B "^6") - (?\$,1sw(B "^7") - (?\$,1sx(B "^8") - (?\$,1sy(B "^9") - (?\$,1sz(B "^+") - (?\$,1s{(B "^-") - (?\$,1s|(B "^=") - (?\$,1s}(B "^(") - (?\$,1s~(B "^)") - (?\$,1s(B "^n") - (?\$,1t (B "_0") - (?\$,1t!(B "_1") - (?\$,1t"(B "_2") - (?\$,1t#(B "_3") - (?\$,1t$(B "_4") - (?\$,1t%(B "_5") - (?\$,1t&(B "_6") - (?\$,1t'(B "_7") - (?\$,1t((B "_8") - (?\$,1t)(B "_9") - (?\$,1t*(B "_+") - (?\$,1t+(B "_-") - (?\$,1t,(B "_=") - (?\$,1t-(B "(") - (?\$,1t.(B ")") - (?\$,1tC(B "Ff") - (?\$,1tD(B "Li") - (?\$,1tG(B "Pt") - (?\$,1tI(B "W=") - (?\$,1tL(B "EUR") - (?\$,1u@(B "a/c") - (?\$,1uA(B "a/s") - (?\$,1uC(B "oC") - (?\$,1uE(B "c/o") - (?\$,1uF(B "c/u") - (?\$,1uI(B "oF") - (?\$,1uJ(B "g") - (?\$,1uN(B "h") - (?\$,1uO(B "\\hbar") - (?\$,1uQ(B "Im") - (?\$,1uS(B "l") - (?\$,1uV(B "No.") - (?\$,1uW(B "PO") - (?\$,1uX(B "P") - (?\$,1u\(B "Re") - (?\$,1u^(B "Rx") - (?\$,1u`(B "(SM)") - (?\$,1ua(B "TEL") - (?\$,1ub(B "(TM)") - (?\$,1uf(B "Ohm") - (?\$,1uj(B "K") - (?\$,1uk(B "Ang.") - (?\$,1un(B "est.") - (?\$,1ut(B "o") - (?\$,1uu(B "Aleph ") - (?\$,1uv(B "Bet ") - (?\$,1uw(B "Gimel ") - (?\$,1ux(B "Dalet ") - (?\$,1v3(B " 1/3") - (?\$,1v4(B " 2/3") - (?\$,1v5(B " 1/5") - (?\$,1v6(B " 2/5") - (?\$,1v7(B " 3/5") - (?\$,1v8(B " 4/5") - (?\$,1v9(B " 1/6") - (?\$,1v:(B " 5/6") - (?\$,1v;(B " 1/8") - (?\$,1v<(B " 3/8") - (?\$,1v=(B " 5/8") - (?\$,1v>(B " 7/8") - (?\$,1v?(B " 1/") - (?\$,1v@(B "I") - (?\$,1vA(B "II") - (?\$,1vB(B "III") - (?\$,1vC(B "IV") - (?\$,1vD(B "V") - (?\$,1vE(B "VI") - (?\$,1vF(B "VII") - (?\$,1vG(B "VIII") - (?\$,1vH(B "IX") - (?\$,1vI(B "X") - (?\$,1vJ(B "XI") - (?\$,1vK(B "XII") - (?\$,1vL(B "L") - (?\$,1vM(B "C") - (?\$,1vN(B "D") - (?\$,1vO(B "M") - (?\$,1vP(B "i") - (?\$,1vQ(B "ii") - (?\$,1vR(B "iii") - (?\$,1vS(B "iv") - (?\$,1vT(B "v") - (?\$,1vU(B "vi") - (?\$,1vV(B "vii") - (?\$,1vW(B "viii") - (?\$,1vX(B "ix") - (?\$,1vY(B "x") - (?\$,1vZ(B "xi") - (?\$,1v[(B "xii") - (?\$,1v\(B "l") - (?\$,1v](B "c") - (?\$,1v^(B "d") - (?\$,1v_(B "m") - (?\$,1v`(B "1000RCD") - (?\$,1va(B "5000R") - (?\$,1vb(B "10000R") - (?\$,1vp(B "<-") - (?\$,1vq(B "-^") - (?\$,1vr(B "->") - (?\$,1vs(B "-v") - (?\$,1vt(B "<->") - (?\$,1vu(B "UD") - (?\$,1vv(B "<!!") - (?\$,1vw(B "//>") - (?\$,1vx(B "!!>") - (?\$,1vy(B "<//") - (?\$,1w((B "UD-") - (?\$,1w5(B "RET") - (?\$,1w@(B ">V") - (?\$,1wP(B "<=") - (?\$,1wQ(B "^^") - (?\$,1wR(B "=>") - (?\$,1wS(B "vv") - (?\$,1wT(B "<=>") - (?\$,1x (B "FA") - (?\$,1x"(B "\\partial") - (?\$,1x#(B "TE") - (?\$,1x%(B "{}") - (?\$,1x&(B "Delta") - (?\$,1x'(B "Nabla") - (?\$,1x((B "(-") - (?\$,1x)(B "!(-") - (?\$,1x*(B "(-") - (?\$,1x+(B "-)") - (?\$,1x,(B "!-)") - (?\$,1x-(B "-)") - (?\$,1x.(B " qed") - (?\$,1x/(B "\\prod") - (?\$,1x1(B "\\sum") - (?\$,1x2(B " -") - (?\$,1x3(B "-/+") - (?\$,1x4(B ".+") - (?\$,1x5(B "/") - (?\$,1x6(B " - ") - (?\$,1x7(B "*") - (?\$,1x8(B " ,A0(B ") - (?\$,1x9(B "sb") - (?\$,1x:(B " SQRT ") - (?\$,1x;(B " ROOT,A3(B ") - (?\$,1x<(B " ROOT4 ") - (?\$,1x=(B "0(") - (?\$,1x>(B "infty") - (?\$,1x?(B "-L") - (?\$,1x@(B "-V") - (?\$,1xE(B "PP") - (?\$,1xF(B " !PP ") - (?\$,1xG(B "AND") - (?\$,1xH(B "OR") - (?\$,1xI(B "(U") - (?\$,1xJ(B ")U") - (?\$,1xK(B "\int ") - (?\$,1xL(B "DI") - (?\$,1xN(B "Io") - (?\$,1xT(B ".:") - (?\$,1xU(B ":.") - (?\$,1xV(B ":R") - (?\$,1xW(B "::") - (?\$,1x\(B "?1") - (?\$,1x^(B "CG") - (?\$,1xc(B "?-") - (?\$,1xe(B "?=") - (?\$,1xh(B "~=") - (?\$,1xi(B " !~= ") - (?\$,1xl(B "=?") - (?\$,1xs(B "HI") - (?\$,1xt(B ":=") - (?\$,1xu(B "=:") - (?\$,1y (B "!=") - (?\$,1y!(B "=3") - (?\$,1y"(B " !=3 ") - (?\$,1y$(B "=<") - (?\$,1y%(B ">=") - (?\$,1y&(B ".LE.") - (?\$,1y'(B ".GE.") - (?\$,1y((B ".LT.NOT.EQ.") - (?\$,1y)(B ".GT.NOT.EQ.") - (?\$,1y*(B "<<") - (?\$,1y+(B ">>") - (?\$,1y.(B "!<") - (?\$,1y/(B "!>") - (?\$,1y6(B " <> ") - (?\$,1y7(B " >< ") - (?\$,1yB(B "(C") - (?\$,1yC(B ")C") - (?\$,1yD(B " !(C ") - (?\$,1yE(B " !)C ") - (?\$,1yF(B "(_") - (?\$,1yG(B ")_") - (?\$,1yU(B "(+)") - (?\$,1yV(B "(-)") - (?\$,1yW(B "(,AW(B)") - (?\$,1yX(B "(/)") - (?\$,1yY(B "(,A7(B)") - (?\$,1yZ(B "(,A0(B)") - (?\$,1y[(B "(*)") - (?\$,1y\(B "(=)") - (?\$,1y](B "(-)") - (?\$,1y^(B "[+]") - (?\$,1y_(B "[-]") - (?\$,1y`(B "[,AW(B]") - (?\$,1ya(B "[,A7(B]") - (?\$,1ye(B "-T") - (?\$,1yg(B " MODELS ") - (?\$,1yh(B " TRUE ") - (?\$,1yi(B " FORCES ") - (?\$,1yl(B " !PROVES ") - (?\$,1ym(B " NOT TRUE ") - (?\$,1yn(B " !FORCES ") - (?\$,1yr(B " NORMAL SUBGROUP OF ") - (?\$,1ys(B " CONTAINS AS NORMAL SUBGROUP ") - (?\$,1yt(B " NORMAL SUBGROUP OF OR EQUAL TO ") - (?\$,1yu(B " CONTAINS AS NORMAL SUBGROUP OR EQUAL TO ") - (?\$,1yx(B " MULTIMAP ") - (?\$,1yz(B " INTERCALATE ") - (?\$,1y{(B " XOR ") - (?\$,1y|(B " NAND ") - (?\$,1z%(B " ,A7(B ") - (?\$,1z6(B "<.") - (?\$,1z7(B ">.") - (?\$,1z8(B "<<<") - (?\$,1z9(B ">>>") - (?\$,1zN(B ":3") - (?\$,1zO(B ".3") - (?\$,1zb(B "Eh") - (?\$,1zg(B "~~") - (?\$,1zh(B "<7") - (?\$,1zi(B ">7") - (?\$,1zj(B "7<") - (?\$,1zk(B "7>") - (?\$,1zp(B "NI") - (?\$,1zr(B "(A") - (?\$,1zu(B "TR") - (?\$,1zx(B "88") - (?\$,1{ (B "Iu") - (?\$,1{!(B "Il") - (?\$,1{"(B ":(") - (?\$,1{#(B ":)") - (?\$,1{$(B "|^|") - (?\$,1{'(B "[X]") - (?\$,1{)(B "</") - (?\$,1{*(B "/>") - (?\$,1}c(B "Vs") - (?\$,1~ (B "1h") - (?\$,1~!(B "3h") - (?\$,1~"(B "2h") - (?\$,1~#(B "4h") - (?\$,1~&(B "1j") - (?\$,1~'(B "2j") - (?\$,1~((B "3j") - (?\$,1~)(B "4j") - (?\$,1~@(B "1-o") - (?\$,1~A(B "2-o") - (?\$,1~B(B "3-o") - (?\$,1~C(B "4-o") - (?\$,1~D(B "5-o") - (?\$,1~E(B "6-o") - (?\$,1~F(B "7-o") - (?\$,1~G(B "8-o") - (?\$,1~H(B "9-o") - (?\$,1~I(B "10-o") - (?\$,1~J(B "11-o") - (?\$,1~K(B "12-o") - (?\$,1~L(B "13-o") - (?\$,1~M(B "14-o") - (?\$,1~N(B "15-o") - (?\$,1~O(B "16-o") - (?\$,1~P(B "17-o") - (?\$,1~Q(B "18-o") - (?\$,1~R(B "19-o") - (?\$,1~S(B "20-o") - (?\$,1~T(B "(1)") - (?\$,1~U(B "(2)") - (?\$,1~V(B "(3)") - (?\$,1~W(B "(4)") - (?\$,1~X(B "(5)") - (?\$,1~Y(B "(6)") - (?\$,1~Z(B "(7)") - (?\$,1~[(B "(8)") - (?\$,1~\(B "(9)") - (?\$,1~](B "(10)") - (?\$,1~^(B "(11)") - (?\$,1~_(B "(12)") - (?\$,1~`(B "(13)") - (?\$,1~a(B "(14)") - (?\$,1~b(B "(15)") - (?\$,1~c(B "(16)") - (?\$,1~d(B "(17)") - (?\$,1~e(B "(18)") - (?\$,1~f(B "(19)") - (?\$,1~g(B "(20)") - (?\$,1~h(B "1.") - (?\$,1~i(B "2.") - (?\$,1~j(B "3.") - (?\$,1~k(B "4.") - (?\$,1~l(B "5.") - (?\$,1~m(B "6.") - (?\$,1~n(B "7.") - (?\$,1~o(B "8.") - (?\$,1~p(B "9.") - (?\$,1~q(B "10.") - (?\$,1~r(B "11.") - (?\$,1~s(B "12.") - (?\$,1~t(B "13.") - (?\$,1~u(B "14.") - (?\$,1~v(B "15.") - (?\$,1~w(B "16.") - (?\$,1~x(B "17.") - (?\$,1~y(B "18.") - (?\$,1~z(B "19.") - (?\$,1~{(B "20.") - (?\$,1~|(B "(a)") - (?\$,1~}(B "(b)") - (?\$,1~~(B "(c)") - (?\$,1~(B "(d)") - (?\$,1 (B "(e)") - (?\$,1!(B "(f)") - (?\$,1"(B "(g)") - (?\$,1#(B "(h)") - (?\$,1$(B "(i)") - (?\$,1%(B "(j)") - (?\$,1&(B "(k)") - (?\$,1'(B "(l)") - (?\$,1((B "(m)") - (?\$,1)(B "(n)") - (?\$,1*(B "(o)") - (?\$,1+(B "(p)") - (?\$,1,(B "(q)") - (?\$,1-(B "(r)") - (?\$,1.(B "(s)") - (?\$,1/(B "(t)") - (?\$,10(B "(u)") - (?\$,11(B "(v)") - (?\$,12(B "(w)") - (?\$,13(B "(x)") - (?\$,14(B "(y)") - (?\$,15(B "(z)") - (?\$,16(B "A-o") - (?\$,17(B "B-o") - (?\$,18(B "C-o") - (?\$,19(B "D-o") - (?\$,1:(B "E-o") - (?\$,1;(B "F-o") - (?\$,1<(B "G-o") - (?\$,1=(B "H-o") - (?\$,1>(B "I-o") - (?\$,1?(B "J-o") - (?\$,1@(B "K-o") - (?\$,1A(B "L-o") - (?\$,1B(B "M-o") - (?\$,1C(B "N-o") - (?\$,1D(B "O-o") - (?\$,1E(B "P-o") - (?\$,1F(B "Q-o") - (?\$,1G(B "R-o") - (?\$,1H(B "S-o") - (?\$,1I(B "T-o") - (?\$,1J(B "U-o") - (?\$,1K(B "V-o") - (?\$,1L(B "W-o") - (?\$,1M(B "X-o") - (?\$,1N(B "Y-o") - (?\$,1O(B "Z-o") - (?\$,1P(B "a-o") - (?\$,1Q(B "b-o") - (?\$,1R(B "c-o") - (?\$,1S(B "d-o") - (?\$,1T(B "e-o") - (?\$,1U(B "f-o") - (?\$,1V(B "g-o") - (?\$,1W(B "h-o") - (?\$,1X(B "i-o") - (?\$,1Y(B "j-o") - (?\$,1Z(B "k-o") - (?\$,1[(B "l-o") - (?\$,1\(B "m-o") - (?\$,1](B "n-o") - (?\$,1^(B "o-o") - (?\$,1_(B "p-o") - (?\$,1`(B "q-o") - (?\$,1a(B "r-o") - (?\$,1b(B "s-o") - (?\$,1c(B "t-o") - (?\$,1d(B "u-o") - (?\$,1e(B "v-o") - (?\$,1f(B "w-o") - (?\$,1g(B "x-o") - (?\$,1h(B "y-o") - (?\$,1i(B "z-o") - (?\$,1j(B "0-o") - (?\$,2 (B "-") - (?\$,2 !(B "=") - (?\$,2 "(B "|") - (?\$,2 #(B "|") - (?\$,2 $(B "-") - (?\$,2 %(B "=") - (?\$,2 &(B "|") - (?\$,2 '(B "|") - (?\$,2 ((B "-") - (?\$,2 )(B "=") - (?\$,2 *(B "|") - (?\$,2 +(B "|") - (?\$,2 ,(B "+") - (?\$,2 -(B "+") - (?\$,2 .(B "+") - (?\$,2 /(B "+") - (?\$,2 0(B "+") - (?\$,2 1(B "+") - (?\$,2 2(B "+") - (?\$,2 3(B "+") - (?\$,2 4(B "+") - (?\$,2 5(B "+") - (?\$,2 6(B "+") - (?\$,2 7(B "+") - (?\$,2 8(B "+") - (?\$,2 9(B "+") - (?\$,2 :(B "+") - (?\$,2 ;(B "+") - (?\$,2 <(B "+") - (?\$,2 =(B "+") - (?\$,2 >(B "+") - (?\$,2 ?(B "+") - (?\$,2 @(B "+") - (?\$,2 A(B "+") - (?\$,2 B(B "+") - (?\$,2 C(B "+") - (?\$,2 D(B "+") - (?\$,2 E(B "+") - (?\$,2 F(B "+") - (?\$,2 G(B "+") - (?\$,2 H(B "+") - (?\$,2 I(B "+") - (?\$,2 J(B "+") - (?\$,2 K(B "+") - (?\$,2 L(B "+") - (?\$,2 M(B "+") - (?\$,2 N(B "+") - (?\$,2 O(B "+") - (?\$,2 P(B "+") - (?\$,2 Q(B "+") - (?\$,2 R(B "+") - (?\$,2 S(B "+") - (?\$,2 T(B "+") - (?\$,2 U(B "+") - (?\$,2 V(B "+") - (?\$,2 W(B "+") - (?\$,2 X(B "+") - (?\$,2 Y(B "+") - (?\$,2 Z(B "+") - (?\$,2 [(B "+") - (?\$,2 \(B "+") - (?\$,2 ](B "+") - (?\$,2 ^(B "+") - (?\$,2 _(B "+") - (?\$,2 `(B "+") - (?\$,2 a(B "+") - (?\$,2 b(B "+") - (?\$,2 c(B "+") - (?\$,2 d(B "+") - (?\$,2 e(B "+") - (?\$,2 f(B "+") - (?\$,2 g(B "+") - (?\$,2 h(B "+") - (?\$,2 i(B "+") - (?\$,2 j(B "+") - (?\$,2 k(B "+") - (?\$,2 l(B "+") - (?\$,2 m(B "+") - (?\$,2 n(B "+") - (?\$,2 o(B "+") - (?\$,2 p(B "+") - (?\$,2 q(B "+") - (?\$,2 r(B "+") - (?\$,2 s(B "+") - (?\$,2 t(B "+") - (?\$,2 u(B "+") - (?\$,2 v(B "+") - (?\$,2 w(B "+") - (?\$,2 x(B "+") - (?\$,2 y(B "+") - (?\$,2 z(B "+") - (?\$,2 {(B "+") - (?\$,2 |(B "+") - (?\$,2 }(B "+") - (?\$,2 ~(B "+") - (?\$,2 (B "+") - (?\$,2! (B "+") - (?\$,2!!(B "+") - (?\$,2!"(B "+") - (?\$,2!#(B "+") - (?\$,2!$(B "+") - (?\$,2!%(B "+") - (?\$,2!&(B "+") - (?\$,2!'(B "+") - (?\$,2!((B "+") - (?\$,2!)(B "+") - (?\$,2!*(B "+") - (?\$,2!+(B "+") - (?\$,2!,(B "+") - (?\$,2!1(B "/") - (?\$,2!2(B "\\") - (?\$,2!@(B "TB") - (?\$,2!D(B "LB") - (?\$,2!H(B "FB") - (?\$,2!L(B "lB") - (?\$,2!P(B "RB") - (?\$,2!Q(B ".S") - (?\$,2!R(B ":S") - (?\$,2!S(B "?S") - (?\$,2!`(B "fS") - (?\$,2!a(B "OS") - (?\$,2!b(B "RO") - (?\$,2!c(B "Rr") - (?\$,2!d(B "RF") - (?\$,2!e(B "RY") - (?\$,2!f(B "RH") - (?\$,2!g(B "RZ") - (?\$,2!h(B "RK") - (?\$,2!i(B "RX") - (?\$,2!j(B "sB") - (?\$,2!l(B "SR") - (?\$,2!m(B "Or") - (?\$,2!r(B "^") - (?\$,2!s(B "uT") - (?\$,2!v(B "|>") - (?\$,2!w(B "Tr") - (?\$,2!z(B "|>") - (?\$,2!|(B "v") - (?\$,2!}(B "dT") - (?\$,2" (B "<|") - (?\$,2"!(B "Tl") - (?\$,2"$(B "<|") - (?\$,2"&(B "Db") - (?\$,2"'(B "Dw") - (?\$,2"*(B "LZ") - (?\$,2"+(B "0m") - (?\$,2".(B "0o") - (?\$,2"/(B "0M") - (?\$,2"0(B "0L") - (?\$,2"1(B "0R") - (?\$,2"8(B "Sn") - (?\$,2"9(B "Ic") - (?\$,2"B(B "Fd") - (?\$,2"C(B "Bd") - (?\$,2"O(B "Ci") - (?\$,2"e(B "*2") - (?\$,2"f(B "*1") - (?\$,2"n(B "TEL") - (?\$,2"o(B "tel") - (?\$,2"|(B "<--") - (?\$,2"~(B "-->") - (?\$,2#!(B "CAUTION ") - (?\$,2#'(B "XP") - (?\$,2#9(B ":-(") - (?\$,2#:(B ":-)") - (?\$,2#;(B "(-:") - (?\$,2#<(B "SU") - (?\$,2#@(B "f.") - (?\$,2#B(B "m.") - (?\$,2#`(B "cS") - (?\$,2#a(B "cH") - (?\$,2#b(B "cD") - (?\$,2#c(B "cC") - (?\$,2#d(B "cS-") - (?\$,2#e(B "cH-") - (?\$,2#f(B "cD-") - (?\$,2#g(B "cC-") - (?\$,2#i(B "Md") - (?\$,2#j(B "M8") - (?\$,2#k(B "M2") - (?\$,2#l(B "M16") - (?\$,2#m(B "b") - (?\$,2#n(B "Mx") - (?\$,2#o(B "#") - (?\$,2%S(B "X") - (?\$,2%W(B "X") - (?\$,2%`(B "-X") - (?\$,2=@(B " ") - (?\$,2=A(B ",_") - (?\$,2=B(B "._") - (?\$,2=C(B "+\"") - (?\$,2=D(B "JIS") - (?\$,2=E(B "*_") - (?\$,2=F(B ";_") - (?\$,2=G(B "0_") - (?\$,2=J(B "<+") - (?\$,2=K(B ">+") - (?\$,2=L(B "<'") - (?\$,2=M(B ">'") - (?\$,2=N(B "<\"") - (?\$,2=O(B ">\"") - (?\$,2=P(B "(\"") - (?\$,2=Q(B ")\"") - (?\$,2=R(B "=T") - (?\$,2=S(B "=_") - (?\$,2=T(B "('") - (?\$,2=U(B ")'") - (?\$,2=V(B "(I") - (?\$,2=W(B ")I") - (?\$,2=Z(B "[[") - (?\$,2=[(B "]]") - (?\$,2=\(B "-?") - (?\$,2=`(B "=T:)") - (?\$,2=(B " ") - (?\$,2>!(B "A5") - (?\$,2>"(B "a5") - (?\$,2>#(B "I5") - (?\$,2>$(B "i5") - (?\$,2>%(B "U5") - (?\$,2>&(B "u5") - (?\$,2>'(B "E5") - (?\$,2>((B "e5") - (?\$,2>)(B "O5") - (?\$,2>*(B "o5") - (?\$,2>+(B "ka") - (?\$,2>,(B "ga") - (?\$,2>-(B "ki") - (?\$,2>.(B "gi") - (?\$,2>/(B "ku") - (?\$,2>0(B "gu") - (?\$,2>1(B "ke") - (?\$,2>2(B "ge") - (?\$,2>3(B "ko") - (?\$,2>4(B "go") - (?\$,2>5(B "sa") - (?\$,2>6(B "za") - (?\$,2>7(B "si") - (?\$,2>8(B "zi") - (?\$,2>9(B "su") - (?\$,2>:(B "zu") - (?\$,2>;(B "se") - (?\$,2><(B "ze") - (?\$,2>=(B "so") - (?\$,2>>(B "zo") - (?\$,2>?(B "ta") - (?\$,2>@(B "da") - (?\$,2>A(B "ti") - (?\$,2>B(B "di") - (?\$,2>C(B "tU") - (?\$,2>D(B "tu") - (?\$,2>E(B "du") - (?\$,2>F(B "te") - (?\$,2>G(B "de") - (?\$,2>H(B "to") - (?\$,2>I(B "do") - (?\$,2>J(B "na") - (?\$,2>K(B "ni") - (?\$,2>L(B "nu") - (?\$,2>M(B "ne") - (?\$,2>N(B "no") - (?\$,2>O(B "ha") - (?\$,2>P(B "ba") - (?\$,2>Q(B "pa") - (?\$,2>R(B "hi") - (?\$,2>S(B "bi") - (?\$,2>T(B "pi") - (?\$,2>U(B "hu") - (?\$,2>V(B "bu") - (?\$,2>W(B "pu") - (?\$,2>X(B "he") - (?\$,2>Y(B "be") - (?\$,2>Z(B "pe") - (?\$,2>[(B "ho") - (?\$,2>\(B "bo") - (?\$,2>](B "po") - (?\$,2>^(B "ma") - (?\$,2>_(B "mi") - (?\$,2>`(B "mu") - (?\$,2>a(B "me") - (?\$,2>b(B "mo") - (?\$,2>c(B "yA") - (?\$,2>d(B "ya") - (?\$,2>e(B "yU") - (?\$,2>f(B "yu") - (?\$,2>g(B "yO") - (?\$,2>h(B "yo") - (?\$,2>i(B "ra") - (?\$,2>j(B "ri") - (?\$,2>k(B "ru") - (?\$,2>l(B "re") - (?\$,2>m(B "ro") - (?\$,2>n(B "wA") - (?\$,2>o(B "wa") - (?\$,2>p(B "wi") - (?\$,2>q(B "we") - (?\$,2>r(B "wo") - (?\$,2>s(B "n5") - (?\$,2>t(B "vu") - (?\$,2>{(B "\"5") - (?\$,2>|(B "05") - (?\$,2>}(B "*5") - (?\$,2>~(B "+5") - (?\$,2?!(B "a6") - (?\$,2?"(B "A6") - (?\$,2?#(B "i6") - (?\$,2?$(B "I6") - (?\$,2?%(B "u6") - (?\$,2?&(B "U6") - (?\$,2?'(B "e6") - (?\$,2?((B "E6") - (?\$,2?)(B "o6") - (?\$,2?*(B "O6") - (?\$,2?+(B "Ka") - (?\$,2?,(B "Ga") - (?\$,2?-(B "Ki") - (?\$,2?.(B "Gi") - (?\$,2?/(B "Ku") - (?\$,2?0(B "Gu") - (?\$,2?1(B "Ke") - (?\$,2?2(B "Ge") - (?\$,2?3(B "Ko") - (?\$,2?4(B "Go") - (?\$,2?5(B "Sa") - (?\$,2?6(B "Za") - (?\$,2?7(B "Si") - (?\$,2?8(B "Zi") - (?\$,2?9(B "Su") - (?\$,2?:(B "Zu") - (?\$,2?;(B "Se") - (?\$,2?<(B "Ze") - (?\$,2?=(B "So") - (?\$,2?>(B "Zo") - (?\$,2??(B "Ta") - (?\$,2?@(B "Da") - (?\$,2?A(B "Ti") - (?\$,2?B(B "Di") - (?\$,2?C(B "TU") - (?\$,2?D(B "Tu") - (?\$,2?E(B "Du") - (?\$,2?F(B "Te") - (?\$,2?G(B "De") - (?\$,2?H(B "To") - (?\$,2?I(B "Do") - (?\$,2?J(B "Na") - (?\$,2?K(B "Ni") - (?\$,2?L(B "Nu") - (?\$,2?M(B "Ne") - (?\$,2?N(B "No") - (?\$,2?O(B "Ha") - (?\$,2?P(B "Ba") - (?\$,2?Q(B "Pa") - (?\$,2?R(B "Hi") - (?\$,2?S(B "Bi") - (?\$,2?T(B "Pi") - (?\$,2?U(B "Hu") - (?\$,2?V(B "Bu") - (?\$,2?W(B "Pu") - (?\$,2?X(B "He") - (?\$,2?Y(B "Be") - (?\$,2?Z(B "Pe") - (?\$,2?[(B "Ho") - (?\$,2?\(B "Bo") - (?\$,2?](B "Po") - (?\$,2?^(B "Ma") - (?\$,2?_(B "Mi") - (?\$,2?`(B "Mu") - (?\$,2?a(B "Me") - (?\$,2?b(B "Mo") - (?\$,2?c(B "YA") - (?\$,2?d(B "Ya") - (?\$,2?e(B "YU") - (?\$,2?f(B "Yu") - (?\$,2?g(B "YO") - (?\$,2?h(B "Yo") - (?\$,2?i(B "Ra") - (?\$,2?j(B "Ri") - (?\$,2?k(B "Ru") - (?\$,2?l(B "Re") - (?\$,2?m(B "Ro") - (?\$,2?n(B "WA") - (?\$,2?o(B "Wa") - (?\$,2?p(B "Wi") - (?\$,2?q(B "We") - (?\$,2?r(B "Wo") - (?\$,2?s(B "N6") - (?\$,2?t(B "Vu") - (?\$,2?u(B "KA") - (?\$,2?v(B "KE") - (?\$,2?w(B "Va") - (?\$,2?x(B "Vi") - (?\$,2?y(B "Ve") - (?\$,2?z(B "Vo") - (?\$,2?{(B ".6") - (?\$,2?|(B "-6") - (?\$,2?}(B "*6") - (?\$,2?~(B "+6") - (?\$,2@%(B "b4") - (?\$,2@&(B "p4") - (?\$,2@'(B "m4") - (?\$,2@((B "f4") - (?\$,2@)(B "d4") - (?\$,2@*(B "t4") - (?\$,2@+(B "n4") - (?\$,2@,(B "l4") - (?\$,2@-(B "g4") - (?\$,2@.(B "k4") - (?\$,2@/(B "h4") - (?\$,2@0(B "j4") - (?\$,2@1(B "q4") - (?\$,2@2(B "x4") - (?\$,2@3(B "zh") - (?\$,2@4(B "ch") - (?\$,2@5(B "sh") - (?\$,2@6(B "r4") - (?\$,2@7(B "z4") - (?\$,2@8(B "c4") - (?\$,2@9(B "s4") - (?\$,2@:(B "a4") - (?\$,2@;(B "o4") - (?\$,2@<(B "e4") - (?\$,2@=(B "eh4") - (?\$,2@>(B "ai") - (?\$,2@?(B "ei") - (?\$,2@@(B "au") - (?\$,2@A(B "ou") - (?\$,2@B(B "an") - (?\$,2@C(B "en") - (?\$,2@D(B "aN") - (?\$,2@E(B "eN") - (?\$,2@F(B "er") - (?\$,2@G(B "i4") - (?\$,2@H(B "u4") - (?\$,2@I(B "iu") - (?\$,2@J(B "v4") - (?\$,2@K(B "nG") - (?\$,2@L(B "gn") - (?\$,2B|(B "(JU)") - (?\$,2C (B "1c") - (?\$,2C!(B "2c") - (?\$,2C"(B "3c") - (?\$,2C#(B "4c") - (?\$,2C$(B "5c") - (?\$,2C%(B "6c") - (?\$,2C&(B "7c") - (?\$,2C'(B "8c") - (?\$,2C((B "9c") - (?\$,2C)(B "10c") - (?\$,2C(B "KSC") - (?\$,2GB(B "am") - (?\$,2GX(B "pm") - (?\$,3h (B "ff") - (?\$,3h!(B "fi") - (?\$,3h"(B "fl") - (?\$,3h#(B "ffi") - (?\$,3h$(B "ffl") - (?\$,3h%(B "St") - (?\$,3h&(B "st") - (?\$,3q=(B "3+;") - (?\$,3qB(B "aM.") - (?\$,3qD(B "aH.") - (?\$,3qH(B "ah.") - (?\$,3qM(B "a+-") - (?\$,3qN(B "a+.") - (?\$,3qO(B "b+-") - (?\$,3qP(B "b+.") - (?\$,3qQ(B "b+,") - (?\$,3qR(B "b+;") - (?\$,3qS(B "tm-") - (?\$,3qT(B "tm.") - (?\$,3qU(B "t+-") - (?\$,3qV(B "t+.") - (?\$,3qW(B "t+,") - (?\$,3qX(B "t+;") - (?\$,3qY(B "tk-") - (?\$,3qZ(B "tk.") - (?\$,3q[(B "tk,") - (?\$,3q\(B "tk;") - (?\$,3q](B "g+-") - (?\$,3q^(B "g+.") - (?\$,3q_(B "g+,") - (?\$,3q`(B "g+;") - (?\$,3qa(B "hk-") - (?\$,3qb(B "hk.") - (?\$,3qc(B "hk,") - (?\$,3qd(B "hk;") - (?\$,3qe(B "x+-") - (?\$,3qf(B "x+.") - (?\$,3qg(B "x+,") - (?\$,3qh(B "x+;") - (?\$,3qi(B "d+-") - (?\$,3qj(B "d+.") - (?\$,3qk(B "dk-") - (?\$,3ql(B "dk.") - (?\$,3qm(B "r+-") - (?\$,3qn(B "r+.") - (?\$,3qo(B "z+-") - (?\$,3qp(B "z+.") - (?\$,3qq(B "s+-") - (?\$,3qr(B "s+.") - (?\$,3qs(B "s+,") - (?\$,3qt(B "s+;") - (?\$,3qu(B "sn-") - (?\$,3qv(B "sn.") - (?\$,3qw(B "sn,") - (?\$,3qx(B "sn;") - (?\$,3qy(B "c+-") - (?\$,3qz(B "c+.") - (?\$,3q{(B "c+,") - (?\$,3q|(B "c+;") - (?\$,3q}(B "dd-") - (?\$,3q~(B "dd.") - (?\$,3q(B "dd,") - (?\$,3r (B "dd;") - (?\$,3r!(B "tj-") - (?\$,3r"(B "tj.") - (?\$,3r#(B "tj,") - (?\$,3r$(B "tj;") - (?\$,3r%(B "zH-") - (?\$,3r&(B "zH.") - (?\$,3r'(B "zH,") - (?\$,3r((B "zH;") - (?\$,3r)(B "e+-") - (?\$,3r*(B "e+.") - (?\$,3r+(B "e+,") - (?\$,3r,(B "e+;") - (?\$,3r-(B "i+-") - (?\$,3r.(B "i+.") - (?\$,3r/(B "i+,") - (?\$,3r0(B "i+;") - (?\$,3r1(B "f+-") - (?\$,3r2(B "f+.") - (?\$,3r3(B "f+,") - (?\$,3r4(B "f+;") - (?\$,3r5(B "q+-") - (?\$,3r6(B "q+.") - (?\$,3r7(B "q+,") - (?\$,3r8(B "q+;") - (?\$,3r9(B "k+-") - (?\$,3r:(B "k+.") - (?\$,3r;(B "k+,") - (?\$,3r<(B "k+;") - (?\$,3r=(B "l+-") - (?\$,3r>(B "l+.") - (?\$,3r?(B "l+,") - (?\$,3r@(B "l+;") - (?\$,3rA(B "m+-") - (?\$,3rB(B "m+.") - (?\$,3rC(B "m+,") - (?\$,3rD(B "m+;") - (?\$,3rE(B "n+-") - (?\$,3rF(B "n+.") - (?\$,3rG(B "n+,") - (?\$,3rH(B "n+;") - (?\$,3rI(B "h+-") - (?\$,3rJ(B "h+.") - (?\$,3rK(B "h+,") - (?\$,3rL(B "h+;") - (?\$,3rM(B "w+-") - (?\$,3rN(B "w+.") - (?\$,3rO(B "j+-") - (?\$,3rP(B "j+.") - (?\$,3rQ(B "y+-") - (?\$,3rR(B "y+.") - (?\$,3rS(B "y+,") - (?\$,3rT(B "y+;") - (?\$,3rU(B "lM-") - (?\$,3rV(B "lM.") - (?\$,3rW(B "lH-") - (?\$,3rX(B "lH.") - (?\$,3rY(B "lh-") - (?\$,3rZ(B "lh.") - (?\$,3r[(B "la-") - (?\$,3r\(B "la.") - (?\$,3ra(B "!") - (?\$,3rb(B "\"") - (?\$,3rc(B "#") - (?\$,3rd(B "$") - (?\$,3re(B "%") - (?\$,3rf(B "&") - (?\$,3rg(B "'") - (?\$,3rh(B "(") - (?\$,3ri(B ")") - (?\$,3rj(B "*") - (?\$,3rk(B "+") - (?\$,3rl(B ",") - (?\$,3rm(B "-") - (?\$,3rn(B ".") - (?\$,3ro(B "/") - (?\$,3rp(B "0") - (?\$,3rq(B "1") - (?\$,3rr(B "2") - (?\$,3rs(B "3") - (?\$,3rt(B "4") - (?\$,3ru(B "5") - (?\$,3rv(B "6") - (?\$,3rw(B "7") - (?\$,3rx(B "8") - (?\$,3ry(B "9") - (?\$,3rz(B ":") - (?\$,3r{(B ";") - (?\$,3r|(B "<") - (?\$,3r}(B "=") - (?\$,3r~(B ">") - (?\$,3r(B "?") - (?\$,3s (B "@") - (?\$,3s!(B "A") - (?\$,3s"(B "B") - (?\$,3s#(B "C") - (?\$,3s$(B "D") - (?\$,3s%(B "E") - (?\$,3s&(B "F") - (?\$,3s'(B "G") - (?\$,3s((B "H") - (?\$,3s)(B "I") - (?\$,3s*(B "J") - (?\$,3s+(B "K") - (?\$,3s,(B "L") - (?\$,3s-(B "M") - (?\$,3s.(B "N") - (?\$,3s/(B "O") - (?\$,3s0(B "P") - (?\$,3s1(B "Q") - (?\$,3s2(B "R") - (?\$,3s3(B "S") - (?\$,3s4(B "T") - (?\$,3s5(B "U") - (?\$,3s6(B "V") - (?\$,3s7(B "W") - (?\$,3s8(B "X") - (?\$,3s9(B "Y") - (?\$,3s:(B "Z") - (?\$,3s;(B "[") - (?\$,3s<(B "\\") - (?\$,3s=(B "]") - (?\$,3s>(B "^") - (?\$,3s?(B "_") - (?\$,3s@(B "`") - (?\$,3sA(B "a") - (?\$,3sB(B "b") - (?\$,3sC(B "c") - (?\$,3sD(B "d") - (?\$,3sE(B "e") - (?\$,3sF(B "f") - (?\$,3sG(B "g") - (?\$,3sH(B "h") - (?\$,3sI(B "i") - (?\$,3sJ(B "j") - (?\$,3sK(B "k") - (?\$,3sL(B "l") - (?\$,3sM(B "m") - (?\$,3sN(B "n") - (?\$,3sO(B "o") - (?\$,3sP(B "p") - (?\$,3sQ(B "q") - (?\$,3sR(B "r") - (?\$,3sS(B "s") - (?\$,3sT(B "t") - (?\$,3sU(B "u") - (?\$,3sV(B "v") - (?\$,3sW(B "w") - (?\$,3sX(B "x") - (?\$,3sY(B "y") - (?\$,3sZ(B "z") - (?\$,3s[(B "{") - (?\$,3s\(B "|") - (?\$,3s](B "}") - (?\$,3s^(B "~") - (?\$,3sa(B ".") - (?\$,3sb(B "\"") - (?\$,3sc(B "\"") - (?\$,3sd(B ",") + '((?\Ä€ "A") + (?\Ä "a") + (?\Ä‚ "A") + (?\ă "a") + (?\Ä„ "A") + (?\Ä… "a") + (?\Ć "C") + (?\ć "c") + (?\Ĉ "C") + (?\ĉ "c") + (?\ÄŠ "C") + (?\Ä‹ "c") + (?\ÄŒ "C") + (?\Ä "c") + (?\ÄŽ "D") + (?\Ä "d") + (?\Ä "Ã") + (?\Ä‘ "d/") + (?\Ä’ "E") + (?\Ä“ "e") + (?\Ä” "E") + (?\Ä• "e") + (?\Ä– "E") + (?\Ä— "e") + (?\Ę "E") + (?\Ä™ "e") + (?\Äš "E") + (?\Ä› "e") + (?\Äœ "G") + (?\Ä "g") + (?\Äž "G") + (?\ÄŸ "g") + (?\Ä "G") + (?\Ä¡ "g") + (?\Ä¢ "G") + (?\Ä£ "g") + (?\Ĥ "H") + (?\Ä¥ "h") + (?\Ħ "H/") + (?\ħ "H") + (?\Ĩ "I") + (?\Ä© "i") + (?\Ī "I") + (?\Ä« "i") + (?\Ĭ "I") + (?\Ä "i") + (?\Ä® "I") + (?\į "i") + (?\Ä° "I") + (?\ı "i") + (?\IJ "IJ") + (?\ij "ij") + (?\Ä´ "J") + (?\ĵ "j") + (?\Ķ "K") + (?\Ä· "k") + (?\ĸ "kk") + (?\Ĺ "L") + (?\ĺ "l") + (?\Ä» "L") + (?\ļ "l") + (?\Ľ "L") + (?\ľ "l") + (?\Ä¿ "L.") + (?\Å€ "l.") + (?\Å "L/") + (?\Å‚ "l/") + (?\Ń "N") + (?\Å„ "n") + (?\Å… "N") + (?\ņ "n") + (?\Ň "N") + (?\ň "n") + (?\ʼn "'n") + (?\ÅŠ "NG") + (?\Å‹ "N") + (?\ÅŒ "O") + (?\Å "o") + (?\ÅŽ "O") + (?\Å "o") + (?\Å "O\"") + (?\Å‘ "o\"") + (?\Å’ "OE") + (?\Å“ "oe") + (?\Å” "R") + (?\Å• "r") + (?\Å– "R") + (?\Å— "r") + (?\Ř "R") + (?\Å™ "r") + (?\Åš "S") + (?\Å› "s") + (?\Åœ "S") + (?\Å "s") + (?\Åž "S") + (?\ÅŸ "s") + (?\Å "S") + (?\Å¡ "s") + (?\Å¢ "T") + (?\Å£ "t") + (?\Ť "T") + (?\Å¥ "t") + (?\Ŧ "T/") + (?\ŧ "t/") + (?\Ũ "U") + (?\Å© "u") + (?\Ū "U") + (?\Å« "u") + (?\Ŭ "U") + (?\Å "u") + (?\Å® "U") + (?\ů "u") + (?\Å° "U\"") + (?\ű "u\"") + (?\Ų "U") + (?\ų "u") + (?\Å´ "W") + (?\ŵ "w") + (?\Ŷ "Y") + (?\Å· "y") + (?\Ÿ "Y") + (?\Ź "Z") + (?\ź "z") + (?\Å» "Z") + (?\ż "z") + (?\Ž "Z") + (?\ž "z") + (?\Å¿ "s1") + (?\Ƈ "C2") + (?\ƈ "c2") + (?\Æ‘ "F2") + (?\Æ’ " f") + (?\Ƙ "K2") + (?\Æ™ "k2") + (?\Æ "O9") + (?\Æ¡ "o9") + (?\Æ¢ "OI") + (?\Æ£ "oi") + (?\Ʀ "yr") + (?\Ư "U9") + (?\Æ° "u9") + (?\Ƶ "Z/") + (?\ƶ "z/") + (?\Æ· "ED") + (?\Ç "A") + (?\ÇŽ "a") + (?\Ç "I") + (?\Ç "i") + (?\Ç‘ "O") + (?\Ç’ "o") + (?\Ç“ "U") + (?\Ç” "u") + (?\Ç• "U:-") + (?\Ç– "u:-") + (?\Ç— "U:'") + (?\ǘ "u:'") + (?\Ç™ "U:<") + (?\Çš "u:<") + (?\Ç› "U:!") + (?\Çœ "u:!") + (?\Çž "A1") + (?\ÇŸ "a1") + (?\Ç "A7") + (?\Ç¡ "a7") + (?\Ç¢ "A3") + (?\Ç£ "a3") + (?\Ǥ "G/") + (?\Ç¥ "g/") + (?\Ǧ "G") + (?\ǧ "g") + (?\Ǩ "K") + (?\Ç© "k") + (?\Ǫ "O") + (?\Ç« "o") + (?\Ǭ "O1") + (?\Ç "o1") + (?\Ç® "EZ") + (?\ǯ "ez") + (?\Ç° "j") + (?\Ç´ "G") + (?\ǵ "g") + (?\Ǻ "AA'") + (?\Ç» "aa'") + (?\Ǽ "AE'") + (?\ǽ "ae'") + (?\Ǿ "O/'") + (?\Ç¿ "o/'") + (?\È€ "A!!") + (?\È "a!!") + (?\È‚ "A)") + (?\ȃ "a)") + (?\È„ "E!!") + (?\È… "e!!") + (?\Ȇ "E)") + (?\ȇ "e)") + (?\Ȉ "I!!") + (?\ȉ "i!!") + (?\ÈŠ "I)") + (?\È‹ "i)") + (?\ÈŒ "O!!") + (?\È "o!!") + (?\ÈŽ "O)") + (?\È "o)") + (?\È "R!!") + (?\È‘ "r!!") + (?\È’ "R)") + (?\È“ "r)") + (?\È” "U!!") + (?\È• "u!!") + (?\È– "U)") + (?\È— "u)") + (?\È "Z") + (?\É‘ "A") + (?\É’ "A.") + (?\É“ "b`") + (?\É” "O") + (?\É– "d.") + (?\É— "d`") + (?\ɘ "@<umd>") + (?\É™ "@") + (?\Éš "R") + (?\É› "E") + (?\Éœ "V\"") + (?\É "R<umd>") + (?\Éž "O\"") + (?\ÉŸ "J") + (?\É "g`") + (?\É¡ "g") + (?\É¢ "G") + (?\É£ "Q") + (?\ɤ "o-") + (?\É¥ "j<rnd>") + (?\ɦ "h<?>") + (?\ɨ "i\"") + (?\É© "I") + (?\ɪ "I") + (?\É« "L") + (?\ɬ "L") + (?\É "l.") + (?\É® "z<lat>") + (?\ɯ "u-") + (?\É° "j<vel>") + (?\ɱ "M") + (?\ɳ "n.") + (?\É´ "n\"") + (?\ɵ "@.") + (?\ɶ "&.") + (?\É· "U") + (?\ɹ "r") + (?\ɺ "*<lat>") + (?\É» "r.") + (?\ɽ "*.") + (?\ɾ "*") + (?\Ê€ "R") + (?\Ê "g\"") + (?\Ê‚ "s.") + (?\ʃ "S") + (?\Ê„ "J`") + (?\ʇ "t!") + (?\ʈ "t.") + (?\ʉ "u\"") + (?\ÊŠ "U") + (?\Ê‹ "r<lbd>") + (?\ÊŒ "V") + (?\Ê "w<vls>") + (?\ÊŽ "l^") + (?\Ê "I.") + (?\Ê "z.") + (?\Ê’ "Z") + (?\Ê” "?") + (?\Ê• "H<vcd>") + (?\Ê– "l!") + (?\Ê— "c!") + (?\ʘ "p!") + (?\Ê™ "b<trl>") + (?\Ê› "G`") + (?\Ê "j") + (?\Êž "k!") + (?\ÊŸ "L") + (?\Ê "q`") + (?\ʤ "d3") + (?\ʦ "ts") + (?\ʧ "tS") + (?\Ê° "<h>") + (?\ʱ "<?>") + (?\ʲ ";") + (?\ʳ "<r>") + (?\Ê· "<w>") + (?\Ê» ";S") + (?\ʼ "`") + (?\ˆ "^") + (?\ˇ "'<") + (?\ˈ "|") + (?\ˉ "1-") + (?\Ë‹ "1!") + (?\Ë ":") + (?\Ë‘ ":\\") + (?\Ë– "+") + (?\Ë— "-") + (?\˘ "'(") + (?\Ë™ "'.") + (?\Ëš "'0") + (?\Ë› "';") + (?\Ëœ "~") + (?\Ë "'\"") + (?\Ë¥ "_T") + (?\˦ "_H") + (?\˧ "_M") + (?\˨ "_L") + (?\Ë© "_B") + (?\ˬ "_v") + (?\Ë® "''") + (?\Ì€ "`") + (?\Ì "'") + (?\Ì‚ "^") + (?\̃ "~") + (?\Ì„ "¯") + (?\̇ "·") + (?\̈ "¨") + (?\ÌŠ "°") + (?\Ì‹ "''") + (?\Ì "|") + (?\ÌŽ "||") + (?\Ì "``") + (?\Ì¡ ";") + (?\Ì¢ ".") + (?\Ì£ ".") + (?\̤ "<?>") + (?\Ì¥ "<o>") + (?\̦ ",") + (?\̧ "¸") + (?\Ì© "-") + (?\̪ "[") + (?\Ì« "<w>") + (?\Ì´ "~") + (?\Ì· "/") + (?\̸ "/") + (?\Í€ "`") + (?\Í "'") + (?\Í‚ "~") + (?\Í„ "'%") + (?\Í… "j3") + (?\͇ "=") + (?\Í "~~") + (?\Í´ "'") + (?\͵ ",") + (?\ͺ "j3") + (?\; "?%") + (?\΄ "'*") + (?\Î… "'%") + (?\Ά "A'") + (?\· "·") + (?\Έ "E'") + (?\Ή "Y%") + (?\Ί "I'") + (?\ÎŒ "O'") + (?\ÎŽ "U%") + (?\Î "W%") + (?\Î "i3") + (?\Α "A") + (?\Î’ "B") + (?\Γ "G") + (?\Δ "D") + (?\Ε "E") + (?\Ζ "Z") + (?\Η "Y") + (?\Θ "TH") + (?\Ι "I") + (?\Κ "K") + (?\Λ "L") + (?\Îœ "M") + (?\Î "N") + (?\Ξ "C") + (?\Ο "O") + (?\Î "P") + (?\Ρ "R") + (?\Σ "S") + (?\Τ "T") + (?\Î¥ "U") + (?\Φ "F") + (?\Χ "X") + (?\Ψ "Q") + (?\Ω "W*") + (?\Ϊ "J") + (?\Ϋ "V*") + (?\ά "a'") + (?\Î "e'") + (?\ή "y%") + (?\ί "i'") + (?\ΰ "u3") + (?\α "a") + (?\β "b") + (?\γ "g") + (?\δ "d") + (?\ε "e") + (?\ζ "z") + (?\η "y") + (?\θ "th") + (?\ι "i") + (?\κ "k") + (?\λ "l") + (?\μ "µ") + (?\ν "n") + (?\ξ "c") + (?\ο "o") + (?\Ï€ "p") + (?\Ï "r") + (?\Ï‚ "*s") + (?\σ "s") + (?\Ï„ "t") + (?\Ï… "u") + (?\φ "f") + (?\χ "x") + (?\ψ "q") + (?\ω "w") + (?\ÏŠ "j") + (?\Ï‹ "v*") + (?\ÏŒ "o'") + (?\Ï "u%") + (?\ÏŽ "w%") + (?\Ï "beta ") + (?\Ï‘ "theta ") + (?\Ï’ "upsi ") + (?\Ï• "phi ") + (?\Ï– "pi ") + (?\Ï— "k.") + (?\Ïš "T3") + (?\Ï› "t3") + (?\Ïœ "M3") + (?\Ï "m3") + (?\Ïž "K3") + (?\ÏŸ "k3") + (?\Ï "P3") + (?\Ï¡ "p3") + (?\Ï° "kappa ") + (?\ϱ "rho ") + (?\ϳ "J") + (?\Ï´ "'%") + (?\ϵ "j3") + (?\Ð "IO") + (?\Ђ "D%") + (?\Ѓ "G%") + (?\Є "IE") + (?\Ð… "DS") + (?\І "II") + (?\Ї "YI") + (?\Ј "J%") + (?\Љ "LJ") + (?\Њ "NJ") + (?\Ћ "Ts") + (?\ÐŒ "KJ") + (?\ÐŽ "V%") + (?\Ð "DZ") + (?\Ð "A") + (?\Б "B") + (?\Ð’ "V") + (?\Г "G") + (?\Д "D") + (?\Е "E") + (?\Ж "ZH") + (?\З "Z") + (?\И "I") + (?\Й "J") + (?\К "K") + (?\Л "L") + (?\Ðœ "M") + (?\Ð "N") + (?\О "O") + (?\П "P") + (?\Ð "R") + (?\С "S") + (?\Т "T") + (?\У "U") + (?\Ф "F") + (?\Ð¥ "H") + (?\Ц "C") + (?\Ч "CH") + (?\Ш "SH") + (?\Щ "SCH") + (?\Ъ "\"") + (?\Ы "Y") + (?\Ь "'") + (?\Ð "`E") + (?\Ю "YU") + (?\Я "YA") + (?\а "a") + (?\б "b") + (?\в "v") + (?\г "g") + (?\д "d") + (?\е "e") + (?\ж "zh") + (?\з "z") + (?\и "i") + (?\й "j") + (?\к "k") + (?\л "l") + (?\м "m") + (?\н "n") + (?\о "o") + (?\п "p") + (?\Ñ€ "r") + (?\Ñ "s") + (?\Ñ‚ "t") + (?\у "u") + (?\Ñ„ "f") + (?\Ñ… "h") + (?\ц "c") + (?\ч "ch") + (?\ш "sh") + (?\щ "sch") + (?\ÑŠ "\"") + (?\Ñ‹ "y") + (?\ÑŒ "'") + (?\Ñ "`e") + (?\ÑŽ "yu") + (?\Ñ "ya") + (?\Ñ‘ "io") + (?\Ñ’ "d%") + (?\Ñ“ "g%") + (?\Ñ” "ie") + (?\Ñ• "ds") + (?\Ñ– "ii") + (?\Ñ— "yi") + (?\ј "j%") + (?\Ñ™ "lj") + (?\Ñš "nj") + (?\Ñ› "ts") + (?\Ñœ "kj") + (?\Ñž "v%") + (?\ÑŸ "dz") + (?\Ñ¢ "Y3") + (?\Ñ£ "y3") + (?\Ѫ "O3") + (?\Ñ« "o3") + (?\Ѳ "F3") + (?\ѳ "f3") + (?\Ñ´ "V3") + (?\ѵ "v3") + (?\Ò€ "C3") + (?\Ò "c3") + (?\Ò "G3") + (?\Ò‘ "g3") + (?\Ó” "AE") + (?\Ó• "ae") + (?\Ö´ "i") + (?\Ö· "a") + (?\Ö¸ "o") + (?\Ö¼ "u") + (?\Ö¿ "h") + (?\ׂ ":") + (?\× "#") + (?\ב "B+") + (?\×’ "G+") + (?\ד "D+") + (?\×” "H+") + (?\ו "W+") + (?\×– "Z+") + (?\×— "X+") + (?\ט "Tj") + (?\×™ "J+") + (?\ך "K%") + (?\×› "K+") + (?\ל "L+") + (?\× "M%") + (?\מ "M+") + (?\ן "N%") + (?\× "N+") + (?\ס "S+") + (?\×¢ "E+") + (?\×£ "P%") + (?\פ "P+") + (?\×¥ "Zj") + (?\צ "ZJ") + (?\ק "Q+") + (?\ר "R+") + (?\ש "Sh") + (?\ת "T+") + (?\×° "v") + (?\×± "oy") + (?\ײ "ey") + (?\ØŒ ",+") + (?\Ø› ";+") + (?\ØŸ "?+") + (?\Ø¡ "H'") + (?\Ø¢ "aM") + (?\Ø£ "aH") + (?\ؤ "wH") + (?\Ø¥ "ah") + (?\ئ "yH") + (?\ا "a+") + (?\ب "b+") + (?\Ø© "tm") + (?\ت "t+") + (?\Ø« "tk") + (?\ج "g+") + (?\Ø "hk") + (?\Ø® "x+") + (?\د "d+") + (?\Ø° "dk") + (?\ر "r+") + (?\ز "z+") + (?\س "s+") + (?\Ø´ "sn") + (?\ص "c+") + (?\ض "dd") + (?\Ø· "tj") + (?\ظ "zH") + (?\ع "e+") + (?\غ "i+") + (?\Ù€ "++") + (?\Ù "f+") + (?\Ù‚ "q+") + (?\Ùƒ "k+") + (?\Ù„ "l+") + (?\Ù… "m+") + (?\Ù† "n+") + (?\Ù‡ "h+") + (?\Ùˆ "w+") + (?\Ù‰ "j+") + (?\ÙŠ "y+") + (?\Ù‹ ":+") + (?\ÙŒ "\"+") + (?\Ù "=+") + (?\ÙŽ "/+") + (?\Ù "'+") + (?\Ù "1+") + (?\Ù‘ "3+") + (?\Ù’ "0+") + (?\Ù "0a") + (?\Ù¡ "1a") + (?\Ù¢ "2a") + (?\Ù£ "3a") + (?\Ù¤ "4a") + (?\Ù¥ "5a") + (?\Ù¦ "6a") + (?\Ù§ "7a") + (?\Ù¨ "8a") + (?\Ù© "9a") + (?\Ù° "aS") + (?\Ù¾ "p+") + (?\Ú "hH") + (?\Ú† "tc") + (?\Ú˜ "zj") + (?\Ú¤ "v+") + (?\Ú¯ "gf") + (?\Û° "0a") + (?\Û± "1a") + (?\Û² "2a") + (?\Û³ "3a") + (?\Û´ "4a") + (?\Ûµ "5a") + (?\Û¶ "6a") + (?\Û· "7a") + (?\Û¸ "8a") + (?\Û¹ "9a") + (?\ሀ "he") + (?\ሠ"hu") + (?\ሂ "hi") + (?\ሃ "ha") + (?\ሄ "hE") + (?\ህ "h") + (?\ሆ "ho") + (?\ለ "le") + (?\ሉ "lu") + (?\ሊ "li") + (?\ላ "la") + (?\ሌ "lE") + (?\ሠ"l") + (?\ሎ "lo") + (?\ሠ"lWa") + (?\ሠ"He") + (?\ሑ "Hu") + (?\ሒ "Hi") + (?\ሓ "Ha") + (?\ሔ "HE") + (?\ሕ "H") + (?\ሖ "Ho") + (?\ሗ "HWa") + (?\መ "me") + (?\ሙ "mu") + (?\ሚ "mi") + (?\ማ "ma") + (?\ሜ "mE") + (?\ሠ"m") + (?\ሞ "mo") + (?\ሟ "mWa") + (?\ሠ"`se") + (?\ሡ "`su") + (?\ሢ "`si") + (?\ሣ "`sa") + (?\ሤ "`sE") + (?\ሥ "`s") + (?\ሦ "`so") + (?\ሧ "`sWa") + (?\ረ "re") + (?\ሩ "ru") + (?\ሪ "ri") + (?\ራ "ra") + (?\ሬ "rE") + (?\ሠ"r") + (?\ሮ "ro") + (?\ሯ "rWa") + (?\ሰ "se") + (?\ሱ "su") + (?\ሲ "si") + (?\ሳ "sa") + (?\ሴ "sE") + (?\ስ "s") + (?\ሶ "so") + (?\ሷ "sWa") + (?\ሸ "xe") + (?\ሹ "xu") + (?\ሺ "xi") + (?\ሻ "xa") + (?\ሼ "xE") + (?\ሽ "xa") + (?\ሾ "xo") + (?\ሿ "xWa") + (?\ቀ "qe") + (?\በ"qu") + (?\ቂ "qi") + (?\ቃ "qa") + (?\ቄ "qE") + (?\ቅ "q") + (?\ቆ "qo") + (?\ቈ "qWe") + (?\ቊ "qWi") + (?\ቋ "qWa") + (?\ቌ "qWE") + (?\በ"qW") + (?\በ"Qe") + (?\ቑ "Qu") + (?\ቒ "Qi") + (?\ቓ "Qa") + (?\ቔ "QE") + (?\ቕ "Q") + (?\ቖ "Qo") + (?\ቘ "QWe") + (?\ቚ "QWi") + (?\ቛ "QWa") + (?\ቜ "QWE") + (?\በ"QW") + (?\በ"be") + (?\ቡ "bu") + (?\ቢ "bi") + (?\ባ "ba") + (?\ቤ "bE") + (?\ብ "b") + (?\ቦ "bo") + (?\ቧ "bWa") + (?\ቨ "ve") + (?\ቩ "vu") + (?\ቪ "vi") + (?\ቫ "va") + (?\ቬ "vE") + (?\በ"v") + (?\ቮ "vo") + (?\ቯ "vWa") + (?\ተ "te") + (?\ቱ "tu") + (?\ቲ "ti") + (?\ታ "ta") + (?\ቴ "tE") + (?\ት "t") + (?\ቶ "to") + (?\ቷ "tWa") + (?\ቸ "ce") + (?\ቹ "cu") + (?\ቺ "ci") + (?\ቻ "ca") + (?\ቼ "cE") + (?\ች "c") + (?\ቾ "co") + (?\ቿ "cWa") + (?\ኀ "`he") + (?\አ"`hu") + (?\ኂ "`hi") + (?\ኃ "`ha") + (?\ኄ "`hE") + (?\ኅ "`h") + (?\ኆ "`ho") + (?\ኈ "hWe") + (?\ኊ "hWi") + (?\ኋ "hWa") + (?\ኌ "hWE") + (?\አ"hW") + (?\አ"na") + (?\ኑ "nu") + (?\ኒ "ni") + (?\ና "na") + (?\ኔ "nE") + (?\ን "n") + (?\ኖ "no") + (?\ኗ "nWa") + (?\ኘ "Ne") + (?\ኙ "Nu") + (?\ኚ "Ni") + (?\ኛ "Na") + (?\ኜ "NE") + (?\አ"N") + (?\ኞ "No") + (?\ኟ "NWa") + (?\አ"e") + (?\ኡ "u") + (?\ኢ "i") + (?\ኣ "a") + (?\ኤ "E") + (?\እ "I") + (?\ኦ "o") + (?\ኧ "e3") + (?\ከ "ke") + (?\ኩ "ku") + (?\ኪ "ki") + (?\ካ "ka") + (?\ኬ "kE") + (?\አ"k") + (?\ኮ "ko") + (?\ኰ "kWe") + (?\ኲ "kWi") + (?\ኳ "kWa") + (?\ኴ "kWE") + (?\ኵ "kW") + (?\ኸ "Ke") + (?\ኹ "Ku") + (?\ኺ "Ki") + (?\ኻ "Ka") + (?\ኼ "KE") + (?\ኽ "K") + (?\ኾ "Ko") + (?\á‹€ "KWe") + (?\á‹‚ "KWi") + (?\ዃ "KWa") + (?\á‹„ "KWE") + (?\á‹… "KW") + (?\ወ "we") + (?\ዉ "wu") + (?\á‹Š "wi") + (?\á‹‹ "wa") + (?\á‹Œ "wE") + (?\á‹ "w") + (?\á‹Ž "wo") + (?\á‹ "`e") + (?\á‹‘ "`u") + (?\á‹’ "`i") + (?\á‹“ "`a") + (?\á‹” "`E") + (?\á‹• "`I") + (?\á‹– "`o") + (?\ዘ "ze") + (?\á‹™ "zu") + (?\á‹š "zi") + (?\á‹› "za") + (?\á‹œ "zE") + (?\á‹ "z") + (?\á‹ž "zo") + (?\á‹Ÿ "zWa") + (?\á‹ "Ze") + (?\á‹¡ "Zu") + (?\á‹¢ "Zi") + (?\á‹£ "Za") + (?\ዤ "ZE") + (?\á‹¥ "Z") + (?\ዦ "Zo") + (?\ዧ "ZWa") + (?\የ "ye") + (?\á‹© "yu") + (?\ዪ "yi") + (?\á‹« "ya") + (?\ዬ "yE") + (?\á‹ "y") + (?\á‹® "yo") + (?\ዯ "yWa") + (?\á‹° "de") + (?\ዱ "du") + (?\ዲ "di") + (?\ዳ "da") + (?\á‹´ "dE") + (?\ድ "d") + (?\ዶ "do") + (?\á‹· "dWa") + (?\ዸ "De") + (?\ዹ "Du") + (?\ዺ "Di") + (?\á‹» "Da") + (?\ዼ "DE") + (?\ዽ "D") + (?\ዾ "Do") + (?\á‹¿ "DWa") + (?\ጀ "je") + (?\ጠ"ju") + (?\ጂ "ji") + (?\ጃ "ja") + (?\ጄ "jE") + (?\ጅ "j") + (?\ጆ "jo") + (?\ጇ "jWa") + (?\ገ "ga") + (?\ጉ "gu") + (?\ጊ "gi") + (?\ጋ "ga") + (?\ጌ "gE") + (?\ጠ"g") + (?\ጎ "go") + (?\ጠ"gWu") + (?\ጒ "gWi") + (?\ጓ "gWa") + (?\ጔ "gWE") + (?\ጕ "gW") + (?\ጘ "Ge") + (?\ጙ "Gu") + (?\ጚ "Gi") + (?\ጛ "Ga") + (?\ጜ "GE") + (?\ጠ"G") + (?\ጞ "Go") + (?\ጟ "GWa") + (?\ጠ"Te") + (?\ጡ "Tu") + (?\ጢ "Ti") + (?\ጣ "Ta") + (?\ጤ "TE") + (?\ጥ "T") + (?\ጦ "To") + (?\ጧ "TWa") + (?\ጨ "Ce") + (?\ጩ "Ca") + (?\ጪ "Cu") + (?\ጫ "Ca") + (?\ጬ "CE") + (?\ጠ"C") + (?\ጮ "Co") + (?\ጯ "CWa") + (?\ጰ "Pe") + (?\ጱ "Pu") + (?\ጲ "Pi") + (?\ጳ "Pa") + (?\ጴ "PE") + (?\ጵ "P") + (?\ጶ "Po") + (?\ጷ "PWa") + (?\ጸ "SWe") + (?\ጹ "SWu") + (?\ጺ "SWi") + (?\ጻ "SWa") + (?\ጼ "SWE") + (?\ጽ "SW") + (?\ጾ "SWo") + (?\ጿ "SWa") + (?\ဠ"`Sa") + (?\á "`Su") + (?\á‚ "`Si") + (?\რ"`Sa") + (?\á„ "`SE") + (?\á… "`S") + (?\ᆠ"`So") + (?\ሠ"fa") + (?\በ"fu") + (?\አ"fi") + (?\á‹ "fa") + (?\ጠ"fE") + (?\á "o") + (?\Ꭰ"fo") + (?\á "fWa") + (?\á "pe") + (?\á‘ "pu") + (?\á’ "pi") + (?\á“ "pa") + (?\á” "pE") + (?\á• "p") + (?\á– "po") + (?\á— "pWa") + (?\ᘠ"mYa") + (?\á™ "rYa") + (?\áš "fYa") + (?\á " ") + (?\á¡ ":") + (?\ᢠ"::") + (?\ᣠ",") + (?\ᤠ";") + (?\ᥠ"-:") + (?\ᦠ":-") + (?\᧠"`?") + (?\ᨠ":|:") + (?\á© "`1") + (?\᪠"`2") + (?\á« "`3") + (?\ᬠ"`4") + (?\á "`5") + (?\á® "`6") + (?\ᯠ"`7") + (?\á° "`8") + (?\á± "`9") + (?\á² "`10") + (?\á³ "`20") + (?\á´ "`30") + (?\áµ "`40") + (?\ᶠ"`50") + (?\á· "`60") + (?\Ḡ"`70") + (?\á¹ "`80") + (?\Ạ"`90") + (?\á» "`100") + (?\á¼ "`10000") + (?\Ḁ "A-0") + (?\Ḡ"a-0") + (?\Ḃ "B.") + (?\ḃ "b.") + (?\Ḅ "B-.") + (?\ḅ "b-.") + (?\Ḇ "B_") + (?\ḇ "b_") + (?\Ḉ "C,'") + (?\ḉ "c,'") + (?\Ḋ "D.") + (?\ḋ "d.") + (?\Ḍ "D-.") + (?\Ḡ"d-.") + (?\Ḏ "D_") + (?\Ḡ"d_") + (?\Ḡ"D,") + (?\ḑ "d,") + (?\Ḓ "D->") + (?\ḓ "d->") + (?\Ḕ "E-!") + (?\ḕ "e-!") + (?\Ḗ "E-'") + (?\ḗ "e-'") + (?\Ḙ "E->") + (?\ḙ "e->") + (?\Ḛ "E-?") + (?\ḛ "e-?") + (?\Ḝ "E,(") + (?\Ḡ"e,(") + (?\Ḟ "F.") + (?\ḟ "f.") + (?\Ḡ"G-") + (?\ḡ "g-") + (?\Ḣ "H.") + (?\ḣ "h.") + (?\Ḥ "H-.") + (?\ḥ "h-.") + (?\Ḧ "H:") + (?\ḧ "h:") + (?\Ḩ "H,") + (?\ḩ "h,") + (?\Ḫ "H-(") + (?\ḫ "h-(") + (?\Ḭ "I-?") + (?\Ḡ"i-?") + (?\Ḯ "I:'") + (?\ḯ "i:'") + (?\Ḱ "K'") + (?\ḱ "k'") + (?\Ḳ "K-.") + (?\ḳ "k-.") + (?\Ḵ "K_") + (?\ḵ "k_") + (?\Ḷ "L-.") + (?\ḷ "l-.") + (?\Ḹ "L--.") + (?\ḹ "l--.") + (?\Ḻ "L_") + (?\ḻ "l_") + (?\Ḽ "L->") + (?\ḽ "l->") + (?\Ḿ "M'") + (?\ḿ "m'") + (?\á¹€ "M.") + (?\á¹ "m.") + (?\Ṃ "M-.") + (?\ṃ "m-.") + (?\Ṅ "N.") + (?\á¹… "n.") + (?\Ṇ "N-.") + (?\ṇ "n-.") + (?\Ṉ "N_") + (?\ṉ "n_") + (?\Ṋ "N->") + (?\ṋ "n->") + (?\Ṍ "O?'") + (?\á¹ "o?'") + (?\Ṏ "O?:") + (?\á¹ "o?:") + (?\á¹ "O-!") + (?\ṑ "o-!") + (?\á¹’ "O-'") + (?\ṓ "o-'") + (?\á¹” "P'") + (?\ṕ "p'") + (?\á¹– "P.") + (?\á¹— "p.") + (?\Ṙ "R.") + (?\á¹™ "r.") + (?\Ṛ "R-.") + (?\á¹› "r-.") + (?\Ṝ "R--.") + (?\á¹ "r--.") + (?\Ṟ "R_") + (?\ṟ "r_") + (?\á¹ "S.") + (?\ṡ "s.") + (?\á¹¢ "S-.") + (?\á¹£ "s-.") + (?\Ṥ "S'.") + (?\á¹¥ "s'.") + (?\Ṧ "S<.") + (?\ṧ "s<.") + (?\Ṩ "S.-.") + (?\ṩ "s.-.") + (?\Ṫ "T.") + (?\ṫ "t.") + (?\Ṭ "T-.") + (?\á¹ "t-.") + (?\á¹® "T_") + (?\ṯ "t_") + (?\á¹° "T->") + (?\á¹± "t->") + (?\á¹² "U--:") + (?\á¹³ "u--:") + (?\á¹´ "U-?") + (?\á¹µ "u-?") + (?\Ṷ "U->") + (?\á¹· "u->") + (?\Ṹ "U?'") + (?\á¹¹ "u?'") + (?\Ṻ "U-:") + (?\á¹» "u-:") + (?\á¹¼ "V?") + (?\á¹½ "v?") + (?\á¹¾ "V-.") + (?\ṿ "v-.") + (?\Ẁ "W!") + (?\Ạ"w!") + (?\Ẃ "W'") + (?\ẃ "w'") + (?\Ẅ "W:") + (?\ẅ "w:") + (?\Ẇ "W.") + (?\ẇ "w.") + (?\Ẉ "W-.") + (?\ẉ "w-.") + (?\Ẋ "X.") + (?\ẋ "x.") + (?\Ẍ "X:") + (?\Ạ"x:") + (?\Ẏ "Y.") + (?\Ạ"y.") + (?\Ạ"Z>") + (?\ẑ "z>") + (?\Ẓ "Z-.") + (?\ẓ "z-.") + (?\Ẕ "Z_") + (?\ẕ "z_") + (?\ẖ "h_") + (?\ẗ "t:") + (?\ẘ "w0") + (?\ẙ "y0") + (?\Ạ"A-.") + (?\ạ "a-.") + (?\Ả "A2") + (?\ả "a2") + (?\Ấ "A>'") + (?\ấ "a>'") + (?\Ầ "A>!") + (?\ầ "a>!") + (?\Ẩ "A>2") + (?\ẩ "a>2") + (?\Ẫ "A>?") + (?\ẫ "a>?") + (?\Ậ "A>-.") + (?\Ạ"a>-.") + (?\Ắ "A('") + (?\ắ "a('") + (?\Ằ "A(!") + (?\ằ "a(!") + (?\Ẳ "A(2") + (?\ẳ "a(2") + (?\Ẵ "A(?") + (?\ẵ "a(?") + (?\Ặ "A(-.") + (?\ặ "a(-.") + (?\Ẹ "E-.") + (?\ẹ "e-.") + (?\Ẻ "E2") + (?\ẻ "e2") + (?\Ẽ "E?") + (?\ẽ "e?") + (?\Ế "E>'") + (?\ế "e>'") + (?\Ề "E>!") + (?\á» "e>!") + (?\Ể "E>2") + (?\ể "e>2") + (?\Ễ "E>?") + (?\á»… "e>?") + (?\Ệ "E>-.") + (?\ệ "e>-.") + (?\Ỉ "I2") + (?\ỉ "i2") + (?\Ị "I-.") + (?\ị "i-.") + (?\Ọ "O-.") + (?\á» "o-.") + (?\Ỏ "O2") + (?\á» "o2") + (?\á» "O>'") + (?\ố "o>'") + (?\á»’ "O>!") + (?\ồ "o>!") + (?\á»” "O>2") + (?\ổ "o>2") + (?\á»– "O>?") + (?\á»— "o>?") + (?\Ộ "O>-.") + (?\á»™ "o>-.") + (?\Ớ "O9'") + (?\á»› "o9'") + (?\Ờ "O9!") + (?\á» "o9!") + (?\Ở "O92") + (?\ở "o92") + (?\á» "O9?") + (?\ỡ "o9?") + (?\Ợ "O9-.") + (?\ợ "o9-.") + (?\Ụ "U-.") + (?\ụ "u-.") + (?\Ủ "U2") + (?\ủ "u2") + (?\Ứ "U9'") + (?\ứ "u9'") + (?\Ừ "U9!") + (?\ừ "u9!") + (?\Ử "U92") + (?\á» "u92") + (?\á»® "U9?") + (?\ữ "u9?") + (?\á»° "U9-.") + (?\á»± "u9-.") + (?\Ỳ "Y!") + (?\ỳ "y!") + (?\á»´ "Y-.") + (?\ỵ "y-.") + (?\Ỷ "Y2") + (?\á»· "y2") + (?\Ỹ "Y?") + (?\ỹ "y?") + (?\á¼€ "a") + (?\á¼ "ha") + (?\ἂ "`a") + (?\ἃ "h`a") + (?\ἄ "a'") + (?\á¼… "ha'") + (?\ἆ "a~") + (?\ἇ "ha~") + (?\Ἀ "A") + (?\Ἁ "hA") + (?\Ἂ "`A") + (?\Ἃ "h`A") + (?\Ἄ "A'") + (?\á¼ "hA'") + (?\Ἆ "A~") + (?\á¼ "hA~") + (?\ἑ "he") + (?\á¼™ "hE") + (?\á¼± "hi") + (?\á¼¹ "hI") + (?\á½ "ho") + (?\Ὁ "hO") + (?\ὑ "hu") + (?\á½™ "hU") + (?\᾿ ",,") + (?\á¿€ "?*") + (?\á¿ "?:") + (?\á¿ ",!") + (?\á¿Ž ",'") + (?\á¿ "?,") + (?\á¿ ";!") + (?\á¿ž ";'") + (?\á¿Ÿ "?;") + (?\á¿¥ "rh") + (?\Ῥ "Rh") + (?\á¿ "!:") + (?\` "!*") + (?\῾ ";;") + (?\  " ") + (?\†" ") + (?\  " ") + (?\  " ") + (?\  " ") + (?\  " ") + (?\  " ") + (?\  " ") + (?\  " ") + (?\  " ") + (?\†"-") + (?\‑ "-") + (?\– "-") + (?\— "--") + (?\― "-") + (?\‖ "||") + (?\‗ "=2") + (?\‘ "`") + (?\’ "'") + (?\‚ "'") + (?\‛ "'") + (?\“ "\"") + (?\†"\"") + (?\„ "\"") + (?\‟ "\"") + (?\†"/-") + (?\‡ "/=") + (?\• " o ") + (?\․ ".") + (?\‥ "..") + (?\… "...") + (?\‧ "·") + (?\‰ " 0/00") + (?\′ "'") + (?\″ "''") + (?\‴ "'''") + (?\‵ "`") + (?\‶ "``") + (?\‷ "```") + (?\‸ "Ca") + (?\‹ "<") + (?\› ">") + (?\※ ":X") + (?\‼ "!!") + (?\‾ "'-") + (?\⃠"-") + (?\â„ "/") + (?\∠"?!") + (?\≠"!?") + (?\â° "^0") + (?\â´ "^4") + (?\âµ "^5") + (?\ⶠ"^6") + (?\â· "^7") + (?\⸠"^8") + (?\â¹ "^9") + (?\⺠"^+") + (?\â» "^-") + (?\â¼ "^=") + (?\â½ "^(") + (?\â¾ "^)") + (?\â¿ "^n") + (?\â‚€ "_0") + (?\â‚ "_1") + (?\â‚‚ "_2") + (?\₃ "_3") + (?\â‚„ "_4") + (?\â‚… "_5") + (?\₆ "_6") + (?\₇ "_7") + (?\₈ "_8") + (?\₉ "_9") + (?\â‚Š "_+") + (?\â‚‹ "_-") + (?\â‚Œ "_=") + (?\â‚ "(") + (?\â‚Ž ")") + (?\â‚£ "Ff") + (?\₤ "Li") + (?\₧ "Pt") + (?\â‚© "W=") + (?\€ "EUR") + (?\â„€ "a/c") + (?\â„ "a/s") + (?\℃ "oC") + (?\â„… "c/o") + (?\℆ "c/u") + (?\℉ "oF") + (?\â„Š "g") + (?\â„Ž "h") + (?\â„ "\\hbar") + (?\â„‘ "Im") + (?\â„“ "l") + (?\â„– "No.") + (?\â„— "PO") + (?\℘ "P") + (?\â„œ "Re") + (?\â„ž "Rx") + (?\â„ "(SM)") + (?\â„¡ "TEL") + (?\â„¢ "(TM)") + (?\Ω "Ohm") + (?\K "K") + (?\â„« "Ang.") + (?\â„® "est.") + (?\â„´ "o") + (?\ℵ "Aleph ") + (?\ℶ "Bet ") + (?\â„· "Gimel ") + (?\ℸ "Dalet ") + (?\â…“ " 1/3") + (?\â…” " 2/3") + (?\â…• " 1/5") + (?\â…– " 2/5") + (?\â…— " 3/5") + (?\â…˜ " 4/5") + (?\â…™ " 1/6") + (?\â…š " 5/6") + (?\â…› " 1/8") + (?\â…œ " 3/8") + (?\â… " 5/8") + (?\â…ž " 7/8") + (?\â…Ÿ " 1/") + (?\â… "I") + (?\â…¡ "II") + (?\â…¢ "III") + (?\â…£ "IV") + (?\â…¤ "V") + (?\â…¥ "VI") + (?\â…¦ "VII") + (?\â…§ "VIII") + (?\â…¨ "IX") + (?\â…© "X") + (?\â…ª "XI") + (?\â…« "XII") + (?\â…¬ "L") + (?\â… "C") + (?\â…® "D") + (?\â…¯ "M") + (?\â…° "i") + (?\â…± "ii") + (?\â…² "iii") + (?\â…³ "iv") + (?\â…´ "v") + (?\â…µ "vi") + (?\â…¶ "vii") + (?\â…· "viii") + (?\â…¸ "ix") + (?\â…¹ "x") + (?\â…º "xi") + (?\â…» "xii") + (?\â…¼ "l") + (?\â…½ "c") + (?\â…¾ "d") + (?\â…¿ "m") + (?\ↀ "1000RCD") + (?\↠"5000R") + (?\ↂ "10000R") + (?\↠"<-") + (?\↑ "-^") + (?\→ "->") + (?\↓ "-v") + (?\↔ "<->") + (?\↕ "UD") + (?\↖ "<!!") + (?\↗ "//>") + (?\↘ "!!>") + (?\↙ "<//") + (?\↨ "UD-") + (?\↵ "RET") + (?\⇀ ">V") + (?\⇠"<=") + (?\⇑ "^^") + (?\⇒ "=>") + (?\⇓ "vv") + (?\⇔ "<=>") + (?\∀ "FA") + (?\∂ "\\partial") + (?\∃ "TE") + (?\∅ "{}") + (?\∆ "Delta") + (?\∇ "Nabla") + (?\∈ "(-") + (?\∉ "!(-") + (?\∊ "(-") + (?\∋ "-)") + (?\∌ "!-)") + (?\∠"-)") + (?\∎ " qed") + (?\∠"\\prod") + (?\∑ "\\sum") + (?\− " -") + (?\∓ "-/+") + (?\∔ ".+") + (?\∕ "/") + (?\∖ " - ") + (?\∗ "*") + (?\∘ " ° ") + (?\∙ "sb") + (?\√ " SQRT ") + (?\∛ " ROOT³ ") + (?\∜ " ROOT4 ") + (?\∠"0(") + (?\∞ "infty") + (?\∟ "-L") + (?\∠"-V") + (?\∥ "PP") + (?\∦ " !PP ") + (?\∧ "AND") + (?\∨ "OR") + (?\∩ "(U") + (?\∪ ")U") + (?\∫ "\int ") + (?\∬ "DI") + (?\∮ "Io") + (?\∴ ".:") + (?\∵ ":.") + (?\∶ ":R") + (?\∷ "::") + (?\∼ "?1") + (?\∾ "CG") + (?\≃ "?-") + (?\≅ "?=") + (?\≈ "~=") + (?\≉ " !~= ") + (?\≌ "=?") + (?\≓ "HI") + (?\≔ ":=") + (?\≕ "=:") + (?\≠"!=") + (?\≡ "=3") + (?\≢ " !=3 ") + (?\≤ "=<") + (?\≥ ">=") + (?\≦ ".LE.") + (?\≧ ".GE.") + (?\≨ ".LT.NOT.EQ.") + (?\≩ ".GT.NOT.EQ.") + (?\≪ "<<") + (?\≫ ">>") + (?\≮ "!<") + (?\≯ "!>") + (?\≶ " <> ") + (?\≷ " >< ") + (?\⊂ "(C") + (?\⊃ ")C") + (?\⊄ " !(C ") + (?\⊅ " !)C ") + (?\⊆ "(_") + (?\⊇ ")_") + (?\⊕ "(+)") + (?\⊖ "(-)") + (?\⊗ "(×)") + (?\⊘ "(/)") + (?\⊙ "(·)") + (?\⊚ "(°)") + (?\⊛ "(*)") + (?\⊜ "(=)") + (?\⊠"(-)") + (?\⊞ "[+]") + (?\⊟ "[-]") + (?\⊠"[×]") + (?\⊡ "[·]") + (?\⊥ "-T") + (?\⊧ " MODELS ") + (?\⊨ " TRUE ") + (?\⊩ " FORCES ") + (?\⊬ " !PROVES ") + (?\⊠" NOT TRUE ") + (?\⊮ " !FORCES ") + (?\⊲ " NORMAL SUBGROUP OF ") + (?\⊳ " CONTAINS AS NORMAL SUBGROUP ") + (?\⊴ " NORMAL SUBGROUP OF OR EQUAL TO ") + (?\⊵ " CONTAINS AS NORMAL SUBGROUP OR EQUAL TO ") + (?\⊸ " MULTIMAP ") + (?\⊺ " INTERCALATE ") + (?\⊻ " XOR ") + (?\⊼ " NAND ") + (?\â‹… " · ") + (?\â‹– "<.") + (?\â‹— ">.") + (?\⋘ "<<<") + (?\â‹™ ">>>") + (?\â‹® ":3") + (?\⋯ ".3") + (?\⌂ "Eh") + (?\⌇ "~~") + (?\⌈ "<7") + (?\⌉ ">7") + (?\⌊ "7<") + (?\⌋ "7>") + (?\⌠"NI") + (?\⌒ "(A") + (?\⌕ "TR") + (?\⌘ "88") + (?\⌠"Iu") + (?\⌡ "Il") + (?\⌢ ":(") + (?\⌣ ":)") + (?\⌤ "|^|") + (?\⌧ "[X]") + (?\〈 "</") + (?\〉 "/>") + (?\⣠"Vs") + (?\â‘€ "1h") + (?\â‘ "3h") + (?\â‘‚ "2h") + (?\⑃ "4h") + (?\⑆ "1j") + (?\⑇ "2j") + (?\⑈ "3j") + (?\⑉ "4j") + (?\â‘ "1-o") + (?\â‘¡ "2-o") + (?\â‘¢ "3-o") + (?\â‘£ "4-o") + (?\⑤ "5-o") + (?\â‘¥ "6-o") + (?\⑦ "7-o") + (?\⑧ "8-o") + (?\⑨ "9-o") + (?\â‘© "10-o") + (?\⑪ "11-o") + (?\â‘« "12-o") + (?\⑬ "13-o") + (?\â‘ "14-o") + (?\â‘® "15-o") + (?\⑯ "16-o") + (?\â‘° "17-o") + (?\⑱ "18-o") + (?\⑲ "19-o") + (?\⑳ "20-o") + (?\â‘´ "(1)") + (?\⑵ "(2)") + (?\⑶ "(3)") + (?\â‘· "(4)") + (?\⑸ "(5)") + (?\⑹ "(6)") + (?\⑺ "(7)") + (?\â‘» "(8)") + (?\⑼ "(9)") + (?\⑽ "(10)") + (?\⑾ "(11)") + (?\â‘¿ "(12)") + (?\â’€ "(13)") + (?\â’ "(14)") + (?\â’‚ "(15)") + (?\â’ƒ "(16)") + (?\â’„ "(17)") + (?\â’… "(18)") + (?\â’† "(19)") + (?\â’‡ "(20)") + (?\â’ˆ "1.") + (?\â’‰ "2.") + (?\â’Š "3.") + (?\â’‹ "4.") + (?\â’Œ "5.") + (?\â’ "6.") + (?\â’Ž "7.") + (?\â’ "8.") + (?\â’ "9.") + (?\â’‘ "10.") + (?\â’’ "11.") + (?\â’“ "12.") + (?\â’” "13.") + (?\â’• "14.") + (?\â’– "15.") + (?\â’— "16.") + (?\â’˜ "17.") + (?\â’™ "18.") + (?\â’š "19.") + (?\â’› "20.") + (?\â’œ "(a)") + (?\â’ "(b)") + (?\â’ž "(c)") + (?\â’Ÿ "(d)") + (?\â’ "(e)") + (?\â’¡ "(f)") + (?\â’¢ "(g)") + (?\â’£ "(h)") + (?\â’¤ "(i)") + (?\â’¥ "(j)") + (?\â’¦ "(k)") + (?\â’§ "(l)") + (?\â’¨ "(m)") + (?\â’© "(n)") + (?\â’ª "(o)") + (?\â’« "(p)") + (?\â’¬ "(q)") + (?\â’ "(r)") + (?\â’® "(s)") + (?\â’¯ "(t)") + (?\â’° "(u)") + (?\â’± "(v)") + (?\â’² "(w)") + (?\â’³ "(x)") + (?\â’´ "(y)") + (?\â’µ "(z)") + (?\â’¶ "A-o") + (?\â’· "B-o") + (?\â’¸ "C-o") + (?\â’¹ "D-o") + (?\â’º "E-o") + (?\â’» "F-o") + (?\â’¼ "G-o") + (?\â’½ "H-o") + (?\â’¾ "I-o") + (?\â’¿ "J-o") + (?\â“€ "K-o") + (?\â“ "L-o") + (?\â“‚ "M-o") + (?\Ⓝ "N-o") + (?\â“„ "O-o") + (?\â“… "P-o") + (?\Ⓠ "Q-o") + (?\Ⓡ "R-o") + (?\Ⓢ "S-o") + (?\Ⓣ "T-o") + (?\â“Š "U-o") + (?\â“‹ "V-o") + (?\â“Œ "W-o") + (?\â“ "X-o") + (?\â“Ž "Y-o") + (?\â“ "Z-o") + (?\â“ "a-o") + (?\â“‘ "b-o") + (?\â“’ "c-o") + (?\â““ "d-o") + (?\â“” "e-o") + (?\â“• "f-o") + (?\â“– "g-o") + (?\â“— "h-o") + (?\ⓘ "i-o") + (?\â“™ "j-o") + (?\â“š "k-o") + (?\â“› "l-o") + (?\â“œ "m-o") + (?\â“ "n-o") + (?\â“ž "o-o") + (?\â“Ÿ "p-o") + (?\â“ "q-o") + (?\â“¡ "r-o") + (?\â“¢ "s-o") + (?\â“£ "t-o") + (?\ⓤ "u-o") + (?\â“¥ "v-o") + (?\ⓦ "w-o") + (?\ⓧ "x-o") + (?\ⓨ "y-o") + (?\â“© "z-o") + (?\⓪ "0-o") + (?\─ "-") + (?\â” "=") + (?\│ "|") + (?\┃ "|") + (?\┄ "-") + (?\â”… "=") + (?\┆ "|") + (?\┇ "|") + (?\┈ "-") + (?\┉ "=") + (?\┊ "|") + (?\┋ "|") + (?\┌ "+") + (?\â” "+") + (?\┎ "+") + (?\â” "+") + (?\â” "+") + (?\┑ "+") + (?\â”’ "+") + (?\┓ "+") + (?\â”” "+") + (?\┕ "+") + (?\â”– "+") + (?\â”— "+") + (?\┘ "+") + (?\â”™ "+") + (?\┚ "+") + (?\â”› "+") + (?\├ "+") + (?\â” "+") + (?\┞ "+") + (?\┟ "+") + (?\â” "+") + (?\┡ "+") + (?\┢ "+") + (?\┣ "+") + (?\┤ "+") + (?\┥ "+") + (?\┦ "+") + (?\┧ "+") + (?\┨ "+") + (?\┩ "+") + (?\┪ "+") + (?\┫ "+") + (?\┬ "+") + (?\â” "+") + (?\â”® "+") + (?\┯ "+") + (?\â”° "+") + (?\â”± "+") + (?\┲ "+") + (?\┳ "+") + (?\â”´ "+") + (?\┵ "+") + (?\┶ "+") + (?\â”· "+") + (?\┸ "+") + (?\┹ "+") + (?\┺ "+") + (?\â”» "+") + (?\┼ "+") + (?\┽ "+") + (?\┾ "+") + (?\┿ "+") + (?\â•€ "+") + (?\â• "+") + (?\â•‚ "+") + (?\╃ "+") + (?\â•„ "+") + (?\â•… "+") + (?\╆ "+") + (?\╇ "+") + (?\╈ "+") + (?\╉ "+") + (?\â•Š "+") + (?\â•‹ "+") + (?\â•Œ "+") + (?\â• "+") + (?\â•Ž "+") + (?\â• "+") + (?\â• "+") + (?\â•‘ "+") + (?\â•’ "+") + (?\â•“ "+") + (?\â•” "+") + (?\â•• "+") + (?\â•– "+") + (?\â•— "+") + (?\╘ "+") + (?\â•™ "+") + (?\â•š "+") + (?\â•› "+") + (?\â•œ "+") + (?\â• "+") + (?\â•ž "+") + (?\â•Ÿ "+") + (?\â• "+") + (?\â•¡ "+") + (?\â•¢ "+") + (?\â•£ "+") + (?\╤ "+") + (?\â•¥ "+") + (?\╦ "+") + (?\╧ "+") + (?\╨ "+") + (?\â•© "+") + (?\╪ "+") + (?\â•« "+") + (?\╬ "+") + (?\╱ "/") + (?\╲ "\\") + (?\â–€ "TB") + (?\â–„ "LB") + (?\â–ˆ "FB") + (?\â–Œ "lB") + (?\â– "RB") + (?\â–‘ ".S") + (?\â–’ ":S") + (?\â–“ "?S") + (?\â– "fS") + (?\â–¡ "OS") + (?\â–¢ "RO") + (?\â–£ "Rr") + (?\â–¤ "RF") + (?\â–¥ "RY") + (?\â–¦ "RH") + (?\â–§ "RZ") + (?\â–¨ "RK") + (?\â–© "RX") + (?\â–ª "sB") + (?\â–¬ "SR") + (?\â– "Or") + (?\â–² "^") + (?\â–³ "uT") + (?\â–¶ "|>") + (?\â–· "Tr") + (?\â–º "|>") + (?\â–¼ "v") + (?\â–½ "dT") + (?\â—€ "<|") + (?\â— "Tl") + (?\â—„ "<|") + (?\â—† "Db") + (?\â—‡ "Dw") + (?\â—Š "LZ") + (?\â—‹ "0m") + (?\â—Ž "0o") + (?\â— "0M") + (?\â— "0L") + (?\â—‘ "0R") + (?\â—˜ "Sn") + (?\â—™ "Ic") + (?\â—¢ "Fd") + (?\â—£ "Bd") + (?\â—¯ "Ci") + (?\★ "*2") + (?\☆ "*1") + (?\☎ "TEL") + (?\☠"tel") + (?\☜ "<--") + (?\☞ "-->") + (?\☡ "CAUTION ") + (?\☧ "XP") + (?\☹ ":-(") + (?\☺ ":-)") + (?\☻ "(-:") + (?\☼ "SU") + (?\♀ "f.") + (?\♂ "m.") + (?\â™ "cS") + (?\♡ "cH") + (?\♢ "cD") + (?\♣ "cC") + (?\♤ "cS-") + (?\♥ "cH-") + (?\♦ "cD-") + (?\♧ "cC-") + (?\♩ "Md") + (?\♪ "M8") + (?\♫ "M2") + (?\♬ "M16") + (?\â™ "b") + (?\â™® "Mx") + (?\♯ "#") + (?\✓ "X") + (?\✗ "X") + (?\✠"-X") + (?\　 " ") + (?\〠",_") + (?\。 "._") + (?\〃 "+\"") + (?\〄 "JIS") + (?\々 "*_") + (?\〆 ";_") + (?\〇 "0_") + (?\《 "<+") + (?\》 ">+") + (?\「 "<'") + (?\〠">'") + (?\『 "<\"") + (?\〠">\"") + (?\〠"(\"") + (?\】 ")\"") + (?\〒 "=T") + (?\〓 "=_") + (?\〔 "('") + (?\〕 ")'") + (?\〖 "(I") + (?\〗 ")I") + (?\〚 "[[") + (?\〛 "]]") + (?\〜 "-?") + (?\〠"=T:)") + (?\〿 " ") + (?\ã "A5") + (?\ã‚ "a5") + (?\ム"I5") + (?\ã„ "i5") + (?\ã… "U5") + (?\ㆠ"u5") + (?\㇠"E5") + (?\㈠"e5") + (?\㉠"O5") + (?\㊠"o5") + (?\ã‹ "ka") + (?\㌠"ga") + (?\ã "ki") + (?\㎠"gi") + (?\ã "ku") + (?\ã "gu") + (?\ã‘ "ke") + (?\ã’ "ge") + (?\ã“ "ko") + (?\ã” "go") + (?\ã• "sa") + (?\ã– "za") + (?\ã— "si") + (?\㘠"zi") + (?\ã™ "su") + (?\ãš "zu") + (?\ã› "se") + (?\㜠"ze") + (?\ã "so") + (?\ãž "zo") + (?\㟠"ta") + (?\ã "da") + (?\ã¡ "ti") + (?\㢠"di") + (?\㣠"tU") + (?\㤠"tu") + (?\㥠"du") + (?\㦠"te") + (?\㧠"de") + (?\㨠"to") + (?\ã© "do") + (?\㪠"na") + (?\ã« "ni") + (?\㬠"nu") + (?\ã "ne") + (?\ã® "no") + (?\㯠"ha") + (?\ã° "ba") + (?\ã± "pa") + (?\ã² "hi") + (?\ã³ "bi") + (?\ã´ "pi") + (?\ãµ "hu") + (?\㶠"bu") + (?\ã· "pu") + (?\㸠"he") + (?\ã¹ "be") + (?\㺠"pe") + (?\ã» "ho") + (?\ã¼ "bo") + (?\ã½ "po") + (?\ã¾ "ma") + (?\ã¿ "mi") + (?\ã‚€ "mu") + (?\ã‚ "me") + (?\ã‚‚ "mo") + (?\ゃ "yA") + (?\ã‚„ "ya") + (?\ã‚… "yU") + (?\ゆ "yu") + (?\ょ "yO") + (?\よ "yo") + (?\ら "ra") + (?\ã‚Š "ri") + (?\ã‚‹ "ru") + (?\ã‚Œ "re") + (?\ã‚ "ro") + (?\ã‚Ž "wA") + (?\ã‚ "wa") + (?\ã‚ "wi") + (?\ã‚‘ "we") + (?\ã‚’ "wo") + (?\ã‚“ "n5") + (?\ã‚” "vu") + (?\ã‚› "\"5") + (?\ã‚œ "05") + (?\ã‚ "*5") + (?\ã‚ž "+5") + (?\ã‚¡ "a6") + (?\ã‚¢ "A6") + (?\ã‚£ "i6") + (?\イ "I6") + (?\ã‚¥ "u6") + (?\ウ "U6") + (?\ェ "e6") + (?\エ "E6") + (?\ã‚© "o6") + (?\オ "O6") + (?\ã‚« "Ka") + (?\ガ "Ga") + (?\ã‚ "Ki") + (?\ã‚® "Gi") + (?\ク "Ku") + (?\ã‚° "Gu") + (?\ケ "Ke") + (?\ゲ "Ge") + (?\コ "Ko") + (?\ã‚´ "Go") + (?\サ "Sa") + (?\ザ "Za") + (?\ã‚· "Si") + (?\ジ "Zi") + (?\ス "Su") + (?\ズ "Zu") + (?\ã‚» "Se") + (?\ゼ "Ze") + (?\ソ "So") + (?\ゾ "Zo") + (?\ã‚¿ "Ta") + (?\ダ "Da") + (?\ム"Ti") + (?\ヂ "Di") + (?\ッ "TU") + (?\ツ "Tu") + (?\ヅ "Du") + (?\テ "Te") + (?\デ "De") + (?\ト "To") + (?\ド "Do") + (?\ナ "Na") + (?\ニ "Ni") + (?\ヌ "Nu") + (?\ム"Ne") + (?\ノ "No") + (?\ム"Ha") + (?\ム"Ba") + (?\パ "Pa") + (?\ヒ "Hi") + (?\ビ "Bi") + (?\ピ "Pi") + (?\フ "Hu") + (?\ブ "Bu") + (?\プ "Pu") + (?\ヘ "He") + (?\ベ "Be") + (?\ペ "Pe") + (?\ホ "Ho") + (?\ボ "Bo") + (?\ム"Po") + (?\マ "Ma") + (?\ミ "Mi") + (?\ム"Mu") + (?\メ "Me") + (?\モ "Mo") + (?\ャ "YA") + (?\ヤ "Ya") + (?\ュ "YU") + (?\ユ "Yu") + (?\ョ "YO") + (?\ヨ "Yo") + (?\ラ "Ra") + (?\リ "Ri") + (?\ル "Ru") + (?\レ "Re") + (?\ム"Ro") + (?\ヮ "WA") + (?\ワ "Wa") + (?\ヰ "Wi") + (?\ヱ "We") + (?\ヲ "Wo") + (?\ン "N6") + (?\ヴ "Vu") + (?\ヵ "KA") + (?\ヶ "KE") + (?\ヷ "Va") + (?\ヸ "Vi") + (?\ヹ "Ve") + (?\ヺ "Vo") + (?\・ ".6") + (?\ー "-6") + (?\ヽ "*6") + (?\ヾ "+6") + (?\ã„… "b4") + (?\ㄆ "p4") + (?\ㄇ "m4") + (?\ㄈ "f4") + (?\ㄉ "d4") + (?\ã„Š "t4") + (?\ã„‹ "n4") + (?\ã„Œ "l4") + (?\ã„ "g4") + (?\ã„Ž "k4") + (?\ã„ "h4") + (?\ã„ "j4") + (?\ã„‘ "q4") + (?\ã„’ "x4") + (?\ã„“ "zh") + (?\ã„” "ch") + (?\ã„• "sh") + (?\ã„– "r4") + (?\ã„— "z4") + (?\ㄘ "c4") + (?\ã„™ "s4") + (?\ã„š "a4") + (?\ã„› "o4") + (?\ã„œ "e4") + (?\ã„ "eh4") + (?\ã„ž "ai") + (?\ã„Ÿ "ei") + (?\ã„ "au") + (?\ã„¡ "ou") + (?\ã„¢ "an") + (?\ã„£ "en") + (?\ㄤ "aN") + (?\ã„¥ "eN") + (?\ㄦ "er") + (?\ㄧ "i4") + (?\ㄨ "u4") + (?\ã„© "iu") + (?\ㄪ "v4") + (?\ã„« "nG") + (?\ㄬ "gn") + (?\㈜ "(JU)") + (?\㈠"1c") + (?\㈡ "2c") + (?\㈢ "3c") + (?\㈣ "4c") + (?\㈤ "5c") + (?\㈥ "6c") + (?\㈦ "7c") + (?\㈧ "8c") + (?\㈨ "9c") + (?\㈩ "10c") + (?\㉿ "KSC") + (?\ã‚ "am") + (?\㘠"pm") + (?\ff "ff") + (?\ï¬ "fi") + (?\fl "fl") + (?\ffi "ffi") + (?\ffl "ffl") + (?\ſt "St") + (?\st "st") + (?\ï¹½ "3+;") + (?\ﺂ "aM.") + (?\ﺄ "aH.") + (?\ﺈ "ah.") + (?\ïº "a+-") + (?\ﺎ "a+.") + (?\ïº "b+-") + (?\ïº "b+.") + (?\ﺑ "b+,") + (?\ﺒ "b+;") + (?\ﺓ "tm-") + (?\ﺔ "tm.") + (?\ﺕ "t+-") + (?\ﺖ "t+.") + (?\ﺗ "t+,") + (?\ﺘ "t+;") + (?\ﺙ "tk-") + (?\ﺚ "tk.") + (?\ﺛ "tk,") + (?\ﺜ "tk;") + (?\ïº "g+-") + (?\ﺞ "g+.") + (?\ﺟ "g+,") + (?\ïº "g+;") + (?\ﺡ "hk-") + (?\ﺢ "hk.") + (?\ﺣ "hk,") + (?\ﺤ "hk;") + (?\ﺥ "x+-") + (?\ﺦ "x+.") + (?\ﺧ "x+,") + (?\ﺨ "x+;") + (?\ﺩ "d+-") + (?\ﺪ "d+.") + (?\ﺫ "dk-") + (?\ﺬ "dk.") + (?\ïº "r+-") + (?\ﺮ "r+.") + (?\ﺯ "z+-") + (?\ﺰ "z+.") + (?\ﺱ "s+-") + (?\ﺲ "s+.") + (?\ﺳ "s+,") + (?\ﺴ "s+;") + (?\ﺵ "sn-") + (?\ﺶ "sn.") + (?\ﺷ "sn,") + (?\ﺸ "sn;") + (?\ﺹ "c+-") + (?\ﺺ "c+.") + (?\ﺻ "c+,") + (?\ﺼ "c+;") + (?\ﺽ "dd-") + (?\ﺾ "dd.") + (?\ﺿ "dd,") + (?\ﻀ "dd;") + (?\ï» "tj-") + (?\ﻂ "tj.") + (?\ﻃ "tj,") + (?\ﻄ "tj;") + (?\ï»… "zH-") + (?\ﻆ "zH.") + (?\ﻇ "zH,") + (?\ﻈ "zH;") + (?\ﻉ "e+-") + (?\ﻊ "e+.") + (?\ﻋ "e+,") + (?\ﻌ "e+;") + (?\ï» "i+-") + (?\ﻎ "i+.") + (?\ï» "i+,") + (?\ï» "i+;") + (?\ﻑ "f+-") + (?\ï»’ "f+.") + (?\ﻓ "f+,") + (?\ï»” "f+;") + (?\ﻕ "q+-") + (?\ï»– "q+.") + (?\ï»— "q+,") + (?\ﻘ "q+;") + (?\ï»™ "k+-") + (?\ﻚ "k+.") + (?\ï»› "k+,") + (?\ﻜ "k+;") + (?\ï» "l+-") + (?\ﻞ "l+.") + (?\ﻟ "l+,") + (?\ï» "l+;") + (?\ﻡ "m+-") + (?\ﻢ "m+.") + (?\ﻣ "m+,") + (?\ﻤ "m+;") + (?\ﻥ "n+-") + (?\ﻦ "n+.") + (?\ﻧ "n+,") + (?\ﻨ "n+;") + (?\ﻩ "h+-") + (?\ﻪ "h+.") + (?\ﻫ "h+,") + (?\ﻬ "h+;") + (?\ï» "w+-") + (?\ï»® "w+.") + (?\ﻯ "j+-") + (?\ï»° "j+.") + (?\ï»± "y+-") + (?\ﻲ "y+.") + (?\ﻳ "y+,") + (?\ï»´ "y+;") + (?\ﻵ "lM-") + (?\ﻶ "lM.") + (?\ï»· "lH-") + (?\ﻸ "lH.") + (?\ﻹ "lh-") + (?\ﻺ "lh.") + (?\ï»» "la-") + (?\ﻼ "la.") + (?\ï¼ "!") + (?\＂ "\"") + (?\＃ "#") + (?\＄ "$") + (?\ï¼… "%") + (?\＆ "&") + (?\＇ "'") + (?\（ "(") + (?\） ")") + (?\＊ "*") + (?\＋ "+") + (?\， ",") + (?\ï¼ "-") + (?\． ".") + (?\ï¼ "/") + (?\ï¼ "0") + (?\１ "1") + (?\ï¼’ "2") + (?\３ "3") + (?\ï¼” "4") + (?\５ "5") + (?\ï¼– "6") + (?\ï¼— "7") + (?\８ "8") + (?\ï¼™ "9") + (?\： ":") + (?\ï¼› ";") + (?\＜ "<") + (?\ï¼ "=") + (?\＞ ">") + (?\？ "?") + (?\ï¼ "@") + (?\Ａ "A") + (?\ï¼¢ "B") + (?\ï¼£ "C") + (?\Ｄ "D") + (?\ï¼¥ "E") + (?\Ｆ "F") + (?\Ｇ "G") + (?\Ｈ "H") + (?\Ｉ "I") + (?\Ｊ "J") + (?\Ｋ "K") + (?\Ｌ "L") + (?\ï¼ "M") + (?\ï¼® "N") + (?\Ｏ "O") + (?\ï¼° "P") + (?\ï¼± "Q") + (?\ï¼² "R") + (?\ï¼³ "S") + (?\ï¼´ "T") + (?\ï¼µ "U") + (?\Ｖ "V") + (?\ï¼· "W") + (?\Ｘ "X") + (?\ï¼¹ "Y") + (?\Ｚ "Z") + (?\ï¼» "[") + (?\ï¼¼ "\\") + (?\ï¼½ "]") + (?\ï¼¾ "^") + (?\＿ "_") + (?\ï½€ "`") + (?\ï½ "a") + (?\ｂ "b") + (?\ｃ "c") + (?\ｄ "d") + (?\ï½… "e") + (?\ｆ "f") + (?\ｇ "g") + (?\ｈ "h") + (?\ｉ "i") + (?\ｊ "j") + (?\ｋ "k") + (?\ｌ "l") + (?\ï½ "m") + (?\ｎ "n") + (?\ï½ "o") + (?\ï½ "p") + (?\ｑ "q") + (?\ï½’ "r") + (?\ｓ "s") + (?\ï½” "t") + (?\ｕ "u") + (?\ï½– "v") + (?\ï½— "w") + (?\ｘ "x") + (?\ï½™ "y") + (?\ｚ "z") + (?\ï½› "{") + (?\｜ "|") + (?\ï½ "}") + (?\～ "~") + (?\｡ ".") + (?\ï½¢ "\"") + (?\ï½£ "\"") + (?\､ ",") ;; Not from Lynx - (?$,3r_(B "") - (?$,3u=(B "?"))))) + (? "") + (?� "?"))))) (aset standard-display-table (make-char 'mule-unicode-0100-24ff) nil) (aset standard-display-table diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index 4873a5c8356..dd59d5e77ab 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el @@ -1104,8 +1104,7 @@ system which uses fontsets)." (insert-section 2 "Display") (if window-system - (insert (format "Window-system: %s, version %s" - window-system window-system-version)) + (insert (format "Window-system: %s" window-system)) (insert "Terminal: " (getenv "TERM"))) (insert "\n\n") diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el index 5cfc4be4316..15a7dc10f65 100644 --- a/lisp/international/mule-util.el +++ b/lisp/international/mule-util.el @@ -132,38 +132,38 @@ defaults to \"...\"." ;; (("xy" 2 1) . "y") ;; (("xy" 0) . "") ;; (("xy" 3) . "xy") -;; (("$AVP(B" 0) . "") -;; (("$AVP(B" 1) . "") -;; (("$AVP(B" 2) . "$AVP(B") -;; (("$AVP(B" 1 nil ? ) . " ") -;; (("$AVPND(B" 3 1 ? ) . " ") -;; (("x$AVP(Bx" 2) . "x") -;; (("x$AVP(Bx" 3) . "x$AVP(B") -;; (("x$AVP(Bx" 3) . "x$AVP(B") -;; (("x$AVP(Bx" 4 1) . "$AVP(Bx") -;; (("kor$(CGQ(Be$(C1[(Ban" 8 1 ? ) . "or$(CGQ(Be$(C1[(B") -;; (("kor$(CGQ(Be$(C1[(Ban" 7 2 ? ) . "r$(CGQ(Be ") +;; (("ä¸" 0) . "") +;; (("ä¸" 1) . "") +;; (("ä¸" 2) . "ä¸") +;; (("ä¸" 1 nil ? ) . " ") +;; (("ä¸æ–‡" 3 1 ? ) . " ") +;; (("xä¸x" 2) . "x") +;; (("xä¸x" 3) . "xä¸") +;; (("xä¸x" 3) . "xä¸") +;; (("xä¸x" 4 1) . "ä¸x") +;; (("korí•œe글an" 8 1 ? ) . "orí•œe글") +;; (("korí•œe글an" 7 2 ? ) . "rí•œe ") ;; (("" 0 nil nil "...") . "") ;; (("x" 3 nil nil "...") . "x") -;; (("$AVP(B" 3 nil nil "...") . "$AVP(B") +;; (("ä¸" 3 nil nil "...") . "ä¸") ;; (("foo" 3 nil nil "...") . "foo") ;; (("foo" 2 nil nil "...") . "fo") ;; XEmacs failure? ;; (("foobar" 6 0 nil "...") . "foobar") ;; (("foobarbaz" 6 nil nil "...") . "foo...") ;; (("foobarbaz" 7 2 nil "...") . "ob...") ;; (("foobarbaz" 9 3 nil "...") . "barbaz") -;; (("$A$3(Bh$A$s(Be$A$K(Bl$A$A(Bl$A$O(Bo" 15 1 ? t) . " h$A$s(Be$A$K(Bl$A$A(Bl$A$O(Bo") -;; (("$A$3(Bh$A$s(Be$A$K(Bl$A$A(Bl$A$O(Bo" 14 1 ? t) . " h$A$s(Be$A$K(Bl$A$A(B...") -;; (("x" 3 nil nil "$(Gemk#(B") . "x") -;; (("$AVP(B" 2 nil nil "$(Gemk#(B") . "$AVP(B") -;; (("$AVP(B" 1 nil ?x "$(Gemk#(B") . "x") ;; XEmacs error -;; (("$AVPND(B" 3 nil ? "$(Gemk#(B") . "$AVP(B ") ;; XEmacs error -;; (("foobarbaz" 4 nil nil "$(Gemk#(B") . "$(Gemk#(B") -;; (("foobarbaz" 5 nil nil "$(Gemk#(B") . "f$(Gemk#(B") -;; (("foobarbaz" 6 nil nil "$(Gemk#(B") . "fo$(Gemk#(B") -;; (("foobarbaz" 8 3 nil "$(Gemk#(B") . "b$(Gemk#(B") -;; (("$A$3(Bh$A$s(Be$A$K(Bl$A$A(Bl$A$O(Bo" 14 4 ?x "$AHU1>$(Gk#(B") . "xe$A$KHU1>$(Gk#(B") -;; (("$A$3(Bh$A$s(Be$A$K(Bl$A$A(Bl$A$O(Bo" 13 4 ?x "$AHU1>$(Gk#(B") . "xex$AHU1>$(Gk#(B") +;; (("ã“hã‚“eã«lã¡lã¯o" 15 1 ? t) . " hã‚“eã«lã¡lã¯o") +;; (("ã“hã‚“eã«lã¡lã¯o" 14 1 ? t) . " hã‚“eã«lã¡...") +;; (("x" 3 nil nil "粵語") . "x") +;; (("ä¸" 2 nil nil "粵語") . "ä¸") +;; (("ä¸" 1 nil ?x "粵語") . "x") ;; XEmacs error +;; (("ä¸æ–‡" 3 nil ? "粵語") . "ä¸ ") ;; XEmacs error +;; (("foobarbaz" 4 nil nil "粵語") . "粵語") +;; (("foobarbaz" 5 nil nil "粵語") . "f粵語") +;; (("foobarbaz" 6 nil nil "粵語") . "fo粵語") +;; (("foobarbaz" 8 3 nil "粵語") . "b粵語") +;; (("ã“hã‚“eã«lã¡lã¯o" 14 4 ?x "日本語") . "xeã«æ—¥æœ¬èªž") +;; (("ã“hã‚“eã«lã¡lã¯o" 13 4 ?x "日本語") . "xex日本語") ;; )) ;; (let (ret) ;; (condition-case e @@ -367,7 +367,7 @@ per-character basis, this may not be accurate." (provide 'mule-util) ;; Local Variables: -;; coding: iso-2022-7bit +;; coding: utf-8 ;; End: ;;; mule-util.el ends here diff --git a/lisp/isearch.el b/lisp/isearch.el index b36b250738a..c49b0d7fc59 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -47,7 +47,7 @@ ;; modify the search string before executing the search. There are ;; three commands to terminate the editing: C-s and C-r exit the ;; minibuffer and search forward and reverse respectively, while C-m -;; exits and does a nonincremental search. +;; exits and searches in the last search direction. ;; Exiting immediately from isearch uses isearch-edit-string instead ;; of nonincremental-search, if search-nonincremental-instead is non-nil. @@ -187,12 +187,21 @@ or to the end of the buffer for a backward search.") "Function to save a function restoring the mode-specific Isearch state to the search status stack.") -(defvar isearch-filter-predicate 'isearch-filter-visible - "Predicate that filters the search hits that would normally be available. -Search hits that dissatisfy the predicate are skipped. The function -has two arguments: the positions of start and end of text matched by -the search. If this function returns nil, continue searching without -stopping at this match.") +(defvar isearch-filter-predicates nil + "Predicates that filter the search hits that would normally be available. +Search hits that dissatisfy the list of predicates are skipped. +Each function in this list has two arguments: the positions of +start and end of text matched by the search. +The search loop uses `run-hook-with-args-until-failure' to call +each predicate in order, and when one of the predicates returns nil, +skips this match and continues searching for the next match. +When the list of predicates is empty, `run-hook-with-args-until-failure' +returns non-nil that means that the found match is accepted. +The property `isearch-message-prefix' put on the predicate's symbol +specifies the prefix string displayed in the search message.") +(define-obsolete-variable-alias 'isearch-filter-predicate + 'isearch-filter-predicates + "24.4") ;; Search ring. @@ -505,6 +514,7 @@ This is like `describe-bindings', but displays only Isearch keys." (define-key map "\M-e" 'isearch-edit-string) (define-key map "\M-sc" 'isearch-toggle-case-fold) + (define-key map "\M-si" 'isearch-toggle-invisible) (define-key map "\M-sr" 'isearch-toggle-regexp) (define-key map "\M-sw" 'isearch-toggle-word) (define-key map "\M-s_" 'isearch-toggle-symbol) @@ -515,12 +525,12 @@ This is like `describe-bindings', but displays only Isearch keys." (define-key map "\M-so" 'isearch-occur) (define-key map "\M-shr" 'isearch-highlight-regexp) - ;; The key translations defined in the C-x 8 prefix should insert - ;; characters into the search string. See iso-transl.el. + ;; The key translations defined in the C-x 8 prefix should add + ;; characters to the search string. See iso-transl.el. (define-key map "\C-x" nil) (define-key map [?\C-x t] 'isearch-other-control-char) (define-key map "\C-x8" nil) - (define-key map "\C-x8\r" 'isearch-insert-char-by-name) + (define-key map "\C-x8\r" 'isearch-char-by-name) map) "Keymap for `isearch-mode'.") @@ -528,7 +538,7 @@ This is like `describe-bindings', but displays only Isearch keys." (defvar minibuffer-local-isearch-map (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) - (define-key map "\r" 'isearch-nonincremental-exit-minibuffer) + (define-key map "\r" 'exit-minibuffer) (define-key map "\M-\t" 'isearch-complete-edit) (define-key map "\C-s" 'isearch-forward-exit-minibuffer) (define-key map "\C-r" 'isearch-reverse-exit-minibuffer) @@ -593,6 +603,11 @@ Each set is a vector of the form: ;; case in the search string is ignored. (defvar isearch-case-fold-search nil) +;; search-invisible while searching. +;; either nil, t, or 'open. 'open means the same as t except that +;; opens hidden overlays. +(defvar isearch-invisible search-invisible) + (defvar isearch-last-case-fold-search nil) ;; Used to save default value while isearch is active @@ -652,6 +667,7 @@ Each set is a vector of the form: (define-key esc-map "\C-r" 'isearch-backward-regexp) (define-key search-map "w" 'isearch-forward-word) (define-key search-map "_" 'isearch-forward-symbol) +(define-key search-map "." 'isearch-forward-symbol-at-point) ;; Entry points to isearch-mode. @@ -679,6 +695,8 @@ Type \\[isearch-yank-kill] to yank the last string of killed text. Type \\[isearch-yank-pop] to replace string just yanked into search prompt with string killed before it. Type \\[isearch-quote-char] to quote control character to search for it. +Type \\[isearch-char-by-name] to add a character to search by Unicode name,\ + with completion. \\[isearch-abort] while searching or when search has failed cancels input\ back to what has been found successfully. @@ -689,6 +707,7 @@ If you try to exit with the search string still empty, it invokes nonincremental search. Type \\[isearch-toggle-case-fold] to toggle search case-sensitivity. +Type \\[isearch-toggle-invisible] to toggle search in invisible text. Type \\[isearch-toggle-regexp] to toggle regular-expression mode. Type \\[isearch-toggle-word] to toggle word mode. Type \\[isearch-toggle-symbol] to toggle symbol mode. @@ -735,8 +754,9 @@ Other control and meta characters terminate the search and are then executed normally (depending on `search-exit-option'). Likewise for function keys and mouse button events. -If this function is called non-interactively, it does not return to -the calling function until the search is done." +If this function is called non-interactively with a nil NO-RECURSIVE-EDIT, +it does not return to the calling function until the search is done. +See the function `isearch-mode' for more information." (interactive "P\np") (isearch-mode t (not (null regexp-p)) nil (not no-recursive-edit))) @@ -787,6 +807,25 @@ as a regexp. See the command `isearch-forward' for more information." (interactive "P\np") (isearch-mode nil (null not-regexp) nil (not no-recursive-edit))) +(defun isearch-forward-symbol-at-point () + "Do incremental search forward for a symbol found near point. +Like ordinary incremental search except that the symbol found at point +is added to the search string initially as a regexp surrounded +by symbol boundary constructs \\_< and \\_>. +See the command `isearch-forward-symbol' for more information." + (interactive) + (isearch-forward-symbol nil 1) + (let ((bounds (find-tag-default-bounds))) + (cond + (bounds + (when (< (car bounds) (point)) + (goto-char (car bounds))) + (isearch-yank-string + (buffer-substring-no-properties (car bounds) (cdr bounds)))) + (t + (setq isearch-error "No symbol at point") + (isearch-update))))) + ;; isearch-mode only sets up incremental search for the minor mode. ;; All the work is done by the isearch-mode commands. @@ -799,7 +838,23 @@ as a regexp. See the command `isearch-forward' for more information." (defun isearch-mode (forward &optional regexp op-fun recursive-edit word) "Start Isearch minor mode. -It is called by the function `isearch-forward' and other related functions." +It is called by the function `isearch-forward' and other related functions. + +The non-nil arg FORWARD means searching in the forward direction. + +The non-nil arg REGEXP does an incremental regular expression search. + +The arg OP-FUN is a function to be called after each input character +is processed. (It is not called after characters that exit the search.) + +When the arg RECURSIVE-EDIT is non-nil, this function behaves modally and +does not return to the calling function until the search is completed. +To behave this way it enters a recursive-edit and exits it when done +isearching. + +The arg WORD, if t, does incremental search for a sequence of words, +ignoring punctuation. If the value is a function, it is called to +convert the search string to a regexp used by regexp search functions." ;; Initialize global vars. (setq isearch-forward forward @@ -808,6 +863,7 @@ It is called by the function `isearch-forward' and other related functions." isearch-op-fun op-fun isearch-last-case-fold-search isearch-case-fold-search isearch-case-fold-search case-fold-search + isearch-invisible search-invisible isearch-string "" isearch-message "" isearch-cmds nil @@ -1106,8 +1162,9 @@ If MSG is non-nil, use variable `isearch-message', otherwise `isearch-string'." (curr-msg (if msg isearch-message isearch-string)) succ-msg) (when (or (not isearch-success) isearch-error) - (while (or (not (isearch--state-success (car cmds))) - (isearch--state-error (car cmds))) + (while (and cmds + (or (not (isearch--state-success (car cmds))) + (isearch--state-error (car cmds)))) (pop cmds)) (setq succ-msg (and cmds (if msg (isearch--state-message (car cmds)) (isearch--state-string (car cmds))))) @@ -1255,7 +1312,6 @@ You can update the global isearch variables by setting new values to The following additional command keys are active while editing. \\<minibuffer-local-isearch-map> \\[exit-minibuffer] to resume incremental searching with the edited string. -\\[isearch-nonincremental-exit-minibuffer] to do one nonincremental search. \\[isearch-forward-exit-minibuffer] to resume isearching forward. \\[isearch-reverse-exit-minibuffer] to resume isearching backward. \\[isearch-complete-edit] to complete the search string using the search ring." @@ -1289,13 +1345,18 @@ The following additional command keys are active while editing. (interactive) (setq isearch-nonincremental t) (exit-minibuffer)) +;; Changing the value of `isearch-nonincremental' has no effect here, +;; because `isearch-edit-string' ignores this change. Thus marked as obsolete. +(make-obsolete 'isearch-nonincremental-exit-minibuffer 'exit-minibuffer "24.4") (defun isearch-forward-exit-minibuffer () + "Resume isearching forward from the minibuffer that edits the search string." (interactive) (setq isearch-new-forward t) (exit-minibuffer)) (defun isearch-reverse-exit-minibuffer () + "Resume isearching backward from the minibuffer that edits the search string." (interactive) (setq isearch-new-forward nil) (exit-minibuffer)) @@ -1441,7 +1502,8 @@ value of the variable `isearch-regexp-lax-whitespace'." (isearch-update)) (defun isearch-toggle-case-fold () - "Toggle case folding in searching on or off." + "Toggle case folding in searching on or off. +Toggles the value of the variable `isearch-case-fold-search'." (interactive) (setq isearch-case-fold-search (if isearch-case-fold-search nil 'yes)) @@ -1454,6 +1516,23 @@ value of the variable `isearch-regexp-lax-whitespace'." (sit-for 1) (isearch-update)) +(defun isearch-toggle-invisible () + "Toggle searching in invisible text on or off. +Toggles the variable `isearch-invisible' between values +nil and a non-nil value of the option `search-invisible' +\(or `open' if `search-invisible' is nil)." + (interactive) + (setq isearch-invisible + (if isearch-invisible nil (or search-invisible 'open))) + (let ((message-log-max nil)) + (message "%s%s [match %svisible text]" + (isearch-message-prefix nil isearch-nonincremental) + isearch-message + (if isearch-invisible "in" ""))) + (setq isearch-success t isearch-adjusted t) + (sit-for 1) + (isearch-update)) + ;; Word search @@ -1589,6 +1668,7 @@ way to run word replacements from Isearch is `M-s w ... M-%'." ;; set `search-upper-case' to nil to not call ;; `isearch-no-upper-case-p' in `perform-replace' (search-upper-case nil) + (search-invisible isearch-invisible) (replace-lax-whitespace isearch-lax-whitespace) (replace-regexp-lax-whitespace @@ -1692,7 +1772,10 @@ and reads its face argument using `hi-lock-read-face-name'." (isearch-done nil t) (isearch-clean-overlays)) (require 'hi-lock nil t) - (let ((string (cond (isearch-regexp isearch-string) + (let ((regexp (cond ((functionp isearch-word) + (funcall isearch-word isearch-string)) + (isearch-word (word-search-regexp isearch-string)) + (isearch-regexp isearch-string) ((if (and (eq isearch-case-fold-search t) search-upper-case) (isearch-no-upper-case-p @@ -1708,7 +1791,7 @@ and reads its face argument using `hi-lock-read-face-name'." (regexp-quote s)))) isearch-string "")) (t (regexp-quote isearch-string))))) - (hi-lock-face-buffer string (hi-lock-read-face-name))) + (hi-lock-face-buffer regexp (hi-lock-read-face-name))) (and isearch-recursive-edit (exit-recursive-edit))) @@ -1848,11 +1931,12 @@ Subword is used when `subword-mode' is activated. " (lambda () (let ((inhibit-field-text-motion t)) (line-end-position (if (eolp) 2 1)))))) -(defun isearch-insert-char-by-name () - "Read a character by its Unicode name and insert it into search string." +(defun isearch-char-by-name () + "Read a character by its Unicode name and add it to the search string. +Completion is available like in `read-char-by-name' used by `insert-char'." (interactive) (with-isearch-suspended - (let ((char (read-char-by-name "Insert character (Unicode name or hex): "))) + (let ((char (read-char-by-name "Add character to search (Unicode name or hex): "))) (when char (setq isearch-new-string (concat isearch-string (string char)) isearch-new-message (concat isearch-message @@ -2466,6 +2550,13 @@ If there is no completion possible, say so and continue searching." (< (point) isearch-opoint))) "over") (if isearch-wrapped "wrapped ") + (mapconcat (lambda (s) + (and (symbolp s) + (get s 'isearch-message-prefix))) + (if (consp isearch-filter-predicates) + isearch-filter-predicates + (list isearch-filter-predicates)) + "") (if isearch-word (or (and (symbolp isearch-word) (get isearch-word 'isearch-message-prefix)) @@ -2597,12 +2688,10 @@ update the match data, and return point." (setq isearch-case-fold-search (isearch-no-upper-case-p isearch-string isearch-regexp))) (condition-case lossage - (let ((inhibit-point-motion-hooks - ;; FIXME: equality comparisons on functions is asking for trouble. - (and (eq isearch-filter-predicate 'isearch-filter-visible) - search-invisible)) + (let ((inhibit-point-motion-hooks isearch-invisible) (inhibit-quit nil) (case-fold-search isearch-case-fold-search) + (search-invisible isearch-invisible) (retry t)) (setq isearch-error nil) (while retry @@ -2613,8 +2702,15 @@ update the match data, and return point." (if (or (not isearch-success) (bobp) (eobp) (= (match-beginning 0) (match-end 0)) - (funcall isearch-filter-predicate - (match-beginning 0) (match-end 0))) + ;; When one of filter predicates returns nil, + ;; retry the search. Otherwise, act according + ;; to search-invisible (open overlays, etc.) + (and (run-hook-with-args-until-failure + 'isearch-filter-predicates + (match-beginning 0) (match-end 0)) + (or (eq search-invisible t) + (not (isearch-range-invisible + (match-beginning 0) (match-end 0)))))) (setq retry nil))) (setq isearch-just-started nil) (if isearch-success @@ -2791,6 +2887,7 @@ determined by `isearch-range-invisible' unless invisible text can be searched too when `search-invisible' is t." (or (eq search-invisible t) (not (isearch-range-invisible beg end)))) +(make-obsolete 'isearch-filter-visible 'isearch-invisible "24.4") ;; General utilities @@ -3016,8 +3113,11 @@ Attempt to do the search exactly the way the pending Isearch would." (if (or (not success) (= (point) bound) ; like (bobp) (eobp) in `isearch-search'. (= (match-beginning 0) (match-end 0)) - (funcall isearch-filter-predicate - (match-beginning 0) (match-end 0))) + (and (run-hook-with-args-until-failure + 'isearch-filter-predicates + (match-beginning 0) (match-end 0)) + (not (isearch-range-invisible + (match-beginning 0) (match-end 0))))) (setq retry nil))) success) (error nil))) diff --git a/lisp/iswitchb.el b/lisp/iswitchb.el index 68749f1b012..07873db38e1 100644 --- a/lisp/iswitchb.el +++ b/lisp/iswitchb.el @@ -597,7 +597,7 @@ the selection process begins. Used by isearchb.el." ;; The map is generated every time so that it can inherit new ;; functions. (let ((map (copy-keymap minibuffer-local-map)) - buf-sel iswitchb-final-text map + buf-sel iswitchb-final-text icomplete-mode) ; prevent icomplete starting up (define-key map "?" 'iswitchb-completion-help) (define-key map "\C-s" 'iswitchb-next-match) diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index d879735c344..9d700a5ed82 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -1,4 +1,4 @@ -;;; jit-lock.el --- just-in-time fontification +;;; jit-lock.el --- just-in-time fontification -*- lexical-binding: t -*- ;; Copyright (C) 1998, 2000-2013 Free Software Foundation, Inc. @@ -258,7 +258,7 @@ the variable `jit-lock-stealth-nice'." When this minor mode is enabled, jit-lock runs as little code as possible during redisplay and moves the rest to a timer, where things like `debug-on-error' and Edebug can be used." - :global t + :global t :group 'jit-lock (when jit-lock-defer-timer (cancel-timer jit-lock-defer-timer) (setq jit-lock-defer-timer nil)) @@ -412,21 +412,24 @@ Defaults to the whole buffer. END can be out of bounds." ;; eagerly extend the refontified region with ;; jit-lock-after-change-extend-region-functions. (when (< start orig-start) - (run-with-timer 0 nil 'jit-lock-force-redisplay - (current-buffer) start orig-start)) + (run-with-timer 0 nil #'jit-lock-force-redisplay + (copy-marker start) (copy-marker orig-start))) ;; Find the start of the next chunk, if any. (setq start (text-property-any next end 'fontified nil)))))))) -(defun jit-lock-force-redisplay (buf start end) +(defun jit-lock-force-redisplay (start end) "Force the display engine to re-render buffer BUF from START to END." - (with-current-buffer buf - (with-buffer-prepared-for-jit-lock - ;; Don't cause refontification (it's already been done), but just do - ;; some random buffer change, so as to force redisplay. - (put-text-property start end 'fontified t)))) - - + (when (marker-buffer start) + (with-current-buffer (marker-buffer start) + (with-buffer-prepared-for-jit-lock + (when (> end (point-max)) + (setq end (point-max) start (min start end))) + (when (< start (point-min)) + (setq start (point-min) end (max start end))) + ;; Don't cause refontification (it's already been done), but just do + ;; some random buffer change, so as to force redisplay. + (put-text-property start end 'fontified t))))) ;;; Stealth fontification. diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el index 851bceccf30..32788b2dfb7 100644 --- a/lisp/jka-cmpr-hook.el +++ b/lisp/jka-cmpr-hook.el @@ -308,7 +308,7 @@ variables. Setting this through Custom does that automatically." (defcustom jka-compr-mode-alist-additions (purecopy '(("\\.tgz\\'" . tar-mode) ("\\.tbz2?\\'" . tar-mode) - ("\\.txz\\'" . 'tar-mode))) + ("\\.txz\\'" . tar-mode))) "List of pairs added to `auto-mode-alist' when installing jka-compr. Uninstalling jka-compr removes all pairs from `auto-mode-alist' that installing added. @@ -318,6 +318,7 @@ already enabled \(as it is by default), you have to call `jka-compr-update' after setting it to properly update other variables. Setting this through Custom does that automatically." :type '(repeat (cons string symbol)) + :version "24.4" ; add txz :set 'jka-compr-set :group 'jka-compr) diff --git a/lisp/kmacro.el b/lisp/kmacro.el index d573bd02397..d6de2feb3fc 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -202,6 +202,7 @@ macro to be executed before appending to it." ;; naming and binding (define-key map "b" 'kmacro-bind-to-key) (define-key map "n" 'kmacro-name-last-macro) + (define-key map "x" 'kmacro-to-register) map) "Keymap for keyboard macro commands.") (defalias 'kmacro-keymap kmacro-keymap) @@ -613,9 +614,10 @@ An argument of zero means repeat until error." ;;;###autoload -(defun kmacro-call-macro (arg &optional no-repeat end-macro) - "Call the last keyboard macro that you defined with \\[kmacro-start-macro]. +(defun kmacro-call-macro (arg &optional no-repeat end-macro macro) + "Call the keyboard MACRO that you defined with \\[kmacro-start-macro]. A prefix argument serves as a repeat count. Zero means repeat until error. +MACRO defaults to `last-kbd-macro'. When you call the macro, you can call the macro again by repeating just the last key in the key sequence that you used to call this @@ -631,8 +633,9 @@ others, use \\[kmacro-name-last-macro]." (eq no-repeat 'repeating)) last-input-event))) (if end-macro - (kmacro-end-macro arg) - (call-last-kbd-macro arg #'kmacro-loop-setup-function)) + (kmacro-end-macro arg) ; modifies last-kbd-macro + (let ((last-kbd-macro (or macro last-kbd-macro))) + (call-last-kbd-macro arg #'kmacro-loop-setup-function))) (when (consp arg) (setq arg (car arg))) (when (and (or (null arg) (> arg 0)) @@ -655,7 +658,9 @@ others, use \\[kmacro-name-last-macro]." (define-key map (vector repeat-key) `(lambda () (interactive) (kmacro-call-macro ,(and kmacro-call-repeat-with-arg arg) - 'repeating))) + 'repeating nil ,(if end-macro + last-kbd-macro + (or macro last-kbd-macro))))) map))))) @@ -836,6 +841,25 @@ Such a \"function\" cannot be called from Lisp, but it is a valid editor command (put symbol 'kmacro t)) +(defun kmacro-execute-from-register (k) + (kmacro-call-macro current-prefix-arg nil nil k)) + +(defun kmacro-to-register (r) + "Store the last keyboard macro in register R." + (interactive + (progn + (or last-kbd-macro (error "No keyboard macro defined")) + (list (read-char "Save to register: ")))) + (set-register r (registerv-make + last-kbd-macro + :jump-func 'kmacro-execute-from-register + :print-func (lambda (k) + (princ (format "a keyboard macro:\n %s" + (format-kbd-macro k)))) + :insert-func (lambda (k) + (insert (format-kbd-macro k)))))) + + (defun kmacro-view-macro (&optional _arg) "Display the last keyboard macro. If repeated, it shows previous elements in the macro ring." diff --git a/lisp/language/cyril-util.el b/lisp/language/cyril-util.el index 441519d5426..7af8b993288 100644 --- a/lisp/language/cyril-util.el +++ b/lisp/language/cyril-util.el @@ -71,124 +71,124 @@ If the argument is nil, we return the display table to its standard state." (if (null cyrillic-language) (setq standard-display-table (make-display-table)) - (aset standard-display-table ?,LP(B [?a]) - (aset standard-display-table ?,LQ(B [?b]) - (aset standard-display-table ?,LR(B [?v]) - (aset standard-display-table ?,LS(B [?g]) - (aset standard-display-table ?,LT(B [?d]) - (aset standard-display-table ?,LU(B [?e]) - (aset standard-display-table ?,Lq(B [?y ?o]) - (aset standard-display-table ?,LV(B [?z ?h]) - (aset standard-display-table ?,LW(B [?z]) - (aset standard-display-table ?,LX(B [?i]) - (aset standard-display-table ?,LY(B [?j]) - (aset standard-display-table ?,LZ(B [?k]) - (aset standard-display-table ?,L[(B [?l]) - (aset standard-display-table ?,L\(B [?m]) - (aset standard-display-table ?,L](B [?n]) - (aset standard-display-table ?,L^(B [?o]) - (aset standard-display-table ?,L_(B [?p]) - (aset standard-display-table ?,L`(B [?r]) - (aset standard-display-table ?,La(B [?s]) - (aset standard-display-table ?,Lb(B [?t]) - (aset standard-display-table ?,Lc(B [?u]) - (aset standard-display-table ?,Ld(B [?f]) - (aset standard-display-table ?,Le(B [?k ?h]) - (aset standard-display-table ?,Lf(B [?t ?s]) - (aset standard-display-table ?,Lg(B [?c ?h]) - (aset standard-display-table ?,Lh(B [?s ?h]) - (aset standard-display-table ?,Li(B [?s ?c ?h]) - (aset standard-display-table ?,Lj(B [?~]) - (aset standard-display-table ?,Lk(B [?y]) - (aset standard-display-table ?,Ll(B [?']) - (aset standard-display-table ?,Lm(B [?e ?']) - (aset standard-display-table ?,Ln(B [?y ?u]) - (aset standard-display-table ?,Lo(B [?y ?a]) - - (aset standard-display-table ?,L0(B [?A]) - (aset standard-display-table ?,L1(B [?B]) - (aset standard-display-table ?,L2(B [?V]) - (aset standard-display-table ?,L3(B [?G]) - (aset standard-display-table ?,L4(B [?D]) - (aset standard-display-table ?,L5(B [?E]) - (aset standard-display-table ?,L!(B [?Y ?o]) - (aset standard-display-table ?,L6(B [?Z ?h]) - (aset standard-display-table ?,L7(B [?Z]) - (aset standard-display-table ?,L8(B [?I]) - (aset standard-display-table ?,L9(B [?J]) - (aset standard-display-table ?,L:(B [?K]) - (aset standard-display-table ?,L;(B [?L]) - (aset standard-display-table ?,L<(B [?M]) - (aset standard-display-table ?,L=(B [?N]) - (aset standard-display-table ?,L>(B [?O]) - (aset standard-display-table ?,L?(B [?P]) - (aset standard-display-table ?,L@(B [?R]) - (aset standard-display-table ?,LA(B [?S]) - (aset standard-display-table ?,LB(B [?T]) - (aset standard-display-table ?,LC(B [?U]) - (aset standard-display-table ?,LD(B [?F]) - (aset standard-display-table ?,LE(B [?K ?h]) - (aset standard-display-table ?,LF(B [?T ?s]) - (aset standard-display-table ?,LG(B [?C ?h]) - (aset standard-display-table ?,LH(B [?S ?h]) - (aset standard-display-table ?,LI(B [?S ?c ?h]) - (aset standard-display-table ?,LJ(B [?~]) - (aset standard-display-table ?,LK(B [?Y]) - (aset standard-display-table ?,LL(B [?']) - (aset standard-display-table ?,LM(B [?E ?']) - (aset standard-display-table ?,LN(B [?Y ?u]) - (aset standard-display-table ?,LO(B [?Y ?a]) - - (aset standard-display-table ?,Lt(B [?i ?e]) - (aset standard-display-table ?,Lw(B [?i]) - (aset standard-display-table ?,L~(B [?u]) - (aset standard-display-table ?,Lr(B [?d ?j]) - (aset standard-display-table ?,L{(B [?c ?h ?j]) - (aset standard-display-table ?,Ls(B [?g ?j]) - (aset standard-display-table ?,Lu(B [?s]) - (aset standard-display-table ?,L|(B [?k]) - (aset standard-display-table ?,Lv(B [?i]) - (aset standard-display-table ?,Lx(B [?j]) - (aset standard-display-table ?,Ly(B [?l ?j]) - (aset standard-display-table ?,Lz(B [?n ?j]) - (aset standard-display-table ?,L(B [?d ?z]) - - (aset standard-display-table ?,L$(B [?Y ?e]) - (aset standard-display-table ?,L'(B [?Y ?i]) - (aset standard-display-table ?,L.(B [?U]) - (aset standard-display-table ?,L"(B [?D ?j]) - (aset standard-display-table ?,L+(B [?C ?h ?j]) - (aset standard-display-table ?,L#(B [?G ?j]) - (aset standard-display-table ?,L%(B [?S]) - (aset standard-display-table ?,L,(B [?K]) - (aset standard-display-table ?,L&(B [?I]) - (aset standard-display-table ?,L((B [?J]) - (aset standard-display-table ?,L)(B [?L ?j]) - (aset standard-display-table ?,L*(B [?N ?j]) - (aset standard-display-table ?,L/(B [?D ?j]) + (aset standard-display-table ?а [?a]) + (aset standard-display-table ?б [?b]) + (aset standard-display-table ?в [?v]) + (aset standard-display-table ?г [?g]) + (aset standard-display-table ?д [?d]) + (aset standard-display-table ?е [?e]) + (aset standard-display-table ?Ñ‘ [?y ?o]) + (aset standard-display-table ?ж [?z ?h]) + (aset standard-display-table ?з [?z]) + (aset standard-display-table ?и [?i]) + (aset standard-display-table ?й [?j]) + (aset standard-display-table ?к [?k]) + (aset standard-display-table ?л [?l]) + (aset standard-display-table ?м [?m]) + (aset standard-display-table ?н [?n]) + (aset standard-display-table ?о [?o]) + (aset standard-display-table ?п [?p]) + (aset standard-display-table ?Ñ€ [?r]) + (aset standard-display-table ?Ñ [?s]) + (aset standard-display-table ?Ñ‚ [?t]) + (aset standard-display-table ?у [?u]) + (aset standard-display-table ?Ñ„ [?f]) + (aset standard-display-table ?Ñ… [?k ?h]) + (aset standard-display-table ?ц [?t ?s]) + (aset standard-display-table ?ч [?c ?h]) + (aset standard-display-table ?ш [?s ?h]) + (aset standard-display-table ?щ [?s ?c ?h]) + (aset standard-display-table ?ÑŠ [?~]) + (aset standard-display-table ?Ñ‹ [?y]) + (aset standard-display-table ?ÑŒ [?']) + (aset standard-display-table ?Ñ [?e ?']) + (aset standard-display-table ?ÑŽ [?y ?u]) + (aset standard-display-table ?Ñ [?y ?a]) + + (aset standard-display-table ?Ð [?A]) + (aset standard-display-table ?Б [?B]) + (aset standard-display-table ?Ð’ [?V]) + (aset standard-display-table ?Г [?G]) + (aset standard-display-table ?Д [?D]) + (aset standard-display-table ?Е [?E]) + (aset standard-display-table ?Ð [?Y ?o]) + (aset standard-display-table ?Ж [?Z ?h]) + (aset standard-display-table ?З [?Z]) + (aset standard-display-table ?И [?I]) + (aset standard-display-table ?Й [?J]) + (aset standard-display-table ?К [?K]) + (aset standard-display-table ?Л [?L]) + (aset standard-display-table ?Ðœ [?M]) + (aset standard-display-table ?Ð [?N]) + (aset standard-display-table ?О [?O]) + (aset standard-display-table ?П [?P]) + (aset standard-display-table ?Ð [?R]) + (aset standard-display-table ?С [?S]) + (aset standard-display-table ?Т [?T]) + (aset standard-display-table ?У [?U]) + (aset standard-display-table ?Ф [?F]) + (aset standard-display-table ?Ð¥ [?K ?h]) + (aset standard-display-table ?Ц [?T ?s]) + (aset standard-display-table ?Ч [?C ?h]) + (aset standard-display-table ?Ш [?S ?h]) + (aset standard-display-table ?Щ [?S ?c ?h]) + (aset standard-display-table ?Ъ [?~]) + (aset standard-display-table ?Ы [?Y]) + (aset standard-display-table ?Ь [?']) + (aset standard-display-table ?Ð [?E ?']) + (aset standard-display-table ?Ю [?Y ?u]) + (aset standard-display-table ?Я [?Y ?a]) + + (aset standard-display-table ?Ñ” [?i ?e]) + (aset standard-display-table ?Ñ— [?i]) + (aset standard-display-table ?Ñž [?u]) + (aset standard-display-table ?Ñ’ [?d ?j]) + (aset standard-display-table ?Ñ› [?c ?h ?j]) + (aset standard-display-table ?Ñ“ [?g ?j]) + (aset standard-display-table ?Ñ• [?s]) + (aset standard-display-table ?Ñœ [?k]) + (aset standard-display-table ?Ñ– [?i]) + (aset standard-display-table ?ј [?j]) + (aset standard-display-table ?Ñ™ [?l ?j]) + (aset standard-display-table ?Ñš [?n ?j]) + (aset standard-display-table ?ÑŸ [?d ?z]) + + (aset standard-display-table ?Є [?Y ?e]) + (aset standard-display-table ?Ї [?Y ?i]) + (aset standard-display-table ?ÐŽ [?U]) + (aset standard-display-table ?Ђ [?D ?j]) + (aset standard-display-table ?Ћ [?C ?h ?j]) + (aset standard-display-table ?Ѓ [?G ?j]) + (aset standard-display-table ?Ð… [?S]) + (aset standard-display-table ?ÐŒ [?K]) + (aset standard-display-table ?І [?I]) + (aset standard-display-table ?Ј [?J]) + (aset standard-display-table ?Љ [?L ?j]) + (aset standard-display-table ?Њ [?N ?j]) + (aset standard-display-table ?Ð [?D ?j]) (when (equal cyrillic-language "Bulgarian") - (aset standard-display-table ?,Li(B [?s ?h ?t]) - (aset standard-display-table ?,LI(B [?S ?h ?t]) - (aset standard-display-table ?,Ln(B [?i ?u]) - (aset standard-display-table ?,LN(B [?I ?u]) - (aset standard-display-table ?,Lo(B [?i ?a]) - (aset standard-display-table ?,LO(B [?I ?a])) + (aset standard-display-table ?щ [?s ?h ?t]) + (aset standard-display-table ?Щ [?S ?h ?t]) + (aset standard-display-table ?ÑŽ [?i ?u]) + (aset standard-display-table ?Ю [?I ?u]) + (aset standard-display-table ?Ñ [?i ?a]) + (aset standard-display-table ?Я [?I ?a])) (when (equal cyrillic-language "Ukrainian") ; based on the official ; transliteration table - (aset standard-display-table ?,LX(B [?y]) - (aset standard-display-table ?,L8(B [?Y]) - (aset standard-display-table ?,LY(B [?i]) - (aset standard-display-table ?,L9(B [?Y]) - (aset standard-display-table ?,Ln(B [?i ?u]) - (aset standard-display-table ?,Lo(B [?i ?a])))) + (aset standard-display-table ?и [?y]) + (aset standard-display-table ?И [?Y]) + (aset standard-display-table ?й [?i]) + (aset standard-display-table ?Й [?Y]) + (aset standard-display-table ?ÑŽ [?i ?u]) + (aset standard-display-table ?Ñ [?i ?a])))) ;; (provide 'cyril-util) ;; Local Variables: -;; coding: iso-2022-7bit +;; coding: utf-8 ;; End: ;;; cyril-util.el ends here diff --git a/lisp/language/european.el b/lisp/language/european.el index e3156fa855e..efcdf9db2c8 100644 --- a/lisp/language/european.el +++ b/lisp/language/european.el @@ -1,4 +1,4 @@ -;;; european.el --- support for European languages -*- coding: iso-2022-7bit; -*- +;;; european.el --- support for European languages -*- coding: utf-8; -*- ;; Copyright (C) 1997-1998, 2000-2013 Free Software Foundation, Inc. ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, @@ -43,7 +43,7 @@ (unibyte-display . iso-latin-1) (input-method . "latin-1-prefix") (sample-text - . "Hello, Hej, Tere, Hei, Bonjour, Gr$(D+d)N(B Gott, Ciao, $(D"B(BHola!") + . "Hello, Hej, Tere, Hei, Bonjour, Grüß Gott, Ciao, ¡Hola!") (documentation . "\ This language environment is a generic one for the Latin-1 (ISO-8859-1) character set which supports the following European languages: @@ -241,7 +241,7 @@ See also the Turkish environment.")) (unibyte-display . iso-latin-8) (input-method . "latin-8-prefix") ;; Fixme: Welsh/Ga{e}lic greetings - (sample-text . ",_"(B $(D+q(B $(D*t(B") + (sample-text . "ḃ ŵ Ŷ") (documentation . "\ This language environment is a generic one for the Latin-8 (ISO-8859-14) character set which supports the Celtic languages, including those not @@ -271,7 +271,7 @@ covered by other ISO-8859 character sets: (unibyte-display . iso-latin-9) (input-method . "latin-9-prefix") (sample-text - . "AVE. $(D*^+^*v+v)-)M*s(B $(Q)!(B") + . "AVE. ŠšŽžŒœŸ €") (documentation . "\ This language environment is a generic one for the Latin-9 (ISO-8859-15) character set which supports the same languages as Latin-1 with the @@ -427,7 +427,7 @@ but it selects the Dutch tutorial and input method.")) (unibyte-display . iso-latin-1) (sample-text . "\ German (Deutsch Nord) Guten Tag -German (Deutsch S$(D+d(Bd) Gr$(D+d)N(B Gott") +German (Deutsch Süd) Grüß Gott") (documentation . "\ This language environment is almost the same as Latin-1, but sets the default input method to \"german-postfix\". @@ -442,7 +442,7 @@ Additionally, it selects the German tutorial.")) (nonascii-translation . iso-8859-1) (unibyte-display . iso-latin-1) (input-method . "latin-1-prefix") - (sample-text . "French (Fran$(D+.(Bais) Bonjour, Salut") + (sample-text . "French (Français) Bonjour, Salut") (documentation . "\ This language environment is almost the same as Latin-1, but it selects the French tutorial and input method.")) @@ -471,7 +471,7 @@ Additionally, it selects the Italian tutorial.")) (input-method . "slovenian") (unibyte-display . iso-8859-2) (tutorial . "TUTORIAL.sl") - (sample-text . "$(D*v(Belimo vam uspe$(D+^(Ben dan!") + (sample-text . "Želimo vam uspeÅ¡en dan!") (documentation . "\ This language environment is almost the same as Latin-2, but it selects the Slovenian tutorial and input method.")) @@ -485,7 +485,7 @@ but it selects the Slovenian tutorial and input method.")) (input-method . "spanish-postfix") (nonascii-translation . iso-8859-1) (unibyte-display . iso-latin-1) - (sample-text . "Spanish (Espa$(D+P(Bol) $(D"B(BHola!") + (sample-text . "Spanish (Español) ¡Hola!") (documentation . "\ This language environment is almost the same as Latin-1, but it sets the default input method to \"spanish-postfix\", @@ -504,25 +504,25 @@ and it selects the Spanish tutorial.")) (nonascii-translation . iso-8859-9) (unibyte-display . iso-latin-5) (input-method . "turkish-postfix") - (sample-text . "Turkish (T$(D+d(Brk$(D+.(Be) Merhaba") + (sample-text . "Turkish (Türkçe) Merhaba") (setup-function . turkish-case-conversion-enable) (setup-function . turkish-case-conversion-disable) (documentation . "Support for Turkish. Differs from the Latin-5 environment in using the `turkish-postfix' input -method and applying Turkish case rules for the characters i, I, $(D)E(B, $(D*D(B."))) +method and applying Turkish case rules for the characters i, I, ı, Ä°."))) (defun turkish-case-conversion-enable () - "Set up Turkish case conversion of `i' and `I' into `$(D*D(B' and `$(D)E(B'." + "Set up Turkish case conversion of `i' and `I' into `Ä°' and `ı'." (let ((table (standard-case-table))) - (set-case-syntax-pair ?$(D*D(B ?i table) - (set-case-syntax-pair ?I ?$(D)E(B table))) + (set-case-syntax-pair ?Ä° ?i table) + (set-case-syntax-pair ?I ?ı table))) (defun turkish-case-conversion-disable () "Set up normal (non-Turkish) case conversion of `i' into `I'." (let ((table (standard-case-table))) (set-case-syntax-pair ?I ?i table) - (set-case-syntax ?$(D*D(B "w" table) - (set-case-syntax ?$(D)E(B "w" table))) + (set-case-syntax ?Ä° "w" table) + (set-case-syntax ?ı "w" table))) ;; Polish ISO 8859-2 environment. ;; Maintainer: Wlodek Bzyl <matwb@univ.gda.pl> @@ -536,7 +536,7 @@ method and applying Turkish case rules for the characters i, I, $(D)E(B, $(D* (nonascii-translation . iso-8859-2) (unibyte-display . iso-8859-2) (tutorial . "TUTORIAL.pl") - (sample-text . "P$(D+Q(Bjd$(D+u(B, ki$(D+M(B-$(D+w(Be t$(D+8(B chmurno$(D+\++(B w g$(D)H+((Bb flaszy") + (sample-text . "Pójdź, kiÅ„-że tÄ™ chmurność w gÅ‚Ä…b flaszy") (documentation . t)) '("European")) diff --git a/lisp/language/ind-util.el b/lisp/language/ind-util.el index 8964da1ea13..c8df282e6e9 100644 --- a/lisp/language/ind-util.el +++ b/lisp/language/ind-util.el @@ -1,4 +1,4 @@ -;;; ind-util.el --- Transliteration and Misc. Tools for Indian Languages -*- coding: iso-2022-7bit; -*- +;;; ind-util.el --- Transliteration and Misc. Tools for Indian Languages -*- coding: utf-8-emacs; -*- ;; Copyright (C) 2001-2013 Free Software Foundation, Inc. @@ -47,233 +47,233 @@ (defvar indian-dev-base-table '( (;; VOWELS (18) - (?$,15E(B nil) (?$,15F(B ?$,15~(B) (?$,15G(B ?$,15(B) (?$,15H(B ?$,16 (B) (?$,15I(B ?$,16!(B) (?$,15J(B ?$,16"(B) - (?$,15K(B ?$,16#(B) (?$,15L(B ?$,16B(B) (?$,15M(B ?$,16%(B) (?$,15N(B ?$,16&(B) (?$,15O(B ?$,16'(B) (?$,15P(B ?$,16((B) - (?$,15Q(B ?$,16)(B) (?$,15R(B ?$,16*(B) (?$,15S(B ?$,16+(B) (?$,15T(B ?$,16,(B) (?$,16@(B ?$,16$(B) (?$,16A(B ?$,16C(B)) + (?अ nil) (?आ ?ा) (?इ ?ि) (?ई ?ी) (?उ ?à¥) (?ऊ ?ू) + (?ऋ ?ृ) (?ऌ ?ॢ) (?ठ?ॅ) (?ऎ ?ॆ) (?ठ?े) (?ठ?ै) + (?ऑ ?ॉ) (?ऒ ?ॊ) (?ओ ?ो) (?औ ?ौ) (?ॠ?ॄ) (?ॡ ?ॣ)) (;; CONSONANTS (currently 42, including special cases) - ?$,15U(B ?$,15V(B ?$,15W(B ?$,15X(B ?$,15Y(B ;; GUTTRULS - ?$,15Z(B ?$,15[(B ?$,15\(B ?$,15](B ?$,15^(B ;; PALATALS - ?$,15_(B ?$,15`(B ?$,15a(B ?$,15b(B ?$,15c(B ;; CEREBRALS - ?$,15d(B ?$,15e(B ?$,15f(B ?$,15g(B ?$,15h(B ?$,15i(B ;; DENTALS - ?$,15j(B ?$,15k(B ?$,15l(B ?$,15m(B ?$,15n(B ;; LABIALS - ?$,15o(B ?$,15p(B ?$,15q(B ?$,15r(B ?$,15s(B ?$,15t(B ?$,15u(B ;; SEMIVOWELS - ?$,15v(B ?$,15w(B ?$,15x(B ?$,15y(B ;; SIBILANTS - ?$,168(B ?$,169(B ?$,16:(B ?$,16;(B ?$,16<(B ?$,16=(B ?$,16>(B ?$,16?(B ;; NUKTAS - "$,15\6-5^(B" "$,15U6-5w(B") + ?क ?ख ?ग ?घ ?ङ ;; GUTTRULS + ?च ?छ ?ज ?ठ?ञ ;; PALATALS + ?ट ?ठ?ड ?ढ ?ण ;; CEREBRALS + ?त ?थ ?द ?ध ?न ?ऩ ;; DENTALS + ?प ?फ ?ब ?ठ?म ;; LABIALS + ?य ?र ?ऱ ?ल ?ळ ?ऴ ?व ;; SEMIVOWELS + ?श ?ष ?स ?ह ;; SIBILANTS + ?क़ ?ख़ ?ग़ ?ज़ ?ड़ ?ॠ?फ़ ?य़ ;; NUKTAS + "जà¥à¤ž" "कà¥à¤·") (;; Misc Symbols (7) - ?$,15A(B ?$,15B(B ?$,15C(B ?$,15}(B ?$,16-(B ?$,160(B ?$,16D(B) + ?ठ?ं ?ः ?ऽ ?ॠ?ॠ?।) (;; Digits (10) - ?$,16F(B ?$,16G(B ?$,16H(B ?$,16I(B ?$,16J(B ?$,16K(B ?$,16L(B ?$,16M(B ?$,16N(B ?$,16O(B) + ?० ?१ ?२ ?३ ?४ ?५ ?६ ?ॠ?८ ?९) (;; Inscript-extra (4) (#, $, ^, *, ]) - "$,16-5p(B" "$,15p6-(B" "$,15d6-5p(B" "$,15v6-5p(B" "$,15|(B"))) + "à¥à¤°" "रà¥" "तà¥à¤°" "शà¥à¤°" "़"))) ;; Punjabi is also known as Gurmukhi. (defvar indian-pnj-base-table '( (;; VOWELS - (?$,18%(B nil) (?$,18&(B ?$,18^(B) (?$,18'(B ?$,18_(B) (?$,18((B ?$,18`(B) (?$,18)(B ?$,18a(B) (?$,18*(B ?$,18b(B) - nil nil nil nil (?$,18/(B ?$,18g(B) (?$,180(B ?$,18h(B) - nil nil (?$,183(B ?$,18k(B) (?$,184(B ?$,18l(B) nil nil) + (?ਅ nil) (?ਆ ?ਾ) (?ਇ ?ਿ) (?ਈ ?à©€) (?ਉ ?à©) (?ਊ ?à©‚) + nil nil nil nil (?ਠ?ੇ) (?ਠ?ੈ) + nil nil (?ਓ ?à©‹) (?ਔ ?à©Œ) nil nil) (;; CONSONANTS - ?$,185(B ?$,186(B ?$,187(B ?$,188(B ?$,189(B ;; GUTTRULS - ?$,18:(B ?$,18;(B ?$,18<(B ?$,18=(B ?$,18>(B ;; PALATALS - ?$,18?(B ?$,18@(B ?$,18A(B ?$,18B(B ?$,18C(B ;; CEREBRALS - ?$,18D(B ?$,18E(B ?$,18F(B ?$,18G(B ?$,18H(B nil ;; DENTALS - ?$,18J(B ?$,18K(B ?$,18L(B ?$,18M(B ?$,18N(B ;; LABIALS - ?$,18O(B ?$,18P(B nil ?$,18R(B ?$,18S(B nil ?$,18U(B ;; SEMIVOWELS - ?$,18V(B nil ?$,18X(B ?$,18Y(B ;; SIBILANTS - nil ?$,18y(B ?$,18z(B ?$,18{(B ?$,18|(B nil ?$,18~(B nil ;; NUKTAS - "$,18<8m8>(B" nil) + ?ਕ ?ਖ ?ਗ ?ਘ ?ਙ ;; GUTTRULS + ?ਚ ?ਛ ?ਜ ?ਠ?ਞ ;; PALATALS + ?ਟ ?ਠ?ਡ ?ਢ ?ਣ ;; CEREBRALS + ?ਤ ?ਥ ?ਦ ?ਧ ?ਨ nil ;; DENTALS + ?ਪ ?ਫ ?ਬ ?ਠ?ਮ ;; LABIALS + ?ਯ ?ਰ nil ?ਲ ?ਲ਼ nil ?ਵ ;; SEMIVOWELS + ?ਸ਼ nil ?ਸ ?ਹ ;; SIBILANTS + nil ?à©™ ?à©š ?à©› ?à©œ nil ?à©ž nil ;; NUKTAS + "ਜà©à¨ž" nil) (;; Misc Symbols (7) - nil ?$,18"(B nil nil ?$,18m(B nil nil) ;; ek onkar, etc. + nil ?ਂ nil nil ?à© nil nil) ;; ek onkar, etc. (;; Digits - ?$,19&(B ?$,19'(B ?$,19((B ?$,19)(B ?$,19*(B ?$,19+(B ?$,19,(B ?$,19-(B ?$,19.(B ?$,19/(B) + ?੦ ?੧ ?੨ ?à©© ?੪ ?à©« ?੬ ?à© ?à©® ?੯) (;; Inscript-extra (4) (#, $, ^, *, ]) - "$,18m8P(B" "$,18P8m(B" "$,18D8m8P(B" "$,18V8m8P(B" "$,18\(B"))) + "à©à¨°" "ਰà©" "ਤà©à¨°" "ਸ਼à©à¨°" "਼"))) (defvar indian-gjr-base-table '( (;; VOWELS - (?$,19E(B nil) (?$,19F(B ?$,19~(B) (?$,19G(B ?$,19(B) (?$,19H(B ?$,1: (B) (?$,19I(B ?$,1:!(B) (?$,19J(B ?$,1:"(B) - (?$,19K(B ?$,1:#(B) nil (?$,19M(B ?$,1:%(B) nil (?$,19O(B ?$,1:'(B) (?$,19P(B ?$,1:((B) - (?$,19Q(B ?$,1:)(B) nil (?$,19S(B ?$,1:+(B) (?$,19T(B ?$,1:,(B) (?$,1:@(B ?$,1:$(B) nil) + (?અ nil) (?આ ?ા) (?ઇ ?િ) (?ઈ ?à«€) (?ઉ ?à«) (?ઊ ?à«‚) + (?ઋ ?ૃ) nil (?ઠ?à«…) nil (?ઠ?ે) (?ઠ?ૈ) + (?ઑ ?ૉ) nil (?ઓ ?à«‹) (?ઔ ?à«Œ) (?à« ?à«„) nil) (;; CONSONANTS - ?$,19U(B ?$,19V(B ?$,19W(B ?$,19X(B ?$,19Y(B ;; GUTTRULS - ?$,19Z(B ?$,19[(B ?$,19\(B ?$,19](B ?$,19^(B ;; PALATALS - ?$,19_(B ?$,19`(B ?$,19a(B ?$,19b(B ?$,19c(B ;; CEREBRALS - ?$,19d(B ?$,19e(B ?$,19f(B ?$,19g(B ?$,19h(B nil ;; DENTALS - ?$,19j(B ?$,19k(B ?$,19l(B ?$,19m(B ?$,19n(B ;; LABIALS - ?$,19o(B ?$,19p(B nil ?$,19r(B ?$,19s(B nil ?$,19u(B ;; SEMIVOWELS - ?$,19v(B ?$,19w(B ?$,19x(B ?$,19y(B ;; SIBILANTS + ?ક ?ખ ?ગ ?ઘ ?ઙ ;; GUTTRULS + ?ચ ?છ ?જ ?ઠ?ઞ ;; PALATALS + ?ટ ?ઠ?ડ ?ઢ ?ણ ;; CEREBRALS + ?ત ?થ ?દ ?ધ ?ન nil ;; DENTALS + ?પ ?ફ ?બ ?ઠ?મ ;; LABIALS + ?ય ?ર nil ?લ ?ળ nil ?વ ;; SEMIVOWELS + ?શ ?ષ ?સ ?હ ;; SIBILANTS nil nil nil nil nil nil nil nil ;; NUKTAS - "$,19\:-9^(B" "$,19U:-9w(B") + "જà«àªž" "કà«àª·") (;; Misc Symbols (7) - ?$,19A(B ?$,19B(B ?$,19C(B ?$,19}(B ?$,1:-(B ?$,1:0(B nil) + ?ઠ?ં ?ઃ ?ઽ ?à« ?à« nil) (;; Digits - ?$,1:F(B ?$,1:G(B ?$,1:H(B ?$,1:I(B ?$,1:J(B ?$,1:K(B ?$,1:L(B ?$,1:M(B ?$,1:N(B ?$,1:O(B) + ?૦ ?૧ ?૨ ?à«© ?૪ ?à«« ?૬ ?à« ?à«® ?૯) (;; Inscript-extra (4) (#, $, ^, *, ]) - "$,1:-9p(B" "$,19p:-(B" "$,19d:-9p(B" "$,19v:-9p(B" "$,19|(B"))) + "à«àª°" "રà«" "તà«àª°" "શà«àª°" "઼"))) (defvar indian-ori-base-table '( (;; VOWELS - (?$,1:e(B nil) (?$,1:f(B ?$,1;>(B) (?$,1:g(B ?$,1;?(B) (?$,1:h(B ?$,1;@(B) (?$,1:i(B ?$,1;A(B) (?$,1:j(B ?$,1;B(B) - (?$,1:k(B ?$,1;C(B) (?$,1:l(B nil) nil nil (?$,1:o(B ?$,1;G(B) (?$,1:p(B ?$,1;H(B) - nil nil (?$,1:s(B ?$,1;K(B) (?$,1:t(B ?$,1;L(B) (?$,1;`(B nil) (?$,1;a(B nil)) + (?ଅ nil) (?ଆ ?ା) (?ଇ ?ି) (?ଈ ?à€) (?ଉ ?à) (?ଊ ?à‚) + (?ଋ ?àƒ) (?ଌ nil) nil nil (?ଠ?à‡) (?ଠ?àˆ) + nil nil (?ଓ ?à‹) (?ଔ ?àŒ) (?à nil) (?à¡ nil)) (;; CONSONANTS - ?$,1:u(B ?$,1:v(B ?$,1:w(B ?$,1:x(B ?$,1:y(B ;; GUTTRULS - ?$,1:z(B ?$,1:{(B ?$,1:|(B ?$,1:}(B ?$,1:~(B ;; PALATALS - ?$,1:(B ?$,1; (B ?$,1;!(B ?$,1;"(B ?$,1;#(B ;; CEREBRALS - ?$,1;$(B ?$,1;%(B ?$,1;&(B ?$,1;'(B ?$,1;((B nil ;; DENTALS - ?$,1;*(B ?$,1;+(B ?$,1;,(B ?$,1;-(B ?$,1;.(B ;; LABIALS - ?$,1;/(B ?$,1;0(B nil ?$,1;2(B ?$,1;3(B nil nil ;; SEMIVOWELS - ?$,1;6(B ?$,1;7(B ?$,1;8(B ?$,1;9(B ;; SIBILANTS - nil nil nil nil ?$,1;\(B ?$,1;](B nil ?$,1;_(B ;; NUKTAS - "$,1:|;M:~(B" "$,1:u;M;7(B") + ?କ ?ଖ ?ଗ ?ଘ ?ଙ ;; GUTTRULS + ?ଚ ?ଛ ?ଜ ?ଠ?ଞ ;; PALATALS + ?ଟ ?ଠ?ଡ ?ଢ ?ଣ ;; CEREBRALS + ?ତ ?ଥ ?ଦ ?ଧ ?ନ nil ;; DENTALS + ?ପ ?ଫ ?ବ ?ଠ?ମ ;; LABIALS + ?ଯ ?ର nil ?ଲ ?ଳ nil nil ;; SEMIVOWELS + ?ଶ ?ଷ ?ସ ?ହ ;; SIBILANTS + nil nil nil nil ?àœ ?à nil ?àŸ ;; NUKTAS + "ଜàଞ" "କàଷ") (;; Misc Symbols - ?$,1:a(B ?$,1:b(B ?$,1:c(B ?$,1;=(B ?$,1;M(B nil nil) + ?ଠ?ଂ ?ଃ ?ଽ ?à nil nil) (;; Digits - ?$,1;f(B ?$,1;g(B ?$,1;h(B ?$,1;i(B ?$,1;j(B ?$,1;k(B ?$,1;l(B ?$,1;m(B ?$,1;n(B ?$,1;o(B) + ?ঠ?ৠ?ਠ?à© ?ઠ?à« ?ଠ?à ?à® ?à¯) (;; Inscript-extra (4) (#, $, ^, *, ]) - "$,1;M;0(B" "$,1;0;M(B" "$,1;$;M;0(B" "$,1;6;M;0(B" "$,1;<(B"))) + "àର" "ରà" "ତàର" "ଶàର" "଼"))) (defvar indian-bng-base-table '( (;; VOWELS - (?$,16e(B nil) (?$,16f(B ?$,17>(B) (?$,16g(B ?$,17?(B) (?$,16h(B ?$,17@(B) (?$,16i(B ?$,17A(B) (?$,16j(B ?$,17B(B) - (?$,16k(B ?$,17C(B) (?$,16l(B ?$,17b(B) nil nil (?$,16o(B ?$,17G(B) (?$,16p(B ?$,17H(B) - nil nil (?$,16s(B ?$,17K(B) (?$,16t(B ?$,17L(B) (?$,17`(B ?$,17D(B) (?$,17a(B ?$,17c(B)) + (?অ nil) (?আ ?া) (?ই ?ি) (?ঈ ?ী) (?উ ?à§) (?ঊ ?ূ) + (?ঋ ?ৃ) (?ঌ ?ৢ) nil nil (?ঠ?ে) (?ঠ?ৈ) + nil nil (?ও ?ো) (?ঔ ?ৌ) (?ৠ?ৄ) (?ৡ ?ৣ)) (;; CONSONANTS - ?$,16u(B ?$,16v(B ?$,16w(B ?$,16x(B ?$,16y(B ;; GUTTRULS - ?$,16z(B ?$,16{(B ?$,16|(B ?$,16}(B ?$,16~(B ;; PALATALS - ?$,16(B ?$,17 (B ?$,17!(B ?$,17"(B ?$,17#(B ;; CEREBRALS - ?$,17$(B ?$,17%(B ?$,17&(B ?$,17'(B ?$,17((B nil ;; DENTALS - ?$,17*(B ?$,17+(B ?$,17,(B ?$,17-(B ?$,17.(B ;; LABIALS - ?$,17/(B ?$,170(B nil ?$,172(B nil nil nil ;; SEMIVOWELS - ?$,176(B ?$,177(B ?$,178(B ?$,179(B ;; SIBILANTS - nil nil nil nil ?$,17\(B ?$,17](B nil ?$,17_(B ;; NUKTAS - "$,16|7M6~(B" "$,16u7M77(B") + ?ক ?খ ?গ ?ঘ ?ঙ ;; GUTTRULS + ?চ ?ছ ?জ ?ঠ?ঞ ;; PALATALS + ?ট ?ঠ?ড ?ঢ ?ণ ;; CEREBRALS + ?ত ?থ ?দ ?ধ ?ন nil ;; DENTALS + ?প ?ফ ?ব ?ঠ?ম ;; LABIALS + ?য ?র nil ?ল nil nil nil ;; SEMIVOWELS + ?শ ?ষ ?স ?হ ;; SIBILANTS + nil nil nil nil ?ড় ?ৠnil ?য় ;; NUKTAS + "জà§à¦ž" "কà§à¦·") (;; Misc Symbols - ?$,16a(B ?$,16b(B ?$,16c(B nil ?$,17M(B nil nil) + ?ঠ?ং ?ঃ nil ?ৠnil nil) (;; Digits - ?$,17f(B ?$,17g(B ?$,17h(B ?$,17i(B ?$,17j(B ?$,17k(B ?$,17l(B ?$,17m(B ?$,17n(B ?$,17o(B) + ?০ ?১ ?২ ?৩ ?৪ ?৫ ?৬ ?ৠ?৮ ?৯) (;; Inscript-extra (4) (#, $, ^, *, ]) - "$,17M70(B" "$,1707M(B" "$,17$7M70(B" "$,1767M70(B" "$,17<(B"))) + "à§à¦°" "রà§" "তà§à¦°" "শà§à¦°" "়"))) (defvar indian-asm-base-table '( (;; VOWELS - (?$,16e(B nil) (?$,16f(B ?$,17>(B) (?$,16g(B ?$,17?(B) (?$,16h(B ?$,17@(B) (?$,16i(B ?$,17A(B) (?$,16j(B ?$,17B(B) - (?$,16k(B ?$,17C(B) (?$,16l(B ?$,17b(B) nil nil (?$,16o(B ?$,17G(B) (?$,16p(B ?$,17H(B) - nil nil (?$,16s(B ?$,17K(B) (?$,16t(B ?$,17L(B) (?$,17`(B ?$,17D(B) (?$,17a(B ?$,17c(B)) + (?অ nil) (?আ ?া) (?ই ?ি) (?ঈ ?ী) (?উ ?à§) (?ঊ ?ূ) + (?ঋ ?ৃ) (?ঌ ?ৢ) nil nil (?ঠ?ে) (?ঠ?ৈ) + nil nil (?ও ?ো) (?ঔ ?ৌ) (?ৠ?ৄ) (?ৡ ?ৣ)) (;; CONSONANTS - ?$,16u(B ?$,16v(B ?$,16w(B ?$,16x(B ?$,16y(B ;; GUTTRULS - ?$,16z(B ?$,16{(B ?$,16|(B ?$,16}(B ?$,16~(B ;; PALATALS - ?$,16(B ?$,17 (B ?$,17!(B ?$,17"(B ?$,17#(B ;; CEREBRALS - ?$,17$(B ?$,17%(B ?$,17&(B ?$,17'(B ?$,17((B nil ;; DENTALS - ?$,17*(B ?$,17+(B ?$,17,(B ?$,17-(B ?$,17.(B ;; LABIALS - ?$,17/(B ?$,17p(B nil ?$,172(B nil nil ?$,17q(B ;; SEMIVOWELS - ?$,176(B ?$,177(B ?$,178(B ?$,179(B ;; SIBILANTS - nil nil nil nil ?$,17\(B ?$,17](B nil ?$,17_(B ;; NUKTAS - "$,16|7M6~(B" "$,16u7M77(B") + ?ক ?খ ?গ ?ঘ ?ঙ ;; GUTTRULS + ?চ ?ছ ?জ ?ঠ?ঞ ;; PALATALS + ?ট ?ঠ?ড ?ঢ ?ণ ;; CEREBRALS + ?ত ?থ ?দ ?ধ ?ন nil ;; DENTALS + ?প ?ফ ?ব ?ঠ?ম ;; LABIALS + ?য ?ৰ nil ?ল nil nil ?ৱ ;; SEMIVOWELS + ?শ ?ষ ?স ?হ ;; SIBILANTS + nil nil nil nil ?ড় ?ৠnil ?য় ;; NUKTAS + "জà§à¦ž" "কà§à¦·") (;; Misc Symbols - ?$,16a(B ?$,16b(B ?$,16c(B nil ?$,17M(B nil nil) + ?ঠ?ং ?ঃ nil ?ৠnil nil) (;; Digits - ?$,17f(B ?$,17g(B ?$,17h(B ?$,17i(B ?$,17j(B ?$,17k(B ?$,17l(B ?$,17m(B ?$,17n(B ?$,17o(B) + ?০ ?১ ?২ ?৩ ?৪ ?৫ ?৬ ?ৠ?৮ ?৯) (;; Inscript-extra (4) (#, $, ^, *, ]) - "$,17M7p(B" "$,17p7M(B" "$,17$7M7p(B" "$,1767M7p(B" "$,17<(B"))) + "à§à§°" "ৰà§" "তà§à§°" "শà§à§°" "়"))) (defvar indian-tlg-base-table '( (;; VOWELS - (?$,1=E(B nil) (?$,1=F(B ?$,1=~(B) (?$,1=G(B ?$,1=(B) (?$,1=H(B ?$,1> (B) (?$,1=I(B ?$,1>!(B) (?$,1=J(B ?$,1>"(B) - (?$,1=K(B ?$,1>#(B) (?$,1=L(B nil) nil (?$,1=O(B ?$,1>'(B) (?$,1=N(B ?$,1>&(B) (?$,1=P(B ?$,1>((B) - nil (?$,1=S(B ?$,1>+(B) (?$,1=R(B ?$,1>*(B) (?$,1=T(B ?$,1>,(B) (?$,1>@(B ?$,1>$(B) (?$,1>A(B nil)) + (?à°… nil) (?à°† ?à°¾) (?à°‡ ?à°¿) (?à°ˆ ?à±€) (?à°‰ ?à±) (?à°Š ?ూ) + (?à°‹ ?ృ) (?à°Œ nil) nil (?à° ?ే) (?à°Ž ?ె) (?à° ?ై) + nil (?à°“ ?ో) (?à°’ ?ొ) (?à°” ?ౌ) (?à± ?ౄ) (?ౡ nil)) (;; CONSONANTS - ?$,1=U(B ?$,1=V(B ?$,1=W(B ?$,1=X(B ?$,1=Y(B ;; GUTTRULS - ?$,1=Z(B ?$,1=[(B ?$,1=\(B ?$,1=](B ?$,1=^(B ;; PALATALS - ?$,1=_(B ?$,1=`(B ?$,1=a(B ?$,1=b(B ?$,1=c(B ;; CEREBRALS - ?$,1=d(B ?$,1=e(B ?$,1=f(B ?$,1=g(B ?$,1=h(B nil ;; DENTALS - ?$,1=j(B ?$,1=k(B ?$,1=l(B ?$,1=m(B ?$,1=n(B ;; LABIALS - ?$,1=o(B ?$,1=p(B ?$,1=q(B ?$,1=r(B ?$,1=s(B nil ?$,1=u(B ;; SEMIVOWELS - ?$,1=v(B ?$,1=w(B ?$,1=x(B ?$,1=y(B ;; SIBILANTS + ?à°• ?à°– ?à°— ?à°˜ ?à°™ ;; GUTTRULS + ?à°š ?à°› ?à°œ ?à° ?à°ž ;; PALATALS + ?à°Ÿ ?à° ?à°¡ ?à°¢ ?à°£ ;; CEREBRALS + ?à°¤ ?à°¥ ?à°¦ ?à°§ ?à°¨ nil ;; DENTALS + ?à°ª ?à°« ?à°¬ ?à° ?à°® ;; LABIALS + ?à°¯ ?à°° ?à°± ?à°² ?à°³ nil ?à°µ ;; SEMIVOWELS + ?à°¶ ?à°· ?à°¸ ?à°¹ ;; SIBILANTS nil nil nil nil nil nil nil nil ;; NUKTAS - "$,1=\>-=^(B" "$,1=U>-=w(B") + "à°œà±à°ž" "à°•à±à°·") (;; Misc Symbols - ?$,1=A(B ?$,1=B(B ?$,1=C(B nil ?$,1>-(B nil nil) + ?à° ?à°‚ ?à°ƒ nil ?à± nil nil) (;; Digits - ?$,1>F(B ?$,1>G(B ?$,1>H(B ?$,1>I(B ?$,1>J(B ?$,1>K(B ?$,1>L(B ?$,1>M(B ?$,1>N(B ?$,1>O(B) + ?౦ ?౧ ?౨ ?౩ ?౪ ?౫ ?౬ ?à± ?à±® ?౯) (;; Inscript-extra (4) (#, $, ^, *, ]) - "$,1>-=p(B" "$,1=p>-(B" "$,1=d>-=p(B" "$,1=v>-=p(B" nil))) + "à±à°°" "à°°à±" "à°¤à±à°°" "à°¶à±à°°" nil))) (defvar indian-knd-base-table '( (;; VOWELS - (?$,1>e(B nil) (?$,1>f(B ?$,1?>(B) (?$,1>g(B ?$,1??(B) (?$,1>h(B ?$,1?@(B) (?$,1>i(B ?$,1?A(B) (?$,1>j(B ?$,1?B(B) - (?$,1>k(B ?$,1?C(B) (?$,1>l(B nil) nil (?$,1>o(B ?$,1?G(B) (?$,1>n(B ?$,1?F(B) (?$,1>p(B ?$,1?H(B) - nil (?$,1>s(B ?$,1?K(B) (?$,1>r(B ?$,1?J(B) (?$,1>t(B ?$,1?L(B) (?$,1?`(B ?$,1?D(B) (?$,1?a(B nil)) + (?ಅ nil) (?ಆ ?ಾ) (?ಇ ?ಿ) (?ಈ ?à³€) (?ಉ ?à³) (?ಊ ?ೂ) + (?ಋ ?ೃ) (?ಌ nil) nil (?ಠ?ೇ) (?ಎ ?ೆ) (?ಠ?ೈ) + nil (?ಓ ?ೋ) (?ಒ ?ೊ) (?ಔ ?ೌ) (?à³ ?ೄ) (?ೡ nil)) (;; CONSONANTS - ?$,1>u(B ?$,1>v(B ?$,1>w(B ?$,1>x(B ?$,1>y(B ;; GUTTRULS - ?$,1>z(B ?$,1>{(B ?$,1>|(B ?$,1>}(B ?$,1>~(B ;; PALATALS - ?$,1>(B ?$,1? (B ?$,1?!(B ?$,1?"(B ?$,1?#(B ;; CEREBRALS - ?$,1?$(B ?$,1?%(B ?$,1?&(B ?$,1?'(B ?$,1?((B nil ;; DENTALS - ?$,1?*(B ?$,1?+(B ?$,1?,(B ?$,1?-(B ?$,1?.(B ;; LABIALS - ?$,1?/(B ?$,1?0(B ?$,1?1(B ?$,1?2(B ?$,1?3(B nil ?$,1?5(B ;; SEMIVOWELS - ?$,1?6(B ?$,1?7(B ?$,1?8(B ?$,1?9(B ;; SIBILANTS - nil nil nil nil nil nil ?$,1?^(B nil ;; NUKTAS - "$,1>|?M>~(B" "$,1>u?M?7(B") + ?ಕ ?ಖ ?ಗ ?ಘ ?ಙ ;; GUTTRULS + ?ಚ ?ಛ ?ಜ ?ಠ?ಞ ;; PALATALS + ?ಟ ?ಠ?ಡ ?ಢ ?ಣ ;; CEREBRALS + ?ತ ?ಥ ?ದ ?ಧ ?ನ nil ;; DENTALS + ?ಪ ?ಫ ?ಬ ?ಠ?ಮ ;; LABIALS + ?ಯ ?ರ ?ಱ ?ಲ ?ಳ nil ?ವ ;; SEMIVOWELS + ?ಶ ?ಷ ?ಸ ?ಹ ;; SIBILANTS + nil nil nil nil nil nil ?ೞ nil ;; NUKTAS + "ಜà³à²ž" "ಕà³à²·") (;; Misc Symbols - nil ?$,1>b(B ?$,1>c(B nil ?$,1?M(B nil nil) + nil ?ಂ ?ಃ nil ?à³ nil nil) (;; Digits - ?$,1?f(B ?$,1?g(B ?$,1?h(B ?$,1?i(B ?$,1?j(B ?$,1?k(B ?$,1?l(B ?$,1?m(B ?$,1?n(B ?$,1?o(B) + ?೦ ?೧ ?೨ ?೩ ?೪ ?೫ ?೬ ?à³ ?à³® ?೯) (;; Inscript-extra (4) (#, $, ^, *, ]) - "$,1?M?0(B" "$,1?0?M(B" "$,1?$?M?0(B" "$,1?6?M?0(B" nil))) + "à³à²°" "ರà³" "ತà³à²°" "ಶà³à²°" nil))) (defvar indian-mlm-base-table '( (;; VOWELS - (?$,1@%(B nil) (?$,1@&(B ?$,1@^(B) (?$,1@'(B ?$,1@_(B) (?$,1@((B ?$,1@`(B) (?$,1@)(B ?$,1@a(B) (?$,1@*(B ?$,1@b(B) - (?$,1@+(B ?$,1@c(B) (?$,1@,(B nil) nil (?$,1@/(B ?$,1@g(B) (?$,1@.(B ?$,1@f(B) (?$,1@0(B ?$,1@h(B) - nil (?$,1@3(B ?$,1@k(B) (?$,1@2(B ?$,1@j(B) (?$,1@4(B ?$,1@l(B) nil nil) + (?à´… nil) (?à´† ?à´¾) (?à´‡ ?à´¿) (?à´ˆ ?ീ) (?à´‰ ?àµ) (?à´Š ?ൂ) + (?à´‹ ?ൃ) (?à´Œ nil) nil (?à´ ?േ) (?à´Ž ?െ) (?à´ ?ൈ) + nil (?à´“ ?ോ) (?à´’ ?ൊ) (?à´” ?ൌ) nil nil) (;; CONSONANTS - ?$,1@5(B ?$,1@6(B ?$,1@7(B ?$,1@8(B ?$,1@9(B ;; GUTTRULS - ?$,1@:(B ?$,1@;(B ?$,1@<(B ?$,1@=(B ?$,1@>(B ;; PALATALS - ?$,1@?(B ?$,1@@(B ?$,1@A(B ?$,1@B(B ?$,1@C(B ;; CEREBRALS - ?$,1@D(B ?$,1@E(B ?$,1@F(B ?$,1@G(B ?$,1@H(B nil ;; DENTALS - ?$,1@J(B ?$,1@K(B ?$,1@L(B ?$,1@M(B ?$,1@N(B ;; LABIALS - ?$,1@O(B ?$,1@P(B ?$,1@Q(B ?$,1@R(B ?$,1@S(B ?$,1@T(B ?$,1@U(B ;; SEMIVOWELS - ?$,1@V(B ?$,1@W(B ?$,1@X(B ?$,1@Y(B ;; SIBILANTS + ?à´• ?à´– ?à´— ?à´˜ ?à´™ ;; GUTTRULS + ?à´š ?à´› ?à´œ ?à´ ?à´ž ;; PALATALS + ?à´Ÿ ?à´ ?à´¡ ?à´¢ ?à´£ ;; CEREBRALS + ?à´¤ ?à´¥ ?à´¦ ?à´§ ?à´¨ nil ;; DENTALS + ?à´ª ?à´« ?à´¬ ?à´ ?à´® ;; LABIALS + ?à´¯ ?à´° ?à´± ?à´² ?à´³ ?à´´ ?à´µ ;; SEMIVOWELS + ?à´¶ ?à´· ?à´¸ ?à´¹ ;; SIBILANTS nil nil nil nil nil nil nil nil ;; NUKTAS - "$,1@<@m@>(B" "$,1@5@m@W(B") + "à´œàµà´ž" "à´•àµà´·") (;; Misc Symbols - nil ?$,1@"(B ?$,1@#(B nil ?$,1@m(B nil nil) + nil ?à´‚ ?à´ƒ nil ?ൠnil nil) (;; Digits - ?$,1A&(B ?$,1A'(B ?$,1A((B ?$,1A)(B ?$,1A*(B ?$,1A+(B ?$,1A,(B ?$,1A-(B ?$,1A.(B ?$,1A/(B) + ?൦ ?൧ ?൨ ?൩ ?൪ ?൫ ?൬ ?ൠ?൮ ?൯) (;; Inscript-extra (4) (#, $, ^, *, ]) - "$,1@m@P(B" "$,1@P@m(B" "$,1@D@m@P(B" "$,1@V@m@P(B" nil))) + "àµà´°" "à´°àµ" "à´¤àµà´°" "à´¶àµà´°" nil))) (defvar indian-tml-base-table '( (;; VOWELS - (?$,1<%(B nil) (?$,1<&(B ?$,1<^(B) (?$,1<'(B ?$,1<_(B) (?$,1<((B ?$,1<`(B) (?$,1<)(B ?$,1<a(B) (?$,1<*(B ?$,1<b(B) - nil nil nil (?$,1</(B ?$,1<g(B) (?$,1<.(B ?$,1<f(B) (?$,1<0(B ?$,1<h(B) - nil (?$,1<3(B ?$,1<k(B) (?$,1<2(B ?$,1<j(B) (?$,1<4(B ?$,1<l(B) nil nil) + (?à®… nil) (?ஆ ?ா) (?இ ?ி) (?ஈ ?ீ) (?உ ?à¯) (?ஊ ?ூ) + nil nil nil (?à® ?ே) (?எ ?ெ) (?à® ?ை) + nil (?ஓ ?ோ) (?à®’ ?ொ) (?à®” ?ௌ) nil nil) (;; CONSONANTS - ?$,1<5(B nil nil nil ?$,1<9(B ;; GUTTRULS - ?$,1<:(B nil ?$,1<<(B nil ?$,1<>(B ;; PALATALS - ?$,1<?(B nil nil nil ?$,1<C(B ;; CEREBRALS - ?$,1<D(B nil nil nil ?$,1<H(B ?$,1<I(B ;; DENTALS - ?$,1<J(B nil nil nil ?$,1<N(B ;; LABIALS - ?$,1<O(B ?$,1<P(B ?$,1<Q(B ?$,1<R(B ?$,1<S(B ?$,1<T(B ?$,1<U(B ;; SEMIVOWELS - nil ?$,1<W(B ?$,1<X(B ?$,1<Y(B ;; SIBILANTS + ?க nil nil nil ?à®™ ;; GUTTRULS + ?ச nil ?ஜ nil ?ஞ ;; PALATALS + ?ட nil nil nil ?ண ;; CEREBRALS + ?த nil nil nil ?ந ?ன ;; DENTALS + ?ப nil nil nil ?à®® ;; LABIALS + ?ய ?à®° ?à®± ?ல ?ள ?à®´ ?வ ;; SEMIVOWELS + nil ?à®· ?ஸ ?ஹ ;; SIBILANTS nil nil nil nil nil nil nil nil ;; NUKTAS - "$,1<<<m<>(B" "$,1<5<m<W(B") + "ஜà¯à®ž" "கà¯à®·") (;; Misc Symbols - nil ?$,1<"(B ?$,1<#(B nil ?$,1<m(B nil nil) + nil ?ஂ ?ஃ nil ?௠nil nil) (;; Digits - ?$,1=&(B ?$,1='(B ?$,1=((B ?$,1=)(B ?$,1=*(B ?$,1=+(B ?$,1=,(B ?$,1=-(B ?$,1=.(B ?$,1=/(B) + ?௦ ?௧ ?௨ ?௩ ?௪ ?௫ ?௬ ?௠?௮ ?௯) (;; Inscript-extra (4) (#, $, ^, *, ]) - "$,1<m<P(B" "$,1<P<m(B" "$,1<D<m<P(B" nil nil))) + "à¯à®°" "à®°à¯" "தà¯à®°" nil nil))) (defvar indian-base-table-to-language-alist '((indian-dev-base-table . "Devanagari") @@ -588,117 +588,117 @@ ;;Unicode vs IS13194 ;; only Devanagari is supported now. ((ucs-devanagari-to-is13194-alist '((?\x0900 . "[U+0900]") - (?\x0901 . "(5!(B") - (?\x0902 . "(5"(B") - (?\x0903 . "(5#(B") + (?\x0901 . "ö€€€") + (?\x0902 . "ö€€") + (?\x0903 . "ö€€‚") (?\x0904 . "[U+0904]") - (?\x0905 . "(5$(B") - (?\x0906 . "(5%(B") - (?\x0907 . "(5&(B") - (?\x0908 . "(5'(B") - (?\x0909 . "(5((B") - (?\x090a . "(5)(B") - (?\x090b . "(5*(B") - (?\x090c . "(5&i(B") - (?\x090d . "(5.(B") - (?\x090e . "(5+(B") - (?\x090f . "(5,(B") - (?\x0910 . "(5-(B") - (?\x0911 . "(52(B") - (?\x0912 . "(5/(B") - (?\x0913 . "(50(B") - (?\x0914 . "(51(B") - (?\x0915 . "(53(B") - (?\x0916 . "(54(B") - (?\x0917 . "(55(B") - (?\x0918 . "(56(B") - (?\x0919 . "(57(B") - (?\x091a . "(58(B") - (?\x091b . "(59(B") - (?\x091c . "(5:(B") - (?\x091d . "(5;(B") - (?\x091e . "(5<(B") - (?\x091f . "(5=(B") - (?\x0920 . "(5>(B") - (?\x0921 . "(5?(B") - (?\x0922 . "(5@(B") - (?\x0923 . "(5A(B") - (?\x0924 . "(5B(B") - (?\x0925 . "(5C(B") - (?\x0926 . "(5D(B") - (?\x0927 . "(5E(B") - (?\x0928 . "(5F(B") - (?\x0929 . "(5G(B") - (?\x092a . "(5H(B") - (?\x092b . "(5I(B") - (?\x092c . "(5J(B") - (?\x092d . "(5K(B") - (?\x092e . "(5L(B") - (?\x092f . "(5M(B") - (?\x0930 . "(5O(B") - (?\x0931 . "(5P(B") - (?\x0932 . "(5Q(B") - (?\x0933 . "(5R(B") - (?\x0934 . "(5S(B") - (?\x0935 . "(5T(B") - (?\x0936 . "(5U(B") - (?\x0937 . "(5V(B") - (?\x0938 . "(5W(B") - (?\x0939 . "(5X(B") + (?\x0905 . "ö€€ƒ") + (?\x0906 . "ö€€„") + (?\x0907 . "ö€€…") + (?\x0908 . "ö€€†") + (?\x0909 . "ö€€‡") + (?\x090a . "ö€€ˆ") + (?\x090b . "ö€€‰") + (?\x090c . "ö€€…ö€ˆ") + (?\x090d . "ö€€") + (?\x090e . "ö€€Š") + (?\x090f . "ö€€‹") + (?\x0910 . "ö€€Œ") + (?\x0911 . "ö€€‘") + (?\x0912 . "ö€€Ž") + (?\x0913 . "ö€€") + (?\x0914 . "ö€€") + (?\x0915 . "ö€€’") + (?\x0916 . "ö€€“") + (?\x0917 . "ö€€”") + (?\x0918 . "ö€€•") + (?\x0919 . "ö€€–") + (?\x091a . "ö€€—") + (?\x091b . "ö€€˜") + (?\x091c . "ö€€™") + (?\x091d . "ö€€š") + (?\x091e . "ö€€›") + (?\x091f . "ö€€œ") + (?\x0920 . "ö€€") + (?\x0921 . "ö€€ž") + (?\x0922 . "ö€€Ÿ") + (?\x0923 . "ö€€ ") + (?\x0924 . "ö€€¡") + (?\x0925 . "ö€€¢") + (?\x0926 . "ö€€£") + (?\x0927 . "ö€€¤") + (?\x0928 . "ö€€¥") + (?\x0929 . "ö€€¦") + (?\x092a . "ö€€§") + (?\x092b . "ö€€¨") + (?\x092c . "ö€€©") + (?\x092d . "ö€€ª") + (?\x092e . "ö€€«") + (?\x092f . "ö€€¬") + (?\x0930 . "ö€€®") + (?\x0931 . "ö€€¯") + (?\x0932 . "ö€€°") + (?\x0933 . "ö€€±") + (?\x0934 . "ö€€²") + (?\x0935 . "ö€€³") + (?\x0936 . "ö€€´") + (?\x0937 . "ö€€µ") + (?\x0938 . "ö€€¶") + (?\x0939 . "ö€€·") (?\x093a . "[U+093a]") (?\x093b . "[U+093b]") - (?\x093c . "(5i(B") - (?\x093d . "(5ji(B") - (?\x093e . "(5Z(B") - (?\x093f . "(5[(B") - (?\x0940 . "(5\(B") - (?\x0941 . "(5](B") - (?\x0942 . "(5^(B") - (?\x0943 . "(5_(B") - (?\x0944 . "(5_i(B") - (?\x0945 . "(5c(B") - (?\x0946 . "(5`(B") - (?\x0947 . "(5a(B") - (?\x0948 . "(5b(B") - (?\x0949 . "(5g(B") - (?\x094a . "(5d(B") - (?\x094b . "(5e(B") - (?\x094c . "(5f(B") - (?\x094d . "(5h(B") + (?\x093c . "ö€ˆ") + (?\x093d . "ö€‰ö€ˆ") + (?\x093e . "ö€€¹") + (?\x093f . "ö€€º") + (?\x0940 . "ö€€»") + (?\x0941 . "ö€€¼") + (?\x0942 . "ö€€½") + (?\x0943 . "ö€€¾") + (?\x0944 . "ö€€¾ö€ˆ") + (?\x0945 . "ö€‚") + (?\x0946 . "ö€€¿") + (?\x0947 . "ö€€") + (?\x0948 . "ö€") + (?\x0949 . "ö€†") + (?\x094a . "ö€ƒ") + (?\x094b . "ö€„") + (?\x094c . "ö€…") + (?\x094d . "ö€‡") (?\x094e . "[U+094e]") (?\x094f . "[U+094f]") - (?\x0950 . "(5!i(B") - (?\x0951 . "(5p5(B") - (?\x0952 . "(5p8(B") + (?\x0950 . "ö€€€ö€ˆ") + (?\x0951 . "ö€ö€€”") + (?\x0952 . "ö€ö€€—") (?\x0953 . "[DEVANAGARI GRAVE ACCENT]") (?\x0954 . "[DEVANAGARI ACUTE ACCENT]") (?\x0955 . "[U+0955]") (?\x0956 . "[U+0956]") (?\x0957 . "[U+0957]") - (?\x0958 . "(53i(B") - (?\x0959 . "(54i(B") - (?\x095a . "(55i(B") - (?\x095b . "(5:i(B") - (?\x095c . "(5?i(B") - (?\x095d . "(5@i(B") - (?\x095e . "(5Ii(B") - (?\x095f . "(5N(B") - (?\x0960 . "(5*i(B") - (?\x0961 . "(5'i(B") - (?\x0962 . "(5[i(B") - (?\x0963 . "(5ei(B") - (?\x0964 . "(5j(B") - (?\x0965 . "(5jj(B") - (?\x0966 . "(5q(B") - (?\x0967 . "(5r(B") - (?\x0968 . "(5s(B") - (?\x0969 . "(5t(B") - (?\x096a . "(5u(B") - (?\x096b . "(5v(B") - (?\x096c . "(5w(B") - (?\x096d . "(5x(B") - (?\x096e . "(5y(B") - (?\x096f . "(5z(B") + (?\x0958 . "ö€€’ö€ˆ") + (?\x0959 . "ö€€“ö€ˆ") + (?\x095a . "ö€€”ö€ˆ") + (?\x095b . "ö€€™ö€ˆ") + (?\x095c . "ö€€žö€ˆ") + (?\x095d . "ö€€Ÿö€ˆ") + (?\x095e . "ö€€¨ö€ˆ") + (?\x095f . "ö€€") + (?\x0960 . "ö€€‰ö€ˆ") + (?\x0961 . "ö€€†ö€ˆ") + (?\x0962 . "ö€€ºö€ˆ") + (?\x0963 . "ö€„ö€ˆ") + (?\x0964 . "ö€‰") + (?\x0965 . "ö€‰ö€‰") + (?\x0966 . "ö€") + (?\x0967 . "ö€‘") + (?\x0968 . "ö€’") + (?\x0969 . "ö€“") + (?\x096a . "ö€”") + (?\x096b . "ö€•") + (?\x096c . "ö€–") + (?\x096d . "ö€—") + (?\x096e . "ö€˜") + (?\x096f . "ö€™") (?\x0970 . "[U+0970]") (?\x0971 . "[U+0971]") (?\x0972 . "[U+0972]") @@ -870,332 +870,332 @@ Returns new end position." (defconst indian-2-colum-to-ucs '( ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2120 $(6!!!"!#!$!%!&!'!(!)!*!+!,!-!.!/(B - ("$(6!!(B" . "$,15A(B") - ("$(6!"(B" . "$,15B(B") - ("$(6!#(B" . "$,15C(B") - ("$(6!$(B" . "$,15E(B") - ("$(6!%(B" . "$,15F(B") - ("$(6!&(B" . "$,15G(B") - ("$(6!'(B" . "$,15H(B") - ("$(6!((B" . "$,15I(B") - ("$(6!)(B" . "$,15J(B") - ("$(6!*(B" . "$,15K(B") - ("$(6!*"p(B" . "$,15p6#(B") - ("$(6!+(B" . "$,15N(B") - ("$(6!,(B" . "$,15O(B") - ("$(6!-(B" . "$,15P(B") - ("$(6!.(B" . "$,15M(B") - ("$(6!/(B" . "$,15R(B") + ;;2120 ö„€€ö„€ö„€‚ö„€ƒö„€„ö„€…ö„€†ö„€‡ö„€ˆö„€‰ö„€Šö„€‹ö„€Œö„€ö„€Ž + ("ö„€€" . "à¤") + ("ö„€" . "ं") + ("ö„€‚" . "ः") + ("ö„€ƒ" . "अ") + ("ö„€„" . "आ") + ("ö„€…" . "इ") + ("ö„€†" . "ई") + ("ö„€‡" . "उ") + ("ö„€ˆ" . "ऊ") + ("ö„€‰" . "ऋ") + ("ö„€‰ö„‚" . "रृ") + ("ö„€Š" . "ऎ") + ("ö„€‹" . "à¤") + ("ö„€Œ" . "à¤") + ("ö„€" . "à¤") + ("ö„€Ž" . "ऒ") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2130 $(6!0!1!2!3!4!5!6!7!8!9!:!;!<!=!>!?(B - ("$(6!0(B" . "$,15S(B") - ("$(6!1(B" . "$,15T(B") - ("$(6!2(B" . "$,15Q(B") - ("$(6!3(B" . "$,15U(B") - ("$(6!4(B" . "$,15V(B") - ("$(6!5(B" . "$,15W(B") - ("$(6!6(B" . "$,15X(B") - ("$(6!7(B" . "$,15Y(B") - ("$(6!8(B" . "$,15Z(B") - ("$(6!9(B" . "$,15[(B") - ("$(6!:(B" . "$,15\(B") - ("$(6!;(B" . "$,15](B") - ("$(6!<(B" . "$,15^(B") - ("$(6!=(B" . "$,15_(B") - ("$(6!>(B" . "$,15`(B") - ("$(6!?(B" . "$,15a(B") + ;;2130 ö„€ö„€ö„€‘ö„€’ö„€“ö„€”ö„€•ö„€–ö„€—ö„€˜ö„€™ö„€šö„€›ö„€œö„€ö„€ž + ("ö„€" . "ओ") + ("ö„€" . "औ") + ("ö„€‘" . "ऑ") + ("ö„€’" . "क") + ("ö„€“" . "ख") + ("ö„€”" . "ग") + ("ö„€•" . "घ") + ("ö„€–" . "ङ") + ("ö„€—" . "च") + ("ö„€˜" . "छ") + ("ö„€™" . "ज") + ("ö„€š" . "à¤") + ("ö„€›" . "ञ") + ("ö„€œ" . "ट") + ("ö„€" . "ठ") + ("ö„€ž" . "ड") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2140 $(6!@!A!B!C!D!E!F!G!H!I!J!K!L!M!N!O(B - ("$(6!@(B" . "$,15b(B") - ("$(6!A(B" . "$,15c(B") - ("$(6!B(B" . "$,15d(B") - ("$(6!C(B" . "$,15e(B") - ("$(6!D(B" . "$,15f(B") - ("$(6!E(B" . "$,15g(B") - ("$(6!F(B" . "$,15h(B") - ("$(6!G(B" . "$,15i(B") - ("$(6!H(B" . "$,15j(B") - ("$(6!I(B" . "$,15k(B") - ("$(6!J(B" . "$,15l(B") - ("$(6!K(B" . "$,15m(B") - ("$(6!L(B" . "$,15n(B") - ("$(6!M(B" . "$,15o(B") - ("$(6!N(B" . "$,16?(B") - ("$(6!O(B" . "$,15p(B") + ;;2140 ö„€Ÿö„€ ö„€¡ö„€¢ö„€£ö„€¤ö„€¥ö„€¦ö„€§ö„€¨ö„€©ö„€ªö„€«ö„€¬ö„€ö„€® + ("ö„€Ÿ" . "ढ") + ("ö„€ " . "ण") + ("ö„€¡" . "त") + ("ö„€¢" . "थ") + ("ö„€£" . "द") + ("ö„€¤" . "ध") + ("ö„€¥" . "न") + ("ö„€¦" . "ऩ") + ("ö„€§" . "प") + ("ö„€¨" . "फ") + ("ö„€©" . "ब") + ("ö„€ª" . "à¤") + ("ö„€«" . "म") + ("ö„€¬" . "य") + ("ö„€" . "य़") + ("ö„€®" . "र") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2150 $(6!P!Q!R!S!T!U!V!W!X!Y!Z![!\!]!^!_(B - ("$(6!P(B" . "$,15q(B") - ("$(6!Q(B" . "$,15r(B") - ("$(6!R(B" . "$,15s(B") - ("$(6!S(B" . "$,15t(B") - ("$(6!T(B" . "$,15u(B") - ("$(6!U(B" . "$,15v(B") - ("$(6!V(B" . "$,15w(B") - ("$(6!W(B" . "$,15x(B") - ("$(6!X(B" . "$,15y(B") - ("$(6!Z(B" . "$,15~(B") - ("$(6![(B" . "$,15(B") - ("$(6!\(B" . "$,16 (B") - ("$(6!](B" . "$,16!(B") - ("$(6!^(B" . "$,16"(B") - ("$(6!_(B" . "$,16#(B") + ;;2150 ö„€¯ö„€°ö„€±ö„€²ö„€³ö„€´ö„€µö„€¶ö„€·ö„€¸ö„€¹ö„€ºö„€»ö„€¼ö„€½ö„€¾ + ("ö„€¯" . "ऱ") + ("ö„€°" . "ल") + ("ö„€±" . "ळ") + ("ö„€²" . "ऴ") + ("ö„€³" . "व") + ("ö„€´" . "श") + ("ö„€µ" . "ष") + ("ö„€¶" . "स") + ("ö„€·" . "ह") + ("ö„€¹" . "ा") + ("ö„€º" . "ि") + ("ö„€»" . "ी") + ("ö„€¼" . "à¥") + ("ö„€½" . "ू") + ("ö„€¾" . "ृ") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2160 $(6!`!a!b!c!d!e!f!g!h!i!j!k!l!m!n!o(B - ("$(6!`(B" . "$,16&(B") - ("$(6!a(B" . "$,16'(B") - ("$(6!b(B" . "$,16((B") - ("$(6!c(B" . "$,16%(B") - ("$(6!d(B" . "$,16*(B") - ("$(6!e(B" . "$,16+(B") - ("$(6!f(B" . "$,16,(B") - ("$(6!g(B" . "$,16)(B") - ("$(6!h(B" . "$,16-(B") - ("$(6!i(B" . "$,15|(B") - ("$(6!j(B" . "$,16D(B") - ("$(6!j!j(B" . "$,16E(B") + ;;2160 ö„€¿ö„€ö„ö„‚ö„ƒö„„ö„…ö„†ö„‡ö„ˆö„‰ö„Šö„‹ö„Œö„ö„Ž + ("ö„€¿" . "ॆ") + ("ö„€" . "े") + ("ö„" . "ै") + ("ö„‚" . "ॅ") + ("ö„ƒ" . "ॊ") + ("ö„„" . "ो") + ("ö„…" . "ौ") + ("ö„†" . "ॉ") + ("ö„‡" . "à¥") + ("ö„ˆ" . "़") + ("ö„‰" . "।") + ("ö„‰ö„‰" . "॥") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2170 $(6!p!q!r!s!t!u!v!w!x!y!z!{!|!}!~(B - ("$(6!q(B" . "$,16F(B") - ("$(6!r(B" . "$,16G(B") - ("$(6!s(B" . "$,16H(B") - ("$(6!t(B" . "$,16I(B") - ("$(6!u(B" . "$,16J(B") - ("$(6!v(B" . "$,16K(B") - ("$(6!w(B" . "$,16L(B") - ("$(6!x(B" . "$,16M(B") - ("$(6!y(B" . "$,16N(B") - ("$(6!z(B" . "$,16O(B") + ;;2170 ö„ö„ö„‘ö„’ö„“ö„”ö„•ö„–ö„—ö„˜ö„™ö„šö„›ö„œö„ + ("ö„" . "०") + ("ö„‘" . "१") + ("ö„’" . "२") + ("ö„“" . "३") + ("ö„”" . "४") + ("ö„•" . "५") + ("ö„–" . "६") + ("ö„—" . "à¥") + ("ö„˜" . "८") + ("ö„™" . "९") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2220 $(6"!"""#"$"%"&"'"(")"*"+","-"."/(B - ("$(6"!(B" . "$,16;6-5p(B") - ("$(6""(B" . "$,16>6-5p(B") - ("$(6"#(B" . "$,15U6-5p(B") - ("$(6"$(B" . "$,15W6-5p(B") - ("$(6"%(B" . "$,15d6-5p(B") - ("$(6"&(B" . "$,15j6-5p(B") - ("$(6"'(B" . "$,15k6-5p(B") - ("$(6")(B" . "$,15v6-5p(B") - ("$(6",(B" . "$,15p6!(B") - ("$(6"-(B" . "$,15p6"(B") - ("$(6".(B" . "$,15q6!(B") - ("$(6"/(B" . "$,15q6"(B") + ;;2220 ö„žö„Ÿö„ ö„¡ö„¢ö„£ö„¤ö„¥ö„¦ö„§ö„¨ö„©ö„ªö„«ö„¬ + ("ö„ž" . "ज़à¥à¤°") + ("ö„Ÿ" . "फ़à¥à¤°") + ("ö„ " . "कà¥à¤°") + ("ö„¡" . "गà¥à¤°") + ("ö„¢" . "तà¥à¤°") + ("ö„£" . "पà¥à¤°") + ("ö„¤" . "फà¥à¤°") + ("ö„¦" . "शà¥à¤°") + ("ö„©" . "रà¥") + ("ö„ª" . "रू") + ("ö„«" . "ऱà¥") + ("ö„¬" . "ऱू") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2230 $(6"0"1"2"3"4"5"6"7"8"9":";"<"=">"?(B - ("$(6"3(B" . "$,15U6-(B") - ("$(6"4(B" . "$,15V6-(B") - ("$(6"5(B" . "$,15W6-(B") - ("$(6"6(B" . "$,15X6-(B") - ("$(6"8(B" . "$,15Z6-(B") - ("$(6"8"q(B" . "$,15Z6-5p6-(B") - ("$(6":(B" . "$,15\6-(B") - ("$(6";(B" . "$,15]6-(B") - ("$(6"<(B" . "$,15^6-(B") - ("$(6"<(B" . "$,15^6-(B") + ;;2230 ö„ö„®ö„¯ö„°ö„±ö„²ö„³ö„´ö„µö„¶ö„·ö„¸ö„¹ö„ºö„»ö„¼ + ("ö„°" . "कà¥") + ("ö„±" . "खà¥") + ("ö„²" . "गà¥") + ("ö„³" . "घà¥") + ("ö„µ" . "चà¥") + ("ö„µö„‚®" . "चà¥à¤°à¥") + ("ö„·" . "जà¥") + ("ö„¸" . "à¤à¥") + ("ö„¹" . "ञà¥") + ("ö„¹" . "ञà¥") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2240 $(6"@"A"B"C"D"E"F"G"H"I"J"K"L"M"N"O(B - ("$(6"A(B" . "$,15c6-(B") - ("$(6"B(B" . "$,15d6-(B") - ("$(6"C(B" . "$,15e6-(B") - ("$(6"E(B" . "$,15g6-(B") - ("$(6"F(B" . "$,15h6-(B") - ("$(6"G(B" . "$,15i6-(B") - ("$(6"H(B" . "$,15j6-(B") - ("$(6"I(B" . "$,15k6-(B") - ("$(6"J(B" . "$,15l6-(B") - ("$(6"J(B" . "$,15l6-(B") - ("$(6"K(B" . "$,15m6-(B") - ("$(6"L(B" . "$,15n6-(B") - ("$(6"M(B" . "$,15o6-(B") - ("$(6"N(B" . "$,16?6-(B") + ;;2240 ö„½ö„¾ö„¿ö„‚€ö„‚ö„‚‚ö„‚ƒö„‚„ö„‚…ö„‚†ö„‚‡ö„‚ˆö„‚‰ö„‚Šö„‚‹ö„‚Œ + ("ö„¾" . "णà¥") + ("ö„¿" . "तà¥") + ("ö„‚€" . "थà¥") + ("ö„‚‚" . "धà¥") + ("ö„‚ƒ" . "नà¥") + ("ö„‚„" . "ऩà¥") + ("ö„‚…" . "पà¥") + ("ö„‚†" . "फà¥") + ("ö„‚‡" . "बà¥") + ("ö„‚‡" . "बà¥") + ("ö„‚ˆ" . "à¤à¥") + ("ö„‚‰" . "मà¥") + ("ö„‚Š" . "यà¥") + ("ö„‚‹" . "य़à¥") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2250 $(6"P"Q"R"S"T"U"V"W"X"Y"Z"["\"]"^"_(B - ("$(6"Q(B" . "$,15r6-(B") - ("$(6"R(B" . "$,15s6-(B") - ("$(6"S(B" . "$,15t6-(B") - ("$(6"T(B" . "$,15u6-(B") - ("$(6"U(B" . "$,15v6-(B") - ("$(6"V(B" . "$,15w6-(B") - ("$(6"W(B" . "$,15x6-(B") - ("$(6"](B" . "$,16-5o(B") + ;;2250 ö„‚ö„‚Žö„‚ö„‚ö„‚‘ö„‚’ö„‚“ö„‚”ö„‚•ö„‚–ö„‚—ö„‚˜ö„‚™ö„‚šö„‚›ö„‚œ + ("ö„‚Ž" . "लà¥") + ("ö„‚" . "ळà¥") + ("ö„‚" . "ऴà¥") + ("ö„‚‘" . "वà¥") + ("ö„‚’" . "शà¥") + ("ö„‚“" . "षà¥") + ("ö„‚”" . "सà¥") + ("ö„‚š" . "à¥à¤¯") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2260 $(6"`"a"b"c"d"e"f"g"h"i"j"k"l"m"n"o(B - ("$(6"`(B" . "$,15W6-5p6-(B") - ("$(6"a(B" . "$,15X6-5h6-(B") - ("$(6"c(B" . "$,15d6-5d6-(B") - ("$(6"d(B" . "$,15d6-5p6-(B") - ("$(6"e(B" . "$,15g6-5h6-(B") - ("$(6"f(B" . "$,15g6-5p6-(B") - ("$(6"g(B" . "$,15j6-5d6-(B") - ("$(6"h(B" . "$,15v6-5Z6-(B") - ("$(6"i(B" . "$,15v6-5p6-(B") - ("$(6"j(B" . "$,15v6-5u6-(B") - ("$(6"k(B" . "$,15h6-5h6-(B") - ("$(6"l(B" . "$,15U6-5w6-(B") - ("$(6"m(B" . "$,15\6-5^6-(B") + ;;2260 ö„‚ö„‚žö„‚Ÿö„‚ ö„‚¡ö„‚¢ö„‚£ö„‚¤ö„‚¥ö„‚¦ö„‚§ö„‚¨ö„‚©ö„‚ªö„‚«ö„‚¬ + ("ö„‚" . "गà¥à¤°à¥") + ("ö„‚ž" . "घà¥à¤¨à¥") + ("ö„‚ " . "तà¥à¤¤à¥") + ("ö„‚¡" . "तà¥à¤°à¥") + ("ö„‚¢" . "धà¥à¤¨à¥") + ("ö„‚£" . "धà¥à¤°à¥") + ("ö„‚¤" . "पà¥à¤¤à¥") + ("ö„‚¥" . "शà¥à¤šà¥") + ("ö„‚¦" . "शà¥à¤°à¥") + ("ö„‚§" . "शà¥à¤µà¥") + ("ö„‚¨" . "नà¥à¤¨à¥") + ("ö„‚©" . "कà¥à¤·à¥") + ("ö„‚ª" . "जà¥à¤žà¥") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2270 $(6"p"q"r"s"t"u"v"w"x"y"z"{"|"}"~(B - ("$(6"p(B" . "$,15p6-(B") - ("$(6"q(B" . "$,16-5p(B") - ("$(6"r(B" . "$,16-5p(B") - ("$(6"s(B" . "$,1686-(B") - ("$(6"t(B" . "$,1696-(B") - ("$(6"u(B" . "$,16:6-(B") - ("$(6"y(B" . "$,16>6-(B") - ("$(6"z(B" . "$,16;6-(B") + ;;2270 ö„‚ö„‚®ö„‚¯ö„‚°ö„‚±ö„‚²ö„‚³ö„‚´ö„‚µö„‚¶ö„‚·ö„‚¸ö„‚¹ö„‚ºö„‚» + ("ö„‚" . "रà¥") + ("ö„‚®" . "à¥à¤°") + ("ö„‚¯" . "à¥à¤°") + ("ö„‚°" . "क़à¥") + ("ö„‚±" . "ख़à¥") + ("ö„‚²" . "ग़à¥") + ("ö„‚¶" . "फ़à¥") + ("ö„‚·" . "ज़à¥") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2320 $(6#!#"###$#%#&#'#(#)#*#+#,#-#.#/(B - ("$(6#!(B" . "$,160(B") - ("$(6#&(B" . "$,15L(B") - ("$(6#&"p(B" . "$,15p6$(B") - ("$(6#'(B" . "$,16A(B") - ("$(6#'"p(B" . "$,15p6C(B") - ("$(6#*(B" . "$,16@(B") - ("$(6#*"p(B" . "$,15p6B(B") + ;;2320 ö„‚¼ö„‚½ö„‚¾ö„‚¿ö„ƒ€ö„ƒö„ƒ‚ö„ƒƒö„ƒ„ö„ƒ…ö„ƒ†ö„ƒ‡ö„ƒˆö„ƒ‰ö„ƒŠ + ("ö„‚¼" . "à¥") + ("ö„ƒ" . "ऌ") + ("ö„ƒö„‚" . "रॄ") + ("ö„ƒ‚" . "ॡ") + ("ö„ƒ‚ö„‚" . "रॣ") + ("ö„ƒ…" . "ॠ") + ("ö„ƒ…ö„‚" . "रॢ") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2330 $(6#0#1#2#3#4#5#6#7#8#9#:#;#<#=#>#?(B - ("$(6#3(B" . "$,168(B") - ("$(6#4(B" . "$,169(B") - ("$(6#5(B" . "$,16:(B") - ("$(6#:(B" . "$,16;(B") - ("$(6#?(B" . "$,16<(B") + ;;2330 ö„ƒ‹ö„ƒŒö„ƒö„ƒŽö„ƒö„ƒö„ƒ‘ö„ƒ’ö„ƒ“ö„ƒ”ö„ƒ•ö„ƒ–ö„ƒ—ö„ƒ˜ö„ƒ™ö„ƒš + ("ö„ƒŽ" . "क़") + ("ö„ƒ" . "ख़") + ("ö„ƒ" . "ग़") + ("ö„ƒ•" . "ज़") + ("ö„ƒš" . "ड़") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2340 $(6#@#A#B#C#D#E#F#G#H#I#J#K#L#M#N#O(B - ("$(6#@(B" . "$,16=(B") - ("$(6#I(B" . "$,16>(B") - ("$(6#J(B" . "$,15}(B") - ("$(6#K(B" . "$,16$(B") - ("$(6#L(B" . "$,16B(B") - ("$(6#M(B" . "$,16C(B") + ;;2340 ö„ƒ›ö„ƒœö„ƒö„ƒžö„ƒŸö„ƒ ö„ƒ¡ö„ƒ¢ö„ƒ£ö„ƒ¤ö„ƒ¥ö„ƒ¦ö„ƒ§ö„ƒ¨ö„ƒ©ö„ƒª + ("ö„ƒ›" . "à¥") + ("ö„ƒ¤" . "फ़") + ("ö„ƒ¥" . "ऽ") + ("ö„ƒ¦" . "ॄ") + ("ö„ƒ§" . "ॢ") + ("ö„ƒ¨" . "ॣ") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2350 $(6#P#Q#R#S#T#U#V#W#X#Y#Z#[#\#]#^#_(B - ("$(6#P(B" . "$,15n6-5h(B") - ("$(6#Q(B" . "$,15n6-5r(B") - ("$(6#R(B" . "$,15y6#(B") + ;;2350 ö„ƒ«ö„ƒ¬ö„ƒö„ƒ®ö„ƒ¯ö„ƒ°ö„ƒ±ö„ƒ²ö„ƒ³ö„ƒ´ö„ƒµö„ƒ¶ö„ƒ·ö„ƒ¸ö„ƒ¹ö„ƒº + ("ö„ƒ«" . "मà¥à¤¨") + ("ö„ƒ¬" . "मà¥à¤²") + ("ö„ƒ" . "हृ") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2360 $(6#`#a#b#c#d#e#f#g#h#i#j#k#l#m#n#o(B - ("$(6#`(B" . "$,15r6-5r(B") - ("$(6#a(B" . "$,15u6-5h(B") - ("$(6#b(B" . "$,15u6-5u(B") - ("$(6#c(B" . "$,15v6-5Z(B") - ("$(6#d(B" . "$,15v6-5h(B") - ("$(6#e(B" . "$,15v6-5l(B") - ("$(6#f(B" . "$,15v6-5r(B") - ("$(6#g(B" . "$,15v6-5u(B") - ("$(6#h(B" . "$,15w6-5_6-5p6-5o(B") - ("$(6#i(B" . "$,15w6-5_6-5o(B") - ("$(6#j(B" . "$,15w6-5_6-5u(B") - ("$(6#k(B" . "$,15w6-5_(B") - ("$(6#l(B" . "$,15w6-5`(B") - ("$(6#m(B" . "$,15x6-5h(B") - ("$(6#n(B" . "$,15x6-5p(B") + ;;2360 ö„ƒ»ö„ƒ¼ö„ƒ½ö„ƒ¾ö„ƒ¿ö„„€ö„„ö„„‚ö„„ƒö„„„ö„„…ö„„†ö„„‡ö„„ˆö„„‰ö„„Š + ("ö„ƒ»" . "लà¥à¤²") + ("ö„ƒ¼" . "वà¥à¤¨") + ("ö„ƒ½" . "वà¥à¤µ") + ("ö„ƒ¾" . "शà¥à¤š") + ("ö„ƒ¿" . "शà¥à¤¨") + ("ö„„€" . "शà¥à¤¬") + ("ö„„" . "शà¥à¤²") + ("ö„„‚" . "शà¥à¤µ") + ("ö„„ƒ" . "षà¥à¤Ÿà¥à¤°à¥à¤¯") + ("ö„„„" . "षà¥à¤Ÿà¥à¤¯") + ("ö„„…" . "षà¥à¤Ÿà¥à¤µ") + ("ö„„†" . "षà¥à¤Ÿ") + ("ö„„‡" . "षà¥à¤ ") + ("ö„„ˆ" . "सà¥à¤¨") + ("ö„„‰" . "सà¥à¤°") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2370 $(6#p#q#r#s#t#u#v#w#x#y#z#{#|#}#~(B - ("$(6#p(B" . "$,15y6-5c(B") - ("$(6#q(B" . "$,15y6-5h(B") - ("$(6#r(B" . "$,15y6-5n(B") - ("$(6#s(B" . "$,15y6-5o(B") - ("$(6#t(B" . "$,15y6-5p(B") - ("$(6#u(B" . "$,15y6-5r(B") - ("$(6#v(B" . "$,15y6-5u(B") + ;;2370 ö„„‹ö„„Œö„„ö„„Žö„„ö„„ö„„‘ö„„’ö„„“ö„„”ö„„•ö„„–ö„„—ö„„˜ö„„™ + ("ö„„‹" . "हà¥à¤£") + ("ö„„Œ" . "हà¥à¤¨") + ("ö„„" . "हà¥à¤®") + ("ö„„Ž" . "हà¥à¤¯") + ("ö„„" . "हà¥à¤°") + ("ö„„" . "हà¥à¤²") + ("ö„„‘" . "हà¥à¤µ") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2420 $(6$!$"$#$$$%$&$'$($)$*$+$,$-$.$/(B - ("$(6$!(B" . "$,15U6-5d6-5p6-5o(B") - ("$(6$"(B" . "$,15U6-5d6-5u(B") - ("$(6$#(B" . "$,15U6-5d6-5o(B") - ("$(6$$(B" . "$,15U6-5h6-5o(B") - ("$(6$%(B" . "$,15U6-5p6-5o(B") - ("$(6$&(B" . "$,15U6-5u6-5o(B") - ("$(6$'(B" . "$,15U6-5U(B") - ("$(6$((B" . "$,15U6-5d(B") - ("$(6$)(B" . "$,15U6-5h(B") - ("$(6$*(B" . "$,15U6-5n(B") - ("$(6$+(B" . "$,15U6-5o(B") - ("$(6$,(B" . "$,15U6-5r(B") - ("$(6$-(B" . "$,15U6-5u(B") - ("$(6$.(B" . "$,15U6-5w(B") - ("$(6$/(B" . "$,15X6-5h(B") + ;;2420 ö„„šö„„›ö„„œö„„ö„„žö„„Ÿö„„ ö„„¡ö„„¢ö„„£ö„„¤ö„„¥ö„„¦ö„„§ö„„¨ + ("ö„„š" . "कà¥à¤¤à¥à¤°à¥à¤¯") + ("ö„„›" . "कà¥à¤¤à¥à¤µ") + ("ö„„œ" . "कà¥à¤¤à¥à¤¯") + ("ö„„" . "कà¥à¤¨à¥à¤¯") + ("ö„„ž" . "कà¥à¤°à¥à¤¯") + ("ö„„Ÿ" . "कà¥à¤µà¥à¤¯") + ("ö„„ " . "कà¥à¤•") + ("ö„„¡" . "कà¥à¤¤") + ("ö„„¢" . "कà¥à¤¨") + ("ö„„£" . "कà¥à¤®") + ("ö„„¤" . "कà¥à¤¯") + ("ö„„¥" . "कà¥à¤²") + ("ö„„¦" . "कà¥à¤µ") + ("ö„„§" . "कà¥à¤·") + ("ö„„¨" . "घà¥à¤¨") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2430 $(6$0$1$2$3$4$5$6$7$8$9$:$;$<$=$>$?(B - ("$(6$0(B" . "$,15Y6-5U6-5d6-5o(B") - ("$(6$1(B" . "$,15Y6-5U6-5w6-5u(B") - ("$(6$2(B" . "$,15Y6-5U6-5d(B") - ("$(6$3(B" . "$,15Y6-5U6-5w(B") - ("$(6$4(B" . "$,15Y6-5X6-5p(B") - ("$(6$5(B" . "$,15Y6-5U6-5o(B") - ("$(6$6(B" . "$,15Y6-5V6-5o(B") - ("$(6$7(B" . "$,15Y6-5W6-5o(B") - ("$(6$8(B" . "$,15Y6-5X6-5o(B") - ("$(6$9(B" . "$,15Y6-5U(B") - ("$(6$:(B" . "$,15Y6-5V(B") - ("$(6$;(B" . "$,15Y6-5W(B") - ("$(6$<(B" . "$,15Y6-5X(B") - ("$(6$=(B" . "$,15Y6-5Y(B") - ("$(6$>(B" . "$,15Y6-5h(B") - ("$(6$?(B" . "$,15Y6-5n(B") + ;;2430 ö„„©ö„„ªö„„«ö„„¬ö„„ö„„®ö„„¯ö„„°ö„„±ö„„²ö„„³ö„„´ö„„µö„„¶ö„„·ö„„¸ + ("ö„„©" . "ङà¥à¤•à¥à¤¤à¥à¤¯") + ("ö„„ª" . "ङà¥à¤•à¥à¤·à¥à¤µ") + ("ö„„«" . "ङà¥à¤•à¥à¤¤") + ("ö„„¬" . "ङà¥à¤•à¥à¤·") + ("ö„„" . "ङà¥à¤˜à¥à¤°") + ("ö„„®" . "ङà¥à¤•à¥à¤¯") + ("ö„„¯" . "ङà¥à¤–à¥à¤¯") + ("ö„„°" . "ङà¥à¤—à¥à¤¯") + ("ö„„±" . "ङà¥à¤˜à¥à¤¯") + ("ö„„²" . "ङà¥à¤•") + ("ö„„³" . "ङà¥à¤–") + ("ö„„´" . "ङà¥à¤—") + ("ö„„µ" . "ङà¥à¤˜") + ("ö„„¶" . "ङà¥à¤™") + ("ö„„·" . "ङà¥à¤¨") + ("ö„„¸" . "ङà¥à¤®") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2440 $(6$@$A$B$C$D$E$F$G$H$I$J$K$L$M$N$O(B - ("$(6$@(B" . "$,15Y6-5o(B") - ("$(6$A(B" . "$,15Z6-5Z(B") - ("$(6$B(B" . "$,15Z6-5^(B") - ("$(6$C(B" . "$,15[6-5o(B") - ("$(6$D(B" . "$,15\6-5p(B") - ("$(6$E(B" . "$,15\6-5^(B") - ("$(6$F(B" . "$,15^6-5Z(B") - ("$(6$G(B" . "$,15^6-5\(B") - ("$(6$H(B" . "$,15_6-5U(B") - ("$(6$I(B" . "$,15_6-5_(B") - ("$(6$J(B" . "$,15_6-5`(B") - ("$(6$K(B" . "$,15_6-5o(B") - ("$(6$L(B" . "$,15`6-5o(B") - ("$(6$M(B" . "$,15a6-5W6-5o(B") - ("$(6$N(B" . "$,15a6-5X6-5p(B") - ("$(6$O(B" . "$,15a6-5p6-5o(B") + ;;2440 ö„„¹ö„„ºö„„»ö„„¼ö„„½ö„„¾ö„„¿ö„…€ö„…ö„…‚ö„…ƒö„…„ö„……ö„…†ö„…‡ö„…ˆ + ("ö„„¹" . "ङà¥à¤¯") + ("ö„„º" . "चà¥à¤š") + ("ö„„»" . "चà¥à¤ž") + ("ö„„¼" . "छà¥à¤¯") + ("ö„„½" . "जà¥à¤°") + ("ö„„¾" . "जà¥à¤ž") + ("ö„„¿" . "ञà¥à¤š") + ("ö„…€" . "ञà¥à¤œ") + ("ö„…" . "टà¥à¤•") + ("ö„…‚" . "टà¥à¤Ÿ") + ("ö„…ƒ" . "टà¥à¤ ") + ("ö„…„" . "टà¥à¤¯") + ("ö„……" . "ठà¥à¤¯") + ("ö„…†" . "डà¥à¤—à¥à¤¯") + ("ö„…‡" . "डà¥à¤˜à¥à¤°") + ("ö„…ˆ" . "डà¥à¤°à¥à¤¯") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2450 $(6$P$Q$R$S$T$U$V$W$X$Y$Z$[$\$]$^$_(B - ("$(6$P(B" . "$,15a6-5W(B") - ("$(6$Q(B" . "$,15a6-5X(B") - ("$(6$R(B" . "$,15a6-5a(B") - ("$(6$S(B" . "$,15a6-5n(B") - ("$(6$T(B" . "$,15a6-5o(B") + ;;2450 ö„…‰ö„…Šö„…‹ö„…Œö„…ö„…Žö„…ö„…ö„…‘ö„…’ö„…“ö„…”ö„…•ö„…–ö„…—ö„…˜ + ("ö„…‰" . "डà¥à¤—") + ("ö„…Š" . "डà¥à¤˜") + ("ö„…‹" . "डà¥à¤¡") + ("ö„…Œ" . "डà¥à¤®") + ("ö„…" . "डà¥à¤¯") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2460 $(6$`$a$b$c$d$e$f$g$h$i$j$k$l$m$n$o(B - ("$(6$`(B" . "$,15b6-5o(B") - ("$(6$a(B" . "$,15d6-5d(B") - ("$(6$b(B" . "$,15d6-5h(B") - ("$(6$c(B" . "$,15f6-5f6-5o(B") - ("$(6$d(B" . "$,15f6-5g6-5o(B") - ("$(6$e(B" . "$,15f6-5m6-5o(B") - ("$(6$f(B" . "$,15f6-5p6-5o(B") - ("$(6$g(B" . "$,15f6-5u6-5o(B") - ("$(6$h(B" . "$,15f6-5W6-5p(B") - ("$(6$i(B" . "$,15f6-5X6-5p(B") - ("$(6$j(B" . "$,15f6-5f6-5u(B") - ("$(6$k(B" . "$,15f6-5g6-5u(B") - ("$(6$l(B" . "$,15f6-5W(B") - ("$(6$m(B" . "$,15f6-5X(B") - ("$(6$n(B" . "$,15f6-5f(B") - ("$(6$o(B" . "$,15f6-5g(B") + ;;2460 ö„…™ö„…šö„…›ö„…œö„…ö„…žö„…Ÿö„… ö„…¡ö„…¢ö„…£ö„…¤ö„…¥ö„…¦ö„…§ö„…¨ + ("ö„…™" . "ढà¥à¤¯") + ("ö„…š" . "तà¥à¤¤") + ("ö„…›" . "तà¥à¤¨") + ("ö„…œ" . "दà¥à¤¦à¥à¤¯") + ("ö„…" . "दà¥à¤§à¥à¤¯") + ("ö„…ž" . "दà¥à¤à¥à¤¯") + ("ö„…Ÿ" . "दà¥à¤°à¥à¤¯") + ("ö„… " . "दà¥à¤µà¥à¤¯") + ("ö„…¡" . "दà¥à¤—à¥à¤°") + ("ö„…¢" . "दà¥à¤˜à¥à¤°") + ("ö„…£" . "दà¥à¤¦à¥à¤µ") + ("ö„…¤" . "दà¥à¤§à¥à¤µ") + ("ö„…¥" . "दà¥à¤—") + ("ö„…¦" . "दà¥à¤˜") + ("ö„…§" . "दà¥à¤¦") + ("ö„…¨" . "दà¥à¤§") ;; 0 1 2 3 4 5 6 7 8 9 a b c d e f - ;;2470 $(6$p$q$r$s$t$u$v$w$x$y$z${$|$}$~(B - ("$(6$p(B" . "$,15f6-5h(B") - ("$(6$q(B" . "$,15f6-5l(B") - ("$(6$r(B" . "$,15f6-5m(B") - ("$(6$s(B" . "$,15f6-5n(B") - ("$(6$t(B" . "$,15f6-5o(B") - ("$(6$u(B" . "$,15f6-5u(B") - ("$(6$v(B" . "$,15g6-5h(B") - ("$(6$w(B" . "$,15h6-5h(B") - ("$(6$x(B" . "$,15j6-5d(B") - ("$(6$y(B" . "$,15j6-5h(B") - ("$(6$z(B" . "$,15j6-5r(B") - ("$(6${(B" . "$,15l6-5h(B") - ("$(6$|(B" . "$,15l6-5l(B") - ("$(6$}(B" . "$,15l6-5u(B") - ("$(6$~(B" . "$,15m6-5h(B"))) + ;;2470 ö„…©ö„…ªö„…«ö„…¬ö„…ö„…®ö„…¯ö„…°ö„…±ö„…²ö„…³ö„…´ö„…µö„…¶ö„…· + ("ö„…©" . "दà¥à¤¨") + ("ö„…ª" . "दà¥à¤¬") + ("ö„…«" . "दà¥à¤") + ("ö„…¬" . "दà¥à¤®") + ("ö„…" . "दà¥à¤¯") + ("ö„…®" . "दà¥à¤µ") + ("ö„…¯" . "धà¥à¤¨") + ("ö„…°" . "नà¥à¤¨") + ("ö„…±" . "पà¥à¤¤") + ("ö„…²" . "पà¥à¤¨") + ("ö„…³" . "पà¥à¤²") + ("ö„…´" . "बà¥à¤¨") + ("ö„…µ" . "बà¥à¤¬") + ("ö„…¶" . "बà¥à¤µ") + ("ö„…·" . "à¤à¥à¤¨"))) (defconst indian-2-column-to-ucs-regexp - "$(6!j!j(B\\|$(6"8"q(B\\|[$(6#&#'!*#*(B]$(6"p(B\\|[$(6!!(B-$(6$~(B]") + "ö„‰ö„‰\\|ö„µö„‚®\\|[ö„ƒö„ƒ‚ö„€‰ö„ƒ…]ö„‚\\|[ö„€€-ö„…·]") (put 'indian-2-column-to-ucs-chartable 'char-table-extra-slots 1) (defconst indian-2-column-to-ucs-chartable diff --git a/lisp/language/lao-util.el b/lisp/language/lao-util.el index d1bee8aec01..8a30ff49264 100644 --- a/lisp/language/lao-util.el +++ b/lisp/language/lao-util.el @@ -1,4 +1,4 @@ -;;; lao-util.el --- utilities for Lao -*- coding: iso-2022-7bit; -*- +;;; lao-util.el --- utilities for Lao -*- coding: utf-8; -*- ;; Copyright (C) 2001-2013 Free Software Foundation, Inc. ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, @@ -38,100 +38,100 @@ (define-category ?v "Lao upper/lower vowel" lao-category-table) (define-category ?t "Lao tone" lao-category-table) -(let ((l '((?(1!(B consonant "LETTER KOR KAI'" "CHICKEN") - (?(1"(B consonant "LETTER KHOR KHAI'" "EGG") - (?(1#(B invalid nil) - (?(1$(B consonant "LETTER QHOR QHWARGN" "BUFFALO") - (?(1%(B invalid nil) +(let ((l '((?ຠconsonant "LETTER KOR KAI'" "CHICKEN") + (?ຂ consonant "LETTER KHOR KHAI'" "EGG") + (?຃ invalid nil) + (?ຄ consonant "LETTER QHOR QHWARGN" "BUFFALO") + (?຅ invalid nil) (? invalid nil) - (?(1'(B consonant "LETTER NGOR NGUU" "SNAKE") - (?(1((B consonant "LETTER JOR JUA" "BUDDHIST NOVICE") - (?(1)(B invalid nil) - (?(1*(B consonant "LETTER XOR X\"ARNG" "ELEPHANT") - (?(1+(B invalid nil) - (?(1,(B invalid nil) - (?(1-(B consonant "LETTER YOR YUNG" "MOSQUITO") - (?(1.(B invalid nil) - (?(1.(B invalid nil) - (?(1.(B invalid nil) - (?(1.(B invalid nil) - (?(1.(B invalid nil) - (?(1.(B invalid nil) - (?(14(B consonant "LETTER DOR DANG" "NOSE") - (?(15(B consonant "LETTER TOR TAR" "EYE") - (?(16(B consonant "LETTER THOR THUNG" "TO ASK,QUESTION") - (?(17(B consonant "LETTER DHOR DHARM" "FLAG") - (?(18(B invalid nil) - (?(19(B consonant "LETTER NOR NOK" "BIRD") - (?(1:(B consonant "LETTER BOR BED" "FISHHOOK") - (?(1;(B consonant "LETTER POR PAR" "FISH") - (?(1<(B consonant "LETTER HPOR HPER\"" "BEE") - (?(1=(B consonant "LETTER FHOR FHAR" "WALL") - (?(1>(B consonant "LETTER PHOR PHUU" "MOUNTAIN") - (?(1?(B consonant "LETTER FOR FAI" "FIRE") - (?(1@(B invalid nil) - (?(1A(B consonant "LETTER MOR MAR\"" "HORSE") - (?(1B(B consonant "LETTER GNOR GNAR" "MEDICINE") - (?(1C(B consonant "LETTER ROR ROD" "CAR") - (?(1D(B invalid nil) - (?(1E(B consonant "LETTER LOR LIING" "MONKEY") - (?(1F(B invalid nil) - (?(1G(B consonant "LETTER WOR WII" "HAND FAN") - (?(1H(B invalid nil) - (?(1I(B invalid nil) - (?(1J(B consonant "LETTER SOR SEA" "TIGER") - (?(1K(B consonant "LETTER HHOR HHAI" "JAR") - (?(1L(B invalid nil) - (?(1M(B consonant "LETTER OR OOW" "TAKE") - (?(1N(B consonant "LETTER HOR HEA" "BOAT") - (?(1O(B special "ELLIPSIS") - (?(1P(B vowel-base "VOWEL SIGN SARA A") - (?(1Q(B vowel-upper "VOWEL SIGN MAI KAN") - (?(1R(B vowel-base "VOWEL SIGN SARA AR") - (?(1S(B vowel-base "VOWEL SIGN SARA AM") - (?(1T(B vowel-upper "VOWEL SIGN SARA I") - (?(1U(B vowel-upper "VOWEL SIGN SARA II") - (?(1V(B vowel-upper "VOWEL SIGN SARA EU") - (?(1W(B vowel-upper "VOWEL SIGN SARA UR") - (?(1X(B vowel-lower "VOWEL SIGN SARA U") - (?(1Y(B vowel-lower "VOWEL SIGN SARA UU") - (?(1Z(B invalid nil) - (?(1[(B vowel-upper "VOWEL SIGN MAI KONG") - (?(1\(B semivowel-lower "SEMIVOWEL SIGN LO") - (?(1](B vowel-base "SEMIVOWEL SIGN SARA IA") - (?(1^(B invalid nil) - (?(1_(B invalid nil) - (?(1`(B vowel-base "VOWEL SIGN SARA EE") - (?(1a(B vowel-base "VOWEL SIGN SARA AA") - (?(1b(B vowel-base "VOWEL SIGN SARA OO") - (?(1c(B vowel-base "VOWEL SIGN SARA EI MAI MUAN\"") - (?(1d(B vowel-base "VOWEL SIGN SARA AI MAI MAY") - (?(1e(B invalid nil) - (?(1f(B special "KO LA (REPETITION)") - (?(1g(B invalid nil) - (?(1h(B tone "TONE MAI EK") - (?(1i(B tone "TONE MAI THO") - (?(1j(B tone "TONE MAI TI") - (?(1k(B tone "TONE MAI JADTAWAR") - (?(1l(B tone "CANCELLATION MARK") - (?(1m(B vowel-upper "VOWEL SIGN SARA OR") - (?(1n(B invalid nil) - (?(1o(B invalid nil) - (?(1p(B special "DIGIT ZERO") - (?(1q(B special "DIGIT ONE") - (?(1r(B special "DIGIT TWO") - (?(1s(B special "DIGIT THREE") - (?(1t(B special "DIGIT FOUR") - (?(1u(B special "DIGIT FIVE") - (?(1v(B special "DIGIT SIX") - (?(1w(B special "DIGIT SEVEN") - (?(1x(B special "DIGIT EIGHT") - (?(1y(B special "DIGIT NINE") - (?(1z(B invalid nil) - (?(1{(B invalid nil) - (?(1|(B consonant "LETTER NHOR NHUU" "MOUSE") - (?(1}(B consonant "LETTER MHOR MHAR" "DOG") - (?(1~(B invalid nil))) + (?ງ consonant "LETTER NGOR NGUU" "SNAKE") + (?ຈ consonant "LETTER JOR JUA" "BUDDHIST NOVICE") + (?ຉ invalid nil) + (?ຊ consonant "LETTER XOR X\"ARNG" "ELEPHANT") + (?຋ invalid nil) + (?ຌ invalid nil) + (?ຠconsonant "LETTER YOR YUNG" "MOSQUITO") + (?ຎ invalid nil) + (?ຎ invalid nil) + (?ຎ invalid nil) + (?ຎ invalid nil) + (?ຎ invalid nil) + (?ຎ invalid nil) + (?ດ consonant "LETTER DOR DANG" "NOSE") + (?ຕ consonant "LETTER TOR TAR" "EYE") + (?ຖ consonant "LETTER THOR THUNG" "TO ASK,QUESTION") + (?ທ consonant "LETTER DHOR DHARM" "FLAG") + (?ຘ invalid nil) + (?ນ consonant "LETTER NOR NOK" "BIRD") + (?ບ consonant "LETTER BOR BED" "FISHHOOK") + (?ປ consonant "LETTER POR PAR" "FISH") + (?ຜ consonant "LETTER HPOR HPER\"" "BEE") + (?ຠconsonant "LETTER FHOR FHAR" "WALL") + (?ພ consonant "LETTER PHOR PHUU" "MOUNTAIN") + (?ຟ consonant "LETTER FOR FAI" "FIRE") + (?ຠinvalid nil) + (?ມ consonant "LETTER MOR MAR\"" "HORSE") + (?ຢ consonant "LETTER GNOR GNAR" "MEDICINE") + (?ຣ consonant "LETTER ROR ROD" "CAR") + (?຤ invalid nil) + (?ລ consonant "LETTER LOR LIING" "MONKEY") + (?຦ invalid nil) + (?ວ consonant "LETTER WOR WII" "HAND FAN") + (?ຨ invalid nil) + (?ຩ invalid nil) + (?ສ consonant "LETTER SOR SEA" "TIGER") + (?ຫ consonant "LETTER HHOR HHAI" "JAR") + (?ຬ invalid nil) + (?ຠconsonant "LETTER OR OOW" "TAKE") + (?ຮ consonant "LETTER HOR HEA" "BOAT") + (?ຯ special "ELLIPSIS") + (?ະ vowel-base "VOWEL SIGN SARA A") + (?ັ vowel-upper "VOWEL SIGN MAI KAN") + (?າ vowel-base "VOWEL SIGN SARA AR") + (?ຳ vowel-base "VOWEL SIGN SARA AM") + (?ິ vowel-upper "VOWEL SIGN SARA I") + (?ີ vowel-upper "VOWEL SIGN SARA II") + (?ຶ vowel-upper "VOWEL SIGN SARA EU") + (?ື vowel-upper "VOWEL SIGN SARA UR") + (?ຸ vowel-lower "VOWEL SIGN SARA U") + (?ູ vowel-lower "VOWEL SIGN SARA UU") + (?຺ invalid nil) + (?ົ vowel-upper "VOWEL SIGN MAI KONG") + (?ຼ semivowel-lower "SEMIVOWEL SIGN LO") + (?ຽ vowel-base "SEMIVOWEL SIGN SARA IA") + (?຾ invalid nil) + (?຿ invalid nil) + (?ເ vowel-base "VOWEL SIGN SARA EE") + (?à» vowel-base "VOWEL SIGN SARA AA") + (?ໂ vowel-base "VOWEL SIGN SARA OO") + (?ໃ vowel-base "VOWEL SIGN SARA EI MAI MUAN\"") + (?ໄ vowel-base "VOWEL SIGN SARA AI MAI MAY") + (?à»… invalid nil) + (?ໆ special "KO LA (REPETITION)") + (?໇ invalid nil) + (?່ tone "TONE MAI EK") + (?້ tone "TONE MAI THO") + (?໊ tone "TONE MAI TI") + (?໋ tone "TONE MAI JADTAWAR") + (?໌ tone "CANCELLATION MARK") + (?à» vowel-upper "VOWEL SIGN SARA OR") + (?໎ invalid nil) + (?à» invalid nil) + (?à» special "DIGIT ZERO") + (?໑ special "DIGIT ONE") + (?à»’ special "DIGIT TWO") + (?໓ special "DIGIT THREE") + (?à»” special "DIGIT FOUR") + (?໕ special "DIGIT FIVE") + (?à»– special "DIGIT SIX") + (?à»— special "DIGIT SEVEN") + (?໘ special "DIGIT EIGHT") + (?à»™ special "DIGIT NINE") + (?໚ invalid nil) + (?à»› invalid nil) + (?ໜ consonant "LETTER NHOR NHUU" "MOUSE") + (?à» consonant "LETTER MHOR MHAR" "DOG") + (?ໞ invalid nil))) elm) (while l (setq elm (car l) l (cdr l)) @@ -185,115 +185,115 @@ (defconst lao-transcription-consonant-alist (sort '(;; single consonants - ("k" . "(1!(B") - ("kh" . "(1"(B") - ("qh" . "(1$(B") - ("ng" . "(1'(B") - ("j" . "(1((B") - ("s" . "(1J(B") - ("x" . "(1*(B") - ("y" . "(1-(B") - ("d" . "(14(B") - ("t" . "(15(B") - ("th" . "(16(B") - ("dh" . "(17(B") - ("n" . "(19(B") - ("b" . "(1:(B") - ("p" . "(1;(B") - ("hp" . "(1<(B") - ("fh" . "(1=(B") - ("ph" . "(1>(B") - ("f" . "(1?(B") - ("m" . "(1A(B") - ("gn" . "(1B(B") - ("l" . "(1E(B") - ("r" . "(1C(B") - ("v" . "(1G(B") - ("w" . "(1G(B") - ("hh" . "(1K(B") - ("O" . "(1M(B") - ("h" . "(1N(B") - ("nh" . "(1|(B") - ("mh" . "(1}(B") - ("lh" . ["(1K\(B"]) + ("k" . "àº") + ("kh" . "ຂ") + ("qh" . "ຄ") + ("ng" . "ງ") + ("j" . "ຈ") + ("s" . "ສ") + ("x" . "ຊ") + ("y" . "àº") + ("d" . "ດ") + ("t" . "ຕ") + ("th" . "ຖ") + ("dh" . "ທ") + ("n" . "ນ") + ("b" . "ບ") + ("p" . "ປ") + ("hp" . "ຜ") + ("fh" . "àº") + ("ph" . "ພ") + ("f" . "ຟ") + ("m" . "ມ") + ("gn" . "ຢ") + ("l" . "ລ") + ("r" . "ຣ") + ("v" . "ວ") + ("w" . "ວ") + ("hh" . "ຫ") + ("O" . "àº") + ("h" . "ຮ") + ("nh" . "ໜ") + ("mh" . "à»") + ("lh" . ["ຫຼ"]) ;; double consonants - ("ngh" . ["(1K'(B"]) - ("yh" . ["(1K](B"]) - ("wh" . ["(1KG(B"]) - ("hl" . ["(1KE(B"]) - ("hy" . ["(1K-(B"]) - ("hn" . ["(1K9(B"]) - ("hm" . ["(1KA(B"]) + ("ngh" . ["ຫງ"]) + ("yh" . ["ຫຽ"]) + ("wh" . ["ຫວ"]) + ("hl" . ["ຫລ"]) + ("hy" . ["ຫàº"]) + ("hn" . ["ຫນ"]) + ("hm" . ["ຫມ"]) ) (function (lambda (x y) (> (length (car x)) (length (car y))))))) (defconst lao-transcription-semi-vowel-alist - '(("r" . "(1\(B"))) + '(("r" . "ຼ"))) (defconst lao-transcription-vowel-alist - (sort '(("a" . "(1P(B") - ("ar" . "(1R(B") - ("i" . "(1T(B") - ("ii" . "(1U(B") - ("eu" . "(1V(B") - ("ur" . "(1W(B") - ("u" . "(1X(B") - ("uu" . "(1Y(B") - ("e" . ["(1`P(B"]) - ("ee" . "(1`(B") - ("ae" . ["(1aP(B"]) - ("aa" . "(1a(B") - ("o" . ["(1bP(B"]) - ("oo" . "(1b(B") - ("oe" . ["(1`RP(B"]) - ("or" . "(1m(B") - ("er" . ["(1`T(B"]) - ("ir" . ["(1`U(B"]) - ("ua" . ["(1[GP(B"]) - ("uaa" . ["(1[G(B"]) - ("ie" . ["(1`Q]P(B"]) - ("ia" . ["(1`Q](B"]) - ("ea" . ["(1`VM(B"]) - ("eaa" . ["(1`WM(B"]) - ("ai" . "(1d(B") - ("ei" . "(1c(B") - ("ao" . ["(1`[R(B"]) - ("aM" . "(1S(B")) + (sort '(("a" . "ະ") + ("ar" . "າ") + ("i" . "ິ") + ("ii" . "ີ") + ("eu" . "ຶ") + ("ur" . "ື") + ("u" . "ຸ") + ("uu" . "ູ") + ("e" . ["ເະ"]) + ("ee" . "ເ") + ("ae" . ["à»àº°"]) + ("aa" . "à»") + ("o" . ["ໂະ"]) + ("oo" . "ໂ") + ("oe" . ["ເາະ"]) + ("or" . "à»") + ("er" . ["ເິ"]) + ("ir" . ["ເີ"]) + ("ua" . ["ົວະ"]) + ("uaa" . ["ົວ"]) + ("ie" . ["ເັຽະ"]) + ("ia" . ["ເັຽ"]) + ("ea" . ["ເຶàº"]) + ("eaa" . ["ເືàº"]) + ("ai" . "ໄ") + ("ei" . "ໃ") + ("ao" . ["ເົາ"]) + ("aM" . "ຳ")) (function (lambda (x y) (> (length (car x)) (length (car y))))))) ;; Maa-sakod is put at the tail. (defconst lao-transcription-maa-sakod-alist - '(("k" . "(1!(B") - ("g" . "(1'(B") - ("y" . "(1-(B") - ("d" . "(14(B") - ("n" . "(19(B") - ("b" . "(1:(B") - ("m" . "(1A(B") - ("v" . "(1G(B") - ("w" . "(1G(B") + '(("k" . "àº") + ("g" . "ງ") + ("y" . "àº") + ("d" . "ດ") + ("n" . "ນ") + ("b" . "ບ") + ("m" . "ມ") + ("v" . "ວ") + ("w" . "ວ") )) (defconst lao-transcription-tone-alist - '(("'" . "(1h(B") - ("\"" . "(1i(B") - ("^" . "(1j(B") - ("+" . "(1k(B") - ("~" . "(1l(B"))) + '(("'" . "່") + ("\"" . "້") + ("^" . "໊") + ("+" . "໋") + ("~" . "໌"))) (defconst lao-transcription-punctuation-alist - '(("\\0" . "(1p(B") - ("\\1" . "(1q(B") - ("\\2" . "(1r(B") - ("\\3" . "(1s(B") - ("\\4" . "(1t(B") - ("\\5" . "(1u(B") - ("\\6" . "(1v(B") - ("\\7" . "(1w(B") - ("\\8" . "(1x(B") - ("\\9" . "(1y(B") - ("\\\\" . "(1f(B") - ("\\$" . "(1O(B"))) + '(("\\0" . "à»") + ("\\1" . "໑") + ("\\2" . "à»’") + ("\\3" . "໓") + ("\\4" . "à»”") + ("\\5" . "໕") + ("\\6" . "à»–") + ("\\7" . "à»—") + ("\\8" . "໘") + ("\\9" . "à»™") + ("\\\\" . "ໆ") + ("\\$" . "ຯ"))) (defconst lao-transcription-pattern (concat @@ -332,39 +332,39 @@ "Regexp of Roman transcription pattern for one Lao syllable.") (defconst lao-vowel-reordering-rule - '(("(1P(B" (0 ?(1P(B) (0 ?(1Q(B)) - ("(1R(B" (0 ?(1R(B)) - ("(1T(B" (0 ?(1U(B)) - ("(1U(B" (0 ?(1U(B)) - ("(1V(B" (0 ?(1V(B)) - ("(1W(B" (0 ?(1W(B)) - ("(1X(B" (0 ?(1X(B)) - ("(1Y(B" (0 ?(1Y(B)) - ("(1`P(B" (?(1`(B 0 ?(1P(B) (?(1`(B 0 ?(1Q(B)) - ("(1`(B" (?(1`(B 0)) - ("(1aP(B" (?(1a(B 0 ?(1P(B) (?(1a(B 0 ?(1Q(B)) - ("(1a(B" (?(1a(B 0)) - ("(1bP(B" (?(1b(B 0 ?(1P(B) (0 ?(1[(B) (?(1-(B ?(1b(B 0 ?(1Q(B) (?(1G(B ?(1b(B 0 ?(1Q(B)) - ("(1b(B" (?(1b(B 0)) - ("(1`RP(B" (?(1`(B 0 ?(1R(B ?(1P(B) (0 ?(1Q(B ?(1M(B)) - ("(1m(B" (0 ?(1m(B) (0 ?(1M(B)) - ("(1`T(B" (?(1`(B 0 ?(1T(B)) - ("(1`U(B" (?(1`(B 0 ?(1U(B)) - ("(1[GP(B" (0 ?(1[(B ?(1G(B ?(1P(B) (0 ?(1Q(B ?(1G(B)) - ("(1[G(B" (0 ?(1[(B ?(1G(B) (0 ?(1G(B)) - ("(1`Q]P(B" (?(1`(B 0 ?(1Q(B ?(1](B ?(1P(B) (0 ?(1Q(B ?(1](B)) - ("(1`Q](B" (?(1`(B 0 ?(1Q(B ?(1](B) (0 ?(1](B)) - ("(1`VM(B" (?(1`(B 0 ?(1V(B ?(1M(B)) - ("(1`WM(B" (?(1`(B 0 ?(1W(B ?(1M(B)) - ("(1d(B" (?(1d(B 0)) - ("(1c(B" (?(1c(B 0)) - ("(1`[R(B" (?(1`(B 0 ?(1[(B ?(1R(B)) - ("(1S(B" (0 ?(1S(B))) + '(("ະ" (0 ?ະ) (0 ?ັ)) + ("າ" (0 ?າ)) + ("ິ" (0 ?ີ)) + ("ີ" (0 ?ີ)) + ("ຶ" (0 ?ຶ)) + ("ື" (0 ?ື)) + ("ຸ" (0 ?ຸ)) + ("ູ" (0 ?ູ)) + ("ເະ" (?ເ 0 ?ະ) (?ເ 0 ?ັ)) + ("ເ" (?ເ 0)) + ("à»àº°" (?à» 0 ?ະ) (?à» 0 ?ັ)) + ("à»" (?à» 0)) + ("ໂະ" (?ໂ 0 ?ະ) (0 ?ົ) (?ຠ?ໂ 0 ?ັ) (?ວ ?ໂ 0 ?ັ)) + ("ໂ" (?ໂ 0)) + ("ເາະ" (?ເ 0 ?າ ?ະ) (0 ?ັ ?àº)) + ("à»" (0 ?à») (0 ?àº)) + ("ເິ" (?ເ 0 ?ິ)) + ("ເີ" (?ເ 0 ?ີ)) + ("ົວະ" (0 ?ົ ?ວ ?ະ) (0 ?ັ ?ວ)) + ("ົວ" (0 ?ົ ?ວ) (0 ?ວ)) + ("ເັຽະ" (?ເ 0 ?ັ ?ຽ ?ະ) (0 ?ັ ?ຽ)) + ("ເັຽ" (?ເ 0 ?ັ ?ຽ) (0 ?ຽ)) + ("ເຶàº" (?ເ 0 ?ຶ ?àº)) + ("ເືàº" (?ເ 0 ?ື ?àº)) + ("ໄ" (?ໄ 0)) + ("ໃ" (?ໃ 0)) + ("ເົາ" (?ເ 0 ?ົ ?າ)) + ("ຳ" (0 ?ຳ))) "Alist of Lao vowel string vs the corresponding re-ordering rule. Each element has this form: (VOWEL NO-MAA-SAKOD-RULE WITH-MAA-SAKOD-RULE (MAA-SAKOD-0 RULE-0) ...) -VOWEL is a vowel string (e.g. \"(1`Q]P(B\"). +VOWEL is a vowel string (e.g. \"ເັຽະ\"). NO-MAA-SAKOD-RULE is a rule to re-order and modify VOWEL following a consonant. It is a list vowel characters or 0. The element 0 @@ -375,8 +375,8 @@ following a consonant and preceding a maa-sakod character. If it is nil, NO-MAA-SAKOD-RULE is used. The maa-sakod character is always appended at the tail. -For instance, rule `(\"(1`WM(B\" (?(1`(B t ?(1W(B ?(1M(B))' tells that this vowel -string following a consonant `(1!(B' should be re-ordered as \"(1`!WM(B\". +For instance, rule `(\"ເືàº\" (?ເ t ?ື ?àº))' tells that this vowel +string following a consonant `àº' should be re-ordered as \"ເàºàº·àº\". Optional (MAA-SAKOD-n RULE-n) are rules specially applied to maa-sakod character MAA-SAKOD-n.") diff --git a/lisp/language/thai.el b/lisp/language/thai.el index abed8f1036e..803e9977d47 100644 --- a/lisp/language/thai.el +++ b/lisp/language/thai.el @@ -1,4 +1,4 @@ -;;; thai.el --- support for Thai -*- coding: iso-2022-7bit -*- +;;; thai.el --- support for Thai -*- coding: utf-8 -*- ;; Copyright (C) 1997-1998, 2000-2013 Free Software Foundation, Inc. ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, @@ -55,7 +55,7 @@ (exit-function . exit-thai-language-environment-internal) (sample-text . (thai-compose-string - (copy-sequence "Thai (,T@RIRd7B(B) ,TJGQJ4U$CQ:(B, ,TJGQJ4U$hP(B"))) + (copy-sequence "Thai (ภาษาไทย) สวัสดีครับ, สวัสดีค่ะ"))) (documentation . t))) (define-coding-system 'cp874 @@ -75,12 +75,12 @@ This is the same as `thai-tis620' with the addition of no-break-space." :charset-list '(iso-8859-11)) ;; For automatic composition. -(let ((chars ",TQTUVWXYZghijklmn(B") - (elt '(["[,T!(B-,TO(B].[,Thijkl(B]?,TS(B?" 1 thai-composition-function] +(let ((chars "ัิีึืฺุู็่้๊๋์à¹à¹Ž") + (elt '(["[à¸-ฯ].[่้๊๋์]?ำ?" 1 thai-composition-function] [nil 0 thai-composition-function]))) (dotimes (i (length chars)) (aset composition-function-table (aref chars i) elt))) -(aset composition-function-table ?,TS(B '(["[,T!(B-,TO(B]." 1 thai-composition-function])) +(aset composition-function-table ?ำ '(["[à¸-ฯ]." 1 thai-composition-function])) (provide 'thai) diff --git a/lisp/language/tibet-util.el b/lisp/language/tibet-util.el index 1617c2f3eba..422fc697df8 100644 --- a/lisp/language/tibet-util.el +++ b/lisp/language/tibet-util.el @@ -1,4 +1,4 @@ -;;; tibet-util.el --- utilities for Tibetan -*- coding: iso-2022-7bit; -*- +;;; tibet-util.el --- utilities for Tibetan -*- coding: utf-8-emacs; -*- ;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc. ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, @@ -35,21 +35,21 @@ ;;; Code: (defconst tibetan-obsolete-glyphs - `(("$(7!=(B" . "$(7!=(B") ; 2 col <-> 1 col - ("$(7!?(B" . "$(7!?(B") - ("$(7!@(B" . "$(7!@(B") - ("$(7!A(B" . "$(7!A(B") - ("$(7"`(B" . "$(7"`(B") - ("$(7!;(B" . "$(7!;(B") - ("$(7!D(B" . "$(7!D(B") + `(("à¼" . "à¼") ; 2 col <-> 1 col + ("à¼" . "à¼") + ("à¼" . "à¼") + ("༑" . "༑") + ("ཿ" . "ཿ") + ("་" . "་") + ("༔" . "༔") ;; Yes these are dirty. But ... - ("$(7!>(B $(7!>(B" . ,(compose-string "$(7!>(B $(7!>(B" 0 3 [?$(7!>(B (Br . Bl) ? (Br . Bl) ?$(7!>(B])) - ("$(7!4!5!5(B" . ,(compose-string - "$(7#R#S#S#S(B" 0 4 - [?$(7#R(B (Br . Bl) ?$(7#S(B (Br . Bl) ?$(7#S(B (Br . Bl) ?$(7#S(B])) - ("$(7!4!5(B" . ,(compose-string "$(7#R#S#S(B" 0 3 [?$(7#R(B (Br . Bl) ?$(7#S(B (Br . Bl) ?$(7#S(B])) - ("$(7!6(B" . ,(compose-string "$(7#R#S!I(B" 0 3 [?$(7#R(B (Br . Bl) ?$(7#S(B (br . tr) ?$(7!I(B])) - ("$(7!4(B" . ,(compose-string "$(7#R#S(B" 0 2 [?$(7#R(B (Br . Bl) ?$(7#S(B])))) + ("༎ ༎" . ,(compose-string "༎ ༎" 0 3 [?༎ (Br . Bl) ? (Br . Bl) ?༎])) + ("༄༅༅" . ,(compose-string + "à¿à¿‚à¿‚à¿‚" 0 4 + [?à¿ (Br . Bl) ?à¿‚ (Br . Bl) ?à¿‚ (Br . Bl) ?à¿‚])) + ("༄༅" . ,(compose-string "à¿à¿‚à¿‚" 0 3 [?à¿ (Br . Bl) ?à¿‚ (Br . Bl) ?à¿‚])) + ("༆" . ,(compose-string "à¿à¿‚༙" 0 3 [?à¿ (Br . Bl) ?à¿‚ (br . tr) ?༙])) + ("༄" . ,(compose-string "à¿à¿‚" 0 2 [?à¿ (Br . Bl) ?à¿‚])))) ;;;###autoload (defun tibetan-char-p (ch) @@ -136,7 +136,7 @@ The returned string has no composition information." ;;; ;;; Here are examples of the words "bsgrubs" and "hfauM" ;;; -;;; $(7"7"G###C"U"7"G(B $(7"H"R"U"_(B +;;; བསྒྲུབས ཧཱུཾ ;;; ;;; M ;;; b s b s h @@ -144,7 +144,7 @@ The returned string has no composition information." ;;; r u ;;; u ;;; -;;; Consonants `'' ($(7"A(B), `w' ($(7">(B), `y' ($(7"B(B), `r' ($(7"C(B) take special +;;; Consonants `'' (འ), `w' (à½), `y' (ཡ), `r' (ར) take special ;;; forms when they are used as subjoined consonant. Consonant `r' ;;; takes another special form when used as superjoined in such a case ;;; as "rka", while it does not change its form when conjoined with @@ -161,15 +161,15 @@ The returned string has no composition information." ;; Special treatment for 'a chung. ;; If 'a follows a consonant, turn it into the subjoined form. ;; * Disabled by Tomabechi 2000/06/09 * - ;; Because in Unicode, $(7"A(B may follow directly a consonant without - ;; any intervening vowel, as in $(7"9"""Q"A!;(B=$(7"9(B $(7""(B $(7"A(B not $(7"9(B $(7""(B $(7"Q(B $(7"A(B - ;;(if (and (= char ?$(7"A(B) + ;; Because in Unicode, འmay follow directly a consonant without + ;; any intervening vowel, as in མà½ö‚Žà½ ་=མ འའnot མ འö‚Ž འ+ ;;(if (and (= char ?འ) ;; (aref (char-category-set (car last)) ?0)) - ;; (setq char ?$(7"R(B)) ;; modified for new font by Tomabechi 1999/12/10 + ;; (setq char ?ཱ)) ;; modified for new font by Tomabechi 1999/12/10 ;; Composite vowel signs are decomposed before being added ;; Added by Tomabechi 2000/06/08 - (if (memq char '(?$(7"T(B ?$(7"V(B ?$(7"W(B ?$(7"X(B ?$(7"Y(B ?$(7"Z(B ?$(7"b(B)) + (if (memq char '(?ཱི ?ཱུ ?ྲྀ ?ཷ ?ླྀ ?ཹ ?à¾)) (setq comp-vowel (copy-sequence (cddr (assoc (char-to-string char) @@ -184,22 +184,22 @@ The returned string has no composition information." ;; Compose lower vowel sign vertically under. ((aref (char-category-set char) ?3) - (if (or (eq char ?$(7"Q(B) ;; `$(7"Q(B' and `$,1FP(B' should not visible when composed. + (if (or (eq char ?ö‚Ž) ;; `ö‚Ž' and `཰' should not visible when composed. (eq char #xF70)) (setq rule nil) (setq rule stack-under))) ;; Transform ra-mgo (superscribed r) if followed by a subjoined ;; consonant other than w, ', y, r. - ((and (= (car last) ?$(7"C(B) - (not (memq char '(?$(7#>(B ?$(7"R(B ?$(7#B(B ?$(7#C(B)))) - (setcar last ?$(7!"(B) ;; modified for newfont by Tomabechi 1999/12/10 + ((and (= (car last) ?ར) + (not (memq char '(?ྠ?ཱ ?ྱ ?ྲ)))) + (setcar last ?ö€) ;; modified for newfont by Tomabechi 1999/12/10 (setq rule stack-under)) ;; Transform initial base consonant if followed by a subjoined ;; consonant but 'a. (t (let ((laststr (char-to-string (car last)))) - (if (and (/= char ?$(7"R(B) ;; modified for new font by Tomabechi - (string-match "[$(7"!(B-$(7"="?"@"D(B-$(7"J"K(B]" laststr)) + (if (and (/= char ?ཱ) ;; modified for new font by Tomabechi + (string-match "[ཀ-ཛྷཞཟལ-ཀྵཪ]" laststr)) (setcar last (string-to-char (cdr (assoc (char-to-string (car last)) tibetan-base-to-subjoined-alist))))) @@ -216,7 +216,7 @@ The returned string has no composition information." (defun tibetan-compose-string (str) "Compose Tibetan string STR." (let ((idx 0)) - ;; `$(7"A(B' is included in the pattern for subjoined consonants + ;; `འ' is included in the pattern for subjoined consonants ;; because we treat it specially in tibetan-add-components. ;; (This feature is removed by Tomabechi 2000/06/08) (while (setq idx (string-match tibetan-composable-pattern str idx)) @@ -247,7 +247,7 @@ The returned string has no composition information." (save-restriction (narrow-to-region beg end) (goto-char (point-min)) - ;; `$(7"A(B' is included in the pattern for subjoined consonants + ;; `འ' is included in the pattern for subjoined consonants ;; because we treat it specially in tibetan-add-components. ;; (This feature is removed by Tomabechi 2000/06/08) (while (re-search-forward tibetan-composable-pattern nil t) @@ -366,18 +366,18 @@ See also docstring of the function tibetan-compose-region." ;;; (defvar tibetan-canonicalize-for-unicode-alist - '(("$(7"Q(B" . "") ;; remove vowel a - ("$(7"T(B" . "$(7"R"S(B") ;; decompose vowels whose use is ``discouraged'' in Unicode 3.0 - ("$(7"V(B" . "$(7"R"U(B") - ("$(7"W(B" . "$(7#C"a(B") - ("$(7"X(B" . "$(7#C"R"a(B") - ("$(7"Y(B" . "$(7#D"a(B") - ("$(7"Z(B" . "$(7#D"R"a(B") - ("$(7"b(B" . "$(7"R"a(B")) + '(("ö‚Ž" . "") ;; remove vowel a + ("ཱི" . "ཱི") ;; decompose vowels whose use is ``discouraged'' in Unicode 3.0 + ("ཱུ" . "ཱུ") + ("ྲྀ" . "ྲྀ") + ("ཷ" . "ྲཱྀ") + ("ླྀ" . "ླྀ") + ("ཹ" . "ླཱྀ") + ("à¾" . "ཱྀ")) "Rules for canonicalizing Tibetan vowels for Unicode.") (defvar tibetan-canonicalize-for-unicode-regexp - "[$(7"Q"T"V"W"X"Y"Z"b(B]" + "[ö‚Žà½³à½µà½¶à½·à½¸à½¹à¾]" "Regexp for Tibetan vowels to be canonicalized in Unicode.") (defun tibetan-canonicalize-for-unicode-region (from to) diff --git a/lisp/language/tibetan.el b/lisp/language/tibetan.el index e80ded9c98e..f85284702a2 100644 --- a/lisp/language/tibetan.el +++ b/lisp/language/tibetan.el @@ -1,4 +1,4 @@ -;;; tibetan.el --- support for Tibetan language -*- coding: iso-2022-7bit; -*- +;;; tibetan.el --- support for Tibetan language -*- coding: utf-8-emacs; -*- ;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc. ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -43,45 +43,45 @@ ;;; I hope I can add missing characters later. ;;; ;;; 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F -;;;2120 // $(7!!(B $(7!"(B $(7!#(B $(7!$(B $(7!%(B $(7!&(B $(7!'(B $(7!((B $(7!)(B $(7!*(B $(7!+(B $(7!,(B $(7!-(B $(7!.(B $(7!/(B ; obsolete glyphs (2123-5) -;;;2130 $(7!0(B $(7!1(B $(7!2(B $(7!3(B $(7!4(B $(7!5(B $(7!6(B $(7!7(B $(7!8(B $(7!9(B $(7!:(B $(7!;(B $(7!<(B $(7!=(B $(7!>(B $(7!?(B ; Punctuation, -;;;2140 $(7!@(B $(7!A(B $(7!B(B $(7!C(B $(7!D(B $(7!E(B $(7!F(B $(7!G(B $(7!H(B $(7!I(B $(7!J(B $(7!K(B $(7!L(B $(7!M(B $(7!N(B $(7!O(B ; Digits and -;;;2150 $(7!P(B $(7!Q(B $(7!R(B $(7!S(B $(7!T(B $(7!U(B $(7!V(B $(7!W(B $(7!X(B $(7!Y(B $(7!Z(B $(7 +;;;2130 ༀ ༠༂ ༃ ༄ ༅ ༆ ༇ ༈ ༉ ༊ ་ ༌ ༠༎ ༠; Punctuation, +;;;2140 ༠༑ ༒ ༓ ༔ ༕ ༖ ༗ ༘ ༙ ༚ ༛ ༜ ༠༞ ༟ ; Digits and +;;;2150 ༠༡ ༢ ༣ ༤ ༥ ༦ ༧ ༨ ༩ ༪ ༫ ༬ ༠༮ ༯ ; Special signs. +;;;2160 ༰ ༱ ༲ ༳ ༴ ༵ ༶ ༷ ༸ ༹ ༺ ༻ ༼ ༽ ༾ ༿ ; +;;;2170 ö ö ö‘ ö’ ö“ ö” ö• ö– ö— ö˜ ö™ öš ö› öœ ö // ; ;;; ;;; 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F -;;;2220 // $(7"!(B $(7""(B $(7"#(B $(7"$(B $(7"%(B $(7"&(B $(7"'(B $(7"((B $(7")(B $(7"*(B $(7"+(B $(7",(B $(7"-(B $(7".(B $(7"/(B ; Base consonants -;;;2230 $(7"0(B $(7"1(B $(7"2(B $(7"3(B $(7"4(B $(7"5(B $(7"6(B $(7"7(B $(7"8(B $(7"9(B $(7":(B $(7";(B $(7"<(B $(7"=(B $(7">(B $(7"?(B ; and -;;;2240 $(7"@(B $(7"A(B $(7"B(B $(7"C(B $(7"D(B $(7"E(B $(7"F(B $(7"G(B $(7"H(B $(7"I(B $(7"J(B $(7"K(B $(7"L(B $(7"M(B $(7"N(B $(7"O(B ; Vowel signs. -;;;2250 $(7"P(B $(7"Q(B $(7"R(B $(7"S(B $(7"T(B $(7"U(B $(7"V(B $(7"W(B $(7"X(B $(7"Y(B $(7"Z(B $(7"[(B $(7"\(B $(7"](B $(7"^(B $(7"_(B ; (\x2251 = vowel a) -;;;2260 $(7"`(B $(7"a(B $(7"b(B $(7"c(B $(7"d(B $(7"e(B $(7"f(B $(7"g(B $(7"h(B $(7"i(B $(7"j(B $(7"k(B $(7"l(B $(7"m(B $(7"n(B $(7"o(B ; Long vowels and -;;;2270 $(7"p(B $(7"q(B $(7"r(B $(7"s(B $(7"t(B $(7"u(B $(7"v(B $(7"w(B $(7"x(B $(7"y(B $(7"z(B $(7"{(B $(7"|(B $(7"}(B $(7"~(B // ; vocalic r, l ARE +;;;2220 // ཀ འག གྷ ང ཅ ཆ ཇ ö¦ ཉ ཊ ཋ ཌ འཎ ; Base consonants +;;;2230 འའད དྷ ན པ ཕ བ བྷ མ ཙ ཚ ཛ ཛྷ འཞ ; and +;;;2240 ཟ འཡ ར ལ ཤ ཥ ས ཧ ཨ ཀྵ ཪ ö‚‰ ö‚Š ö‚‹ ö‚Œ ; Vowel signs. +;;;2250 ö‚ ö‚Ž ཱ ི ཱི ུ ཱུ ྲྀ ཷ ླྀ ཹ ེ ཻ ོ ཽ ཾ ; (\x2251 = vowel a) +;;;2260 ཿ ྀ ྠྂ ྃ ྄ ྅ ྆ ྇ ྈ ྉ ྊ ྋ ö‚ª ö‚« ö‚¬ ; Long vowels and +;;;2270 ö‚ ö‚® ö‚¯ ö‚° ö‚± ö‚² ö‚³ ö‚´ ö‚µ ö‚¶ ö‚· ö‚¸ ö‚¹ ö‚º ö‚» // ; vocalic r, l ARE ;;; ; atomically ;;; ; encoded. ;;; 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F -;;;2320 // $(7#!(B $(7#"(B $(7##(B $(7#$(B $(7#%(B $(7#&(B $(7#'(B $(7#((B $(7#)(B $(7#*(B $(7#+(B $(7#,(B $(7#-(B $(7#.(B $(7#/(B ; Subjoined consonants -;;;2330 $(7#0(B $(7#1(B $(7#2(B $(7#3(B $(7#4(B $(7#5(B $(7#6(B $(7#7(B $(7#8(B $(7#9(B $(7#:(B $(7#;(B $(7#<(B $(7#=(B $(7#>(B $(7#?(B ; -;;;2340 $(7#@(B $(7#A(B $(7#B(B $(7#C(B $(7#D(B $(7#E(B $(7#F(B $(7#G(B $(7#H(B $(7#I(B $(7#J(B $(7#K(B $(7#L(B $(7#M(B $(7#N(B $(7#O(B ; -;;;2350 $(7#P(B $(7#Q(B $(7#R(B $(7#S(B $(7#T(B $(7#U(B $(7#V(B $(7#W(B $(7#X(B $(7#Y(B $(7#Z(B $(7#[(B $(7#\(B $(7#](B $(7#^(B $(7#_(B ; Hereafter, the chars -;;;2360 $(7#`(B $(7#a(B $(7#b(B $(7#c(B $(7#d(B $(7#e(B $(7#f(B $(7#g(B $(7#h(B $(7#i(B $(7#j(B $(7#k(B $(7#l(B $(7#m(B $(7#n(B $(7#o(B ; are not specified -;;;2370 $(7#p(B $(7#q(B $(7#r(B $(7#s(B $(7#t(B $(7#u(B $(7#v(B $(7#w(B $(7#x(B $(7#y(B $(7#z(B $(7#{(B $(7#|(B $(7#}(B $(7#~(B // ; in Unicode. +;;;2320 // ྠྑ ྒ ྒྷ ྔ ྕ ྖ ྗ öƒ„ ྙ ྚ ྛ ྜ ྠྞ ; Subjoined consonants +;;;2330 ྟ ྠྡ ྡྷ ྣ ྤ ྥ ྦ ྦྷ ྨ ྩ ྪ ྫ ྫྷ ྠྮ ; +;;;2340 ྯ ྰ ྱ ྲ ླ ྴ ྵ ྶ ྷ ྸ ྐྵ ྺ ྻ ྼ öƒ© ྾ ; +;;;2350 ྿ à¿€ à¿ à¿‚ ࿃ à¿„ à¿… ࿆ ࿇ ࿈ ࿉ à¿Š à¿‹ à¿Œ öƒ¹ öƒº ; Hereafter, the chars +;;;2360 à¿ öƒ¼ öƒ½ öƒ¾ öƒ¿ ö„€ ö„ ö„‚ ö„ƒ ö„„ ö„… ö„† ö„‡ ö„ˆ ö„‰ ö„Š ; are not specified +;;;2370 ö„‹ ö„Œ ö„ ö„Ž ö„ ö„ ö„‘ ö„’ ö„“ ö„” ö„• ö„– ö„— ö„˜ ö„™ // ; in Unicode. ;;; ;;; 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F -;;;2420 // $(7$!(B $(7$"(B $(7$#(B $(7$$(B $(7$%(B $(7$&(B $(7$'(B $(7$((B $(7$)(B $(7$*(B $(7$+(B $(7$,(B $(7$-(B $(7$.(B $(7$/(B ; Precomposed -;;;2430 $(7$0(B $(7$1(B $(7$2(B $(7$3(B $(7$4(B $(7$5(B $(7$6(B $(7$7(B $(7$8(B $(7$9(B $(7$:(B $(7$;(B $(7$<(B $(7$=(B $(7$>(B $(7$?(B ; consonants for -;;;2440 $(7$@(B $(7$A(B $(7$B(B $(7$C(B $(7$D(B $(7$E(B $(7$F(B $(7$G(B $(7$H(B $(7$I(B $(7$J(B $(7$K(B $(7$L(B $(7$M(B $(7$N(B $(7$O(B ; ordinary Tibetan. -;;;2450 $(7$P(B $(7$Q(B $(7$R(B $(7$S(B $(7$T(B $(7$U(B $(7$V(B $(7$W(B $(7$X(B $(7$Y(B $(7$Z(B $(7$[(B $(7$\(B $(7$](B $(7$^(B $(7$_(B ; They are decomposed -;;;2460 $(7$`(B $(7$a(B $(7$b(B $(7$c(B $(7$d(B $(7$e(B $(7$f(B $(7$g(B $(7$h(B $(7$i(B $(7$j(B $(7$k(B $(7$l(B $(7$m(B $(7$n(B $(7$o(B ; into base and -;;;2470 $(7$p(B $(7$q(B $(7$r(B $(7$s(B $(7$t(B $(7$u(B $(7$v(B $(7$w(B $(7$x(B $(7$y(B $(7$z(B $(7${(B $(7$|(B $(7$}(B $(7$~(B // ; subjoined consonants +;;;2420 // ö„š ö„› ö„œ ö„ ö„ž ö„Ÿ ö„ ö„¡ ö„¢ ö„£ ö„¤ ö„¥ ö„¦ ö„§ ö„¨ ; Precomposed +;;;2430 ö„© ö„ª ö„« ö„¬ ö„ ö„® ö„¯ ö„° ö„± ö„² ö„³ ö„´ ö„µ ö„¶ ö„· ö„¸ ; consonants for +;;;2440 ö„¹ ö„º ö„» ö„¼ ö„½ ö„¾ ö„¿ ö…€ ö… ö…‚ ö…ƒ ö…„ ö…… ö…† ö…‡ ö…ˆ ; ordinary Tibetan. +;;;2450 ö…‰ ö…Š ö…‹ ö…Œ ö… ö…Ž ö… ö… ö…‘ ö…’ ö…“ ö…” ö…• ö…– ö…— ö…˜ ; They are decomposed +;;;2460 ö…™ ö…š ö…› ö…œ ö… ö…ž ö…Ÿ ö… ö…¡ ö…¢ ö…£ ö…¤ ö…¥ ö…¦ ö…§ ö…¨ ; into base and +;;;2470 ö…© ö…ª ö…« ö…¬ ö… ö…® ö…¯ ö…° ö…± ö…² ö…³ ö…´ ö…µ ö…¶ ö…· // ; subjoined consonants ;;; ; when written on a ;;; 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F ; file in Tibetan -;;;2520 // $(7%!(B $(7%"(B $(7%#(B $(7%$(B $(7%%(B $(7%&(B $(7%'(B $(7%((B $(7%)(B $(7%*(B $(7%+(B $(7%,(B $(7%-(B $(7%.(B $(7%/(B ; coding system. -;;;2530 $(7%0(B $(7%1(B $(7%2(B $(7%3(B $(7%4(B $(7%5(B $(7%6(B $(7%7(B $(7%8(B $(7%9(B $(7%:(B $(7%;(B $(7%<(B $(7%=(B $(7%>(B $(7%?(B ; -;;;2540 $(7%@(B $(7%A(B $(7%B(B $(7%C(B $(7%D(B $(7%E(B $(7%F(B $(7%G(B $(7%H(B $(7%I(B $(7%J(B $(7%K(B $(7%L(B $(7%M(B $(7%N(B $(7%O(B ; -;;;2550 $(7%P(B $(7%Q(B $(7%R(B $(7%S(B $(7%T(B $(7%U(B $(7%V(B $(7%W(B $(7%X(B $(7%Y(B $(7%Z(B $(7%[(B $(7%\(B $(7%](B $(7%^(B $(7%_(B ; -;;;2560 $(7%`(B $(7%a(B $(7%b(B $(7%c(B $(7%d(B $(7%e(B $(7%f(B $(7%g(B $(7%h(B $(7%i(B $(7%j(B $(7%k(B $(7%l(B $(7%m(B $(7%n(B $(7%o(B ; -;;;2570 $(7%p(B $(7%q(B $(7%r(B $(7%s(B $(7%t(B $(7%u(B $(7%v(B $(7%w(B $(7%x(B $(7%y(B $(7%z(B $(7%{(B $(7%|(B $(7%}(B $(7%~(B // ; +;;;2520 // ö…¸ ö…¹ ö…º ö…» ö…¼ ö…½ ö…¾ ö…¿ ö†€ ö† ö†‚ ö†ƒ ö†„ ö†… ö†† ; coding system. +;;;2530 ö†‡ ö†ˆ ö†‰ ö†Š ö†‹ ö†Œ ö† ö†Ž ö† ö† ö†‘ ö†’ ö†“ ö†” ö†• ö†– ; +;;;2540 ö†— ö†˜ ö†™ ö†š ö†› ö†œ ö† ö†ž ö†Ÿ ö† ö†¡ ö†¢ ö†£ ö†¤ ö†¥ ö†¦ ; +;;;2550 ö†§ ö†¨ ö†© ö†ª ö†« ö†¬ ö† ö†® ö†¯ ö†° ö†± ö†² ö†³ ö†´ ö†µ ö†¶ ; +;;;2560 ö†· ö†¸ ö†¹ ö†º ö†» ö†¼ ö†½ ö†¾ ö†¿ ö‡€ ö‡ ö‡‚ ö‡ƒ ö‡„ ö‡… ö‡† ; +;;;2570 ö‡‡ ö‡ˆ ö‡‰ ö‡Š ö‡‹ ö‡Œ ö‡ ö‡Ž ö‡ ö‡ ö‡‘ ö‡’ ö‡“ ö‡” ö‡• // ; ;;; @@ -101,18 +101,18 @@ (input-method . "tibetan-wylie") (features tibet-util) (documentation . t) - (sample-text . "Tibetan ($(7"7"]"2!;"G#!"Q"2!;(B) $(7!4!5!5!>"7"!#C"Q!;"E"S"G!;"7"2"[!;"D"["#"G!>"I"]"_!;"9"Q!;"/"S!;"5"Q"2#9"[!;"H"A"U"c!>(B"))) + (sample-text . "Tibetan (བོད་སà¾ö‚Žà½‘་) ༄༅༅༎བཀྲö‚Žà¼‹à½¤à½²à½¦à¼‹à½–དེ་ལེགས༎ཨོཾ་མö‚Žà¼‹à½Žà½²à¼‹à½”ö‚Žà½‘ྨེ་ཧའུྂ༎"))) -;; `$(7"A(B' is included in the pattern for subjoined consonants because we +;; `འ' is included in the pattern for subjoined consonants because we ;; treat it specially in tibetan-add-components. ;; modified by Tomabechi 1999/12/10 ;; modified by Tomabechi 2000/06/08 ;; To allow infinite addition of vowels/modifiers ;; as specified in Unicode v.3 -;; $(7"A(B is removed from the class of subjoined. Tomabechi 2000/06/08 +;; འis removed from the class of subjoined. Tomabechi 2000/06/08 ;; (for Unicode support) (defconst tibetan-composable-pattern - "[$(7"!(B-$(7"J"K(B][$(7#!(B-$(7#J#K#L#M(B]*[$,1FP$(7"Q"R"S(B-$(7"^"a"b"e(B]*[$(7"_"c"d"g(B-$(7"l!I!e!g(B]*" + "[ཀ-ཀྵཪ][à¾-ྐྵྺྻྼ]*[཰ö‚Žà½±à½²-ཽྀà¾à¾„]*[ཾྂྃ྆-ྋ༙༵༷]*" "Regexp matching a composable sequence of Tibetan characters.") ;;; @@ -123,50 +123,50 @@ ;;; alists for tibetan char <-> transcription conversion ;;; longer transcription should come first (defconst tibetan-consonant-transcription-alist - '(("tsh" . "$(7";(B") - ("dzh" . "$(7"=(B") - ("kSH" . "$(7"J(B") - ("kh" . "$(7""(B") - ("gh" . "$(7"$(B") - ("ng" . "$(7"%(B") - ("ch" . "$(7"'(B") - ("ny" . "$(7"*(B") - ("TH" . "$(7",(B") - ("DH" . "$(7".(B") - ("th" . "$(7"1(B") - ("dh" . "$(7"3(B") - ("ph" . "$(7"6(B") - ("bh" . "$(7"8(B") - ("ts" . "$(7":(B") - ("dz" . "$(7"<(B") - ("zh" . "$(7"?(B") - ("sh" . "$(7"E(B") - ("SH" . "$(7"F(B") - ("k" . "$(7"!(B") - ("g" . "$(7"#(B") - ("c" . "$(7"&(B") - ("j" . "$(7"((B") - ("T" . "$(7"+(B") - ("D" . "$(7"-(B") - ("N" . "$(7"/(B") - ("t" . "$(7"0(B") - ("d" . "$(7"2(B") - ("n" . "$(7"4(B") - ("p" . "$(7"5(B") - ("b" . "$(7"7(B") - ("m" . "$(7"9(B") - ("w" . "$(7">(B") - ("z" . "$(7"@(B") - ("'" . "$(7"A(B") - ("y" . "$(7"B(B") - ("r" . "$(7"C(B") - ("l" . "$(7"D(B") - ("s" . "$(7"G(B") - ("h" . "$(7"H(B") - ("H" . "$(7"H(B") - ("A" . "$(7"I(B") + '(("tsh" . "ཚ") + ("dzh" . "ཛྷ") + ("kSH" . "ཀྵ") + ("kh" . "à½") + ("gh" . "གྷ") + ("ng" . "ང") + ("ch" . "ཆ") + ("ny" . "ཉ") + ("TH" . "ཋ") + ("DH" . "à½") + ("th" . "à½") + ("dh" . "དྷ") + ("ph" . "ཕ") + ("bh" . "བྷ") + ("ts" . "ཙ") + ("dz" . "ཛ") + ("zh" . "ཞ") + ("sh" . "ཤ") + ("SH" . "ཥ") + ("k" . "ཀ") + ("g" . "ག") + ("c" . "ཅ") + ("j" . "ཇ") + ("T" . "ཊ") + ("D" . "ཌ") + ("N" . "ཎ") + ("t" . "à½") + ("d" . "ད") + ("n" . "ན") + ("p" . "པ") + ("b" . "བ") + ("m" . "མ") + ("w" . "à½") + ("z" . "ཟ") + ("'" . "འ") + ("y" . "ཡ") + ("r" . "ར") + ("l" . "ལ") + ("s" . "ས") + ("h" . "ཧ") + ("H" . "ཧ") + ("A" . "ཨ") ;; Added by Tomabechi 1999/12/10 - ("R" . "$(7"K(B") ;; fixed form RA + ("R" . "ཪ") ;; fixed form RA )) @@ -174,203 +174,203 @@ '( ;; Composite Vowels ;; Added by Tomabechi 2000/06/08 - ("frr" . "$(7"X(B") - ("fll" . "$(7"Z(B") - ("fa" . "$(7"R(B") - ("fi" . "$(7"T(B") - ("fu" . "$(7"V(B") - ("fr" . "$(7"W(B") - ("fl" . "$(7"Y(B") - ("fI" . "$(7"b(B") + ("frr" . "ཷ") + ("fll" . "ཹ") + ("fa" . "ཱ") + ("fi" . "ཱི") + ("fu" . "ཱུ") + ("fr" . "ྲྀ") + ("fl" . "ླྀ") + ("fI" . "à¾") ;; Normal Vowels - ("ai" . "$(7"\(B") - ("au" . "$(7"^(B") - ("ee" . "$(7"\(B") - ("oo" . "$(7"^(B") - ("a" . "$(7"Q(B") ; invisible vowel sign (\x2251) - ("i" . "$(7"S(B") - ("u" . "$(7"U(B") - ("e" . "$(7"[(B") - ("o" . "$(7"](B") - ("E" . "$(7"\(B") - ("O" . "$(7"^(B") - ("I" . "$(7"a(B") - ("," . "$(7"e(B") ; idem. + ("ai" . "ཻ") + ("au" . "ཽ") + ("ee" . "ཻ") + ("oo" . "ཽ") + ("a" . "ö‚Ž") ; invisible vowel sign (\x2251) + ("i" . "ི") + ("u" . "ུ") + ("e" . "ེ") + ("o" . "ོ") + ("E" . "ཻ") + ("O" . "ཽ") + ("I" . "ྀ") + ("," . "྄") ; idem. )) (defconst tibetan-modifier-transcription-alist - '(("M" . "$(7"_(B") - ("~" . "$(7"c(B") - ("`" . "$(7"d(B") - ("x" . "$(7"i(B") - ("X" . "$(7"j(B") - ("v" . "$(7"g(B") - ("V" . "$(7"h(B") - ("q" . "$(7"k(B") - ("Q" . "$(7"l(B") - ("_/" . "$(7!I(B") - ("_o" . "$(7!g(B") - ("_O" . "$(7!e(B"))) + '(("M" . "ཾ") + ("~" . "ྂ") + ("`" . "ྃ") + ("x" . "ྈ") + ("X" . "ྉ") + ("v" . "྆") + ("V" . "྇") + ("q" . "ྊ") + ("Q" . "ྋ") + ("_/" . "༙") + ("_o" . "༷") + ("_O" . "༵"))) (defconst tibetan-precomposed-transcription-alist - '(("phyw" . "$(7$G(B") - ("tshw" . "$(7$)(B") - ("rtsw" . "$(7%.(B") - ("khw" . "$(7$"(B") - ("nyw" . "$(7$%(B") - ("tsw" . "$(7$((B") - ("zhw" . "$(7$*(B") - ("shw" . "$(7$.(B") - ("khy" . "$(7$A(B") - ("phy" . "$(7$D(B") - ("khr" . "$(7$Q(B") - ("thr" . "$(7$T(B") - ("phr" . "$(7$W(B") - ("shr" . "$(7$Z(B") - ("dzr" . "$(7$^(B") - ("grw" . "$(7$_(B") - ("rng" . "$(7%#(B") - ("rny" . "$(7%%(B") - ("rts" . "$(7%+(B") - ("rdz" . "$(7%,(B") - ("rgw" . "$(7%-(B") - ("rky" . "$(7%0(B") - ("rgy" . "$(7%1(B") - ("rmy" . "$(7%2(B") - ("lng" . "$(7%B(B") - ("sng" . "$(7%R(B") - ("sny" . "$(7%S(B") - ("sts" . "$(7%Z(B") - ("sky" . "$(7%`(B") - ("sgy" . "$(7%a(B") - ("spy" . "$(7%b(B") - ("sby" . "$(7%c(B") - ("smy" . "$(7%d(B") - ("skr" . "$(7%p(B") - ("sgr" . "$(7%q(B") - ("snr" . "$(7%r(B") - ("spr" . "$(7%s(B") - ("sbr" . "$(7%t(B") - ("smr" . "$(7%u(B") - ("kw" . "$(7$!(B") - ("gw" . "$(7$#(B") - ("cw" . "$(7$$(B") - ("tw" . "$(7$&(B") - ("dw" . "$(7$'(B") - ("zw" . "$(7$+(B") - ("rw" . "$(7$,(B") - ("lw" . "$(7$-(B") - ("sw" . "$(7$/(B") - ("hw" . "$(7$0(B") - ("ky" . "$(7$@(B") - ("gy" . "$(7$B(B") - ("py" . "$(7$C(B") - ("by" . "$(7$E(B") - ("my" . "$(7$F(B") - ("kr" . "$(7$P(B") - ("gr" . "$(7$R(B") - ("tr" . "$(7$S(B") - ("dr" . "$(7$U(B") - ("pr" . "$(7$V(B") - ("brk" . "$(7"7%!(B") - ("brg" . "$(7"7%"(B") - ("brng" . "$(7"7%#(B") - ("brj" . "$(7"7%$(B") - ("brny" . "$(7"7%%(B") - ("brt" . "$(7"7%&(B") - ("brd" . "$(7"7%'(B") - ("brn" . "$(7"7%((B") - ("brts" . "$(7"7%+(B") - ("brdz" . "$(7"7%,(B") - ("brl" . "$(7"7$d(B") - ("br" . "$(7$X(B") - ("mr" . "$(7$Y(B") - ("sr" . "$(7$[(B") - ("hr" . "$(7$\(B") - ("jr" . "$(7$](B") - ("kl" . "$(7$`(B") - ("gl" . "$(7$a(B") - ("blt" . "$(7"7%E(B") - ("bld" . "$(7"7%F(B") - ("bl" . "$(7$b(B") - ("zl" . "$(7$c(B") - ("rl" . "$(7$d(B") - ("sl" . "$(7$e(B") - ("rk" . "$(7%!(B") - ("rg" . "$(7%"(B") - ("rj" . "$(7%$(B") - ("rt" . "$(7%&(B") - ("rd" . "$(7%'(B") - ("rn" . "$(7%((B") - ("rb" . "$(7%)(B") - ("rm" . "$(7%*(B") - ("lk" . "$(7%@(B") - ("lg" . "$(7%A(B") - ("lc" . "$(7%C(B") - ("lj" . "$(7%D(B") - ("lt" . "$(7%E(B") - ("ld" . "$(7%F(B") - ("ln" . "$(7!!(B") ; dummy \x2121 - ("lp" . "$(7%G(B") - ("lb" . "$(7%H(B") - ("lh" . "$(7%I(B") - ("sk" . "$(7%P(B") - ("sg" . "$(7%Q(B") - ("st" . "$(7%T(B") - ("sd" . "$(7%U(B") - ("sn" . "$(7%V(B") - ("sp" . "$(7%W(B") - ("sb" . "$(7%X(B") - ("sm" . "$(7%Y(B")) + '(("phyw" . "ö…€") + ("tshw" . "ö„¢") + ("rtsw" . "ö†…") + ("khw" . "ö„›") + ("nyw" . "ö„ž") + ("tsw" . "ö„¡") + ("zhw" . "ö„£") + ("shw" . "ö„§") + ("khy" . "ö„º") + ("phy" . "ö„½") + ("khr" . "ö…Š") + ("thr" . "ö…") + ("phr" . "ö…") + ("shr" . "ö…“") + ("dzr" . "ö…—") + ("grw" . "ö…˜") + ("rng" . "ö…º") + ("rny" . "ö…¼") + ("rts" . "ö†‚") + ("rdz" . "ö†ƒ") + ("rgw" . "ö†„") + ("rky" . "ö†‡") + ("rgy" . "ö†ˆ") + ("rmy" . "ö†‰") + ("lng" . "ö†™") + ("sng" . "ö†©") + ("sny" . "ö†ª") + ("sts" . "ö†±") + ("sky" . "ö†·") + ("sgy" . "ö†¸") + ("spy" . "ö†¹") + ("sby" . "ö†º") + ("smy" . "ö†»") + ("skr" . "ö‡‡") + ("sgr" . "ö‡ˆ") + ("snr" . "ö‡‰") + ("spr" . "ö‡Š") + ("sbr" . "ö‡‹") + ("smr" . "ö‡Œ") + ("kw" . "ö„š") + ("gw" . "ö„œ") + ("cw" . "ö„") + ("tw" . "ö„Ÿ") + ("dw" . "ö„ ") + ("zw" . "ö„¤") + ("rw" . "ö„¥") + ("lw" . "ö„¦") + ("sw" . "ö„¨") + ("hw" . "ö„©") + ("ky" . "ö„¹") + ("gy" . "ö„»") + ("py" . "ö„¼") + ("by" . "ö„¾") + ("my" . "ö„¿") + ("kr" . "ö…‰") + ("gr" . "ö…‹") + ("tr" . "ö…Œ") + ("dr" . "ö…Ž") + ("pr" . "ö…") + ("brk" . "བö…¸") + ("brg" . "བö…¹") + ("brng" . "བö…º") + ("brj" . "བö…»") + ("brny" . "བö…¼") + ("brt" . "བö…½") + ("brd" . "བö…¾") + ("brn" . "བö…¿") + ("brts" . "བö†‚") + ("brdz" . "བö†ƒ") + ("brl" . "བö…") + ("br" . "ö…‘") + ("mr" . "ö…’") + ("sr" . "ö…”") + ("hr" . "ö…•") + ("jr" . "ö…–") + ("kl" . "ö…™") + ("gl" . "ö…š") + ("blt" . "བö†œ") + ("bld" . "བö†") + ("bl" . "ö…›") + ("zl" . "ö…œ") + ("rl" . "ö…") + ("sl" . "ö…ž") + ("rk" . "ö…¸") + ("rg" . "ö…¹") + ("rj" . "ö…»") + ("rt" . "ö…½") + ("rd" . "ö…¾") + ("rn" . "ö…¿") + ("rb" . "ö†€") + ("rm" . "ö†") + ("lk" . "ö†—") + ("lg" . "ö†˜") + ("lc" . "ö†š") + ("lj" . "ö†›") + ("lt" . "ö†œ") + ("ld" . "ö†") + ("ln" . "ö€€") ; dummy \x2121 + ("lp" . "ö†ž") + ("lb" . "ö†Ÿ") + ("lh" . "ö† ") + ("sk" . "ö†§") + ("sg" . "ö†¨") + ("st" . "ö†«") + ("sd" . "ö†¬") + ("sn" . "ö†") + ("sp" . "ö†®") + ("sb" . "ö†¯") + ("sm" . "ö†°")) ) (defconst tibetan-subjoined-transcription-alist - (sort '(("+k" . "$(7#!(B") - ("+kh" . "$(7#"(B") - ("+g" . "$(7##(B") - ("+gh" . "$(7#$(B") - ("+ng" . "$(7#%(B") - ("+c" . "$(7#&(B") - ("+ch" . "$(7#'(B") - ("+j" . "$(7#((B") - ("+ny" . "$(7#*(B") - ("+T" . "$(7#+(B") - ("+TH" . "$(7#,(B") - ("+D" . "$(7#-(B") - ("+DH" . "$(7#.(B") - ("+N" . "$(7#/(B") - ("+t" . "$(7#0(B") - ("+th" . "$(7#1(B") - ("+d" . "$(7#2(B") - ("+dh" . "$(7#3(B") - ("+n" . "$(7#4(B") - ("+p" . "$(7#5(B") - ("+ph" . "$(7#6(B") - ("+b" . "$(7#7(B") - ("+bh" . "$(7#8(B") - ("+m" . "$(7#9(B") - ("+ts" . "$(7#:(B") - ("+tsh" . "$(7#;(B") - ("+dz" . "$(7#<(B") - ("+dzh" . "$(7#=(B") - ("+w" . "$(7#>(B") - ("+zh" . "$(7#?(B") - ("+z" . "$(7#@(B") - ("+'" . "$(7#A(B") - ("+y" . "$(7#B(B") - ("+r" . "$(7#C(B") - ("+l" . "$(7#D(B") - ("+sh" . "$(7#E(B") - ("+SH" . "$(7#F(B") - ("+s" . "$(7#G(B") - ("+h" . "$(7#H(B") - ("+A" . "$(7#I(B") - ("+kSH" . "$(7#J(B") + (sort '(("+k" . "à¾") + ("+kh" . "ྑ") + ("+g" . "ྒ") + ("+gh" . "ྒྷ") + ("+ng" . "ྔ") + ("+c" . "ྕ") + ("+ch" . "ྖ") + ("+j" . "ྗ") + ("+ny" . "ྙ") + ("+T" . "ྚ") + ("+TH" . "ྛ") + ("+D" . "ྜ") + ("+DH" . "à¾") + ("+N" . "ྞ") + ("+t" . "ྟ") + ("+th" . "ྠ") + ("+d" . "ྡ") + ("+dh" . "ྡྷ") + ("+n" . "ྣ") + ("+p" . "ྤ") + ("+ph" . "ྥ") + ("+b" . "ྦ") + ("+bh" . "ྦྷ") + ("+m" . "ྨ") + ("+ts" . "ྩ") + ("+tsh" . "ྪ") + ("+dz" . "ྫ") + ("+dzh" . "ྫྷ") + ("+w" . "à¾") + ("+zh" . "ྮ") + ("+z" . "ྯ") + ("+'" . "ྰ") + ("+y" . "ྱ") + ("+r" . "ྲ") + ("+l" . "ླ") + ("+sh" . "ྴ") + ("+SH" . "ྵ") + ("+s" . "ྶ") + ("+h" . "ྷ") + ("+A" . "ྸ") + ("+kSH" . "ྐྵ") ;; Added by Tomabechi 1999/12/10 - ("+W" . "$(7#K(B") ;; fixed form subscribed WA - ("+Y" . "$(7#L(B") ;; fixed form subscribed YA - ("+R" . "$(7#M(B") ;; fixed form subscribed RA + ("+W" . "ྺ") ;; fixed form subscribed WA + ("+Y" . "ྻ") ;; fixed form subscribed YA + ("+R" . "ྼ") ;; fixed form subscribed RA ) (lambda (x y) (> (length (car x)) (length (car y)))))) @@ -378,70 +378,70 @@ ;;; alist for Tibetan base consonant <-> subjoined consonant conversion. ;;; (defconst tibetan-base-to-subjoined-alist - '(("$(7"!(B" . "$(7#!(B") - ("$(7""(B" . "$(7#"(B") - ("$(7"#(B" . "$(7##(B") - ("$(7"$(B" . "$(7#$(B") - ("$(7"%(B" . "$(7#%(B") - ("$(7"&(B" . "$(7#&(B") - ("$(7"'(B" . "$(7#'(B") - ("$(7"((B" . "$(7#((B") - ("$(7"*(B" . "$(7#*(B") - ("$(7"+(B" . "$(7#+(B") - ("$(7",(B" . "$(7#,(B") - ("$(7"-(B" . "$(7#-(B") - ("$(7".(B" . "$(7#.(B") - ("$(7"/(B" . "$(7#/(B") - ("$(7"0(B" . "$(7#0(B") - ("$(7"1(B" . "$(7#1(B") - ("$(7"2(B" . "$(7#2(B") - ("$(7"3(B" . "$(7#3(B") - ("$(7"4(B" . "$(7#4(B") - ("$(7"5(B" . "$(7#5(B") - ("$(7"6(B" . "$(7#6(B") - ("$(7"7(B" . "$(7#7(B") - ("$(7"8(B" . "$(7#8(B") - ("$(7"9(B" . "$(7#9(B") - ("$(7":(B" . "$(7#:(B") - ("$(7";(B" . "$(7#;(B") - ("$(7"<(B" . "$(7#<(B") - ("$(7"=(B" . "$(7#=(B") - ("$(7">(B" . "$(7#>(B") - ("$(7"?(B" . "$(7#?(B") - ("$(7"@(B" . "$(7#@(B") - ("$(7"A(B" . "$(7#A(B") - ("$(7"B(B" . "$(7#B(B") - ("$(7"C(B" . "$(7#C(B") - ("$(7"D(B" . "$(7#D(B") - ("$(7"E(B" . "$(7#E(B") - ("$(7"F(B" . "$(7#F(B") - ("$(7"G(B" . "$(7#G(B") - ("$(7"H(B" . "$(7#H(B") - ("$(7"I(B" . "$(7#I(B") - ("$(7"J(B" . "$(7#J(B") + '(("ཀ" . "à¾") + ("à½" . "ྑ") + ("ག" . "ྒ") + ("གྷ" . "ྒྷ") + ("ང" . "ྔ") + ("ཅ" . "ྕ") + ("ཆ" . "ྖ") + ("ཇ" . "ྗ") + ("ཉ" . "ྙ") + ("ཊ" . "ྚ") + ("ཋ" . "ྛ") + ("ཌ" . "ྜ") + ("à½" . "à¾") + ("ཎ" . "ྞ") + ("à½" . "ྟ") + ("à½" . "ྠ") + ("ད" . "ྡ") + ("དྷ" . "ྡྷ") + ("ན" . "ྣ") + ("པ" . "ྤ") + ("ཕ" . "ྥ") + ("བ" . "ྦ") + ("བྷ" . "ྦྷ") + ("མ" . "ྨ") + ("ཙ" . "ྩ") + ("ཚ" . "ྪ") + ("ཛ" . "ྫ") + ("ཛྷ" . "ྫྷ") + ("à½" . "à¾") + ("ཞ" . "ྮ") + ("ཟ" . "ྯ") + ("འ" . "ྰ") + ("ཡ" . "ྱ") + ("ར" . "ྲ") + ("ལ" . "ླ") + ("ཤ" . "ྴ") + ("ཥ" . "ྵ") + ("ས" . "ྶ") + ("ཧ" . "ྷ") + ("ཨ" . "ྸ") + ("ཀྵ" . "ྐྵ") ;; Added by Tomabechi 1999/12/10 - ("$(7"K(B" . "$(7#M(B") ;; Fixed form RA (224B->234D) + ("ཪ" . "ྼ") ;; Fixed form RA (224B->234D) )) ;;; alist for Tibetan composite vowels (long i, vocalic r, etc.) ;;; New variable. created by Tomabechi 2000/06/08 (defconst tibetan-composite-vowel-alist '(;; LONG A - ;; ("$(7"R(B" . ((bc . tc) ?$(7"R(B)) + ;; ("ཱ" . ((bc . tc) ?ཱ)) ;; LONG I - ("$(7"T(B" . (?$(7"R(B (tc . bc) ?$(7"S(B)) + ("ཱི" . (?ཱ (tc . bc) ?ི)) ;; LONG U - ("$(7"V(B" . (?$(7"R(B (bc . tc) ?$(7"U(B)) + ("ཱུ" . (?ཱ (bc . tc) ?ུ)) ;; VOCALIC R - ("$(7"W(B" . (?$(7#C(B (tc . bc) ?$(7"a(B)) + ("ྲྀ" . (?ྲ (tc . bc) ?ྀ)) ;; LONG VOCALIC R - ("$(7"X(B" . (?$(7#C(B (bc . tc) ?$(7"R(B (tc . bc) ?$(7"a(B)) + ("ཷ" . (?ྲ (bc . tc) ?ཱ (tc . bc) ?ྀ)) ;; VOCALIC L - ("$(7"Y(B" . (?$(7#D(B (tc . bc) ?$(7"a(B)) - ;;$(7!;(BLONG VOCALIC L - ("$(7"Z(B" . (?$(7#D(B (bc . tc) ?$(7"R(B (tc . bc) ?$(7"a(B)) + ("ླྀ" . (?ླ (tc . bc) ?ྀ)) + ;;་LONG VOCALIC L + ("ཹ" . (?ླ (bc . tc) ?ཱ (tc . bc) ?ྀ)) ;; LONG REVERSE I - ("$(7"b(B" . (?$(7"R(B (tc . bc) ?$(7"a(B)) + ("à¾" . (?ཱ (tc . bc) ?ྀ)) )) @@ -451,102 +451,102 @@ ;;; (includes some punctuation conversion rules) ;;; (defconst tibetan-precomposition-rule-alist - `(("$(7"6#B#>(B" . "$(7$G(B") - ("$(7"##C#>(B" . "$(7$_(B") - ("$(7";#>(B" . "$(7$)(B") - ("$(7"C#:#>(B" . "$(7%.(B") - ("$(7"C###>(B" . "$(7%-(B") - ("$(7"C#!#B(B" . "$(7%0(B") - ("$(7"C###B(B" . "$(7%1(B") - ("$(7"C#9#B(B" . "$(7%2(B") - ("$(7"G#!#B(B" . "$(7%`(B") - ("$(7"G###B(B" . "$(7%a(B") - ("$(7"G#5#B(B" . "$(7%b(B") - ("$(7"G#7#B(B" . "$(7%c(B") - ("$(7"G#9#B(B" . "$(7%d(B") - ("$(7"G#!#C(B" . "$(7%p(B") - ("$(7"G###C(B" . "$(7%q(B") - ("$(7"G#4#C(B" . "$(7%r(B") - ("$(7"G#5#C(B" . "$(7%s(B") - ("$(7"G#7#C(B" . "$(7%t(B") - ("$(7"G#9#C(B" . "$(7%u(B") - ("$(7""#>(B" . "$(7$"(B") - ("$(7"*#>(B" . "$(7$%(B") - ("$(7":#>(B" . "$(7$((B") - ("$(7"?#>(B" . "$(7$*(B") - ("$(7"E#>(B" . "$(7$.(B") - ("$(7""#B(B" . "$(7$A(B") - ("$(7"6#B(B" . "$(7$D(B") - ("$(7""#C(B" . "$(7$Q(B") - ("$(7"1#C(B" . "$(7$T(B") - ("$(7"6#C(B" . "$(7$W(B") - ("$(7"E#C(B" . "$(7$Z(B") - ("$(7"<#C(B" . "$(7$^(B") - ("$(7"C#%(B" . "$(7%#(B") - ("$(7"C#*(B" . "$(7%%(B") - ("$(7"C#:(B" . "$(7%+(B") - ("$(7"C#<(B" . "$(7%,(B") - ("$(7"D#%(B" . "$(7%B(B") - ("$(7"G#%(B" . "$(7%R(B") - ("$(7"G#*(B" . "$(7%S(B") - ("$(7"G#:(B" . "$(7%Z(B") - ("$(7"!#>(B" . "$(7$!(B") - ("$(7"##>(B" . "$(7$#(B") - ("$(7"&#>(B" . "$(7$$(B") - ("$(7"0#>(B" . "$(7$&(B") - ("$(7"2#>(B" . "$(7$'(B") - ("$(7"@#>(B" . "$(7$+(B") - ("$(7"C#>(B" . "$(7$,(B") - ("$(7"D#>(B" . "$(7$-(B") - ("$(7"G#>(B" . "$(7$/(B") - ("$(7"H#>(B" . "$(7$0(B") - ("$(7"!#B(B" . "$(7$@(B") - ("$(7"##B(B" . "$(7$B(B") - ("$(7"5#B(B" . "$(7$C(B") - ("$(7"7#B(B" . "$(7$E(B") - ("$(7"9#B(B" . "$(7$F(B") - ("$(7"!#C(B" . "$(7$P(B") - ("$(7"##C(B" . "$(7$R(B") - ("$(7"0#C(B" . "$(7$S(B") - ("$(7"2#C(B" . "$(7$U(B") - ("$(7"5#C(B" . "$(7$V(B") - ("$(7"7#C(B" . "$(7$X(B") - ("$(7"9#C(B" . "$(7$Y(B") - ("$(7"G#C(B" . "$(7$[(B") - ("$(7"H#C(B" . "$(7$\(B") - ("$(7"(#C(B" . "$(7$](B") - ("$(7"!#D(B" . "$(7$`(B") - ("$(7"##D(B" . "$(7$a(B") - ("$(7"7#D(B" . "$(7$b(B") - ("$(7"@#D(B" . "$(7$c(B") - ("$(7"C#D(B" . "$(7$d(B") - ("$(7"G#D(B" . "$(7$e(B") - ("$(7"C#!(B" . "$(7%!(B") - ("$(7"C##(B" . "$(7%"(B") - ("$(7"C#((B" . "$(7%$(B") - ("$(7"C#0(B" . "$(7%&(B") - ("$(7"C#2(B" . "$(7%'(B") - ("$(7"C#4(B" . "$(7%((B") - ("$(7"C#7(B" . "$(7%)(B") - ("$(7"C#9(B" . "$(7%*(B") - ("$(7"D#!(B" . "$(7%@(B") - ("$(7"D##(B" . "$(7%A(B") - ("$(7"D#4(B" . "$(7!!(B") ; dummy 0x2121 added 2000/06/08 for transition l -> lng - ("$(7"D#&(B" . "$(7%C(B") - ("$(7"D#((B" . "$(7%D(B") - ("$(7"D#0(B" . "$(7%E(B") - ("$(7"D#2(B" . "$(7%F(B") - ("$(7"D#5(B" . "$(7%G(B") - ("$(7"D#7(B" . "$(7%H(B") - ("$(7"D#H(B" . "$(7%I(B") - ("$(7"G#!(B" . "$(7%P(B") - ("$(7"G##(B" . "$(7%Q(B") - ("$(7"G#0(B" . "$(7%T(B") - ("$(7"G#2(B" . "$(7%U(B") - ("$(7"G#4(B" . "$(7%V(B") - ("$(7"G#5(B" . "$(7%W(B") - ("$(7"G#7(B" . "$(7%X(B") - ("$(7"G#9(B" . "$(7%Y(B"))) + `(("ཕྱà¾" . "ö…€") + ("གྲà¾" . "ö…˜") + ("ཚà¾" . "ö„¢") + ("རྩà¾" . "ö†…") + ("རྒà¾" . "ö†„") + ("རà¾à¾±" . "ö†‡") + ("རྒྱ" . "ö†ˆ") + ("རྨྱ" . "ö†‰") + ("སà¾à¾±" . "ö†·") + ("སྒྱ" . "ö†¸") + ("སྤྱ" . "ö†¹") + ("སྦྱ" . "ö†º") + ("སྨྱ" . "ö†»") + ("སà¾à¾²" . "ö‡‡") + ("སྒྲ" . "ö‡ˆ") + ("སྣྲ" . "ö‡‰") + ("སྤྲ" . "ö‡Š") + ("སྦྲ" . "ö‡‹") + ("སྨྲ" . "ö‡Œ") + ("à½à¾" . "ö„›") + ("ཉà¾" . "ö„ž") + ("ཙà¾" . "ö„¡") + ("ཞà¾" . "ö„£") + ("ཤà¾" . "ö„§") + ("à½à¾±" . "ö„º") + ("ཕྱ" . "ö„½") + ("à½à¾²" . "ö…Š") + ("à½à¾²" . "ö…") + ("ཕྲ" . "ö…") + ("ཤྲ" . "ö…“") + ("ཛྲ" . "ö…—") + ("རྔ" . "ö…º") + ("རྙ" . "ö…¼") + ("རྩ" . "ö†‚") + ("རྫ" . "ö†ƒ") + ("ལྔ" . "ö†™") + ("སྔ" . "ö†©") + ("སྙ" . "ö†ª") + ("སྩ" . "ö†±") + ("ཀà¾" . "ö„š") + ("གà¾" . "ö„œ") + ("ཅà¾" . "ö„") + ("à½à¾" . "ö„Ÿ") + ("དà¾" . "ö„ ") + ("ཟà¾" . "ö„¤") + ("རà¾" . "ö„¥") + ("ལà¾" . "ö„¦") + ("སà¾" . "ö„¨") + ("ཧà¾" . "ö„©") + ("ཀྱ" . "ö„¹") + ("གྱ" . "ö„»") + ("པྱ" . "ö„¼") + ("བྱ" . "ö„¾") + ("མྱ" . "ö„¿") + ("ཀྲ" . "ö…‰") + ("གྲ" . "ö…‹") + ("à½à¾²" . "ö…Œ") + ("དྲ" . "ö…Ž") + ("པྲ" . "ö…") + ("བྲ" . "ö…‘") + ("མྲ" . "ö…’") + ("སྲ" . "ö…”") + ("ཧྲ" . "ö…•") + ("ཇྲ" . "ö…–") + ("ཀླ" . "ö…™") + ("གླ" . "ö…š") + ("བླ" . "ö…›") + ("ཟླ" . "ö…œ") + ("རླ" . "ö…") + ("སླ" . "ö…ž") + ("རà¾" . "ö…¸") + ("རྒ" . "ö…¹") + ("རྗ" . "ö…»") + ("རྟ" . "ö…½") + ("རྡ" . "ö…¾") + ("རྣ" . "ö…¿") + ("རྦ" . "ö†€") + ("རྨ" . "ö†") + ("ལà¾" . "ö†—") + ("ལྒ" . "ö†˜") + ("ལྣ" . "ö€€") ; dummy 0x2121 added 2000/06/08 for transition l -> lng + ("ལྕ" . "ö†š") + ("ལྗ" . "ö†›") + ("ལྟ" . "ö†œ") + ("ལྡ" . "ö†") + ("ལྤ" . "ö†ž") + ("ལྦ" . "ö†Ÿ") + ("ལྷ" . "ö† ") + ("སà¾" . "ö†§") + ("སྒ" . "ö†¨") + ("སྟ" . "ö†«") + ("སྡ" . "ö†¬") + ("སྣ" . "ö†") + ("སྤ" . "ö†®") + ("སྦ" . "ö†¯") + ("སྨ" . "ö†°"))) (defconst tibetan-regexp (let ((l (list tibetan-precomposed-transcription-alist diff --git a/lisp/language/viet-util.el b/lisp/language/viet-util.el index a0487df9ea8..a4e7ff564e0 100644 --- a/lisp/language/viet-util.el +++ b/lisp/language/viet-util.el @@ -1,4 +1,4 @@ -;;; viet-util.el --- utilities for Vietnamese -*- coding: iso-2022-7bit; -*- +;;; viet-util.el --- utilities for Vietnamese -*- coding: utf-8; -*- ;; Copyright (C) 1998, 2001-2013 Free Software Foundation, Inc. ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, @@ -52,159 +52,159 @@ ;; ------------+----------+-------- ;; mark | mnemonic | example ;; ------------+----------+--------- -;; breve | ( | a( -> ,1e(B -;; circumflex | ^ | a^ -> ,1b(B -;; horn | + | o+ -> ,1=(B +;; breve | ( | a( -> ă +;; circumflex | ^ | a^ -> â +;; horn | + | o+ -> Æ¡ ;; ------------+----------+--------- -;; acute | ' | a' -> ,1a(B -;; grave | ` | a` -> ,1`(B -;; hook above | ? | a? -> ,1d(B -;; tilde | ~ | a~ -> ,1c(B -;; dot below | . | a. -> ,1U(B +;; acute | ' | a' -> á +;; grave | ` | a` -> à +;; hook above | ? | a? -> ả +;; tilde | ~ | a~ -> ã +;; dot below | . | a. -> ạ ;; ------------+----------+--------- -;; d bar | dd | dd -> ,1p(B +;; d bar | dd | dd -> Ä‘ ;; ------------+----------+--------- (defvar viet-viqr-alist '(;; lowercase - (?,1!(B . "a('") ; 161 - (?,1"(B . "a(`") ; 162 - (?,1#(B . "a(.") ; 163 - (?,1$(B . "a^'") ; 164 - (?,1%(B . "a^`") ; 165 - (?,1&(B . "a^?") ; 166 - (?,1'(B . "a^.") ; 167 - (?,1((B . "e~") ; 168 - (?,1)(B . "e.") ; 169 - (?,1*(B . "e^'") ; 170 - (?,1+(B . "e^`") ; 171 - (?,1,(B . "e^?") ; 172 - (?,1-(B . "e^~") ; 173 - (?,1.(B . "e^.") ; 174 - (?,1/(B . "o^'") ; 175 - (?,10(B . "o^`") ; 176 - (?,11(B . "o^?") ; 177 - (?,12(B . "o^~") ; 178 - (?,15(B . "o^.") ; 181 - (?,16(B . "o+`") ; 182 - (?,17(B . "o+?") ; 183 - (?,18(B . "i.") ; 184 - (?,1=(B . "o+") ; 189 - (?,1>(B . "o+'") ; 190 - (?,1F(B . "a(?") ; 198 - (?,1G(B . "a(~") ; 199 - (?,1O(B . "y`") ; 207 - (?,1Q(B . "u+'") ; 209 - (?,1U(B . "a.") ; 213 - (?,1V(B . "y?") ; 214 - (?,1W(B . "u+`") ; 215 - (?,1X(B . "u+?") ; 216 - (?,1[(B . "y~") ; 219 - (?,1\(B . "y.") ; 220 - (?,1^(B . "o+~") ; 222 - (?,1_(B . "u+") ; 223 - (?,1`(B . "a`") ; 224 - (?,1a(B . "a'") ; 225 - (?,1b(B . "a^") ; 226 - (?,1c(B . "a~") ; 227 - (?,1d(B . "a?") ; 228 - (?,1e(B . "a(") ; 229 - (?,1f(B . "u+~") ; 230 - (?,1g(B . "a^~") ; 231 - (?,1h(B . "e`") ; 232 - (?,1i(B . "e'") ; 233 - (?,1j(B . "e^") ; 234 - (?,1k(B . "e?") ; 235 - (?,1l(B . "i`") ; 236 - (?,1m(B . "i'") ; 237 - (?,1n(B . "i~") ; 238 - (?,1o(B . "i?") ; 239 - (?,1p(B . "dd") ; 240 - (?,1q(B . "u+.") ; 241 - (?,1r(B . "o`") ; 242 - (?,1s(B . "o'") ; 243 - (?,1t(B . "o^") ; 244 - (?,1u(B . "o~") ; 245 - (?,1v(B . "o?") ; 246 - (?,1w(B . "o.") ; 247 - (?,1x(B . "u.") ; 248 - (?,1y(B . "u`") ; 249 - (?,1z(B . "u'") ; 250 - (?,1{(B . "u~") ; 251 - (?,1|(B . "u?") ; 252 - (?,1}(B . "y'") ; 253 - (?,1~(B . "o+.") ; 254 + (?ắ . "a('") ; 161 + (?ằ . "a(`") ; 162 + (?ặ . "a(.") ; 163 + (?ấ . "a^'") ; 164 + (?ầ . "a^`") ; 165 + (?ẩ . "a^?") ; 166 + (?Ạ. "a^.") ; 167 + (?ẽ . "e~") ; 168 + (?ẹ . "e.") ; 169 + (?ế . "e^'") ; 170 + (?á» . "e^`") ; 171 + (?ể . "e^?") ; 172 + (?á»… . "e^~") ; 173 + (?ệ . "e^.") ; 174 + (?ố . "o^'") ; 175 + (?ồ . "o^`") ; 176 + (?ổ . "o^?") ; 177 + (?á»— . "o^~") ; 178 + (?á»™ . "o^.") ; 181 + (?á» . "o+`") ; 182 + (?ở . "o+?") ; 183 + (?ị . "i.") ; 184 + (?Æ¡ . "o+") ; 189 + (?á»› . "o+'") ; 190 + (?ẳ . "a(?") ; 198 + (?ẵ . "a(~") ; 199 + (?ỳ . "y`") ; 207 + (?ứ . "u+'") ; 209 + (?ạ . "a.") ; 213 + (?á»· . "y?") ; 214 + (?ừ . "u+`") ; 215 + (?á» . "u+?") ; 216 + (?ỹ . "y~") ; 219 + (?ỵ . "y.") ; 220 + (?ỡ . "o+~") ; 222 + (?Æ° . "u+") ; 223 + (?à . "a`") ; 224 + (?á . "a'") ; 225 + (?â . "a^") ; 226 + (?ã . "a~") ; 227 + (?ả . "a?") ; 228 + (?ă . "a(") ; 229 + (?ữ . "u+~") ; 230 + (?ẫ . "a^~") ; 231 + (?è . "e`") ; 232 + (?é . "e'") ; 233 + (?ê . "e^") ; 234 + (?ẻ . "e?") ; 235 + (?ì . "i`") ; 236 + (?à . "i'") ; 237 + (?Ä© . "i~") ; 238 + (?ỉ . "i?") ; 239 + (?Ä‘ . "dd") ; 240 + (?á»± . "u+.") ; 241 + (?ò . "o`") ; 242 + (?ó . "o'") ; 243 + (?ô . "o^") ; 244 + (?õ . "o~") ; 245 + (?á» . "o?") ; 246 + (?á» . "o.") ; 247 + (?ụ . "u.") ; 248 + (?ù . "u`") ; 249 + (?ú . "u'") ; 250 + (?Å© . "u~") ; 251 + (?ủ . "u?") ; 252 + (?ý . "y'") ; 253 + (?ợ . "o+.") ; 254 ;; upper case - (?,2!(B . "A('") ; 161 - (?,2"(B . "A(`") ; 162 - (?,2#(B . "A(.") ; 163 - (?,2$(B . "A^'") ; 164 - (?,2%(B . "A^`") ; 165 - (?,2&(B . "A^?") ; 166 - (?,2'(B . "A^.") ; 167 - (?,2((B . "E~") ; 168 - (?,2)(B . "E.") ; 169 - (?,2*(B . "E^'") ; 170 - (?,2+(B . "E^`") ; 171 - (?,2,(B . "E^?") ; 172 - (?,2-(B . "E^~") ; 173 - (?,2.(B . "E^.") ; 174 - (?,2/(B . "O^'") ; 175 - (?,20(B . "O^`") ; 176 - (?,21(B . "O^?") ; 177 - (?,22(B . "O^~") ; 178 - (?,25(B . "O^.") ; 181 - (?,26(B . "O+`") ; 182 - (?,27(B . "O+?") ; 183 - (?,28(B . "I.") ; 184 - (?,2=(B . "O+") ; 189 - (?,2>(B . "O+'") ; 190 - (?,2F(B . "A(?") ; 198 - (?,2G(B . "A(~") ; 199 - (?,2O(B . "Y`") ; 207 - (?,2Q(B . "U+'") ; 209 - (?,2U(B . "A.") ; 213 - (?,2V(B . "Y?") ; 214 - (?,2W(B . "U+`") ; 215 - (?,2X(B . "U+?") ; 216 - (?,2[(B . "Y~") ; 219 - (?,2\(B . "Y.") ; 220 - (?,2^(B . "O+~") ; 222 - (?,2_(B . "U+") ; 223 - (?,2`(B . "A`") ; 224 - (?,2a(B . "A'") ; 225 - (?,2b(B . "A^") ; 226 - (?,2c(B . "A~") ; 227 - (?,2d(B . "A?") ; 228 - (?,2e(B . "A(") ; 229 - (?,2f(B . "U+~") ; 230 - (?,2g(B . "A^~") ; 231 - (?,2h(B . "E`") ; 232 - (?,2i(B . "E'") ; 233 - (?,2j(B . "E^") ; 234 - (?,2k(B . "E?") ; 235 - (?,2l(B . "I`") ; 236 - (?,2m(B . "I'") ; 237 - (?,2n(B . "I~") ; 238 - (?,2o(B . "I?") ; 239 - (?,2p(B . "DD") ; 240 - (?,2p(B . "dD") ; 240 - (?,2p(B . "Dd") ; 240 - (?,2q(B . "U+.") ; 241 - (?,2r(B . "O`") ; 242 - (?,2s(B . "O'") ; 243 - (?,2t(B . "O^") ; 244 - (?,2u(B . "O~") ; 245 - (?,2v(B . "O?") ; 246 - (?,2w(B . "O.") ; 247 - (?,2x(B . "U.") ; 248 - (?,2y(B . "U`") ; 249 - (?,2z(B . "U'") ; 250 - (?,2{(B . "U~") ; 251 - (?,2|(B . "U?") ; 252 - (?,2}(B . "Y'") ; 253 - (?,2~(B . "O+.") ; 254 + (?Ắ . "A('") ; 161 + (?Ằ . "A(`") ; 162 + (?Ặ . "A(.") ; 163 + (?Ấ . "A^'") ; 164 + (?Ầ . "A^`") ; 165 + (?Ẩ . "A^?") ; 166 + (?Ậ . "A^.") ; 167 + (?Ẽ . "E~") ; 168 + (?Ẹ . "E.") ; 169 + (?Ế . "E^'") ; 170 + (?Ề . "E^`") ; 171 + (?Ể . "E^?") ; 172 + (?Ễ . "E^~") ; 173 + (?Ệ . "E^.") ; 174 + (?á» . "O^'") ; 175 + (?á»’ . "O^`") ; 176 + (?á»” . "O^?") ; 177 + (?á»– . "O^~") ; 178 + (?Ộ . "O^.") ; 181 + (?Ờ . "O+`") ; 182 + (?Ở . "O+?") ; 183 + (?Ị . "I.") ; 184 + (?Æ . "O+") ; 189 + (?Ớ . "O+'") ; 190 + (?Ẳ . "A(?") ; 198 + (?Ẵ . "A(~") ; 199 + (?Ỳ . "Y`") ; 207 + (?Ứ . "U+'") ; 209 + (?Ạ. "A.") ; 213 + (?Ỷ . "Y?") ; 214 + (?Ừ . "U+`") ; 215 + (?Ử . "U+?") ; 216 + (?Ỹ . "Y~") ; 219 + (?á»´ . "Y.") ; 220 + (?á» . "O+~") ; 222 + (?Ư . "U+") ; 223 + (?À . "A`") ; 224 + (?à . "A'") ; 225 + (? . "A^") ; 226 + (?à . "A~") ; 227 + (?Ả . "A?") ; 228 + (?Ä‚ . "A(") ; 229 + (?á»® . "U+~") ; 230 + (?Ẫ . "A^~") ; 231 + (?È . "E`") ; 232 + (?É . "E'") ; 233 + (?Ê . "E^") ; 234 + (?Ẻ . "E?") ; 235 + (?ÃŒ . "I`") ; 236 + (?à . "I'") ; 237 + (?Ĩ . "I~") ; 238 + (?Ỉ . "I?") ; 239 + (?Ä . "DD") ; 240 + (?Ä . "dD") ; 240 + (?Ä . "Dd") ; 240 + (?á»° . "U+.") ; 241 + (?Ã’ . "O`") ; 242 + (?Ó . "O'") ; 243 + (?Ô . "O^") ; 244 + (?Õ . "O~") ; 245 + (?Ỏ . "O?") ; 246 + (?Ọ . "O.") ; 247 + (?Ụ . "U.") ; 248 + (?Ù . "U`") ; 249 + (?Ú . "U'") ; 250 + (?Ũ . "U~") ; 251 + (?Ủ . "U?") ; 252 + (?à . "Y'") ; 253 + (?Ợ . "O+.") ; 254 ;; escape from composition (?\( . "\\(") ; breve (left parenthesis) diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index e58967d5a80..6cd20f9c8ca 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -68,7 +68,7 @@ should return a grid vector array that is the new solution. ;;;*** ;;;### (autoloads (ada-mode ada-add-extensions) "ada-mode" "progmodes/ada-mode.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20874 62962 290468 0)) ;;; Generated autoloads from progmodes/ada-mode.el (autoload 'ada-add-extensions "ada-mode" "\ @@ -474,7 +474,7 @@ A replacement function for `newline-and-indent', aligning as it goes. ;;;### (autoloads (outlineify-sticky allout-mode allout-mode-p allout-auto-activation ;;;;;; allout-setup allout-auto-activation-helper) "allout" "allout.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20892 39729 858825 0)) ;;; Generated autoloads from allout.el (autoload 'allout-auto-activation-helper "allout" "\ @@ -895,7 +895,7 @@ outline hot-spot navigation (see `allout-mode'). ;;;*** ;;;### (autoloads (ange-ftp-hook-function ange-ftp-reread-dir) "ange-ftp" -;;;;;; "net/ange-ftp.el" (20763 30266 231060 0)) +;;;;;; "net/ange-ftp.el" (20843 54187 671468 0)) ;;; Generated autoloads from net/ange-ftp.el (defalias 'ange-ftp-re-read-dir 'ange-ftp-reread-dir) @@ -1245,8 +1245,8 @@ Entering array mode calls the function `array-mode-hook'. ;;;*** -;;;### (autoloads (artist-mode) "artist" "textmodes/artist.el" (20777 -;;;;;; 63161 848428 0)) +;;;### (autoloads (artist-mode) "artist" "textmodes/artist.el" (20891 +;;;;;; 18859 893295 0)) ;;; Generated autoloads from textmodes/artist.el (autoload 'artist-mode "artist" "\ @@ -1554,7 +1554,7 @@ This is similar to `autoarg-mode' but rebinds the keypad keys ;;;*** ;;;### (autoloads (autoconf-mode) "autoconf" "progmodes/autoconf.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20874 62962 290468 0)) ;;; Generated autoloads from progmodes/autoconf.el (autoload 'autoconf-mode "autoconf" "\ @@ -1605,7 +1605,7 @@ insert a template for the file depending on the mode of the buffer. ;;;### (autoloads (batch-update-autoloads update-directory-autoloads ;;;;;; update-file-autoloads) "autoload" "emacs-lisp/autoload.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20879 27694 495748 0)) ;;; Generated autoloads from emacs-lisp/autoload.el (put 'generated-autoload-file 'safe-local-variable 'stringp) @@ -1656,7 +1656,7 @@ should be non-nil). ;;;### (autoloads (global-auto-revert-mode turn-on-auto-revert-tail-mode ;;;;;; auto-revert-tail-mode turn-on-auto-revert-mode auto-revert-mode) -;;;;;; "autorevert" "autorevert.el" (20767 27320 533690 0)) +;;;;;; "autorevert" "autorevert.el" (20893 60586 188550 0)) ;;; Generated autoloads from autorevert.el (autoload 'auto-revert-mode "autorevert" "\ @@ -1786,7 +1786,7 @@ definition of \"random distance\".) ;;;*** ;;;### (autoloads (display-battery-mode battery) "battery" "battery.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20791 9657 561026 0)) ;;; Generated autoloads from battery.el (put 'battery-mode-line-string 'risky-local-variable t) @@ -1860,7 +1860,7 @@ For non-interactive use see also `benchmark-run' and ;;;*** ;;;### (autoloads (bibtex-search-entry bibtex-mode bibtex-initialize) -;;;;;; "bibtex" "textmodes/bibtex.el" (20709 26818 907104 0)) +;;;;;; "bibtex" "textmodes/bibtex.el" (20842 33318 816618 0)) ;;; Generated autoloads from textmodes/bibtex.el (autoload 'bibtex-initialize "bibtex" "\ @@ -1868,11 +1868,14 @@ For non-interactive use see also `benchmark-run' and Visit the BibTeX files defined by `bibtex-files' and return a list of corresponding buffers. Initialize in these buffers `bibtex-reference-keys' if not yet set. -List of BibTeX buffers includes current buffer if CURRENT is non-nil. +List of BibTeX buffers includes current buffer if CURRENT is non-nil +and the current buffer visits a file using `bibtex-mode'. If FORCE is non-nil, (re)initialize `bibtex-reference-keys' even if already set. If SELECT is non-nil interactively select a BibTeX buffer. -When called interactively, FORCE is t, CURRENT is t if current buffer uses -`bibtex-mode', and SELECT is t if current buffer does not use `bibtex-mode', + +When called interactively, FORCE is t, CURRENT is t if current buffer +visits a file using `bibtex-mode', and SELECT is t if current buffer +does not use `bibtex-mode', \(fn &optional CURRENT FORCE SELECT)" t nil) @@ -2109,7 +2112,7 @@ a reflection. ;;;;;; bookmark-save bookmark-write bookmark-delete bookmark-insert ;;;;;; bookmark-rename bookmark-insert-location bookmark-relocate ;;;;;; bookmark-jump-other-window bookmark-jump bookmark-set) "bookmark" -;;;;;; "bookmark.el" (20709 26818 907104 0)) +;;;;;; "bookmark.el" (20874 65006 176325 548000)) ;;; Generated autoloads from bookmark.el (define-key ctl-x-r-map "b" 'bookmark-jump) (define-key ctl-x-r-map "m" 'bookmark-set) @@ -2310,7 +2313,7 @@ Incremental search of bookmarks, hiding the non-matches as we go. ;;;;;; browse-url-xdg-open browse-url-at-mouse browse-url-at-point ;;;;;; browse-url browse-url-of-region browse-url-of-dired-file ;;;;;; browse-url-of-buffer browse-url-of-file browse-url-browser-function) -;;;;;; "browse-url" "net/browse-url.el" (20709 26818 907104 0)) +;;;;;; "browse-url" "net/browse-url.el" (20874 62962 290468 0)) ;;; Generated autoloads from net/browse-url.el (defvar browse-url-browser-function 'browse-url-default-browser "\ @@ -2666,8 +2669,8 @@ name of buffer configuration. ;;;*** -;;;### (autoloads (bubbles) "bubbles" "play/bubbles.el" (20709 26818 -;;;;;; 907104 0)) +;;;### (autoloads (bubbles) "bubbles" "play/bubbles.el" (20791 9657 +;;;;;; 561026 0)) ;;; Generated autoloads from play/bubbles.el (autoload 'bubbles "bubbles" "\ @@ -2713,7 +2716,7 @@ Like `bug-reference-mode', but only buttonize in comments and strings. ;;;;;; batch-byte-compile-if-not-done display-call-tree byte-compile ;;;;;; compile-defun byte-compile-file byte-recompile-directory ;;;;;; byte-force-recompile byte-compile-enable-warning byte-compile-disable-warning) -;;;;;; "bytecomp" "emacs-lisp/bytecomp.el" (20780 39352 990623 0)) +;;;;;; "bytecomp" "emacs-lisp/bytecomp.el" (20900 33838 319219 0)) ;;; 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) @@ -2872,8 +2875,8 @@ from the cursor position. ;;;### (autoloads (defmath calc-embedded-activate calc-embedded calc-grab-rectangle ;;;;;; calc-grab-region full-calc-keypad calc-keypad calc-eval quick-calc -;;;;;; full-calc calc calc-dispatch) "calc" "calc/calc.el" (20759 -;;;;;; 33211 414988 0)) +;;;;;; full-calc calc calc-dispatch) "calc" "calc/calc.el" (20863 +;;;;;; 39461 835648 0)) ;;; Generated autoloads from calc/calc.el (define-key ctl-x-map "*" 'calc-dispatch) @@ -2968,8 +2971,8 @@ See Info node `(calc)Defining Functions'. ;;;*** -;;;### (autoloads (calculator) "calculator" "calculator.el" (20709 -;;;;;; 26818 907104 0)) +;;;### (autoloads (calculator) "calculator" "calculator.el" (20891 +;;;;;; 18859 893295 0)) ;;; Generated autoloads from calculator.el (autoload 'calculator "calculator" "\ @@ -3090,7 +3093,7 @@ Obsoletes `c-forward-into-nomenclature'. ;;;*** ;;;### (autoloads (c-guess-basic-syntax) "cc-engine" "progmodes/cc-engine.el" -;;;;;; (20755 36154 171386 0)) +;;;;;; (20864 28934 62335 0)) ;;; Generated autoloads from progmodes/cc-engine.el (autoload 'c-guess-basic-syntax "cc-engine" "\ @@ -3203,7 +3206,7 @@ the absolute file name of the file if STYLE-NAME is nil. ;;;### (autoloads (awk-mode pike-mode idl-mode java-mode objc-mode ;;;;;; c++-mode c-mode c-initialize-cc-mode) "cc-mode" "progmodes/cc-mode.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20903 56820 471502 429000)) ;;; Generated autoloads from progmodes/cc-mode.el (autoload 'c-initialize-cc-mode "cc-mode" "\ @@ -3431,8 +3434,8 @@ and exists only for compatibility reasons. ;;;*** -;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" (20709 26818 -;;;;;; 907104 0)) +;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" (20904 30886 +;;;;;; 391458 0)) ;;; Generated autoloads from progmodes/cc-vars.el (put 'c-basic-offset 'safe-local-variable 'integerp) (put 'c-backslash-column 'safe-local-variable 'integerp) @@ -3442,7 +3445,7 @@ and exists only for compatibility reasons. ;;;### (autoloads (ccl-execute-with-args check-ccl-program define-ccl-program ;;;;;; declare-ccl-program ccl-dump ccl-compile) "ccl" "international/ccl.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20884 7264 412929 442000)) ;;; Generated autoloads from international/ccl.el (autoload 'ccl-compile "ccl" "\ @@ -3718,7 +3721,7 @@ Returns a form where all lambdas don't have any free variables. ;;;*** ;;;### (autoloads (cfengine-auto-mode cfengine2-mode cfengine3-mode) -;;;;;; "cfengine" "progmodes/cfengine.el" (20709 26818 907104 0)) +;;;;;; "cfengine" "progmodes/cfengine.el" (20813 33065 721081 0)) ;;; Generated autoloads from progmodes/cfengine.el (autoload 'cfengine3-mode "cfengine" "\ @@ -3773,7 +3776,7 @@ Returns non-nil if any false statements are found. ;;;;;; checkdoc-comments checkdoc-continue checkdoc-start checkdoc-current-buffer ;;;;;; checkdoc-eval-current-buffer checkdoc-message-interactive ;;;;;; checkdoc-interactive checkdoc checkdoc-list-of-strings-p) -;;;;;; "checkdoc" "emacs-lisp/checkdoc.el" (20709 26818 907104 0)) +;;;;;; "checkdoc" "emacs-lisp/checkdoc.el" (20893 60586 188550 0)) ;;; Generated autoloads from emacs-lisp/checkdoc.el (put 'checkdoc-force-docstrings-flag 'safe-local-variable 'booleanp) (put 'checkdoc-force-history-flag 'safe-local-variable 'booleanp) @@ -3969,7 +3972,7 @@ checking of documentation strings. ;;;### (autoloads (pre-write-encode-hz post-read-decode-hz encode-hz-buffer ;;;;;; encode-hz-region decode-hz-buffer decode-hz-region) "china-util" -;;;;;; "language/china-util.el" (20709 26818 907104 0)) +;;;;;; "language/china-util.el" (20799 169 640767 0)) ;;; Generated autoloads from language/china-util.el (autoload 'decode-hz-region "china-util" "\ @@ -4047,7 +4050,7 @@ and runs the normal hook `command-history-hook'. ;;;*** ;;;### (autoloads (common-lisp-indent-function) "cl-indent" "emacs-lisp/cl-indent.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20879 27694 495748 0)) ;;; Generated autoloads from emacs-lisp/cl-indent.el (autoload 'common-lisp-indent-function "cl-indent" "\ @@ -4218,7 +4221,7 @@ If FRAME cannot display COLOR, return nil. ;;;### (autoloads (comint-redirect-results-list-from-process comint-redirect-results-list ;;;;;; comint-redirect-send-command-to-process comint-redirect-send-command ;;;;;; comint-run make-comint make-comint-in-buffer) "comint" "comint.el" -;;;;;; (20721 17977 14204 0)) +;;;;;; (20896 36774 886399 0)) ;;; Generated autoloads from comint.el (defvar comint-output-filter-functions '(ansi-color-process-output comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt) "\ @@ -4318,7 +4321,7 @@ REGEXP-GROUP is the regular expression group in REGEXP to use. ;;;*** ;;;### (autoloads (compare-windows) "compare-w" "vc/compare-w.el" -;;;;;; (20721 17977 14204 0)) +;;;;;; (20871 33574 214287 0)) ;;; Generated autoloads from vc/compare-w.el (autoload 'compare-windows "compare-w" "\ @@ -4355,8 +4358,8 @@ on third call it again advances points to the next difference and so on. ;;;;;; compilation-shell-minor-mode compilation-mode compilation-start ;;;;;; compile compilation-disable-input compile-command compilation-search-path ;;;;;; compilation-ask-about-save compilation-window-height compilation-start-hook -;;;;;; compilation-mode-hook) "compile" "progmodes/compile.el" (20763 -;;;;;; 30266 231060 0)) +;;;;;; compilation-mode-hook) "compile" "progmodes/compile.el" (20856 +;;;;;; 32301 830403 0)) ;;; Generated autoloads from progmodes/compile.el (defvar compilation-mode-hook nil "\ @@ -4536,7 +4539,7 @@ This is the value of `next-error-function' in Compilation buffers. ;;;*** ;;;### (autoloads (dynamic-completion-mode) "completion" "completion.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20884 7264 412929 442000)) ;;; Generated autoloads from completion.el (defvar dynamic-completion-mode nil "\ @@ -4561,7 +4564,7 @@ if ARG is omitted or nil. ;;;### (autoloads (conf-xdefaults-mode conf-ppd-mode conf-colon-mode ;;;;;; conf-space-keywords conf-space-mode conf-javaprop-mode conf-windows-mode ;;;;;; conf-unix-mode conf-mode) "conf-mode" "textmodes/conf-mode.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20791 9657 561026 0)) ;;; Generated autoloads from textmodes/conf-mode.el (autoload 'conf-mode "conf-mode" "\ @@ -4789,7 +4792,7 @@ If FIX is non-nil, run `copyright-fix-years' instead. ;;;*** ;;;### (autoloads (cperl-perldoc-at-point cperl-perldoc cperl-mode) -;;;;;; "cperl-mode" "progmodes/cperl-mode.el" (20763 30266 231060 +;;;;;; "cperl-mode" "progmodes/cperl-mode.el" (20901 54695 989166 ;;;;;; 0)) ;;; Generated autoloads from progmodes/cperl-mode.el (put 'cperl-indent-level 'safe-local-variable 'integerp) @@ -4989,7 +4992,7 @@ Run a `perldoc' on the word around point. ;;;*** ;;;### (autoloads (cpp-parse-edit cpp-highlight-buffer) "cpp" "progmodes/cpp.el" -;;;;;; (20762 9398 526093 0)) +;;;;;; (20874 65006 672942 217000)) ;;; Generated autoloads from progmodes/cpp.el (autoload 'cpp-highlight-buffer "cpp" "\ @@ -5034,7 +5037,7 @@ if ARG is omitted or nil. ;;;*** ;;;### (autoloads (completing-read-multiple) "crm" "emacs-lisp/crm.el" -;;;;;; (20718 41783 713368 0)) +;;;;;; (20825 24233 991089 0)) ;;; Generated autoloads from emacs-lisp/crm.el (autoload 'completing-read-multiple "crm" "\ @@ -5059,7 +5062,8 @@ Completion is available on a per-element basis. For example, if the contents of the minibuffer are 'alice,bob,eve' and point is between 'l' and 'i', pressing TAB operates on the element 'alice'. -The return value of this function is a list of the read strings. +The return value of this function is a list of the read strings +with empty strings removed. See the documentation for `completing-read' for details on the arguments: PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST, DEF, and @@ -5141,7 +5145,7 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings. ;;;;;; customize-mode customize customize-push-and-save customize-save-variable ;;;;;; customize-set-variable customize-set-value custom-menu-sort-alphabetically ;;;;;; custom-buffer-sort-alphabetically custom-browse-sort-alphabetically) -;;;;;; "cus-edit" "cus-edit.el" (20762 9398 526093 0)) +;;;;;; "cus-edit" "cus-edit.el" (20874 9766 437572 0)) ;;; Generated autoloads from cus-edit.el (defvar custom-browse-sort-alphabetically nil "\ @@ -5453,8 +5457,8 @@ The format is suitable for use with `easy-menu-define'. ;;;*** ;;;### (autoloads (customize-themes describe-theme custom-theme-visit-theme -;;;;;; customize-create-theme) "cus-theme" "cus-theme.el" (20709 -;;;;;; 26818 907104 0)) +;;;;;; customize-create-theme) "cus-theme" "cus-theme.el" (20841 +;;;;;; 12463 538770 0)) ;;; Generated autoloads from cus-theme.el (autoload 'customize-create-theme "cus-theme" "\ @@ -5544,7 +5548,7 @@ See `cwarn-mode' for more information on Cwarn mode. ;;;### (autoloads (standard-display-cyrillic-translit cyrillic-encode-alternativnyj-char ;;;;;; cyrillic-encode-koi8-r-char) "cyril-util" "language/cyril-util.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20826 45095 436233 0)) ;;; Generated autoloads from language/cyril-util.el (autoload 'cyrillic-encode-koi8-r-char "cyril-util" "\ @@ -5630,8 +5634,8 @@ Create a new data-debug buffer with NAME. ;;;*** -;;;### (autoloads (dbus-handle-event) "dbus" "net/dbus.el" (20709 -;;;;;; 26818 907104 0)) +;;;### (autoloads (dbus-handle-event) "dbus" "net/dbus.el" (20900 +;;;;;; 33838 319219 0)) ;;; Generated autoloads from net/dbus.el (autoload 'dbus-handle-event "dbus" "\ @@ -5901,7 +5905,7 @@ any selection. ;;;*** ;;;### (autoloads (derived-mode-init-mode-variables define-derived-mode) -;;;;;; "derived" "emacs-lisp/derived.el" (20709 26818 907104 0)) +;;;;;; "derived" "emacs-lisp/derived.el" (20900 33838 319219 0)) ;;; Generated autoloads from emacs-lisp/derived.el (autoload 'define-derived-mode "derived" "\ @@ -5968,7 +5972,7 @@ the first time the mode is used. ;;;*** ;;;### (autoloads (describe-char describe-text-properties) "descr-text" -;;;;;; "descr-text.el" (20764 51137 83502 0)) +;;;;;; "descr-text.el" (20875 30633 412173 0)) ;;; Generated autoloads from descr-text.el (autoload 'describe-text-properties "descr-text" "\ @@ -6005,7 +6009,7 @@ relevant to POS. ;;;### (autoloads (desktop-revert desktop-save-in-desktop-dir desktop-change-dir ;;;;;; desktop-load-default desktop-read desktop-remove desktop-save ;;;;;; desktop-clear desktop-locals-to-save desktop-save-mode) "desktop" -;;;;;; "desktop.el" (20709 26818 907104 0)) +;;;;;; "desktop.el" (20866 42607 417304 513000)) ;;; Generated autoloads from desktop.el (defvar desktop-save-mode nil "\ @@ -6143,9 +6147,10 @@ Furthermore, it clears the variables listed in `desktop-globals-to-clear'. Save the desktop in a desktop file. Parameter DIRNAME specifies where to save the desktop file. Optional parameter RELEASE says whether we're done with this desktop. -See also `desktop-base-file-name'. +If AUTO-SAVE is non-nil, compare the saved contents to the one last saved, +and don't save the buffer if they are the same. -\(fn DIRNAME &optional RELEASE)" t nil) +\(fn DIRNAME &optional RELEASE AUTO-SAVE)" t nil) (autoload 'desktop-remove "desktop" "\ Delete desktop file in `desktop-dirname'. @@ -6170,7 +6175,7 @@ Also inhibit further loading of it. \(fn)" nil nil) -(make-obsolete 'desktop-load-default 'desktop-save-mode "22.1") +(make-obsolete 'desktop-load-default 'desktop-save-mode '"22.1") (autoload 'desktop-change-dir "desktop" "\ Change to desktop saved in DIRNAME. @@ -6194,7 +6199,7 @@ Revert to the last loaded desktop. ;;;### (autoloads (gnus-article-outlook-deuglify-article gnus-outlook-deuglify-article ;;;;;; gnus-article-outlook-repair-attribution gnus-article-outlook-unwrap-lines) -;;;;;; "deuglify" "gnus/deuglify.el" (20709 26818 907104 0)) +;;;;;; "deuglify" "gnus/deuglify.el" (20791 9657 561026 0)) ;;; Generated autoloads from gnus/deuglify.el (autoload 'gnus-article-outlook-unwrap-lines "deuglify" "\ @@ -6227,7 +6232,7 @@ Deuglify broken Outlook (Express) articles and redisplay. ;;;*** ;;;### (autoloads (diary-mode diary-mail-entries diary) "diary-lib" -;;;;;; "calendar/diary-lib.el" (20709 26818 907104 0)) +;;;;;; "calendar/diary-lib.el" (20879 27694 495748 0)) ;;; Generated autoloads from calendar/diary-lib.el (autoload 'diary "diary-lib" "\ @@ -6320,7 +6325,7 @@ This requires the external program `diff' to be in your `exec-path'. ;;;*** ;;;### (autoloads (diff-minor-mode diff-mode) "diff-mode" "vc/diff-mode.el" -;;;;;; (20784 36406 653593 0)) +;;;;;; (20814 53928 50501 0)) ;;; Generated autoloads from vc/diff-mode.el (autoload 'diff-mode "diff-mode" "\ @@ -6365,7 +6370,7 @@ Optional arguments are passed to `dig-invoke'. ;;;### (autoloads (dired-hide-details-mode dired-mode dired-noselect ;;;;;; dired-other-frame dired-other-window dired dired-listing-switches) -;;;;;; "dired" "dired.el" (20784 36406 653593 0)) +;;;;;; "dired" "dired.el" (20900 33838 319219 0)) ;;; Generated autoloads from dired.el (defvar dired-listing-switches (purecopy "-al") "\ @@ -6725,8 +6730,8 @@ Locate SOA record and increment the serial field. ;;;*** ;;;### (autoloads (doc-view-bookmark-jump doc-view-minor-mode doc-view-mode-maybe -;;;;;; doc-view-mode doc-view-mode-p) "doc-view" "doc-view.el" (20783 -;;;;;; 15545 430927 0)) +;;;;;; doc-view-mode doc-view-mode-p) "doc-view" "doc-view.el" (20899 +;;;;;; 12965 791908 0)) ;;; Generated autoloads from doc-view.el (autoload 'doc-view-mode-p "doc-view" "\ @@ -6800,8 +6805,8 @@ strings when pressed twice. See `double-map' for details. ;;;*** -;;;### (autoloads (dunnet) "dunnet" "play/dunnet.el" (20709 26818 -;;;;;; 907104 0)) +;;;### (autoloads (dunnet) "dunnet" "play/dunnet.el" (20900 33838 +;;;;;; 319219 0)) ;;; Generated autoloads from play/dunnet.el (autoload 'dunnet "dunnet" "\ @@ -6813,7 +6818,7 @@ Switch to *dungeon* buffer and start game. ;;;### (autoloads (easy-mmode-defsyntax easy-mmode-defmap easy-mmode-define-keymap ;;;;;; define-globalized-minor-mode define-minor-mode) "easy-mmode" -;;;;;; "emacs-lisp/easy-mmode.el" (20780 39352 990623 0)) +;;;;;; "emacs-lisp/easy-mmode.el" (20900 33838 319219 0)) ;;; Generated autoloads from emacs-lisp/easy-mmode.el (defalias 'easy-mmode-define-minor-mode 'define-minor-mode) @@ -7578,8 +7583,8 @@ With prefix arg NOCONFIRM, execute current line as-is without editing. ;;;*** -;;;### (autoloads (global-ede-mode) "ede" "cedet/ede.el" (20748 62911 -;;;;;; 684442 0)) +;;;### (autoloads (global-ede-mode) "ede" "cedet/ede.el" (20813 33065 +;;;;;; 721081 0)) ;;; Generated autoloads from cedet/ede.el (defvar global-ede-mode nil "\ @@ -7606,7 +7611,7 @@ an EDE controlled project. ;;;### (autoloads (edebug-all-forms edebug-all-defs edebug-eval-top-level-form ;;;;;; edebug-basic-spec edebug-all-forms edebug-all-defs) "edebug" -;;;;;; "emacs-lisp/edebug.el" (20721 17977 14204 0)) +;;;;;; "emacs-lisp/edebug.el" (20834 39208 838628 0)) ;;; Generated autoloads from emacs-lisp/edebug.el (defvar edebug-all-defs nil "\ @@ -7679,8 +7684,8 @@ Toggle edebugging of all forms. ;;;;;; ediff-merge-directories-with-ancestor ediff-merge-directories ;;;;;; ediff-directories3 ediff-directory-revisions ediff-directories ;;;;;; ediff-buffers3 ediff-buffers ediff-backup ediff-current-file -;;;;;; ediff-files3 ediff-files) "ediff" "vc/ediff.el" (20709 26818 -;;;;;; 907104 0)) +;;;;;; ediff-files3 ediff-files) "ediff" "vc/ediff.el" (20893 60586 +;;;;;; 188550 0)) ;;; Generated autoloads from vc/ediff.el (autoload 'ediff-files "ediff" "\ @@ -7923,7 +7928,7 @@ With optional NODE, goes to that node. ;;;*** ;;;### (autoloads (ediff-show-registry) "ediff-mult" "vc/ediff-mult.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20893 60586 188550 0)) ;;; Generated autoloads from vc/ediff-mult.el (autoload 'ediff-show-registry "ediff-mult" "\ @@ -7936,7 +7941,7 @@ Display Ediff's registry. ;;;*** ;;;### (autoloads (ediff-toggle-use-toolbar ediff-toggle-multiframe) -;;;;;; "ediff-util" "vc/ediff-util.el" (20777 63161 848428 0)) +;;;;;; "ediff-util" "vc/ediff-util.el" (20893 60586 188550 0)) ;;; Generated autoloads from vc/ediff-util.el (autoload 'ediff-toggle-multiframe "ediff-util" "\ @@ -8074,7 +8079,7 @@ Optional argument GROUP is the sub-group of slots to display. ;;;### (autoloads (eieio-describe-generic eieio-describe-constructor ;;;;;; eieio-describe-class eieio-browse) "eieio-opt" "emacs-lisp/eieio-opt.el" -;;;;;; (20771 24374 643644 0)) +;;;;;; (20892 39729 858825 0)) ;;; Generated autoloads from emacs-lisp/eieio-opt.el (autoload 'eieio-browse "eieio-opt" "\ @@ -8107,8 +8112,9 @@ Also extracts information about all methods specific to this generic. ;;;*** -;;;### (autoloads (turn-on-eldoc-mode eldoc-mode eldoc-minor-mode-string) -;;;;;; "eldoc" "emacs-lisp/eldoc.el" (20770 3512 176098 0)) +;;;### (autoloads (turn-on-eldoc-mode eldoc-post-insert-mode eldoc-mode +;;;;;; eldoc-minor-mode-string) "eldoc" "emacs-lisp/eldoc.el" (20806 +;;;;;; 59818 347907 0)) ;;; Generated autoloads from emacs-lisp/eldoc.el (defvar eldoc-minor-mode-string (purecopy " ElDoc") "\ @@ -8131,6 +8137,15 @@ expression point is on. \(fn &optional ARG)" t nil) +(autoload 'eldoc-post-insert-mode "eldoc" "\ +Toggle Eldoc-Post-Insert mode on or off. +With a prefix argument ARG, enable Eldoc-Post-Insert mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. +\\{eldoc-post-insert-mode-map} + +\(fn &optional ARG)" t nil) + (autoload 'turn-on-eldoc-mode "eldoc" "\ Unequivocally turn on ElDoc mode (see command `eldoc-mode'). @@ -8155,7 +8170,7 @@ Emacs Lisp mode) that support ElDoc.") ;;;*** ;;;### (autoloads (electric-layout-mode electric-pair-mode electric-indent-mode) -;;;;;; "electric" "electric.el" (20709 26818 907104 0)) +;;;;;; "electric" "electric.el" (20829 21286 719109 0)) ;;; Generated autoloads from electric.el (defvar electric-indent-chars '(10) "\ @@ -8459,8 +8474,8 @@ Commands: ;;;;;; epa-sign-region epa-verify-cleartext-in-region epa-verify-region ;;;;;; epa-decrypt-armor-in-region epa-decrypt-region epa-encrypt-file ;;;;;; epa-sign-file epa-verify-file epa-decrypt-file epa-select-keys -;;;;;; epa-list-secret-keys epa-list-keys) "epa" "epa.el" (20762 -;;;;;; 9398 526093 0)) +;;;;;; epa-list-secret-keys epa-list-keys) "epa" "epa.el" (20879 +;;;;;; 27694 495748 0)) ;;; Generated autoloads from epa.el (autoload 'epa-list-keys "epa" "\ @@ -8484,9 +8499,9 @@ If SECRET is non-nil, list secret keys instead of public keys. \(fn CONTEXT PROMPT &optional NAMES SECRET)" nil nil) (autoload 'epa-decrypt-file "epa" "\ -Decrypt FILE. +Decrypt DECRYPT-FILE into PLAIN-FILE. -\(fn FILE)" t nil) +\(fn DECRYPT-FILE PLAIN-FILE)" t nil) (autoload 'epa-verify-file "epa" "\ Verify FILE. @@ -8757,7 +8772,7 @@ if ARG is omitted or nil. ;;;*** -;;;### (autoloads (epg-make-context) "epg" "epg.el" (20712 3008 596088 +;;;### (autoloads (epg-make-context) "epg" "epg.el" (20853 3623 384273 ;;;;;; 0)) ;;; Generated autoloads from epg.el @@ -8790,7 +8805,7 @@ Look at CONFIG and try to expand GROUP. ;;;*** ;;;### (autoloads (erc-handle-irc-url erc-tls erc erc-select-read-args) -;;;;;; "erc" "erc/erc.el" (20709 26818 907104 0)) +;;;;;; "erc" "erc/erc.el" (20891 18859 893295 0)) ;;; Generated autoloads from erc/erc.el (autoload 'erc-select-read-args "erc" "\ @@ -8897,7 +8912,7 @@ that subcommand. ;;;*** ;;;### (autoloads nil "erc-desktop-notifications" "erc/erc-desktop-notifications.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20874 65006 176325 548000)) ;;; Generated autoloads from erc/erc-desktop-notifications.el (autoload 'erc-notifications-mode "erc-desktop-notifications" "" t) @@ -9022,15 +9037,15 @@ system. ;;;*** -;;;### (autoloads nil "erc-list" "erc/erc-list.el" (20709 26818 907104 -;;;;;; 0)) +;;;### (autoloads nil "erc-list" "erc/erc-list.el" (20884 7264 412929 +;;;;;; 442000)) ;;; Generated autoloads from erc/erc-list.el (autoload 'erc-list-mode "erc-list") ;;;*** ;;;### (autoloads (erc-save-buffer-in-logs erc-logging-enabled) "erc-log" -;;;;;; "erc/erc-log.el" (20709 26818 907104 0)) +;;;;;; "erc/erc-log.el" (20891 18859 893295 0)) ;;; Generated autoloads from erc/erc-log.el (autoload 'erc-log-mode "erc-log" nil t) @@ -9108,8 +9123,8 @@ Delete dangerous-host interactively to `erc-dangerous-hosts'. ;;;*** -;;;### (autoloads nil "erc-menu" "erc/erc-menu.el" (20709 26818 907104 -;;;;;; 0)) +;;;### (autoloads nil "erc-menu" "erc/erc-menu.el" (20884 7264 412929 +;;;;;; 442000)) ;;; Generated autoloads from erc/erc-menu.el (autoload 'erc-menu-mode "erc-menu" nil t) @@ -9146,7 +9161,7 @@ Interactively select a server to connect to using `erc-server-alist'. ;;;*** ;;;### (autoloads (pcomplete/erc-mode/NOTIFY erc-cmd-NOTIFY) "erc-notify" -;;;;;; "erc/erc-notify.el" (20709 26818 907104 0)) +;;;;;; "erc/erc-notify.el" (20891 18859 893295 0)) ;;; Generated autoloads from erc/erc-notify.el (autoload 'erc-notify-mode "erc-notify" nil t) @@ -9185,8 +9200,8 @@ with args, toggle notify status of people. ;;;*** -;;;### (autoloads nil "erc-ring" "erc/erc-ring.el" (20709 26818 907104 -;;;;;; 0)) +;;;### (autoloads nil "erc-ring" "erc/erc-ring.el" (20884 7264 412929 +;;;;;; 442000)) ;;; Generated autoloads from erc/erc-ring.el (autoload 'erc-ring-mode "erc-ring" nil t) @@ -9305,7 +9320,7 @@ Add a file to `erc-xdcc-files'. ;;;### (autoloads (ert-describe-test ert-run-tests-interactively ;;;;;; ert-run-tests-batch-and-exit ert-run-tests-batch ert-deftest) -;;;;;; "ert" "emacs-lisp/ert.el" (20751 39094 700824 0)) +;;;;;; "ert" "emacs-lisp/ert.el" (20834 39208 838628 0)) ;;; Generated autoloads from emacs-lisp/ert.el (autoload 'ert-deftest "ert" "\ @@ -9383,8 +9398,8 @@ Kill all test buffers that are still live. ;;;*** -;;;### (autoloads (eshell-mode) "esh-mode" "eshell/esh-mode.el" (20709 -;;;;;; 26818 907104 0)) +;;;### (autoloads (eshell-mode) "esh-mode" "eshell/esh-mode.el" (20893 +;;;;;; 60586 188550 0)) ;;; Generated autoloads from eshell/esh-mode.el (autoload 'eshell-mode "esh-mode" "\ @@ -9397,7 +9412,7 @@ Emacs shell interactive mode. ;;;*** ;;;### (autoloads (eshell-command-result eshell-command eshell) "eshell" -;;;;;; "eshell/eshell.el" (20709 26818 907104 0)) +;;;;;; "eshell/eshell.el" (20893 60586 188550 0)) ;;; Generated autoloads from eshell/eshell.el (autoload 'eshell "eshell" "\ @@ -9923,7 +9938,7 @@ With ARG, insert that many delimiters. ;;;### (autoloads (eudc-load-eudc eudc-query-form eudc-expand-inline ;;;;;; eudc-get-phone eudc-get-email eudc-set-server) "eudc" "net/eudc.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20791 9657 561026 0)) ;;; Generated autoloads from net/eudc.el (autoload 'eudc-set-server "eudc" "\ @@ -9979,7 +9994,7 @@ This does nothing except loading eudc by autoload side-effect. ;;;### (autoloads (eudc-display-jpeg-as-button eudc-display-jpeg-inline ;;;;;; eudc-display-sound eudc-display-mail eudc-display-url eudc-display-generic-binary) -;;;;;; "eudc-bob" "net/eudc-bob.el" (20709 26818 907104 0)) +;;;;;; "eudc-bob" "net/eudc-bob.el" (20791 9657 561026 0)) ;;; Generated autoloads from net/eudc-bob.el (autoload 'eudc-display-generic-binary "eudc-bob" "\ @@ -10015,7 +10030,7 @@ Display a button for the JPEG DATA. ;;;*** ;;;### (autoloads (eudc-try-bbdb-insert eudc-insert-record-at-point-into-bbdb) -;;;;;; "eudc-export" "net/eudc-export.el" (20709 26818 907104 0)) +;;;;;; "eudc-export" "net/eudc-export.el" (20871 33574 214287 0)) ;;; Generated autoloads from net/eudc-export.el (autoload 'eudc-insert-record-at-point-into-bbdb "eudc-export" "\ @@ -10032,7 +10047,7 @@ Call `eudc-insert-record-at-point-into-bbdb' if on a record. ;;;*** ;;;### (autoloads (eudc-edit-hotlist) "eudc-hotlist" "net/eudc-hotlist.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20791 9657 561026 0)) ;;; Generated autoloads from net/eudc-hotlist.el (autoload 'eudc-edit-hotlist "eudc-hotlist" "\ @@ -10164,8 +10179,8 @@ This is used only in conjunction with `expand-add-abbrevs'. ;;;*** -;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (20709 26818 -;;;;;; 907104 0)) +;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (20886 939 +;;;;;; 575794 0)) ;;; Generated autoloads from progmodes/f90.el (autoload 'f90-mode "f90" "\ @@ -10217,11 +10232,11 @@ Variables controlling indentation style and extra features: Automatic insertion of & at beginning of continuation lines (default t). `f90-smart-end' From an END statement, check and fill the end using matching block start. - Allowed values are 'blink, 'no-blink, and nil, which determine - whether to blink the matching beginning (default 'blink). + Allowed values are `blink', `no-blink', and nil, which determine + whether to blink the matching beginning (default `blink'). `f90-auto-keyword-case' Automatic change of case of keywords (default nil). - The possibilities are 'downcase-word, 'upcase-word, 'capitalize-word. + The possibilities are `downcase-word', `upcase-word', `capitalize-word'. `f90-leave-line-no' Do not left-justify line numbers (default nil). @@ -10235,8 +10250,8 @@ with no args, if that value is non-nil. ;;;### (autoloads (variable-pitch-mode buffer-face-toggle buffer-face-set ;;;;;; buffer-face-mode text-scale-adjust text-scale-decrease text-scale-increase ;;;;;; text-scale-set face-remap-set-base face-remap-reset-base -;;;;;; face-remap-add-relative) "face-remap" "face-remap.el" (20709 -;;;;;; 26818 907104 0)) +;;;;;; face-remap-add-relative) "face-remap" "face-remap.el" (20841 +;;;;;; 12463 538770 0)) ;;; Generated autoloads from face-remap.el (autoload 'face-remap-add-relative "face-remap" "\ @@ -10399,8 +10414,8 @@ Besides the choice of face, it is the same as `buffer-face-mode'. ;;;### (autoloads (feedmail-queue-reminder feedmail-run-the-queue ;;;;;; feedmail-run-the-queue-global-prompt feedmail-run-the-queue-no-prompts -;;;;;; feedmail-send-it) "feedmail" "mail/feedmail.el" (20759 33211 -;;;;;; 414988 0)) +;;;;;; feedmail-send-it) "feedmail" "mail/feedmail.el" (20891 18859 +;;;;;; 893295 0)) ;;; Generated autoloads from mail/feedmail.el (autoload 'feedmail-send-it "feedmail" "\ @@ -10648,8 +10663,8 @@ Copy directory-local variables to the -*- line. ;;;*** -;;;### (autoloads (filesets-init) "filesets" "filesets.el" (20709 -;;;;;; 26818 907104 0)) +;;;### (autoloads (filesets-init) "filesets" "filesets.el" (20791 +;;;;;; 9657 561026 0)) ;;; Generated autoloads from filesets.el (autoload 'filesets-init "filesets" "\ @@ -10721,7 +10736,7 @@ use in place of \"-ls\" as the final argument. ;;;### (autoloads (ff-mouse-find-other-file-other-window ff-mouse-find-other-file ;;;;;; ff-find-other-file ff-get-other-file ff-special-constructs) -;;;;;; "find-file" "find-file.el" (20709 26818 907104 0)) +;;;;;; "find-file" "find-file.el" (20872 54440 171355 0)) ;;; 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)))) "\ @@ -11058,8 +11073,8 @@ to get the effect of a C-q. ;;;*** ;;;### (autoloads (flymake-find-file-hook flymake-mode-off flymake-mode-on -;;;;;; flymake-mode) "flymake" "progmodes/flymake.el" (20717 20920 -;;;;;; 410005 0)) +;;;;;; flymake-mode) "flymake" "progmodes/flymake.el" (20896 36774 +;;;;;; 886399 0)) ;;; Generated autoloads from progmodes/flymake.el (autoload 'flymake-mode "flymake" "\ @@ -11089,7 +11104,7 @@ Turn flymake mode off. ;;;### (autoloads (flyspell-buffer flyspell-region flyspell-mode-off ;;;;;; turn-off-flyspell turn-on-flyspell flyspell-mode flyspell-prog-mode) -;;;;;; "flyspell" "textmodes/flyspell.el" (20721 17977 14204 0)) +;;;;;; "flyspell" "textmodes/flyspell.el" (20847 51240 240216 0)) ;;; Generated autoloads from textmodes/flyspell.el (autoload 'flyspell-prog-mode "flyspell" "\ @@ -11414,7 +11429,7 @@ and choose the directory as the fortune-file. ;;;*** ;;;### (autoloads (gdb gdb-enable-debug) "gdb-mi" "progmodes/gdb-mi.el" -;;;;;; (20721 17977 14204 0)) +;;;;;; (20903 57728 956434 133000)) ;;; Generated autoloads from progmodes/gdb-mi.el (defvar gdb-enable-debug nil "\ @@ -11440,7 +11455,7 @@ and source-file directory for your debugger. COMMAND-LINE is the shell command for starting the gdb session. It should be a string consisting of the name of the gdb -executable followed by command-line options. The command-line +executable followed by command line options. The command line options should include \"-i=mi\" to use gdb's MI text interface. Note that the old \"--annotate\" option is no longer supported. @@ -11643,8 +11658,8 @@ DEFAULT-MAP specifies the default key map for ICON-LIST. ;;;*** ;;;### (autoloads (gnus gnus-other-frame gnus-slave gnus-no-server -;;;;;; gnus-slave-no-server) "gnus" "gnus/gnus.el" (20709 26818 -;;;;;; 907104 0)) +;;;;;; gnus-slave-no-server) "gnus" "gnus/gnus.el" (20901 54695 +;;;;;; 989166 0)) ;;; Generated autoloads from gnus/gnus.el (when (fboundp 'custom-autoload) (custom-autoload 'gnus-select-method "gnus")) @@ -11789,7 +11804,7 @@ If CLEAN, obsolete (ignore). ;;;*** ;;;### (autoloads (gnus-article-prepare-display) "gnus-art" "gnus/gnus-art.el" -;;;;;; (20763 30266 231060 0)) +;;;;;; (20874 65006 176325 548000)) ;;; Generated autoloads from gnus/gnus-art.el (autoload 'gnus-article-prepare-display "gnus-art" "\ @@ -11869,7 +11884,7 @@ supported. ;;;*** ;;;### (autoloads (gnus-delay-initialize gnus-delay-send-queue gnus-delay-article) -;;;;;; "gnus-delay" "gnus/gnus-delay.el" (20709 26818 907104 0)) +;;;;;; "gnus-delay" "gnus/gnus-delay.el" (20791 9657 561026 0)) ;;; Generated autoloads from gnus/gnus-delay.el (autoload 'gnus-delay-article "gnus-delay" "\ @@ -11990,8 +12005,8 @@ FILE should be a PNG file that's 48x48 and smaller than or equal to ;;;*** ;;;### (autoloads (gnus-treat-mail-gravatar gnus-treat-from-gravatar) -;;;;;; "gnus-gravatar" "gnus/gnus-gravatar.el" (20709 26818 907104 -;;;;;; 0)) +;;;;;; "gnus-gravatar" "gnus/gnus-gravatar.el" (20874 65006 176325 +;;;;;; 548000)) ;;; Generated autoloads from gnus/gnus-gravatar.el (autoload 'gnus-treat-from-gravatar "gnus-gravatar" "\ @@ -12009,7 +12024,7 @@ If gravatars are already displayed, remove them. ;;;*** ;;;### (autoloads (gnus-fetch-group-other-frame gnus-fetch-group) -;;;;;; "gnus-group" "gnus/gnus-group.el" (20763 30266 231060 0)) +;;;;;; "gnus-group" "gnus/gnus-group.el" (20901 54695 989166 0)) ;;; Generated autoloads from gnus/gnus-group.el (autoload 'gnus-fetch-group "gnus-group" "\ @@ -12027,7 +12042,7 @@ Pop up a frame and enter GROUP. ;;;*** ;;;### (autoloads (gnus-html-prefetch-images gnus-article-html) "gnus-html" -;;;;;; "gnus/gnus-html.el" (20709 26818 907104 0)) +;;;;;; "gnus/gnus-html.el" (20874 65006 672942 217000)) ;;; Generated autoloads from gnus/gnus-html.el (autoload 'gnus-article-html "gnus-html" "\ @@ -12184,7 +12199,7 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns: ;;;*** ;;;### (autoloads (gnus-button-reply gnus-button-mailto gnus-msg-mail) -;;;;;; "gnus-msg" "gnus/gnus-msg.el" (20709 26818 907104 0)) +;;;;;; "gnus-msg" "gnus/gnus-msg.el" (20858 21542 723007 0)) ;;; Generated autoloads from gnus/gnus-msg.el (autoload 'gnus-msg-mail "gnus-msg" "\ @@ -12211,7 +12226,7 @@ Like `message-reply'. ;;;*** ;;;### (autoloads (gnus-notifications) "gnus-notifications" "gnus/gnus-notifications.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20886 939 575794 0)) ;;; Generated autoloads from gnus/gnus-notifications.el (autoload 'gnus-notifications "gnus-notifications" "\ @@ -12229,7 +12244,7 @@ This is typically a function to add in ;;;### (autoloads (gnus-treat-newsgroups-picon gnus-treat-mail-picon ;;;;;; gnus-treat-from-picon) "gnus-picon" "gnus/gnus-picon.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20874 65006 672942 217000)) ;;; Generated autoloads from gnus/gnus-picon.el (autoload 'gnus-treat-from-picon "gnus-picon" "\ @@ -12370,7 +12385,7 @@ See the documentation for these variables and functions for details. ;;;*** ;;;### (autoloads (gnus-update-format) "gnus-spec" "gnus/gnus-spec.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20893 60586 188550 0)) ;;; Generated autoloads from gnus/gnus-spec.el (autoload 'gnus-update-format "gnus-spec" "\ @@ -12392,7 +12407,7 @@ Declare back end NAME with ABILITIES as a Gnus back end. ;;;*** ;;;### (autoloads (gnus-summary-bookmark-jump) "gnus-sum" "gnus/gnus-sum.el" -;;;;;; (20763 30266 231060 0)) +;;;;;; (20901 54695 989166 0)) ;;; Generated autoloads from gnus/gnus-sum.el (autoload 'gnus-summary-bookmark-jump "gnus-sum" "\ @@ -12518,7 +12533,7 @@ Like `goto-address-mode', but only for comments and strings. ;;;*** ;;;### (autoloads (gravatar-retrieve-synchronously gravatar-retrieve) -;;;;;; "gravatar" "gnus/gravatar.el" (20709 26818 907104 0)) +;;;;;; "gravatar" "gnus/gravatar.el" (20901 54695 989166 0)) ;;; Generated autoloads from gnus/gravatar.el (autoload 'gravatar-retrieve "gravatar" "\ @@ -12536,8 +12551,8 @@ Retrieve MAIL-ADDRESS gravatar and returns it. ;;;### (autoloads (zrgrep rgrep lgrep grep-find grep grep-mode grep-compute-defaults ;;;;;; grep-process-setup grep-setup-hook grep-find-command grep-command -;;;;;; grep-window-height) "grep" "progmodes/grep.el" (20762 9398 -;;;;;; 526093 0)) +;;;;;; grep-window-height) "grep" "progmodes/grep.el" (20896 36774 +;;;;;; 886399 0)) ;;; Generated autoloads from progmodes/grep.el (defvar grep-window-height nil "\ @@ -12715,8 +12730,8 @@ the form \"WINDOW-ID PIXMAP-ID\". Value is non-nil if successful. ;;;*** ;;;### (autoloads (gud-tooltip-mode gdb-script-mode jdb pdb perldb -;;;;;; xdb dbx sdb gud-gdb) "gud" "progmodes/gud.el" (20709 26818 -;;;;;; 907104 0)) +;;;;;; xdb dbx sdb gud-gdb) "gud" "progmodes/gud.el" (20895 15912 +;;;;;; 444844 0)) ;;; Generated autoloads from progmodes/gud.el (autoload 'gud-gdb "gud" "\ @@ -12905,8 +12920,8 @@ This is like the `&' operator of the C language. ;;;*** -;;;### (autoloads (handwrite) "handwrite" "play/handwrite.el" (20709 -;;;;;; 26818 907104 0)) +;;;### (autoloads (handwrite) "handwrite" "play/handwrite.el" (20791 +;;;;;; 9657 561026 0)) ;;; Generated autoloads from play/handwrite.el (autoload 'handwrite "handwrite" "\ @@ -13439,7 +13454,7 @@ This discards the buffer's undo information. ;;;### (autoloads (hi-lock-write-interactive-patterns hi-lock-unface-buffer ;;;;;; hi-lock-face-phrase-buffer hi-lock-face-buffer hi-lock-line-face-buffer ;;;;;; global-hi-lock-mode hi-lock-mode) "hi-lock" "hi-lock.el" -;;;;;; (20743 44982 104196 0)) +;;;;;; (20825 24233 991089 0)) ;;; Generated autoloads from hi-lock.el (autoload 'hi-lock-mode "hi-lock" "\ @@ -13528,13 +13543,13 @@ See `hi-lock-mode' for more information on Hi-Lock mode. (autoload 'hi-lock-line-face-buffer "hi-lock" "\ Set face of all lines containing a match of REGEXP to FACE. -Interactively, prompt for REGEXP then FACE, using a buffer-local -history list for REGEXP and a global history list for FACE. +Interactively, prompt for REGEXP then FACE. Use +`hi-lock-read-regexp-defaults-function' to retrieve default +value(s) of REGEXP. Use the global history list for FACE. -If Font Lock mode is enabled in the buffer, it is used to -highlight REGEXP. If Font Lock mode is disabled, overlays are -used for highlighting; in this case, the highlighting will not be -updated as you type. +Use Font lock mode, if enabled, to highlight REGEXP. Otherwise, +use overlays for highlighting. If overlays are used, the +highlighting will not update as you type. \(fn REGEXP &optional FACE)" t nil) @@ -13542,13 +13557,13 @@ updated as you type. (autoload 'hi-lock-face-buffer "hi-lock" "\ Set face of each match of REGEXP to FACE. -Interactively, prompt for REGEXP then FACE, using a buffer-local -history list for REGEXP and a global history list for FACE. +Interactively, prompt for REGEXP then FACE. Use +`hi-lock-read-regexp-defaults-function' to retrieve default +value(s) REGEXP. Use the global history list for FACE. -If Font Lock mode is enabled in the buffer, it is used to -highlight REGEXP. If Font Lock mode is disabled, overlays are -used for highlighting; in this case, the highlighting will not be -updated as you type. +Use Font lock mode, if enabled, to highlight REGEXP. Otherwise, +use overlays for highlighting. If overlays are used, the +highlighting will not update as you type. \(fn REGEXP &optional FACE)" t nil) @@ -13556,13 +13571,16 @@ updated as you type. (autoload 'hi-lock-face-phrase-buffer "hi-lock" "\ Set face of each match of phrase REGEXP to FACE. -If called interactively, replaces whitespace in REGEXP with -arbitrary whitespace and makes initial lower-case letters case-insensitive. +Interactively, prompt for REGEXP then FACE. Use +`hi-lock-read-regexp-defaults-function' to retrieve default +value(s) of REGEXP. Use the global history list for FACE. When +called interactively, replace whitespace in user provided regexp +with arbitrary whitespace and make initial lower-case letters +case-insensitive before highlighting with `hi-lock-set-pattern'. -If Font Lock mode is enabled in the buffer, it is used to -highlight REGEXP. If Font Lock mode is disabled, overlays are -used for highlighting; in this case, the highlighting will not be -updated as you type. +Use Font lock mode, if enabled, to highlight REGEXP. Otherwise, +use overlays for highlighting. If overlays are used, the +highlighting will not update as you type. \(fn REGEXP &optional FACE)" t nil) @@ -13633,7 +13651,7 @@ Several variables affect how the hiding is done: ;;;*** ;;;### (autoloads (turn-off-hideshow hs-minor-mode) "hideshow" "progmodes/hideshow.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20791 9657 561026 0)) ;;; 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))) "\ @@ -14065,8 +14083,8 @@ The optional LABEL is used to label the buffer created. ;;;*** -;;;### (autoloads (html2text) "html2text" "gnus/html2text.el" (20709 -;;;;;; 26818 907104 0)) +;;;### (autoloads (html2text) "html2text" "gnus/html2text.el" (20791 +;;;;;; 9657 561026 0)) ;;; Generated autoloads from gnus/html2text.el (autoload 'html2text "html2text" "\ @@ -14200,7 +14218,7 @@ bound to the current value of the filter. ;;;*** ;;;### (autoloads (ibuffer ibuffer-other-window ibuffer-list-buffers) -;;;;;; "ibuffer" "ibuffer.el" (20709 26818 907104 0)) +;;;;;; "ibuffer" "ibuffer.el" (20792 30519 8548 0)) ;;; Generated autoloads from ibuffer.el (autoload 'ibuffer-list-buffers "ibuffer" "\ @@ -14384,7 +14402,7 @@ See also the variable `idlwave-shell-prompt-pattern'. ;;;*** ;;;### (autoloads (idlwave-mode) "idlwave" "progmodes/idlwave.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20901 54695 989166 0)) ;;; Generated autoloads from progmodes/idlwave.el (autoload 'idlwave-mode "idlwave" "\ @@ -14518,8 +14536,8 @@ The main features of this mode are ;;;;;; ido-find-alternate-file ido-find-file-other-window ido-find-file ;;;;;; ido-find-file-in-dir ido-switch-buffer-other-frame ido-insert-buffer ;;;;;; ido-kill-buffer ido-display-buffer ido-switch-buffer-other-window -;;;;;; ido-switch-buffer ido-mode ido-mode) "ido" "ido.el" (20766 -;;;;;; 59066 666084 0)) +;;;;;; ido-switch-buffer ido-mode ido-mode) "ido" "ido.el" (20886 +;;;;;; 939 575794 0)) ;;; Generated autoloads from ido.el (defvar ido-mode nil "\ @@ -14778,7 +14796,7 @@ DEF, if non-nil, is the default value. ;;;*** -;;;### (autoloads (ielm) "ielm" "ielm.el" (20709 26818 907104 0)) +;;;### (autoloads (ielm) "ielm" "ielm.el" (20903 10024 645978 0)) ;;; Generated autoloads from ielm.el (autoload 'ielm "ielm" "\ @@ -14811,7 +14829,7 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. ;;;;;; create-image image-type-auto-detected-p image-type-available-p ;;;;;; image-type image-type-from-file-name image-type-from-file-header ;;;;;; image-type-from-buffer image-type-from-data) "image" "image.el" -;;;;;; (20772 45239 494620 0)) +;;;;;; (20903 10024 645978 0)) ;;; Generated autoloads from image.el (autoload 'image-type-from-data "image" "\ @@ -15212,8 +15230,8 @@ An image file is one whose name has an extension in ;;;*** ;;;### (autoloads (image-bookmark-jump image-mode-as-text image-minor-mode -;;;;;; image-mode) "image-mode" "image-mode.el" (20774 51931 214714 -;;;;;; 829000)) +;;;;;; image-mode) "image-mode" "image-mode.el" (20899 12965 791908 +;;;;;; 0)) ;;; Generated autoloads from image-mode.el (autoload 'image-mode "image-mode" "\ @@ -15399,7 +15417,7 @@ for more information. ;;;### (autoloads (indian-2-column-to-ucs-region in-is13194-pre-write-conversion ;;;;;; in-is13194-post-read-conversion indian-compose-string indian-compose-region) -;;;;;; "ind-util" "language/ind-util.el" (20709 26818 907104 0)) +;;;;;; "ind-util" "language/ind-util.el" (20826 45095 436233 0)) ;;; Generated autoloads from language/ind-util.el (autoload 'indian-compose-region "ind-util" "\ @@ -15452,7 +15470,7 @@ of `inferior-lisp-program'). Runs the hooks from ;;;;;; Info-goto-emacs-key-command-node Info-goto-emacs-command-node ;;;;;; Info-mode info-finder info-apropos Info-index Info-directory ;;;;;; Info-on-current-buffer info-standalone info-emacs-bug info-emacs-manual -;;;;;; info info-other-window) "info" "info.el" (20774 566 676067 +;;;;;; info info-other-window) "info" "info.el" (20900 33838 319219 ;;;;;; 0)) ;;; Generated autoloads from info.el @@ -15666,7 +15684,7 @@ Otherwise, visit the manual in a new Info buffer. ;;;### (autoloads (info-complete-file info-complete-symbol info-lookup-file ;;;;;; info-lookup-symbol info-lookup-reset) "info-look" "info-look.el" -;;;;;; (20771 24374 643644 0)) +;;;;;; (20854 24486 190633 0)) ;;; Generated autoloads from info-look.el (autoload 'info-lookup-reset "info-look" "\ @@ -15894,7 +15912,7 @@ accessed via isearchb. ;;;### (autoloads (iso-cvt-define-menu iso-cvt-write-only iso-cvt-read-only ;;;;;; iso-sgml2iso iso-iso2sgml iso-iso2duden iso-iso2gtex iso-gtex2iso ;;;;;; iso-tex2iso iso-iso2tex iso-german iso-spanish) "iso-cvt" -;;;;;; "international/iso-cvt.el" (20709 26818 907104 0)) +;;;;;; "international/iso-cvt.el" (20791 9657 561026 0)) ;;; Generated autoloads from international/iso-cvt.el (autoload 'iso-spanish "iso-cvt" "\ @@ -15985,7 +16003,7 @@ Add submenus to the File menu, to convert to and from various formats. ;;;*** ;;;### (autoloads nil "iso-transl" "international/iso-transl.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20791 9657 561026 0)) ;;; 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) @@ -15997,7 +16015,7 @@ Add submenus to the File menu, to convert to and from various formats. ;;;;;; ispell-buffer ispell-comments-and-strings ispell-region ispell-change-dictionary ;;;;;; ispell-kill-ispell ispell-help ispell-pdict-save ispell-word ;;;;;; ispell-personal-dictionary) "ispell" "textmodes/ispell.el" -;;;;;; (20784 36406 653593 0)) +;;;;;; (20847 51240 240216 0)) ;;; Generated autoloads from textmodes/ispell.el (put 'ispell-check-comments 'safe-local-variable (lambda (a) (memq a '(nil t exclusive)))) @@ -16230,8 +16248,8 @@ You can bind this to the key C-c i in GNUS or mail by adding to ;;;*** -;;;### (autoloads (iswitchb-mode) "iswitchb" "iswitchb.el" (20766 -;;;;;; 59066 666084 0)) +;;;### (autoloads (iswitchb-mode) "iswitchb" "iswitchb.el" (20824 +;;;;;; 3367 300658 0)) ;;; Generated autoloads from iswitchb.el (defvar iswitchb-mode nil "\ @@ -16361,7 +16379,7 @@ by `jka-compr-installed'. ;;;*** -;;;### (autoloads (js-mode) "js" "progmodes/js.el" (20763 30266 231060 +;;;### (autoloads (js-mode) "js" "progmodes/js.el" (20895 15912 444844 ;;;;;; 0)) ;;; Generated autoloads from progmodes/js.el @@ -16452,8 +16470,8 @@ the context of text formatting. ;;;*** -;;;### (autoloads (kkc-region) "kkc" "international/kkc.el" (20709 -;;;;;; 26818 907104 0)) +;;;### (autoloads (kkc-region) "kkc" "international/kkc.el" (20799 +;;;;;; 169 640767 0)) ;;; Generated autoloads from international/kkc.el (defvar kkc-after-update-conversion-functions nil "\ @@ -16478,7 +16496,7 @@ and the return value is the length of the conversion. ;;;### (autoloads (kmacro-end-call-mouse kmacro-end-and-call-macro ;;;;;; kmacro-end-or-call-macro kmacro-start-macro-or-insert-counter ;;;;;; kmacro-call-macro kmacro-end-macro kmacro-start-macro kmacro-exec-ring-item) -;;;;;; "kmacro" "kmacro.el" (20709 26818 907104 0)) +;;;;;; "kmacro" "kmacro.el" (20830 42150 757296 0)) ;;; Generated autoloads from kmacro.el (global-set-key "\C-x(" 'kmacro-start-macro) (global-set-key "\C-x)" 'kmacro-end-macro) @@ -16531,8 +16549,9 @@ An argument of zero means repeat until error. \(fn ARG)" t nil) (autoload 'kmacro-call-macro "kmacro" "\ -Call the last keyboard macro that you defined with \\[kmacro-start-macro]. +Call the keyboard MACRO that you defined with \\[kmacro-start-macro]. A prefix argument serves as a repeat count. Zero means repeat until error. +MACRO defaults to `last-kbd-macro'. When you call the macro, you can call the macro again by repeating just the last key in the key sequence that you used to call this @@ -16542,7 +16561,7 @@ for details on how to adjust or disable this behavior. To make a macro permanent so you can call it even after defining others, use \\[kmacro-name-last-macro]. -\(fn ARG &optional NO-REPEAT END-MACRO)" t nil) +\(fn ARG &optional NO-REPEAT END-MACRO MACRO)" t nil) (autoload 'kmacro-start-macro-or-insert-counter "kmacro" "\ Record subsequent keyboard input, defining a keyboard macro. @@ -16636,7 +16655,7 @@ Use \\[describe-mode] for more info. ;;;### (autoloads (lao-compose-region lao-composition-function lao-transcribe-roman-to-lao-string ;;;;;; lao-transcribe-single-roman-syllable-to-lao lao-compose-string) -;;;;;; "lao-util" "language/lao-util.el" (20709 26818 907104 0)) +;;;;;; "lao-util" "language/lao-util.el" (20826 45095 436233 0)) ;;; Generated autoloads from language/lao-util.el (autoload 'lao-compose-string "lao-util" "\ @@ -16675,7 +16694,7 @@ Transcribe Romanized Lao string STR to Lao character string. ;;;### (autoloads (latexenc-find-file-coding-system latexenc-coding-system-to-inputenc ;;;;;; latexenc-inputenc-to-coding-system latex-inputenc-coding-alist) -;;;;;; "latexenc" "international/latexenc.el" (20709 26818 907104 +;;;;;; "latexenc" "international/latexenc.el" (20799 169 640767 ;;;;;; 0)) ;;; Generated autoloads from international/latexenc.el @@ -16708,8 +16727,8 @@ coding system names is determined from `latex-inputenc-coding-alist'. ;;;*** ;;;### (autoloads (latin1-display-ucs-per-lynx latin1-display latin1-display) -;;;;;; "latin1-disp" "international/latin1-disp.el" (20709 26818 -;;;;;; 907104 0)) +;;;;;; "latin1-disp" "international/latin1-disp.el" (20826 45095 +;;;;;; 436233 0)) ;;; Generated autoloads from international/latin1-disp.el (defvar latin1-display nil "\ @@ -16751,7 +16770,7 @@ use either \\[customize] or the function `latin1-display'.") ;;;*** ;;;### (autoloads (ld-script-mode) "ld-script" "progmodes/ld-script.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20874 62962 290468 0)) ;;; Generated autoloads from progmodes/ld-script.el (autoload 'ld-script-mode "ld-script" "\ @@ -16929,8 +16948,8 @@ done. Otherwise, it uses the current buffer. ;;;*** -;;;### (autoloads (log-view-mode) "log-view" "vc/log-view.el" (20709 -;;;;;; 26818 907104 0)) +;;;### (autoloads (log-view-mode) "log-view" "vc/log-view.el" (20860 +;;;;;; 63270 684173 0)) ;;; Generated autoloads from vc/log-view.el (autoload 'log-view-mode "log-view" "\ @@ -16941,8 +16960,8 @@ Major mode for browsing CVS log output. ;;;*** ;;;### (autoloads (print-region lpr-region print-buffer lpr-buffer -;;;;;; lpr-command lpr-switches printer-name) "lpr" "lpr.el" (20709 -;;;;;; 26818 907104 0)) +;;;;;; lpr-command lpr-switches printer-name) "lpr" "lpr.el" (20878 +;;;;;; 6823 881439 0)) ;;; Generated autoloads from lpr.el (defvar lpr-windows-system (memq system-type '(ms-dos windows-nt)) "\ @@ -17038,7 +17057,7 @@ for further customization of the printer command. ;;;*** ;;;### (autoloads (ls-lisp-support-shell-wildcards) "ls-lisp" "ls-lisp.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20870 12718 549931 0)) ;;; Generated autoloads from ls-lisp.el (defvar ls-lisp-support-shell-wildcards t "\ @@ -17064,8 +17083,8 @@ This function is suitable for execution in an init file. ;;;*** -;;;### (autoloads (m4-mode) "m4-mode" "progmodes/m4-mode.el" (20709 -;;;;;; 26818 907104 0)) +;;;### (autoloads (m4-mode) "m4-mode" "progmodes/m4-mode.el" (20874 +;;;;;; 62962 290468 0)) ;;; Generated autoloads from progmodes/m4-mode.el (autoload 'm4-mode "m4-mode" "\ @@ -17230,7 +17249,7 @@ This function normally would be called when the message is sent. ;;;### (autoloads (mail-fetch-field mail-unquote-printable-region ;;;;;; mail-unquote-printable mail-quote-printable-region mail-quote-printable ;;;;;; mail-file-babyl-p mail-dont-reply-to-names mail-use-rfc822) -;;;;;; "mail-utils" "mail/mail-utils.el" (20709 26818 907104 0)) +;;;;;; "mail-utils" "mail/mail-utils.el" (20891 18859 893295 0)) ;;; Generated autoloads from mail/mail-utils.el (defvar mail-use-rfc822 nil "\ @@ -17305,8 +17324,8 @@ matches may be returned from the message body. ;;;*** ;;;### (autoloads (define-mail-abbrev build-mail-abbrevs mail-abbrevs-setup -;;;;;; mail-abbrevs-mode) "mailabbrev" "mail/mailabbrev.el" (20709 -;;;;;; 26818 907104 0)) +;;;;;; mail-abbrevs-mode) "mailabbrev" "mail/mailabbrev.el" (20847 +;;;;;; 51240 240216 0)) ;;; Generated autoloads from mail/mailabbrev.el (defvar mail-abbrevs-mode nil "\ @@ -17406,7 +17425,7 @@ current header, calls `mail-complete-function' and passes prefix ARG if any. \(fn ARG)" t nil) -(make-obsolete 'mail-complete 'mail-completion-at-point-function "24.1") +(make-obsolete 'mail-complete 'mail-completion-at-point-function '"24.1") ;;;*** @@ -17425,8 +17444,8 @@ The mail client is taken to be the handler of mailto URLs. ;;;### (autoloads (makefile-imake-mode makefile-bsdmake-mode makefile-makepp-mode ;;;;;; makefile-gmake-mode makefile-automake-mode makefile-mode) -;;;;;; "make-mode" "progmodes/make-mode.el" (20748 62911 684442 -;;;;;; 0)) +;;;;;; "make-mode" "progmodes/make-mode.el" (20874 65006 672942 +;;;;;; 217000)) ;;; Generated autoloads from progmodes/make-mode.el (autoload 'makefile-mode "make-mode" "\ @@ -17556,7 +17575,7 @@ Previous contents of that buffer are killed first. ;;;*** ;;;### (autoloads (Man-bookmark-jump man-follow man) "man" "man.el" -;;;;;; (20762 9398 526093 0)) +;;;;;; (20888 42662 256824 0)) ;;; Generated autoloads from man.el (defalias 'manual-entry 'man) @@ -17610,8 +17629,8 @@ Default bookmark handler for Man buffers. ;;;*** -;;;### (autoloads (master-mode) "master" "master.el" (20709 26818 -;;;;;; 907104 0)) +;;;### (autoloads (master-mode) "master" "master.el" (20884 7264 +;;;;;; 912957 506000)) ;;; Generated autoloads from master.el (autoload 'master-mode "master" "\ @@ -17667,7 +17686,7 @@ recursion depth in the minibuffer prompt. This is only useful if ;;;;;; message-forward-make-body message-forward message-recover ;;;;;; message-supersede message-cancel-news message-followup message-wide-reply ;;;;;; message-reply message-news message-mail message-mode) "message" -;;;;;; "gnus/message.el" (20723 59703 12265 0)) +;;;;;; "gnus/message.el" (20889 63525 775294 0)) ;;; 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) @@ -17833,7 +17852,7 @@ which specify the range to operate on. ;;;*** ;;;### (autoloads (metapost-mode metafont-mode) "meta-mode" "progmodes/meta-mode.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20874 62962 290468 0)) ;;; Generated autoloads from progmodes/meta-mode.el (autoload 'metafont-mode "meta-mode" "\ @@ -17895,7 +17914,7 @@ redisplayed as output is inserted. ;;;### (autoloads (mh-fully-kill-draft mh-send-letter mh-user-agent-compose ;;;;;; mh-smail-batch mh-smail-other-window mh-smail) "mh-comp" -;;;;;; "mh-e/mh-comp.el" (20709 26818 907104 0)) +;;;;;; "mh-e/mh-comp.el" (20890 54503 125088 852000)) ;;; Generated autoloads from mh-e/mh-comp.el (autoload 'mh-smail "mh-comp" "\ @@ -17985,8 +18004,8 @@ delete the draft message. ;;;*** -;;;### (autoloads (mh-version) "mh-e" "mh-e/mh-e.el" (20709 26818 -;;;;;; 907104 0)) +;;;### (autoloads (mh-version) "mh-e" "mh-e/mh-e.el" (20874 65006 +;;;;;; 672942 217000)) ;;; Generated autoloads from mh-e/mh-e.el (put 'mh-progs 'risky-local-variable t) @@ -18003,7 +18022,7 @@ Display version information about MH-E and the MH mail handling system. ;;;*** ;;;### (autoloads (mh-folder-mode mh-nmail mh-rmail) "mh-folder" -;;;;;; "mh-e/mh-folder.el" (20709 26818 907104 0)) +;;;;;; "mh-e/mh-folder.el" (20787 12616 976036 0)) ;;; Generated autoloads from mh-e/mh-folder.el (autoload 'mh-rmail "mh-folder" "\ @@ -18346,7 +18365,7 @@ Assume text has been decoded if DECODED is non-nil. ;;;*** ;;;### (autoloads (mml-attach-file mml-to-mime) "mml" "gnus/mml.el" -;;;;;; (20745 310 425822 0)) +;;;;;; (20829 21286 719109 0)) ;;; Generated autoloads from gnus/mml.el (autoload 'mml-to-mime "mml" "\ @@ -18372,7 +18391,7 @@ body) or \"attachment\" (separate from the body). ;;;*** ;;;### (autoloads (mml1991-sign mml1991-encrypt) "mml1991" "gnus/mml1991.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20875 30633 412173 0)) ;;; Generated autoloads from gnus/mml1991.el (autoload 'mml1991-encrypt "mml1991" "\ @@ -18389,7 +18408,7 @@ body) or \"attachment\" (separate from the body). ;;;### (autoloads (mml2015-self-encrypt mml2015-sign mml2015-encrypt ;;;;;; mml2015-verify-test mml2015-verify mml2015-decrypt-test mml2015-decrypt) -;;;;;; "mml2015" "gnus/mml2015.el" (20780 39352 990623 0)) +;;;;;; "mml2015" "gnus/mml2015.el" (20893 60586 188550 0)) ;;; Generated autoloads from gnus/mml2015.el (autoload 'mml2015-decrypt "mml2015" "\ @@ -18545,7 +18564,7 @@ To test this function, evaluate: ;;;*** -;;;### (autoloads (mpc) "mpc" "mpc.el" (20709 26818 907104 0)) +;;;### (autoloads (mpc) "mpc" "mpc.el" (20838 36262 626321 0)) ;;; Generated autoloads from mpc.el (autoload 'mpc "mpc" "\ @@ -18596,7 +18615,7 @@ different buffer menu using the function `msb'. ;;;;;; describe-current-coding-system describe-current-coding-system-briefly ;;;;;; describe-coding-system describe-character-set list-charset-chars ;;;;;; read-charset list-character-sets) "mule-diag" "international/mule-diag.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20891 18859 893295 0)) ;;; Generated autoloads from international/mule-diag.el (autoload 'list-character-sets "mule-diag" "\ @@ -18733,7 +18752,7 @@ The default is 20. If LIMIT is negative, do not limit the listing. ;;;;;; coding-system-translation-table-for-decode coding-system-pre-write-conversion ;;;;;; coding-system-post-read-conversion lookup-nested-alist set-nested-alist ;;;;;; truncate-string-to-width store-substring) "mule-util" "international/mule-util.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20826 45095 436233 0)) ;;; Generated autoloads from international/mule-util.el (defsubst string-to-list (string) "\ @@ -18844,7 +18863,7 @@ coding systems ordered by priority. \(fn FROM TO PRIORITY-LIST)" nil t) -(make-obsolete 'detect-coding-with-priority 'with-coding-priority "23.1") +(make-obsolete 'detect-coding-with-priority 'with-coding-priority '"23.1") (autoload 'detect-coding-with-language-environment "mule-util" "\ Detect a coding system for the text between FROM and TO with LANG-ENV. @@ -18864,9 +18883,9 @@ per-character basis, this may not be accurate. ;;;*** -;;;### (autoloads (advice-member-p advice-remove advice-add advice--add-function -;;;;;; add-function advice--buffer-local advice--remove-function) -;;;;;; "nadvice" "emacs-lisp/nadvice.el" (20725 15032 264919 0)) +;;;### (autoloads (advice-member-p advice-remove advice-add remove-function +;;;;;; advice--add-function add-function advice--buffer-local advice--remove-function) +;;;;;; "nadvice" "emacs-lisp/nadvice.el" (20872 54440 171355 0)) ;;; Generated autoloads from emacs-lisp/nadvice.el (autoload 'advice--remove-function "nadvice" "\ @@ -18888,18 +18907,20 @@ call OLDFUN here: `:before' (lambda (&rest r) (apply FUNCTION r) (apply OLDFUN r)) `:after' (lambda (&rest r) (prog1 (apply OLDFUN r) (apply FUNCTION r))) `:around' (lambda (&rest r) (apply FUNCTION OLDFUN r)) +`:override' (lambda (&rest r) (apply FUNCTION r)) `:before-while' (lambda (&rest r) (and (apply FUNCTION r) (apply OLDFUN r))) `:before-until' (lambda (&rest r) (or (apply FUNCTION r) (apply OLDFUN r))) `:after-while' (lambda (&rest r) (and (apply OLDFUN r) (apply FUNCTION r))) `:after-until' (lambda (&rest r) (or (apply OLDFUN r) (apply FUNCTION r))) +`:filter-args' (lambda (&rest r) (apply OLDFUN (funcall FUNCTION r))) +`:filter-return'(lambda (&rest r) (funcall FUNCTION (apply OLDFUN r))) If FUNCTION was already added, do nothing. PROPS is an alist of additional properties, among which the following have a special meaning: - `name': a string or symbol. It can be used to refer to this piece of advice. -PLACE cannot be a simple variable. Instead it should either be -\(default-value 'VAR) or (local 'VAR) depending on whether FUNCTION -should be applied to VAR buffer-locally or globally. +If PLACE is a simple variable, only its global value will be affected. +Use (local 'VAR) if you want to apply FUNCTION to VAR buffer-locally. If one of FUNCTION or OLDFUN is interactive, then the resulting function is also interactive. There are 3 cases: @@ -18916,6 +18937,14 @@ is also interactive. There are 3 cases: \(fn WHERE REF FUNCTION PROPS)" nil nil) +(autoload 'remove-function "nadvice" "\ +Remove the FUNCTION piece of advice from PLACE. +If FUNCTION was not added to PLACE, do nothing. +Instead of FUNCTION being the actual function, it can also be the `name' +of the piece of advice. + +\(fn PLACE FUNCTION)" nil t) + (autoload 'advice-add "nadvice" "\ Like `add-function' but for the function named SYMBOL. Contrary to `add-function', this will properly handle the cases where SYMBOL @@ -18944,8 +18973,8 @@ of the piece of advice. ;;;### (autoloads (network-connection network-connection-to-service ;;;;;; whois-reverse-lookup whois finger ftp run-dig dns-lookup-host ;;;;;; nslookup nslookup-host ping traceroute route arp netstat -;;;;;; iwconfig ifconfig) "net-utils" "net/net-utils.el" (20784 -;;;;;; 36406 653593 0)) +;;;;;; iwconfig ifconfig) "net-utils" "net/net-utils.el" (20903 +;;;;;; 10024 645978 0)) ;;; Generated autoloads from net/net-utils.el (autoload 'ifconfig "net-utils" "\ @@ -19330,8 +19359,8 @@ Return nil if the face cannot display a glyph for N. ;;;*** -;;;### (autoloads (nxml-mode) "nxml-mode" "nxml/nxml-mode.el" (20763 -;;;;;; 30266 231060 0)) +;;;### (autoloads (nxml-mode) "nxml-mode" "nxml/nxml-mode.el" (20884 +;;;;;; 6711 386198 0)) ;;; Generated autoloads from nxml/nxml-mode.el (autoload 'nxml-mode "nxml-mode" "\ @@ -19405,11 +19434,21 @@ the variable `nxml-enabled-unicode-blocks'. ;;;*** -;;;### (autoloads (inferior-octave) "octave-inf" "progmodes/octave-inf.el" -;;;;;; (20709 26818 907104 0)) -;;; Generated autoloads from progmodes/octave-inf.el +;;;### (autoloads (inferior-octave octave-mode) "octave" "progmodes/octave.el" +;;;;;; (20905 51752 865679 0)) +;;; Generated autoloads from progmodes/octave.el + +(autoload 'octave-mode "octave" "\ +Major mode for editing Octave code. + +Octave is a high-level language, primarily intended for numerical +computations. It provides a convenient command line interface +for solving linear and nonlinear problems numerically. Function +definitions can also be stored in files and used in batch mode. -(autoload 'inferior-octave "octave-inf" "\ +\(fn)" t nil) + +(autoload 'inferior-octave "octave" "\ Run an inferior Octave process, I/O via `inferior-octave-buffer'. This buffer is put in Inferior Octave mode. See `inferior-octave-mode'. @@ -19428,91 +19467,8 @@ startup file, `~/.emacs-octave'. ;;;*** -;;;### (autoloads (octave-mode) "octave-mod" "progmodes/octave-mod.el" -;;;;;; (20709 26818 907104 0)) -;;; Generated autoloads from progmodes/octave-mod.el - -(autoload 'octave-mode "octave-mod" "\ -Major mode for editing Octave code. - -This mode makes it easier to write Octave code by helping with -indentation, doing some of the typing for you (with Abbrev mode) and by -showing keywords, comments, strings, etc. in different faces (with -Font Lock mode on terminals that support it). - -Octave itself is a high-level language, primarily intended for numerical -computations. It provides a convenient command line interface for -solving linear and nonlinear problems numerically. Function definitions -can also be stored in files, and it can be used in a batch mode (which -is why you need this mode!). - -The latest released version of Octave is always available via anonymous -ftp from ftp.octave.org in the directory `/pub/octave'. Complete -source and binaries for several popular systems are available. - -Type \\[list-abbrevs] to display the built-in abbrevs for Octave keywords. - -Keybindings -=========== - -\\{octave-mode-map} - -Variables you can use to customize Octave mode -============================================== - -`octave-blink-matching-block' - Non-nil means show matching begin of block when inserting a space, - newline or semicolon after an else or end keyword. Default is t. - -`octave-block-offset' - Extra indentation applied to statements in block structures. - Default is 2. - -`octave-continuation-offset' - Extra indentation applied to Octave continuation lines. - Default is 4. - -`octave-continuation-string' - String used for Octave continuation lines. - Default is a backslash. - -`octave-send-echo-input' - Non-nil means always display `inferior-octave-buffer' after sending a - command to the inferior Octave process. - -`octave-send-line-auto-forward' - Non-nil means always go to the next unsent line of Octave code after - sending a line to the inferior Octave process. - -`octave-send-echo-input' - Non-nil means echo input sent to the inferior Octave process. - -Turning on Octave mode runs the hook `octave-mode-hook'. - -To begin using this mode for all `.m' files that you edit, add the -following lines to your init file: - - (add-to-list 'auto-mode-alist '(\"\\\\.m\\\\'\" . octave-mode)) - -To automatically turn on the abbrev and auto-fill features, -add the following lines to your init file as well: - - (add-hook 'octave-mode-hook - (lambda () - (abbrev-mode 1) - (auto-fill-mode 1))) - -To submit a problem report, enter \\[octave-submit-bug-report] from an Octave mode buffer. -This automatically sets up a mail buffer with version information -already added. You just need to add a description of the problem, -including a reproducible test case and send the message. - -\(fn)" t nil) - -;;;*** - ;;;### (autoloads (opascal-mode) "opascal" "progmodes/opascal.el" -;;;;;; (20746 21181 635406 0)) +;;;;;; (20858 21542 723007 0)) ;;; Generated autoloads from progmodes/opascal.el (define-obsolete-function-alias 'delphi-mode 'opascal-mode "24.4") @@ -19543,14 +19499,8 @@ Customization: Coloring: - `opascal-comment-face' (default font-lock-comment-face) - Face used to color OPascal comments. - `opascal-string-face' (default font-lock-string-face) - Face used to color OPascal strings. `opascal-keyword-face' (default font-lock-keyword-face) Face used to color OPascal keywords. - `opascal-other-face' (default nil) - Face used to color everything else. Turning on OPascal mode calls the value of the variable `opascal-mode-hook' with no args, if that value is non-nil. @@ -19791,7 +19741,7 @@ Call the customize function with org as argument. ;;;;;; org-search-view org-agenda-list org-batch-store-agenda-views ;;;;;; org-store-agenda-views org-batch-agenda-csv org-batch-agenda ;;;;;; org-agenda org-toggle-sticky-agenda) "org-agenda" "org/org-agenda.el" -;;;;;; (20783 15545 430927 0)) +;;;;;; (20847 51240 240216 0)) ;;; Generated autoloads from org/org-agenda.el (autoload 'org-toggle-sticky-agenda "org-agenda" "\ @@ -20253,7 +20203,7 @@ See the command `outline-mode' for more information on this mode. ;;;### (autoloads (list-packages describe-package package-initialize ;;;;;; package-refresh-contents package-install-file package-install-from-buffer ;;;;;; package-install package-enable-at-startup) "package" "emacs-lisp/package.el" -;;;;;; (20764 51137 83502 0)) +;;;;;; (20882 3877 904124 0)) ;;; Generated autoloads from emacs-lisp/package.el (defvar package-enable-at-startup t "\ @@ -20323,8 +20273,8 @@ The list is displayed in a buffer named `*Packages*'. ;;;*** -;;;### (autoloads (show-paren-mode) "paren" "paren.el" (20738 27061 -;;;;;; 124069 0)) +;;;### (autoloads (show-paren-mode) "paren" "paren.el" (20903 56815 +;;;;;; 695483 0)) ;;; Generated autoloads from paren.el (defvar show-paren-mode nil "\ @@ -20364,8 +20314,8 @@ unknown are returned as nil. ;;;*** -;;;### (autoloads (pascal-mode) "pascal" "progmodes/pascal.el" (20746 -;;;;;; 21181 635406 0)) +;;;### (autoloads (pascal-mode) "pascal" "progmodes/pascal.el" (20870 +;;;;;; 12718 549931 0)) ;;; Generated autoloads from progmodes/pascal.el (autoload 'pascal-mode "pascal" "\ @@ -20542,7 +20492,7 @@ Completion for the GNU tar utility. ;;;*** ;;;### (autoloads (pcomplete/mount pcomplete/umount pcomplete/kill) -;;;;;; "pcmpl-linux" "pcmpl-linux.el" (20709 26818 907104 0)) +;;;;;; "pcmpl-linux" "pcmpl-linux.el" (20884 7264 912957 506000)) ;;; Generated autoloads from pcmpl-linux.el (autoload 'pcomplete/kill "pcmpl-linux" "\ @@ -20631,6 +20581,26 @@ Includes files as well as host names followed by a colon. ;;;*** +;;;### (autoloads (pcomplete/ack pcomplete/tlmgr) "pcmpl-x" "pcmpl-x.el" +;;;;;; (20837 15398 184639 0)) +;;; Generated autoloads from pcmpl-x.el + +(autoload 'pcomplete/tlmgr "pcmpl-x" "\ +Completion for the `tlmgr' command. + +\(fn)" nil nil) + +(autoload 'pcomplete/ack "pcmpl-x" "\ +Completion for the `ack' command. +Start an argument with '-' to complete short options and '--' for +long options. + +\(fn)" nil nil) + +(defalias 'pcomplete/ack-grep 'pcomplete/ack) + +;;;*** + ;;;### (autoloads (pcomplete-shell-setup pcomplete-comint-setup pcomplete-list ;;;;;; pcomplete-help pcomplete-expand pcomplete-continue pcomplete-expand-and-complete ;;;;;; pcomplete-reverse pcomplete) "pcomplete" "pcomplete.el" (20709 @@ -20778,7 +20748,7 @@ Global menu used by PCL-CVS.") ;;;*** ;;;### (autoloads (perl-mode) "perl-mode" "progmodes/perl-mode.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20873 17019 382960 343000)) ;;; Generated autoloads from progmodes/perl-mode.el (put 'perl-indent-level 'safe-local-variable 'integerp) (put 'perl-continued-statement-offset 'safe-local-variable 'integerp) @@ -20937,7 +20907,7 @@ Major mode for editing PLSTORE files. ;;;*** ;;;### (autoloads (po-find-file-coding-system) "po" "textmodes/po.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20791 9657 561026 0)) ;;; Generated autoloads from textmodes/po.el (autoload 'po-find-file-coding-system "po" "\ @@ -21047,7 +21017,7 @@ Ignores leading comment characters. ;;;;;; pr-ps-buffer-print pr-ps-buffer-using-ghostscript pr-ps-buffer-preview ;;;;;; pr-ps-directory-ps-print pr-ps-directory-print pr-ps-directory-using-ghostscript ;;;;;; pr-ps-directory-preview pr-interface) "printing" "printing.el" -;;;;;; (20721 17977 14204 0)) +;;;;;; (20891 44219 680764 0)) ;;; Generated autoloads from printing.el (autoload 'pr-interface "printing" "\ @@ -21655,7 +21625,7 @@ Proced buffers. ;;;### (autoloads (profiler-find-profile-other-frame profiler-find-profile-other-window ;;;;;; profiler-find-profile profiler-start) "profiler" "profiler.el" -;;;;;; (20752 27211 244736 501000)) +;;;;;; (20824 3367 300658 0)) ;;; Generated autoloads from profiler.el (autoload 'profiler-start "profiler" "\ @@ -21684,7 +21654,7 @@ Open profile FILENAME. ;;;*** ;;;### (autoloads (run-prolog mercury-mode prolog-mode) "prolog" -;;;;;; "progmodes/prolog.el" (20709 26818 907104 0)) +;;;;;; "progmodes/prolog.el" (20891 18859 893295 0)) ;;; Generated autoloads from progmodes/prolog.el (autoload 'prolog-mode "prolog" "\ @@ -21719,8 +21689,8 @@ With prefix argument ARG, restart the Prolog process if running before. ;;;*** -;;;### (autoloads (bdf-directory-list) "ps-bdf" "ps-bdf.el" (20709 -;;;;;; 26818 907104 0)) +;;;### (autoloads (bdf-directory-list) "ps-bdf" "ps-bdf.el" (20799 +;;;;;; 169 640767 0)) ;;; 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")) "\ @@ -21783,8 +21753,8 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number ;;;;;; ps-spool-region ps-spool-buffer-with-faces ps-spool-buffer ;;;;;; ps-print-region-with-faces ps-print-region ps-print-buffer-with-faces ;;;;;; ps-print-buffer ps-print-customize ps-print-color-p ps-paper-type -;;;;;; ps-page-dimensions-database) "ps-print" "ps-print.el" (20721 -;;;;;; 17977 14204 0)) +;;;;;; ps-page-dimensions-database) "ps-print" "ps-print.el" (20874 +;;;;;; 65006 672942 217000)) ;;; Generated autoloads from ps-print.el (defvar ps-page-dimensions-database (purecopy (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4") (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3") (list 'letter (* 72 8.5) (* 72 11.0) "Letter") (list 'legal (* 72 8.5) (* 72 14.0) "Legal") (list 'letter-small (* 72 7.68) (* 72 10.16) "LetterSmall") (list 'tabloid (* 72 11.0) (* 72 17.0) "Tabloid") (list 'ledger (* 72 17.0) (* 72 11.0) "Ledger") (list 'statement (* 72 5.5) (* 72 8.5) "Statement") (list 'executive (* 72 7.5) (* 72 10.0) "Executive") (list 'a4small (* 72 7.47) (* 72 10.85) "A4Small") (list 'b4 (* 72 10.125) (* 72 14.33) "B4") (list 'b5 (* 72 7.16) (* 72 10.125) "B5") '(addresslarge 236.0 99.0 "AddressLarge") '(addresssmall 236.0 68.0 "AddressSmall") '(cuthanging13 90.0 222.0 "CutHanging13") '(cuthanging15 90.0 114.0 "CutHanging15") '(diskette 181.0 136.0 "Diskette") '(eurofilefolder 139.0 112.0 "EuropeanFilefolder") '(eurofoldernarrow 526.0 107.0 "EuroFolderNarrow") '(eurofolderwide 526.0 136.0 "EuroFolderWide") '(euronamebadge 189.0 108.0 "EuroNameBadge") '(euronamebadgelarge 223.0 136.0 "EuroNameBadgeLarge") '(filefolder 230.0 37.0 "FileFolder") '(jewelry 76.0 136.0 "Jewelry") '(mediabadge 180.0 136.0 "MediaBadge") '(multipurpose 126.0 68.0 "MultiPurpose") '(retaillabel 90.0 104.0 "RetailLabel") '(shipping 271.0 136.0 "Shipping") '(slide35mm 26.0 104.0 "Slide35mm") '(spine8mm 187.0 26.0 "Spine8mm") '(topcoated 425.19685 136.0 "TopCoatedPaper") '(topcoatedpaper 396.0 136.0 "TopcoatedPaper150") '(vhsface 205.0 127.0 "VHSFace") '(vhsspine 400.0 50.0 "VHSSpine") '(zipdisk 156.0 136.0 "ZipDisk"))) "\ @@ -21981,7 +21951,7 @@ If EXTENSION is any other symbol, it is ignored. ;;;*** ;;;### (autoloads (python-mode run-python) "python" "progmodes/python.el" -;;;;;; (20774 51843 230245 0)) +;;;;;; (20874 65006 672942 217000)) ;;; Generated autoloads from progmodes/python.el (add-to-list 'auto-mode-alist (cons (purecopy "\\.py\\'") 'python-mode)) @@ -22271,8 +22241,8 @@ of each directory. ;;;### (autoloads (quickurl-list quickurl-list-mode quickurl-edit-urls ;;;;;; quickurl-browse-url-ask quickurl-browse-url quickurl-add-url -;;;;;; quickurl-ask quickurl) "quickurl" "net/quickurl.el" (20764 -;;;;;; 51137 83502 0)) +;;;;;; quickurl-ask quickurl) "quickurl" "net/quickurl.el" (20799 +;;;;;; 169 640767 0)) ;;; 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" "\ @@ -22413,8 +22383,8 @@ matching parts of the target buffer will be highlighted. ;;;*** -;;;### (autoloads (recentf-mode) "recentf" "recentf.el" (20709 26818 -;;;;;; 907104 0)) +;;;### (autoloads (recentf-mode) "recentf" "recentf.el" (20871 33574 +;;;;;; 214287 0)) ;;; Generated autoloads from recentf.el (defvar recentf-mode nil "\ @@ -22578,8 +22548,8 @@ with a prefix argument, prompt for START-AT and FORMAT. ;;;*** -;;;### (autoloads (refill-mode) "refill" "textmodes/refill.el" (20709 -;;;;;; 26818 907104 0)) +;;;### (autoloads (refill-mode) "refill" "textmodes/refill.el" (20884 +;;;;;; 7264 912957 506000)) ;;; Generated autoloads from textmodes/refill.el (autoload 'refill-mode "refill" "\ @@ -22600,8 +22570,8 @@ For true \"word wrap\" behavior, use `visual-line-mode' instead. ;;;*** ;;;### (autoloads (reftex-reset-scanning-information reftex-mode -;;;;;; turn-on-reftex) "reftex" "textmodes/reftex.el" (20777 63161 -;;;;;; 848428 0)) +;;;;;; turn-on-reftex) "reftex" "textmodes/reftex.el" (20895 15912 +;;;;;; 444844 0)) ;;; Generated autoloads from textmodes/reftex.el (autoload 'turn-on-reftex "reftex" "\ @@ -22651,7 +22621,7 @@ This enforces rescanning the buffer on next use. ;;;*** ;;;### (autoloads (reftex-citation) "reftex-cite" "textmodes/reftex-cite.el" -;;;;;; (20734 30007 218637 0)) +;;;;;; (20838 36262 626321 0)) ;;; Generated autoloads from textmodes/reftex-cite.el (autoload 'reftex-citation "reftex-cite" "\ @@ -22731,7 +22701,7 @@ Here are all local bindings. ;;;*** ;;;### (autoloads (reftex-all-document-files) "reftex-parse" "textmodes/reftex-parse.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20895 15912 444844 0)) ;;; Generated autoloads from textmodes/reftex-parse.el (autoload 'reftex-all-document-files "reftex-parse" "\ @@ -22743,8 +22713,8 @@ of master file. ;;;*** -;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (20734 -;;;;;; 30007 218637 0)) +;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (20895 +;;;;;; 15912 444844 0)) ;;; 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)))) @@ -22785,7 +22755,7 @@ This means the number of non-shy regexp grouping constructs ;;;### (autoloads (remember-diary-extract-entries remember-clipboard ;;;;;; remember-other-frame remember) "remember" "textmodes/remember.el" -;;;;;; (20748 62911 684442 0)) +;;;;;; (20874 65006 672942 217000)) ;;; Generated autoloads from textmodes/remember.el (autoload 'remember "remember" "\ @@ -22949,8 +22919,8 @@ Make a ring that can contain SIZE elements. ;;;*** -;;;### (autoloads (rlogin) "rlogin" "net/rlogin.el" (20709 26818 -;;;;;; 907104 0)) +;;;### (autoloads (rlogin) "rlogin" "net/rlogin.el" (20903 10024 +;;;;;; 645978 0)) ;;; Generated autoloads from net/rlogin.el (autoload 'rlogin "rlogin" "\ @@ -22999,7 +22969,7 @@ variable. ;;;;;; rmail-secondary-file-directory rmail-primary-inbox-list rmail-highlighted-headers ;;;;;; rmail-retry-ignored-headers rmail-displayed-headers rmail-ignored-headers ;;;;;; rmail-user-mail-address-regexp rmail-movemail-variant-p rmail-spool-directory -;;;;;; rmail-file-name) "rmail" "mail/rmail.el" (20762 9398 526093 +;;;;;; rmail-file-name) "rmail" "mail/rmail.el" (20892 39729 858825 ;;;;;; 0)) ;;; Generated autoloads from mail/rmail.el @@ -23276,7 +23246,7 @@ Return a pattern. ;;;*** ;;;### (autoloads (rng-nxml-mode-init) "rng-nxml" "nxml/rng-nxml.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20813 33065 721081 0)) ;;; Generated autoloads from nxml/rng-nxml.el (autoload 'rng-nxml-mode-init "rng-nxml" "\ @@ -23289,7 +23259,7 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil. ;;;*** ;;;### (autoloads (rng-validate-mode) "rng-valid" "nxml/rng-valid.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20884 6711 386198 0)) ;;; Generated autoloads from nxml/rng-valid.el (autoload 'rng-validate-mode "rng-valid" "\ @@ -23420,7 +23390,7 @@ Toggle the use of ROT13 encoding for the current window. ;;;*** ;;;### (autoloads (rst-minor-mode rst-mode) "rst" "textmodes/rst.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20884 7264 912957 506000)) ;;; Generated autoloads from textmodes/rst.el (add-to-list 'auto-mode-alist (purecopy '("\\.re?st\\'" . rst-mode))) @@ -23451,7 +23421,7 @@ for modes derived from Text mode, like Mail mode. ;;;*** ;;;### (autoloads (ruby-mode) "ruby-mode" "progmodes/ruby-mode.el" -;;;;;; (20764 51137 83502 0)) +;;;;;; (20905 51752 865679 0)) ;;; Generated autoloads from progmodes/ruby-mode.el (autoload 'ruby-mode "ruby-mode" "\ @@ -23476,8 +23446,8 @@ The variable `ruby-indent-level' controls the amount of indentation. ;;;*** -;;;### (autoloads (ruler-mode) "ruler-mode" "ruler-mode.el" (20709 -;;;;;; 26818 907104 0)) +;;;### (autoloads (ruler-mode) "ruler-mode" "ruler-mode.el" (20791 +;;;;;; 9657 561026 0)) ;;; Generated autoloads from ruler-mode.el (defvar ruler-mode nil "\ @@ -23839,7 +23809,7 @@ histories, which is probably undesirable. ;;;*** ;;;### (autoloads (dsssl-mode scheme-mode) "scheme" "progmodes/scheme.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20805 38951 572072 0)) ;;; Generated autoloads from progmodes/scheme.el (autoload 'scheme-mode "scheme" "\ @@ -23946,7 +23916,7 @@ vertically fixed relative to window boundaries during scrolling. ;;;*** ;;;### (autoloads (semantic-mode semantic-default-submodes) "semantic" -;;;;;; "cedet/semantic.el" (20748 62911 684442 0)) +;;;;;; "cedet/semantic.el" (20813 33065 721081 0)) ;;; Generated autoloads from cedet/semantic.el (defvar semantic-default-submodes '(global-semantic-idle-scheduler-mode global-semanticdb-minor-mode) "\ @@ -24003,7 +23973,7 @@ Semantic mode. ;;;*** ;;;### (autoloads (bovine-grammar-mode) "semantic/bovine/grammar" -;;;;;; "cedet/semantic/bovine/grammar.el" (20709 26818 907104 0)) +;;;;;; "cedet/semantic/bovine/grammar.el" (20895 15912 444844 0)) ;;; Generated autoloads from cedet/semantic/bovine/grammar.el (autoload 'bovine-grammar-mode "semantic/bovine/grammar" "\ @@ -24014,7 +23984,7 @@ Major mode for editing Bovine grammars. ;;;*** ;;;### (autoloads (wisent-grammar-mode) "semantic/wisent/grammar" -;;;;;; "cedet/semantic/wisent/grammar.el" (20709 26818 907104 0)) +;;;;;; "cedet/semantic/wisent/grammar.el" (20879 27694 495748 0)) ;;; Generated autoloads from cedet/semantic/wisent/grammar.el (autoload 'wisent-grammar-mode "semantic/wisent/grammar" "\ @@ -24467,7 +24437,7 @@ To work around that, do: ;;;*** ;;;### (autoloads (sh-mode) "sh-script" "progmodes/sh-script.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20850 27430 515630 0)) ;;; Generated autoloads from progmodes/sh-script.el (put 'sh-shell 'safe-local-variable 'symbolp) @@ -24531,7 +24501,7 @@ with your script for an edit-interpret-debug cycle. ;;;*** ;;;### (autoloads (list-load-path-shadows) "shadow" "emacs-lisp/shadow.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20858 21542 723007 0)) ;;; Generated autoloads from emacs-lisp/shadow.el (autoload 'list-load-path-shadows "shadow" "\ @@ -24549,7 +24519,7 @@ the earlier. For example, suppose `load-path' is set to -\(\"/usr/gnu/emacs/site-lisp\" \"/usr/gnu/emacs/share/emacs/19.30/lisp\") +\(\"/usr/share/emacs/site-lisp\" \"/usr/share/emacs/24.3/lisp\") and that each of these directories contains a file called XXX.el. Then XXX.el in the site-lisp directory is referred to by all of: @@ -24561,9 +24531,9 @@ the second is loaded explicitly via `load-file'). When not intended, such shadowings can be the source of subtle problems. For example, the above situation may have arisen because the XXX package was not distributed with versions of Emacs prior to -19.30. An Emacs maintainer downloaded XXX from elsewhere and installed +24.3. A system administrator downloaded XXX from elsewhere and installed it. Later, XXX was updated and included in the Emacs distribution. -Unless the Emacs maintainer checks for this, the new version of XXX +Unless the system administrator checks for this, the new version of XXX will be hidden behind the old (which may no longer work with the new Emacs version). @@ -24581,8 +24551,8 @@ function, `load-path-shadows-find'. ;;;*** ;;;### (autoloads (shadow-initialize shadow-define-regexp-group shadow-define-literal-group -;;;;;; shadow-define-cluster) "shadowfile" "shadowfile.el" (20709 -;;;;;; 26818 907104 0)) +;;;;;; shadow-define-cluster) "shadowfile" "shadowfile.el" (20799 +;;;;;; 169 640767 0)) ;;; Generated autoloads from shadowfile.el (autoload 'shadow-define-cluster "shadowfile" "\ @@ -24621,7 +24591,7 @@ Set up file shadowing. ;;;*** ;;;### (autoloads (shell shell-dumb-shell-regexp) "shell" "shell.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20884 7264 912957 506000)) ;;; Generated autoloads from shell.el (defvar shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe") "\ @@ -24669,8 +24639,8 @@ Otherwise, one argument `-i' is passed to the shell. ;;;*** -;;;### (autoloads (shr-insert-document) "shr" "gnus/shr.el" (20768 -;;;;;; 48184 78670 0)) +;;;### (autoloads (shr-insert-document) "shr" "gnus/shr.el" (20903 +;;;;;; 10024 645978 0)) ;;; Generated autoloads from gnus/shr.el (autoload 'shr-insert-document "shr" "\ @@ -24683,7 +24653,7 @@ DOM should be a parse tree as generated by ;;;*** ;;;### (autoloads (sieve-upload-and-kill sieve-upload-and-bury sieve-upload -;;;;;; sieve-manage) "sieve" "gnus/sieve.el" (20709 26818 907104 +;;;;;; sieve-manage) "sieve" "gnus/sieve.el" (20896 36774 886399 ;;;;;; 0)) ;;; Generated autoloads from gnus/sieve.el @@ -24915,6 +24885,30 @@ If no conflict maker is found, turn off `smerge-mode'. ;;;*** +;;;### (autoloads (smie-highlight-matching-block-mode) "smie" "emacs-lisp/smie.el" +;;;;;; (20901 54695 989166 0)) +;;; Generated autoloads from emacs-lisp/smie.el + +(defvar smie-highlight-matching-block-mode nil "\ +Non-nil if Smie-Highlight-Matching-Block mode is enabled. +See the command `smie-highlight-matching-block-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 `smie-highlight-matching-block-mode'.") + +(custom-autoload 'smie-highlight-matching-block-mode "smie" nil) + +(autoload 'smie-highlight-matching-block-mode "smie" "\ +Toggle Smie-Highlight-Matching-Block mode on or off. +With a prefix argument ARG, enable Smie-Highlight-Matching-Block mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. +\\{smie-highlight-matching-block-mode-map} + +\(fn &optional ARG)" t nil) + +;;;*** + ;;;### (autoloads (smiley-buffer smiley-region) "smiley" "gnus/smiley.el" ;;;;;; (20726 5184 974741 509000)) ;;; Generated autoloads from gnus/smiley.el @@ -24974,7 +24968,7 @@ Snake mode keybindings: ;;;*** ;;;### (autoloads (snmpv2-mode snmp-mode) "snmp-mode" "net/snmp-mode.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20891 18859 893295 0)) ;;; Generated autoloads from net/snmp-mode.el (autoload 'snmp-mode "snmp-mode" "\ @@ -25097,8 +25091,8 @@ Pick your favorite shortcuts: ;;;### (autoloads (delete-duplicate-lines reverse-region sort-columns ;;;;;; sort-regexp-fields sort-fields sort-numeric-fields sort-pages -;;;;;; sort-paragraphs sort-lines sort-subr) "sort" "sort.el" (20709 -;;;;;; 26818 907104 0)) +;;;;;; sort-paragraphs sort-lines sort-subr) "sort" "sort.el" (20896 +;;;;;; 36774 886399 0)) ;;; Generated autoloads from sort.el (put 'sort-fold-case 'safe-local-variable 'booleanp) @@ -25264,16 +25258,19 @@ delete repeated lines only if they are adjacent. It works like the utility this is more efficient in performance and memory usage than when ADJACENT is nil that uses additional memory to remember previous lines. +If KEEP-BLANKS is non-nil (when called interactively with three C-u prefixes), +duplicate blank lines are preserved. + When called from Lisp and INTERACTIVE is omitted or nil, return the number of deleted duplicate lines, do not print it; if INTERACTIVE is t, the function behaves in all respects as if it had been called interactively. -\(fn BEG END &optional REVERSE ADJACENT INTERACTIVE)" t nil) +\(fn BEG END &optional REVERSE ADJACENT KEEP-BLANKS INTERACTIVE)" t nil) ;;;*** -;;;### (autoloads (spam-initialize) "spam" "gnus/spam.el" (20709 -;;;;;; 26818 907104 0)) +;;;### (autoloads (spam-initialize) "spam" "gnus/spam.el" (20901 +;;;;;; 54695 989166 0)) ;;; Generated autoloads from gnus/spam.el (autoload 'spam-initialize "spam" "\ @@ -25289,7 +25286,7 @@ installed through `spam-necessary-extra-headers'. ;;;### (autoloads (spam-report-deagentize spam-report-agentize spam-report-url-to-file ;;;;;; spam-report-url-ping-mm-url spam-report-process-queue) "spam-report" -;;;;;; "gnus/spam-report.el" (20709 26818 907104 0)) +;;;;;; "gnus/spam-report.el" (20874 65006 672942 217000)) ;;; Generated autoloads from gnus/spam-report.el (autoload 'spam-report-process-queue "spam-report" "\ @@ -25332,7 +25329,7 @@ Spam reports will be queued with the method used when ;;;*** ;;;### (autoloads (speedbar-get-focus speedbar-frame-mode) "speedbar" -;;;;;; "speedbar.el" (20709 26818 907104 0)) +;;;;;; "speedbar.el" (20892 39729 858825 0)) ;;; Generated autoloads from speedbar.el (defalias 'speedbar 'speedbar-frame-mode) @@ -25376,7 +25373,7 @@ Return a vector containing the lines from `spook-phrases-file'. ;;;;;; sql-ms sql-ingres sql-solid sql-mysql sql-sqlite sql-informix ;;;;;; sql-sybase sql-oracle sql-product-interactive sql-connect ;;;;;; sql-mode sql-add-product-keywords) "sql" "progmodes/sql.el" -;;;;;; (20725 15032 264919 0)) +;;;;;; (20878 6823 881439 0)) ;;; Generated autoloads from progmodes/sql.el (autoload 'sql-add-product-keywords "sql" "\ @@ -25839,7 +25836,7 @@ buffer. ;;;*** ;;;### (autoloads (srecode-template-mode) "srecode/srt-mode" "cedet/srecode/srt-mode.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20813 33065 721081 0)) ;;; Generated autoloads from cedet/srecode/srt-mode.el (autoload 'srecode-template-mode "srecode/srt-mode" "\ @@ -25879,8 +25876,8 @@ GnuTLS requires a port number. ;;;;;; strokes-mode strokes-list-strokes strokes-load-user-strokes ;;;;;; strokes-help strokes-describe-stroke strokes-do-complex-stroke ;;;;;; strokes-do-stroke strokes-read-complex-stroke strokes-read-stroke -;;;;;; strokes-global-set-stroke) "strokes" "strokes.el" (20709 -;;;;;; 26818 907104 0)) +;;;;;; strokes-global-set-stroke) "strokes" "strokes.el" (20799 +;;;;;; 169 640767 0)) ;;; Generated autoloads from strokes.el (autoload 'strokes-global-set-stroke "strokes" "\ @@ -26014,8 +26011,9 @@ Studlify-case the current buffer. ;;;*** -;;;### (autoloads (global-subword-mode subword-mode) "subword" "progmodes/subword.el" -;;;;;; (20709 26818 907104 0)) +;;;### (autoloads (global-superword-mode superword-mode global-subword-mode +;;;;;; subword-mode) "subword" "progmodes/subword.el" (20886 47777 +;;;;;; 83668 440000)) ;;; Generated autoloads from progmodes/subword.el (autoload 'subword-mode "subword" "\ @@ -26068,6 +26066,45 @@ See `subword-mode' for more information on Subword mode. \(fn &optional ARG)" t nil) +(autoload 'superword-mode "subword" "\ +Toggle superword movement and editing (Superword mode). +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-map} + +\(fn &optional ARG)" t nil) + +(defvar global-superword-mode nil "\ +Non-nil if Global-Superword mode is enabled. +See the command `global-superword-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 `global-superword-mode'.") + +(custom-autoload 'global-superword-mode "subword" nil) + +(autoload 'global-superword-mode "subword" "\ +Toggle Superword mode in all buffers. +With prefix ARG, enable Global-Superword mode if ARG is positive; +otherwise, disable it. If called from Lisp, enable the mode if +ARG is omitted or nil. + +Superword mode is enabled in all buffers where +`(lambda nil (superword-mode 1))' would do it. +See `superword-mode' for more information on Superword mode. + +\(fn &optional ARG)" t nil) + ;;;*** ;;;### (autoloads (sc-cite-original) "supercite" "mail/supercite.el" @@ -26776,8 +26813,8 @@ Connect to the Emacs talk group from the current X display or tty frame. ;;;*** -;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (20709 26818 -;;;;;; 907104 0)) +;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (20874 65222 +;;;;;; 672942 464000)) ;;; Generated autoloads from tar-mode.el (autoload 'tar-mode "tar-mode" "\ @@ -26801,7 +26838,7 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. ;;;*** ;;;### (autoloads (tcl-help-on-word inferior-tcl tcl-mode) "tcl" -;;;;;; "progmodes/tcl.el" (20774 53405 704746 172000)) +;;;;;; "progmodes/tcl.el" (20903 10024 645978 0)) ;;; Generated autoloads from progmodes/tcl.el (autoload 'tcl-mode "tcl" "\ @@ -26876,7 +26913,7 @@ Normally input is edited in Emacs and sent a line at a time. ;;;*** ;;;### (autoloads (serial-term ansi-term term make-term) "term" "term.el" -;;;;;; (20712 3008 596088 0)) +;;;;;; (20878 6823 881439 0)) ;;; Generated autoloads from term.el (autoload 'make-term "term" "\ @@ -26919,7 +26956,7 @@ use in that buffer. ;;;*** ;;;### (autoloads (testcover-this-defun) "testcover" "emacs-lisp/testcover.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20878 6823 881439 0)) ;;; Generated autoloads from emacs-lisp/testcover.el (autoload 'testcover-this-defun "testcover" "\ @@ -26929,8 +26966,8 @@ Start coverage on function under point. ;;;*** -;;;### (autoloads (tetris) "tetris" "play/tetris.el" (20709 26818 -;;;;;; 907104 0)) +;;;### (autoloads (tetris) "tetris" "play/tetris.el" (20874 65006 +;;;;;; 672942 217000)) ;;; Generated autoloads from play/tetris.el (autoload 'tetris "tetris" "\ @@ -27418,7 +27455,7 @@ Compose Thai characters in the current buffer. ;;;### (autoloads (list-at-point number-at-point symbol-at-point ;;;;;; sexp-at-point thing-at-point bounds-of-thing-at-point forward-thing) -;;;;;; "thingatpt" "thingatpt.el" (20752 26669 524456 0)) +;;;;;; "thingatpt" "thingatpt.el" (20874 62962 290468 0)) ;;; Generated autoloads from thingatpt.el (autoload 'forward-thing "thingatpt" "\ @@ -27452,10 +27489,13 @@ Possibilities include `symbol', `list', `sexp', `defun', `filename', `url', `email', `word', `sentence', `whitespace', `line', `number', and `page'. +When the optional argument NO-PROPERTIES is non-nil, +strip text properties from the return value. + See the file `thingatpt.el' for documentation on how to define a symbol as a valid THING. -\(fn THING)" nil nil) +\(fn THING &optional NO-PROPERTIES)" nil nil) (autoload 'sexp-at-point "thingatpt" "\ Return the sexp at point, or nil if none is found. @@ -27519,8 +27559,8 @@ In dired, call the setroot program on the image at point. ;;;;;; tibetan-post-read-conversion tibetan-compose-buffer tibetan-decompose-buffer ;;;;;; tibetan-decompose-string tibetan-decompose-region tibetan-compose-region ;;;;;; tibetan-compose-string tibetan-transcription-to-tibetan tibetan-tibetan-to-transcription -;;;;;; tibetan-char-p) "tibet-util" "language/tibet-util.el" (20709 -;;;;;; 26818 907104 0)) +;;;;;; tibetan-char-p) "tibet-util" "language/tibet-util.el" (20826 +;;;;;; 45095 436233 0)) ;;; Generated autoloads from language/tibet-util.el (autoload 'tibetan-char-p "tibet-util" "\ @@ -27594,7 +27634,7 @@ See also docstring of the function tibetan-compose-region. ;;;*** ;;;### (autoloads (tildify-buffer tildify-region) "tildify" "textmodes/tildify.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20791 9657 561026 0)) ;;; Generated autoloads from textmodes/tildify.el (autoload 'tildify-region "tildify" "\ @@ -27841,7 +27881,7 @@ With ARG, turn time stamping on if and only if arg is positive. ;;;;;; timeclock-workday-remaining-string timeclock-reread-log timeclock-query-out ;;;;;; timeclock-change timeclock-status-string timeclock-out timeclock-in ;;;;;; timeclock-mode-line-display) "timeclock" "calendar/timeclock.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20799 169 640767 0)) ;;; Generated autoloads from calendar/timeclock.el (autoload 'timeclock-mode-line-display "timeclock" "\ @@ -28004,7 +28044,7 @@ Its value should be an event that has a binding in MENU. ;;;### (autoloads (todo-show todo-cp todo-mode todo-print todo-top-priorities ;;;;;; todo-insert-item todo-add-item-non-interactively todo-add-category) -;;;;;; "todo-mode" "calendar/todo-mode.el" (20709 26818 907104 0)) +;;;;;; "todo-mode" "calendar/todo-mode.el" (20799 169 640767 0)) ;;; Generated autoloads from calendar/todo-mode.el (autoload 'todo-add-category "todo-mode" "\ @@ -28135,7 +28175,7 @@ holds a keymap. ;;;*** ;;;### (autoloads (tpu-edt-on tpu-edt-mode) "tpu-edt" "emulation/tpu-edt.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20884 7264 412929 442000)) ;;; Generated autoloads from emulation/tpu-edt.el (defvar tpu-edt-mode nil "\ @@ -28214,8 +28254,8 @@ to a tcp server on another machine. ;;;*** ;;;### (autoloads (trace-function-background trace-function-foreground -;;;;;; trace-buffer) "trace" "emacs-lisp/trace.el" (20727 56759 -;;;;;; 628211 0)) +;;;;;; trace-values trace-buffer) "trace" "emacs-lisp/trace.el" +;;;;;; (20903 10024 645978 0)) ;;; Generated autoloads from emacs-lisp/trace.el (defvar trace-buffer "*trace-output*" "\ @@ -28223,6 +28263,12 @@ Trace output will by default go to that buffer.") (custom-autoload 'trace-buffer "trace" t) +(autoload 'trace-values "trace" "\ +Helper function to get internal values. +You can call this function to add internal values in the trace buffer. + +\(fn &rest VALUES)" nil nil) + (autoload 'trace-function-foreground "trace" "\ Traces FUNCTION with trace output going to BUFFER. For every call of FUNCTION Lisp-style trace messages that display argument @@ -28250,7 +28296,7 @@ changing the window configuration. ;;;### (autoloads (tramp-unload-tramp tramp-completion-handle-file-name-completion ;;;;;; tramp-completion-handle-file-name-all-completions tramp-unload-file-name-handlers ;;;;;; tramp-file-name-handler tramp-syntax tramp-mode) "tramp" -;;;;;; "net/tramp.el" (20784 36406 653593 0)) +;;;;;; "net/tramp.el" (20854 24486 190633 0)) ;;; Generated autoloads from net/tramp.el (defvar tramp-mode t "\ @@ -28479,7 +28525,7 @@ First column's text sSs Second column's text ;;;### (autoloads (type-break-guesstimate-keystroke-threshold type-break-statistics ;;;;;; type-break type-break-mode) "type-break" "type-break.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20884 7264 912957 506000)) ;;; Generated autoloads from type-break.el (defvar type-break-mode nil "\ @@ -28717,7 +28763,7 @@ which specify the range to operate on. ;;;*** ;;;### (autoloads (unrmail batch-unrmail) "unrmail" "mail/unrmail.el" -;;;;;; (20731 53823 676680 0)) +;;;;;; (20895 15912 444844 0)) ;;; Generated autoloads from mail/unrmail.el (autoload 'batch-unrmail "unrmail" "\ @@ -28751,7 +28797,7 @@ UNSAFEP-VARS is a list of symbols with local bindings. ;;;*** ;;;### (autoloads (url-retrieve-synchronously url-retrieve) "url" -;;;;;; "url/url.el" (20709 26818 907104 0)) +;;;;;; "url/url.el" (20893 60586 188550 0)) ;;; Generated autoloads from url/url.el (autoload 'url-retrieve "url" "\ @@ -28874,7 +28920,7 @@ Extract FNAM from the local disk cache. ;;;*** ;;;### (autoloads (url-dav-vc-registered url-dav-request url-dav-supported-p) -;;;;;; "url-dav" "url/url-dav.el" (20709 26818 907104 0)) +;;;;;; "url-dav" "url/url-dav.el" (20891 18859 893295 0)) ;;; Generated autoloads from url/url-dav.el (autoload 'url-dav-supported-p "url-dav" "\ @@ -28940,7 +28986,7 @@ Might do a non-blocking connection; use `process-status' to check. ;;;### (autoloads (url-insert-file-contents url-file-local-copy url-copy-file ;;;;;; url-file-handler url-handler-mode) "url-handlers" "url/url-handlers.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20892 39729 858825 0)) ;;; Generated autoloads from url/url-handlers.el (defvar url-handler-mode nil "\ @@ -29082,7 +29128,7 @@ Fetch a data URL (RFC 2397). ;;;*** ;;;### (autoloads (url-snews url-news) "url-news" "url/url-news.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20884 7264 912957 506000)) ;;; Generated autoloads from url/url-news.el (autoload 'url-news "url-news" "\ @@ -29453,8 +29499,8 @@ The buffer in question is current when this function is called. ;;;*** -;;;### (autoloads (utf7-encode) "utf7" "gnus/utf7.el" (20709 26818 -;;;;;; 907104 0)) +;;;### (autoloads (utf7-encode) "utf7" "gnus/utf7.el" (20791 9657 +;;;;;; 561026 0)) ;;; Generated autoloads from gnus/utf7.el (autoload 'utf7-encode "utf7" "\ @@ -29496,8 +29542,8 @@ If FILE-NAME is non-nil, save the result to FILE-NAME. ;;;;;; vc-print-log vc-retrieve-tag vc-create-tag vc-merge vc-insert-headers ;;;;;; vc-revision-other-window vc-root-diff vc-ediff vc-version-ediff ;;;;;; vc-diff vc-version-diff vc-register vc-next-action vc-before-checkin-hook -;;;;;; vc-checkin-hook vc-checkout-hook) "vc" "vc/vc.el" (20752 -;;;;;; 26669 524456 0)) +;;;;;; vc-checkin-hook vc-checkout-hook) "vc" "vc/vc.el" (20855 +;;;;;; 45357 683214 0)) ;;; Generated autoloads from vc/vc.el (defvar vc-checkout-hook nil "\ @@ -29816,7 +29862,7 @@ mode-specific menu. `vc-annotate-color-map' and ;;;*** -;;;### (autoloads nil "vc-arch" "vc/vc-arch.el" (20748 62911 684442 +;;;### (autoloads nil "vc-arch" "vc/vc-arch.el" (20900 33838 319219 ;;;;;; 0)) ;;; Generated autoloads from vc/vc-arch.el (defun vc-arch-registered (file) @@ -29827,7 +29873,7 @@ mode-specific menu. `vc-annotate-color-map' and ;;;*** -;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (20748 62911 684442 +;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (20900 33838 319219 ;;;;;; 0)) ;;; Generated autoloads from vc/vc-bzr.el @@ -29844,7 +29890,7 @@ Name of the format file in a .bzr directory.") ;;;*** -;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (20748 62911 684442 +;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (20900 33838 319219 ;;;;;; 0)) ;;; Generated autoloads from vc/vc-cvs.el (defun vc-cvs-registered (f) @@ -29856,49 +29902,10 @@ Name of the format file in a .bzr directory.") ;;;*** -;;;### (autoloads (vc-dir vc-dir-mode) "vc-dir" "vc/vc-dir.el" (20709 -;;;;;; 26818 907104 0)) +;;;### (autoloads (vc-dir) "vc-dir" "vc/vc-dir.el" (20900 33838 319219 +;;;;;; 0)) ;;; Generated autoloads from vc/vc-dir.el -(autoload 'vc-dir-mode "vc-dir" "\ -Major mode for VC directory buffers. -Marking/Unmarking key bindings and actions: -m - mark a file/directory - - if the region is active, mark all the files in region. - Restrictions: - a file cannot be marked if any parent directory is marked - - a directory cannot be marked if any child file or - directory is marked -u - unmark a file/directory - - if the region is active, unmark all the files in region. -M - if the cursor is on a file: mark all the files with the same state as - the current file - - if the cursor is on a directory: mark all child files - - with a prefix argument: mark all files -U - if the cursor is on a file: unmark all the files with the same state - as the current file - - if the cursor is on a directory: unmark all child files - - with a prefix argument: unmark all files -mouse-2 - toggles the mark state - -VC commands -VC commands in the `C-x v' prefix can be used. -VC commands act on the marked entries. If nothing is marked, VC -commands act on the current entry. - -Search & Replace -S - searches the marked files -Q - does a query replace on the marked files -M-s a C-s - does an isearch on the marked files -M-s a C-M-s - does a regexp isearch on the marked files -If nothing is marked, these commands act on the current entry. -When a directory is current or marked, the Search & Replace -commands act on the child files of that directory that are displayed in -the *vc-dir* buffer. - -\\{vc-dir-mode-map} - -\(fn)" t nil) - (autoload 'vc-dir "vc-dir" "\ Show the VC status for \"interesting\" files in and below DIR. This allows you to mark files and perform VC operations on them. @@ -29921,7 +29928,7 @@ These are the commands available for use in the file status buffer: ;;;*** ;;;### (autoloads (vc-do-command) "vc-dispatcher" "vc/vc-dispatcher.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20851 48294 960738 0)) ;;; Generated autoloads from vc/vc-dispatcher.el (autoload 'vc-do-command "vc-dispatcher" "\ @@ -29944,7 +29951,7 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-git" "vc/vc-git.el" (20748 62911 684442 +;;;### (autoloads nil "vc-git" "vc/vc-git.el" (20900 33838 319219 ;;;;;; 0)) ;;; Generated autoloads from vc/vc-git.el (defun vc-git-registered (file) @@ -29956,7 +29963,7 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (20748 62911 684442 0)) +;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (20900 33838 319219 0)) ;;; Generated autoloads from vc/vc-hg.el (defun vc-hg-registered (file) "Return non-nil if FILE is registered with hg." @@ -29967,7 +29974,7 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (20748 62911 684442 +;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (20900 33838 319219 ;;;;;; 0)) ;;; Generated autoloads from vc/vc-mtn.el @@ -29985,7 +29992,7 @@ Name of the monotone directory's format file.") ;;;*** ;;;### (autoloads (vc-rcs-master-templates) "vc-rcs" "vc/vc-rcs.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20900 33838 319219 0)) ;;; Generated autoloads from vc/vc-rcs.el (defvar vc-rcs-master-templates (purecopy '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")) "\ @@ -29999,7 +30006,7 @@ For a description of possible values, see `vc-check-master-templates'.") ;;;*** ;;;### (autoloads (vc-sccs-master-templates) "vc-sccs" "vc/vc-sccs.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20900 33838 319219 0)) ;;; Generated autoloads from vc/vc-sccs.el (defvar vc-sccs-master-templates (purecopy '("%sSCCS/s.%s" "%ss.%s" vc-sccs-search-project-dir)) "\ @@ -30017,7 +30024,7 @@ find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir) ;;;*** -;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (20760 54070 584283 +;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (20900 33838 319219 ;;;;;; 0)) ;;; Generated autoloads from vc/vc-svn.el (defun vc-svn-registered (f) @@ -30032,7 +30039,7 @@ find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir) ;;;*** ;;;### (autoloads (vera-mode) "vera-mode" "progmodes/vera-mode.el" -;;;;;; (20777 63161 848428 0)) +;;;;;; (20893 60586 188550 0)) ;;; Generated autoloads from progmodes/vera-mode.el (add-to-list 'auto-mode-alist (cons (purecopy "\\.vr[hi]?\\'") 'vera-mode)) @@ -30090,7 +30097,7 @@ Key bindings: ;;;*** ;;;### (autoloads (verilog-mode) "verilog-mode" "progmodes/verilog-mode.el" -;;;;;; (20763 30266 231060 0)) +;;;;;; (20885 2819 449152 0)) ;;; Generated autoloads from progmodes/verilog-mode.el (autoload 'verilog-mode "verilog-mode" "\ @@ -30229,7 +30236,7 @@ Key bindings specific to `verilog-mode-map' are: ;;;*** ;;;### (autoloads (vhdl-mode) "vhdl-mode" "progmodes/vhdl-mode.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20892 39729 858825 0)) ;;; Generated autoloads from progmodes/vhdl-mode.el (autoload 'vhdl-mode "vhdl-mode" "\ @@ -30599,7 +30606,7 @@ Usage: option `vhdl-index-menu' to non-nil) or made accessible as a mouse menu (e.g. add \"(global-set-key '[S-down-mouse-3] 'imenu)\" to your start-up file) for browsing the file contents (is not populated if buffer is - larger than `font-lock-maximum-size'). Also, a source file menu can be + larger than 256000). Also, a source file menu can be added (set option `vhdl-source-file-menu' to non-nil) for browsing the current directory for VHDL source files. @@ -30726,7 +30733,7 @@ Usage: automatically recognized as VHDL source files. To add an extension \".xxx\", add the following line to your Emacs start-up file (`.emacs'): - (setq auto-mode-alist (cons '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist)) + (push '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist) HINTS: @@ -30839,7 +30846,7 @@ Syntax table and abbrevs while in vi mode remain as they were in Emacs. ;;;### (autoloads (viqr-pre-write-conversion viqr-post-read-conversion ;;;;;; viet-encode-viqr-buffer viet-encode-viqr-region viet-decode-viqr-buffer ;;;;;; viet-decode-viqr-region viet-encode-viscii-char) "viet-util" -;;;;;; "language/viet-util.el" (20709 26818 907104 0)) +;;;;;; "language/viet-util.el" (20826 45095 436233 0)) ;;; Generated autoloads from language/viet-util.el (autoload 'viet-encode-viscii-char "viet-util" "\ @@ -31117,7 +31124,7 @@ entry for the selected window, purge that entry from \(fn BUFFER &optional ITEM)" nil nil) -(make-obsolete 'view-return-to-alist-update '"this function has no effect." "24.1") +(make-obsolete 'view-return-to-alist-update '"this function has no effect." '"24.1") (autoload 'view-mode-enter "view" "\ Enter View mode and set up exit from view mode depending on optional arguments. @@ -31143,8 +31150,8 @@ Exit View mode and make the current buffer editable. ;;;*** -;;;### (autoloads (vip-mode vip-setup) "vip" "emulation/vip.el" (20762 -;;;;;; 9398 526093 0)) +;;;### (autoloads (vip-mode vip-setup) "vip" "emulation/vip.el" (20799 +;;;;;; 169 640767 0)) ;;; Generated autoloads from emulation/vip.el (autoload 'vip-setup "vip" "\ @@ -31160,7 +31167,7 @@ Turn on VIP emulation of VI. ;;;*** ;;;### (autoloads (viper-mode toggle-viper-mode) "viper" "emulation/viper.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20799 169 640767 0)) ;;; Generated autoloads from emulation/viper.el (autoload 'toggle-viper-mode "viper" "\ @@ -31267,7 +31274,7 @@ this is equivalent to `display-warning', using ;;;*** ;;;### (autoloads (wdired-change-to-wdired-mode) "wdired" "wdired.el" -;;;;;; (20709 26818 907104 0)) +;;;;;; (20900 33838 319219 0)) ;;; Generated autoloads from wdired.el (autoload 'wdired-change-to-wdired-mode "wdired" "\ @@ -31302,7 +31309,7 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke ;;;*** ;;;### (autoloads (which-function-mode) "which-func" "progmodes/which-func.el" -;;;;;; (20725 15032 264919 0)) +;;;;;; (20895 15912 444844 0)) ;;; Generated autoloads from progmodes/which-func.el (put 'which-func-format 'risky-local-variable t) (put 'which-func-current 'risky-local-variable t) @@ -31335,8 +31342,8 @@ in certain major modes. ;;;### (autoloads (whitespace-report-region whitespace-report whitespace-cleanup-region ;;;;;; whitespace-cleanup global-whitespace-toggle-options whitespace-toggle-options ;;;;;; global-whitespace-newline-mode global-whitespace-mode whitespace-newline-mode -;;;;;; whitespace-mode) "whitespace" "whitespace.el" (20721 17977 -;;;;;; 14204 0)) +;;;;;; whitespace-mode) "whitespace" "whitespace.el" (20874 65007 +;;;;;; 172950 7000)) ;;; Generated autoloads from whitespace.el (autoload 'whitespace-mode "whitespace" "\ @@ -31862,8 +31869,8 @@ Default MODIFIER is 'shift. ;;;*** -;;;### (autoloads (winner-mode) "winner" "winner.el" (20709 26818 -;;;;;; 907104 0)) +;;;### (autoloads (winner-mode) "winner" "winner.el" (20849 6570 +;;;;;; 598687 0)) ;;; Generated autoloads from winner.el (defvar winner-mode nil "\ @@ -32049,26 +32056,6 @@ The key bindings are: ;;;*** -;;;### (autoloads (xesam-search) "xesam" "net/xesam.el" (20709 26818 -;;;;;; 907104 0)) -;;; Generated autoloads from net/xesam.el - -(autoload 'xesam-search "xesam" "\ -Perform an interactive search. -ENGINE is the Xesam search engine to be applied, it must be one of the -entries of `xesam-search-engines'. QUERY is the search string in the -Xesam user query language. If the search engine does not support -the Xesam user query language, a Xesam fulltext search is applied. - -The default search engine is the first entry in `xesam-search-engines'. -Example: - - (xesam-search (car (xesam-search-engines)) \"emacs\") - -\(fn ENGINE QUERY)" t nil) - -;;;*** - ;;;### (autoloads (xml-parse-region xml-parse-file) "xml" "xml.el" ;;;;;; (20766 6456 368550 0)) ;;; Generated autoloads from xml.el @@ -32127,7 +32114,7 @@ Both features can be combined by providing a cons cell ;;;*** ;;;### (autoloads (xmltok-get-declared-encoding-position) "xmltok" -;;;;;; "nxml/xmltok.el" (20709 26818 907104 0)) +;;;;;; "nxml/xmltok.el" (20884 6711 386198 0)) ;;; Generated autoloads from nxml/xmltok.el (autoload 'xmltok-get-declared-encoding-position "xmltok" "\ @@ -32145,8 +32132,8 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT. ;;;*** -;;;### (autoloads (xterm-mouse-mode) "xt-mouse" "xt-mouse.el" (20709 -;;;;;; 26818 907104 0)) +;;;### (autoloads (xterm-mouse-mode) "xt-mouse" "xt-mouse.el" (20797 +;;;;;; 44848 327754 0)) ;;; Generated autoloads from xt-mouse.el (defvar xterm-mouse-mode nil "\ @@ -32284,18 +32271,18 @@ Zone out, completely. ;;;;;; "emacs-lisp/eieio-base.el" "emacs-lisp/eieio-datadebug.el" ;;;;;; "emacs-lisp/eieio-speedbar.el" "emacs-lisp/eieio.el" "emacs-lisp/find-gc.el" ;;;;;; "emacs-lisp/gulp.el" "emacs-lisp/lisp-mnt.el" "emacs-lisp/package-x.el" -;;;;;; "emacs-lisp/regi.el" "emacs-lisp/smie.el" "emacs-lisp/tcover-ses.el" -;;;;;; "emacs-lisp/tcover-unsafep.el" "emulation/cua-gmrk.el" "emulation/cua-rect.el" -;;;;;; "emulation/edt-lk201.el" "emulation/edt-mapper.el" "emulation/edt-pc.el" -;;;;;; "emulation/edt-vt100.el" "emulation/tpu-extras.el" "emulation/viper-cmd.el" -;;;;;; "emulation/viper-ex.el" "emulation/viper-init.el" "emulation/viper-keym.el" -;;;;;; "emulation/viper-macs.el" "emulation/viper-mous.el" "emulation/viper-util.el" -;;;;;; "erc/erc-backend.el" "erc/erc-goodies.el" "erc/erc-ibuffer.el" -;;;;;; "erc/erc-lang.el" "eshell/em-alias.el" "eshell/em-banner.el" -;;;;;; "eshell/em-basic.el" "eshell/em-cmpl.el" "eshell/em-dirs.el" -;;;;;; "eshell/em-glob.el" "eshell/em-hist.el" "eshell/em-ls.el" -;;;;;; "eshell/em-pred.el" "eshell/em-prompt.el" "eshell/em-rebind.el" -;;;;;; "eshell/em-script.el" "eshell/em-smart.el" "eshell/em-term.el" +;;;;;; "emacs-lisp/regi.el" "emacs-lisp/tcover-ses.el" "emacs-lisp/tcover-unsafep.el" +;;;;;; "emulation/cua-gmrk.el" "emulation/cua-rect.el" "emulation/edt-lk201.el" +;;;;;; "emulation/edt-mapper.el" "emulation/edt-pc.el" "emulation/edt-vt100.el" +;;;;;; "emulation/tpu-extras.el" "emulation/viper-cmd.el" "emulation/viper-ex.el" +;;;;;; "emulation/viper-init.el" "emulation/viper-keym.el" "emulation/viper-macs.el" +;;;;;; "emulation/viper-mous.el" "emulation/viper-util.el" "erc/erc-backend.el" +;;;;;; "erc/erc-goodies.el" "erc/erc-ibuffer.el" "erc/erc-lang.el" +;;;;;; "eshell/em-alias.el" "eshell/em-banner.el" "eshell/em-basic.el" +;;;;;; "eshell/em-cmpl.el" "eshell/em-dirs.el" "eshell/em-glob.el" +;;;;;; "eshell/em-hist.el" "eshell/em-ls.el" "eshell/em-pred.el" +;;;;;; "eshell/em-prompt.el" "eshell/em-rebind.el" "eshell/em-script.el" +;;;;;; "eshell/em-smart.el" "eshell/em-term.el" "eshell/em-tramp.el" ;;;;;; "eshell/em-unix.el" "eshell/em-xtra.el" "eshell/esh-arg.el" ;;;;;; "eshell/esh-cmd.el" "eshell/esh-ext.el" "eshell/esh-groups.el" ;;;;;; "eshell/esh-io.el" "eshell/esh-module.el" "eshell/esh-opt.el" @@ -32411,8 +32398,8 @@ Zone out, completely. ;;;;;; "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") (20784 36426 559404 -;;;;;; 170000)) +;;;;;; "w32-fns.el" "w32-vars.el" "x-dnd.el") (20905 51795 339257 +;;;;;; 114000)) ;;;*** diff --git a/lisp/loadup.el b/lisp/loadup.el index 00c52341058..5764cdec7eb 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -290,9 +290,12 @@ (equal (nth 4 command-line-args) "dump")) (not (eq system-type 'ms-dos))) (let* ((base (concat "emacs-" emacs-version ".")) + (exelen (if (eq system-type 'windows-nt) -4)) (files (file-name-all-completions base default-directory)) - (versions (mapcar (function (lambda (name) - (string-to-number (substring name (length base))))) + (versions (mapcar (function + (lambda (name) + (string-to-number + (substring name (length base) exelen)))) files))) (setq emacs-bzr-version (condition-case nil (emacs-bzr-get-version) (error nil))) @@ -305,22 +308,10 @@ (message "Finding pointers to doc strings...") (if (or (equal (nth 3 command-line-args) "dump") (equal (nth 4 command-line-args) "dump")) - (let ((name emacs-version)) - (while (string-match "[^-+_.a-zA-Z0-9]+" name) - (setq name (concat (downcase (substring name 0 (match-beginning 0))) - "-" - (substring name (match-end 0))))) - (if (memq system-type '(ms-dos windows-nt)) - (setq name (expand-file-name - (if (fboundp 'x-create-frame) "DOC-X" "DOC") "../etc")) - (setq name (concat (expand-file-name "../etc/DOC-") name)) - (if (file-exists-p name) - (delete-file name)) - (copy-file (expand-file-name "../etc/DOC") name t)) - (Snarf-documentation (file-name-nondirectory name))) - (condition-case nil - (Snarf-documentation "DOC") - (error nil))) + (Snarf-documentation "DOC") + (condition-case nil + (Snarf-documentation "DOC") + (error nil))) (message "Finding pointers to doc strings...done") ;; Note: You can cause additional libraries to be preloaded @@ -388,18 +379,25 @@ (dump-emacs "emacs" "temacs") (message "%d pure bytes used" pure-bytes-used) ;; Recompute NAME now, so that it isn't set when we dump. - (if (not (or (memq system-type '(ms-dos windows-nt)) + (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"))) - (let ((name (concat "emacs-" emacs-version))) + (let ((name (concat "emacs-" emacs-version)) + (exe (if (eq system-type 'windows-nt) ".exe" ""))) (while (string-match "[^-+_.a-zA-Z0-9]+" name) (setq name (concat (downcase (substring name 0 (match-beginning 0))) "-" (substring name (match-end 0))))) + (setq name (concat name exe)) (message "Adding name %s" name) - (add-name-to-file "emacs" name t))) + ;; When this runs on Windows, invocation-directory is not + ;; necessarily the current directory. + (add-name-to-file (expand-file-name (concat "emacs" exe) + invocation-directory) + (expand-file-name name invocation-directory) + t))) (kill-emacs))) ;; For machines with CANNOT_DUMP defined in config.h, diff --git a/lisp/lpr.el b/lisp/lpr.el index 88567abd246..0b860ed07f1 100644 --- a/lisp/lpr.el +++ b/lisp/lpr.el @@ -125,7 +125,9 @@ argument." "List of strings of options to request page headings in the printer program. If nil, we run `lpr-page-header-program' to make page headings and print the result." - :type '(repeat (string :tag "Argument")) + :type '(choice (const nil) + (string :tag "Single argument") + (repeat :tag "Multiple arguments" (string :tag "Argument"))) :group 'lpr) (defcustom print-region-function nil diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 70ee4394b88..82a78545d62 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -404,6 +404,13 @@ not contain `d', so that a full listing is expected." ;; the wildcard; let's say something similar. (insert "(No match)\n")) (insert (format "total %.0f\n" (fceiling (/ sum 1024.0)))))) + ;; dired-insert-directory expects to find point after the + ;; text. But if the listing is empty, as e.g. in empty + ;; directories with -a removed from switches, point will be + ;; before the inserted text, and dired-insert-directory will + ;; not indent the listing correctly. Going to the end of the + ;; buffer fixes that. + (unless files (goto-char (point-max))) (if (memq ?R switches) ;; List the contents of all directories recursively. ;; cadr of each element of `file-alist' is t for diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index 0502e7f9487..091b1a03025 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -370,9 +370,6 @@ (require 'mail-utils) ; pick up mail-strip-quoted-names -(eval-when-compile - (require 'smtpmail)) - (autoload 'mail-do-fcc "sendmail") (defgroup feedmail nil @@ -1619,6 +1616,10 @@ local gurus." ;; These mean "report errors by mail" and "deliver in background". (if (null mail-interactive) '("-oem" "-odb"))))) +(declare-function smtpmail-via-smtp "smtpmail" + (recipient smtpmail-text-buffer &optional ask-for-password)) +(defvar smtpmail-smtp-server) + ;; provided by jam@austin.asc.slb.com (James A. McLaughlin); ;; simplified by WJC after more feedmail development; ;; idea (but not implementation) of copying smtpmail trace buffer to diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el index 4b58016ebc6..0129d270db1 100644 --- a/lisp/mail/mail-utils.el +++ b/lisp/mail/mail-utils.el @@ -183,17 +183,15 @@ as Rmail does." (error "Malformed MIME quoted-printable message")))) (not failed)))))) -(eval-when-compile (require 'rfc822)) +(autoload 'rfc822-addresses "rfc822") (defun mail-strip-quoted-names (address) "Delete comments and quoted strings in an address list ADDRESS. Also delete leading/trailing whitespace and replace FOO <BAR> with just BAR. Return a modified address list." - (if (null address) - nil + (when address (if mail-use-rfc822 - (progn (require 'rfc822) - (mapconcat 'identity (rfc822-addresses address) ", ")) + (mapconcat 'identity (rfc822-addresses address) ", ") (let (pos) ;; Strip comments. diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el index 3308e6416e3..981be8b6a98 100644 --- a/lisp/mail/mailabbrev.el +++ b/lisp/mail/mailabbrev.el @@ -182,7 +182,8 @@ no aliases, which is represented by this being a table with no entries.)") (nth 5 (file-attributes mail-personal-alias-file))) (build-mail-abbrevs))) (mail-abbrevs-sync-aliases) - (add-hook 'abbrev-expand-functions 'mail-abbrev-expand-wrapper nil t) + (add-function :around (local 'abbrev-expand-function) + #'mail-abbrev-expand-wrapper) (abbrev-mode 1)) (defun mail-abbrevs-enable () diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 02703026e84..e29becedb6e 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4105,6 +4105,9 @@ The message should be narrowed to just the headers." (autoload 'mail-position-on-field "sendmail") +(declare-function rmail-mime-message-p "rmailmm" ()) +(declare-function rmail-mime-toggle-raw "rmailmm" (&optional state)) + (defun rmail-retry-failure () "Edit a mail message which is based on the contents of the current message. For a message rejected by the mail system, extract the interesting headers and @@ -4117,7 +4120,13 @@ The variable `rmail-retry-ignored-headers' is a regular expression specifying headers which should not be copied into the new message." (interactive) (require 'mail-utils) - (if rmail-enable-mime + ;; FIXME This does not handle rmail-mime-feature != 'rmailmm. + ;; There is no API defined for rmail-mime-feature to provide + ;; rmail-mime-message-p, rmail-mime-toggle-raw equivalents. + ;; But does anyone actually use rmail-mime-feature != 'rmailmm? + (if (and rmail-enable-mime + (eq rmail-mime-feature 'rmailmm) + (featurep rmail-mime-feature)) (with-current-buffer rmail-buffer (if (rmail-mime-message-p) (let ((rmail-mime-mbox-buffer rmail-view-buffer) @@ -4301,8 +4310,6 @@ This has an effect only if a summary buffer exists." (restore-buffer-modified-p nil))))))) ;;; Speedbar support for RMAIL files. -(eval-when-compile (require 'speedbar)) - (defcustom rmail-speedbar-match-folder-regexp "^[A-Z0-9]+\\(\\.[A-Z0-9]+\\)?$" "Regexp matching Rmail folder names to be displayed in Speedbar. Enabling this permits Speedbar to display your folders for easy @@ -4317,12 +4324,12 @@ browsing, and moving of messages." (defvar rmail-speedbar-key-map nil "Keymap used when in rmail display mode.") +(declare-function speedbar-make-specialized-keymap "speedbar" ()) + (defun rmail-install-speedbar-variables () "Install those variables used by speedbar to enhance rmail." - (if rmail-speedbar-key-map - nil + (unless rmail-speedbar-key-map (setq rmail-speedbar-key-map (speedbar-make-specialized-keymap)) - (define-key rmail-speedbar-key-map "e" 'speedbar-edit-line) (define-key rmail-speedbar-key-map "r" 'speedbar-edit-line) (define-key rmail-speedbar-key-map "\C-m" 'speedbar-edit-line) @@ -4337,6 +4344,9 @@ browsing, and moving of messages." (looking-at "<M> "))]) "Additional menu-items to add to speedbar frame.") +(declare-function speedbar-insert-button "speedbar" + (text face mouse function &optional token prevline)) + ;; Make sure our special speedbar major mode is loaded (if (featurep 'speedbar) (rmail-install-speedbar-variables) @@ -4378,19 +4388,27 @@ current message into that RMAIL folder." (speedbar-insert-button file 'speedbar-file-face 'highlight 'rmail-speedbar-find-file nil t))))))) +(eval-when-compile (require 'dframe)) +;; Part of the macro expansion of dframe-with-attached-buffer. +;; At runtime, will be pulled in as a require of speedbar. +(declare-function dframe-select-attached-frame "dframe" (&optional frame)) +(declare-function dframe-maybee-jump-to-attached-frame "dframe" ()) + (defun rmail-speedbar-button (text token indent) "Execute an rmail command specified by TEXT. The command used is TOKEN. INDENT is not used." - (speedbar-with-attached-buffer + (dframe-with-attached-buffer (funcall token t))) (defun rmail-speedbar-find-file (text token indent) "Load in the rmail file TEXT. TOKEN and INDENT are not used." - (speedbar-with-attached-buffer + (dframe-with-attached-buffer (message "Loading in RMAIL file %s..." text) (rmail text))) +(declare-function speedbar-do-function-pointer "speedbar" ()) + (defun rmail-speedbar-move-message-to-folder-on-line () "If the current line is a folder, move current message to it." (interactive) @@ -4404,7 +4422,7 @@ TOKEN and INDENT are not used." (defun rmail-speedbar-move-message (text token indent) "From button TEXT, copy current message to the rmail file specified by TOKEN. TEXT and INDENT are not used." - (speedbar-with-attached-buffer + (dframe-with-attached-buffer (message "Moving message to %s" token) ;; expand-file-name is needed due to the unhelpful way in which ;; rmail-output expands non-absolute filenames against rmail-default-file. @@ -4752,7 +4770,7 @@ If prefix argument REVERSE is non-nil, sorts in reverse order. ;;;### (autoloads (rmail-summary-by-senders rmail-summary-by-topic ;;;;;; rmail-summary-by-regexp rmail-summary-by-recipients rmail-summary-by-labels -;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "119ce8b431f01e7f54bb6fa99603b3d9") +;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "61e7ad0931be1e07034dd57825ff326a") ;;; Generated autoloads from rmailsum.el (autoload 'rmail-summary "rmailsum" "\ diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index 13cd7c3f05e..8dd4120d179 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -394,12 +394,16 @@ SENDERS is a string of regexps separated by commas." (defvar rmail-new-summary-line-count) -(defun rmail-new-summary (desc redo func &rest args) +(defun rmail-new-summary (desc redo function &rest args) "Create a summary of selected messages. -DESC makes part of the mode line of the summary buffer. REDO is form ... -For each message, FUNC is applied to the message number and ARGS... -and if the result is non-nil, that message is included. -nil for FUNCTION means all messages." +DESC makes part of the mode line of the summary buffer. +REDO is what to put in `rmail-summary-redo'; usually +its car is the function that called `rmail-new-summary' +and its cdr is the arguments passed to that function. + +For each message, applies FUNCTION to the message number and ARGS..., +and if the result is non-nil, it includes that message in the summary. +If FUNCTION is nil, includes all messages." (message "Computing summary lines...") (unless rmail-buffer (error "No RMAIL buffer found")) @@ -407,7 +411,7 @@ nil for FUNCTION means all messages." (if (eq major-mode 'rmail-summary-mode) (setq was-in-summary t)) (with-current-buffer rmail-buffer - (setq rmail-summary-buffer (rmail-new-summary-1 desc redo func args) + (setq rmail-summary-buffer (rmail-new-summary-1 desc redo function args) ;; r-s-b is buffer-local. sumbuf rmail-summary-buffer mesg rmail-current-message)) @@ -435,14 +439,14 @@ nil for FUNCTION means all messages." (rmail-summary-construct-io-menu) (message "Computing summary lines...done"))) -(defun rmail-new-summary-1 (description form function args) +(defun rmail-new-summary-1 (description redo function args) "Filter messages to obtain summary lines. DESCRIPTION is added to the mode line. Return the summary buffer by invoking FUNCTION on each message -passing the message number and ARGS... +passing the message number and ARGS. -REDO is a form ... +REDO is what to put in `rmail-summary-redo'. The current buffer must be a Rmail buffer either containing a collection of mbox formatted messages or displaying a single @@ -490,8 +494,7 @@ message." ;; we "don't have" a summary. (setq rmail-summary-buffer nil) ;; I have not a clue what this clause is doing. If you read this - ;; chunk of code and have a clue, then please email that clue to - ;; pmr@pajato.com + ;; chunk of code and have a clue, then please write it here. (if rmail-enable-mime (with-current-buffer rmail-buffer (setq rmail-summary-buffer nil))) @@ -512,7 +515,7 @@ message." (make-local-variable 'minor-mode-alist) (setq minor-mode-alist (list (list t (concat ": " description)))) (setq rmail-buffer rbuf - rmail-summary-redo form + rmail-summary-redo redo rmail-total-messages total))) sumbuf)) @@ -1122,57 +1125,59 @@ Search, the `unseen' attribute is restored.") (forward-line -1)) (beginning-of-line) (skip-chars-forward " ") - (let ((msg-num (string-to-number (buffer-substring - (point) - (progn (skip-chars-forward "0-9") - (point)))))) - ;; Always leave `unseen' removed - ;; if we get out of isearch mode. - ;; Don't let a subsequent isearch restore that `unseen'. - (if (not isearch-mode) - (setq rmail-summary-put-back-unseen nil)) - - (or (eq rmail-current-message msg-num) - (let ((window (get-buffer-window rmail-buffer t)) - (owin (selected-window))) - (if isearch-mode - (progn - ;; If we first saw the previous message in this search, - ;; and we have gone to a different message while searching, - ;; put back `unseen' on the former one. - (when rmail-summary-put-back-unseen - (rmail-set-attribute rmail-unseen-attr-index t - rmail-current-message) - (save-excursion - (goto-char rmail-summary-put-back-unseen) - (rmail-summary-mark-seen rmail-current-message t t))) - ;; Arrange to do that later, for the new current message, - ;; if it still has `unseen'. - (setq rmail-summary-put-back-unseen - (if (rmail-message-unseen-p msg-num) - (point)))) - (setq rmail-summary-put-back-unseen nil)) - ;; Go to the desired message. - (setq rmail-current-message msg-num) - ;; Update the summary to show the message has been seen. - (rmail-summary-mark-seen msg-num t) - (if window - ;; Using save-window-excursion would cause the new value - ;; of point to get lost. - (unwind-protect - (progn - (select-window window) - (rmail-show-message msg-num t)) - (select-window owin)) - (if (buffer-name rmail-buffer) - (with-current-buffer rmail-buffer - (rmail-show-message msg-num t)))) - ;; In linum mode, the message buffer must be specially - ;; updated (Bug#4878). - (and (fboundp 'linum-update) - (buffer-name rmail-buffer) - (linum-update rmail-buffer)))) - (rmail-summary-update-highlight nil))))) + ;; If the summary is empty, don't do anything. + (unless (eobp) + (let ((msg-num (string-to-number (buffer-substring + (point) + (progn (skip-chars-forward "0-9") + (point)))))) + ;; Always leave `unseen' removed + ;; if we get out of isearch mode. + ;; Don't let a subsequent isearch restore that `unseen'. + (if (not isearch-mode) + (setq rmail-summary-put-back-unseen nil)) + + (or (eq rmail-current-message msg-num) + (let ((window (get-buffer-window rmail-buffer t)) + (owin (selected-window))) + (if isearch-mode + (progn + ;; If we first saw the previous message in this search, + ;; and we have gone to a different message while searching, + ;; put back `unseen' on the former one. + (when rmail-summary-put-back-unseen + (rmail-set-attribute rmail-unseen-attr-index t + rmail-current-message) + (save-excursion + (goto-char rmail-summary-put-back-unseen) + (rmail-summary-mark-seen rmail-current-message t t))) + ;; Arrange to do that later, for the new current message, + ;; if it still has `unseen'. + (setq rmail-summary-put-back-unseen + (if (rmail-message-unseen-p msg-num) + (point)))) + (setq rmail-summary-put-back-unseen nil)) + ;; Go to the desired message. + (setq rmail-current-message msg-num) + ;; Update the summary to show the message has been seen. + (rmail-summary-mark-seen msg-num t) + (if window + ;; Using save-window-excursion would cause the new value + ;; of point to get lost. + (unwind-protect + (progn + (select-window window) + (rmail-show-message msg-num t)) + (select-window owin)) + (if (buffer-name rmail-buffer) + (with-current-buffer rmail-buffer + (rmail-show-message msg-num t)))) + ;; In linum mode, the message buffer must be specially + ;; updated (Bug#4878). + (and (fboundp 'linum-update) + (buffer-name rmail-buffer) + (linum-update rmail-buffer)))) + (rmail-summary-update-highlight nil)))))) (defun rmail-summary-save-buffer () "Save the buffer associated with this RMAIL summary." @@ -1208,6 +1213,10 @@ Returns non-nil if message N was found." (buffer-substring (point) (min (point-max) (+ 6 (point)))))) (total (with-current-buffer buf rmail-total-messages))) + ;; CURMSG should be nil when there's no current summary message + ;; (for instance, if the summary is empty). + (if (= curmsg 0) + (setq curmsg nil)) ;; If message number N was specified, find that message's line ;; or set message-not-found. ;; If N wasn't specified or that message can't be found. @@ -1228,17 +1237,20 @@ Returns non-nil if message N was found." (setq n curmsg) (setq message-not-found t) (goto-char cur)))) - (rmail-summary-mark-seen n) - (rmail-summary-update-highlight message-not-found) - (beginning-of-line) - (unless skip-rmail - (let ((selwin (selected-window))) - (unwind-protect - (progn (rmail-pop-to-buffer buf) - (rmail-show-message n)) - (select-window selwin) - ;; The actions above can alter the current buffer. Preserve it. - (set-buffer obuf)))) + ;; N can be nil now, along with CURMSG, + ;; if the summary is empty. + (when n + (rmail-summary-mark-seen n) + (rmail-summary-update-highlight message-not-found) + (beginning-of-line) + (unless skip-rmail + (let ((selwin (selected-window))) + (unwind-protect + (progn (rmail-pop-to-buffer buf) + (rmail-show-message n)) + (select-window selwin) + ;; The actions above can alter the current buffer. Preserve it. + (set-buffer obuf))))) (not message-not-found))) ;; Update the highlighted line in an rmail summary buffer. diff --git a/lisp/mail/unrmail.el b/lisp/mail/unrmail.el index 698e9b0e0a0..ac28e23e924 100644 --- a/lisp/mail/unrmail.el +++ b/lisp/mail/unrmail.el @@ -94,11 +94,9 @@ The variable `unrmail-mbox-format' controls which mbox format to use." ;; earlier versions did that with the current buffer's encoding. ;; So we want to favor detection of emacs-mule (whose normal ;; priority is quite low), but still allow detection of other - ;; encodings if emacs-mule won't fit. The call to - ;; detect-coding-with-priority below achieves that. - (car (detect-coding-with-priority - from to - '((coding-category-emacs-mule . emacs-mule)))))) + ;; encodings if emacs-mule won't fit. + (car (with-coding-priority '(emacs-mule) + (detect-coding-region from to))))) (unless (memq coding-system '(undecided undecided-unix)) (set-buffer-modified-p t) ; avoid locking when decoding diff --git a/lisp/man.el b/lisp/man.el index 04abc3d4d88..34131f43692 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -752,7 +752,7 @@ POS defaults to `point'." (setq word (concat word (match-string-no-properties 1))) ;; Make sure the section number gets included by the code below. (goto-char (match-end 1))) - (when (string-match "[._]+$" word) + (when (string-match "[-._]+$" word) (setq word (substring word 0 (match-beginning 0)))) ;; The following was commented out since the preceding code ;; should not produce a leading "*" in the first place. diff --git a/lisp/master.el b/lisp/master.el index 368bb0d58d5..4a536ca5cda 100644 --- a/lisp/master.el +++ b/lisp/master.el @@ -53,10 +53,11 @@ ;;; Code: -(defgroup master nil - "Support for master/slave relationships between buffers." - :version "22.1" - :group 'convenience) +;; Unused. +;;; (defgroup master nil +;;; "Support for master/slave relationships between buffers." +;;; :version "22.1" +;;; :group 'convenience) ;; Variables that don't need initialization. @@ -84,7 +85,8 @@ using the following commands: The slave buffer is stored in the buffer-local variable `master-of'. You can set this variable using `master-set-slave'. You can show yourself the value of `master-of' by calling `master-show-slave'." - :group 'master + ;; Not global, so no effect. +;;; :group 'master :keymap '(("\C-c\C-n" . master-says-scroll-up) ("\C-c\C-p" . master-says-scroll-down) diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog index 6894a185ddc..3db1780af63 100644 --- a/lisp/mh-e/ChangeLog +++ b/lisp/mh-e/ChangeLog @@ -1,3 +1,21 @@ +2013-05-22 Glenn Morris <rgm@gnu.org> + + * mh-speed.el (mh-speed-view): + Use dframe-with-attached-buffer rather than speedbar- alias. + +2013-05-21 Glenn Morris <rgm@gnu.org> + + * mh-comp.el (mh-regexp-in-field-p): Fix previous change. + +2013-05-09 Glenn Morris <rgm@gnu.org> + + * mh-e.el (mh-sortm-args, mh-default-folder-for-message-function): + Fix custom types. + +2013-05-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * mh-comp.el (mh-regexp-in-field-p): Minor simplification. + 2013-03-02 Bill Wohler <wohler@newt.com> Release MH-E version 8.5. diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index 1f07a7983b1..782537aee2d 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el @@ -1,7 +1,6 @@ ;;; mh-comp.el --- MH-E functions for composing and sending messages -;; Copyright (C) 1993, 1995, 1997, 2000-2013 Free Software Foundation, -;; Inc. +;; Copyright (C) 1993, 1995, 1997, 2000-2013 Free Software Foundation, Inc. ;; Author: Bill Wohler <wohler@newt.com> ;; Maintainer: Bill Wohler <wohler@newt.com> @@ -1204,18 +1203,18 @@ discarded." (save-excursion (let ((search-result nil)) (while fields - (let ((field (car fields)) - (syntax-table mh-regexp-in-field-syntax-table)) - (if (null syntax-table) - (let ((case-fold-search t)) - (cond - ((string-match field "^To$\\|^[BD]?cc$\\|^From$") - (setq syntax-table mh-addr-syntax-table)) - ((string-match field "^Fcc$") - (setq syntax-table mh-fcc-syntax-table)) - (t - (setq syntax-table (syntax-table))) - ))) + (let* ((field (car fields)) + (syntax-table + (or mh-regexp-in-field-syntax-table + (let ((case-fold-search t)) + (cond + ((string-match field "^To$\\|^[BD]?cc$\\|^From$") + mh-addr-syntax-table) + ((string-match field "^Fcc$") + mh-fcc-syntax-table) + (t + (syntax-table))) + )))) (if (and (mh-goto-header-field field) (set-syntax-table syntax-table) (re-search-forward diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 6ed033b8fa8..303d817dede 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -1354,7 +1354,7 @@ This option is consulted when a prefix argument is used with specified in the MH profile. This option may be used to provide an alternate view. For example, \"'(\"-nolimit\" \"-textfield\" \"subject\")\" is a useful setting." - :type 'string + :type '(repeat string) :group 'mh-folder :package-version '(MH-E . "8.0")) @@ -1368,7 +1368,7 @@ being refiled and point is at the start of the message. This function should return the default folder as a string with a leading \"+\" sign. It can also return nil so that the last folder name is used as the default, or an empty string to suppress the default entirely." - :type 'function + :type '(choice (const nil) function) :group 'mh-folder-selection :package-version '(MH-E . "8.0")) diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el index eb36ffed64b..bae019f8926 100644 --- a/lisp/mh-e/mh-speed.el +++ b/lisp/mh-e/mh-speed.el @@ -175,7 +175,7 @@ The optional arguments from speedbar are IGNORED." (mh-read-range "Scan" folder t nil nil mh-interpret-number-as-range-flag)))) (when (stringp folder) - (speedbar-with-attached-buffer + (dframe-with-attached-buffer (mh-visit-folder folder range) (delete-other-windows))))) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index ec237f0f664..8bcf3afae05 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -525,7 +525,7 @@ for use at QPOS." (eq t (compare-strings s1 nil nil s2 nil nil 'ignore-case))) (defun completion--twq-all (string ustring completions boundary - unquote requote) + _unquote requote) (when completions (pcase-let* ((prefix @@ -638,7 +638,8 @@ If ARGS are provided, then pass MESSAGE through `format'." (defun minibuffer-completion-contents () "Return the user input in a minibuffer before point as a string. -That is what completion commands operate on." +In Emacs-22, that was what completion commands operated on." + (declare (obsolete nil "24.4")) (buffer-substring (field-beginning) (point))) (defun delete-minibuffer-contents () @@ -1043,7 +1044,8 @@ scroll the window of possible completions." (cond ;; If there's a fresh completion window with a live buffer, ;; and this command is repeated, scroll that window. - ((window-live-p minibuffer-scroll-window) + ((and (window-live-p minibuffer-scroll-window) + (eq t (frame-visible-p (window-frame minibuffer-scroll-window)))) (let ((window minibuffer-scroll-window)) (with-current-buffer (window-buffer window) (if (pos-visible-in-window-p (point-max) window) @@ -1140,6 +1142,7 @@ scroll the window of possible completions." "Complete the minibuffer to an exact match. Repeated uses step through the possible completions." (interactive) + (setq minibuffer-scroll-window nil) ;; FIXME: Need to deal with the extra-size issue here as well. ;; FIXME: ~/src/emacs/t<M-TAB>/lisp/minibuffer.el completes to ;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el. @@ -1162,6 +1165,7 @@ Repeated uses step through the possible completions." (completion--done (buffer-substring-no-properties start (point)) 'sole) ;; Set cycling after modifying the buffer since the flush hook resets it. (setq completion-cycling t) + (setq this-command 'completion-at-point) ;For minibuffer-complete. ;; If completing file names, (car all) may be a directory, so we'd now ;; have a new set of possible completions and might want to reset ;; completion-all-sorted-completions to nil, but we prefer not to, @@ -1760,14 +1764,15 @@ variables.") (exit-minibuffer)) (defvar completion-in-region-functions nil - "Wrapper hook around `completion-in-region'. -The functions on this special hook are called with 5 arguments: - NEXT-FUN START END COLLECTION PREDICATE. -NEXT-FUN is a function of four arguments (START END COLLECTION PREDICATE) -that performs the default operation. The other four arguments are like -the ones passed to `completion-in-region'. The functions on this hook -are expected to perform completion on START..END using COLLECTION -and PREDICATE, either by calling NEXT-FUN or by doing it themselves.") + "Wrapper hook around `completion-in-region'.") +(make-obsolete-variable 'completion-in-region-functions + 'completion-in-region-function "24.4") + +(defvar completion-in-region-function #'completion--in-region + "Function to perform the job of `completion-in-region'. +The function is called with 4 arguments: START END COLLECTION PREDICATE. +The arguments and expected return value are like the ones of +`completion-in-region'.") (defvar completion-in-region--data nil) @@ -1789,6 +1794,17 @@ Point needs to be somewhere between START and END. PREDICATE (a function called with no arguments) says when to exit." (cl-assert (<= start (point)) (<= (point) end)) + (funcall completion-in-region-function start end collection predicate)) + +(defcustom read-file-name-completion-ignore-case + (if (memq system-type '(ms-dos windows-nt darwin cygwin)) + t nil) + "Non-nil means when reading a file name completion ignores case." + :group 'minibuffer + :type 'boolean + :version "22.1") + +(defun completion--in-region (start end collection &optional predicate) (with-wrapper-hook ;; FIXME: Maybe we should use this hook to provide a "display ;; completions" operation as well. @@ -1848,6 +1864,7 @@ With a prefix argument ARG, enable the modemode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil." :global t + :group 'minibuffer (setq completion-in-region--data nil) ;; (remove-hook 'pre-command-hook #'completion-in-region--prech) (remove-hook 'post-command-hook #'completion-in-region--postch) @@ -2259,14 +2276,6 @@ except that it passes the file name through `substitute-in-file-name'.") "The function called by `read-file-name' to do its work. It should accept the same arguments as `read-file-name'.") -(defcustom read-file-name-completion-ignore-case - (if (memq system-type '(ms-dos windows-nt darwin cygwin)) - t nil) - "Non-nil means when reading a file name completion ignores case." - :group 'minibuffer - :type 'boolean - :version "22.1") - (defcustom insert-default-directory t "Non-nil means when reading a filename start with default dir in minibuffer. @@ -2997,12 +3006,21 @@ the same set of elements." ;; here any more. (unless unique (push elem res) - (when (memq elem '(star point prefix)) - ;; Extract common suffix additionally to common prefix. - ;; Only do it for `point', `star', and `prefix' since for - ;; `any' it could lead to a merged completion that - ;; doesn't itself match the candidates. - (let ((suffix (completion--common-suffix comps))) + ;; Extract common suffix additionally to common prefix. + ;; Don't do it for `any' since it could lead to a merged + ;; completion that doesn't itself match the candidates. + (when (and (memq elem '(star point prefix)) + ;; If prefix is one of the completions, there's no + ;; suffix left to find. + (not (assoc-string prefix comps t))) + (let ((suffix + (completion--common-suffix + (if (zerop (length prefix)) comps + ;; Ignore the chars in the common prefix, so we + ;; don't merge '("abc" "abbc") as "ab*bc". + (let ((skip (length prefix))) + (mapcar (lambda (str) (substring str skip)) + comps)))))) (cl-assert (stringp suffix)) (unless (equal suffix "") (push suffix res))))) diff --git a/lisp/mouse.el b/lisp/mouse.el index 51601bca8df..0367cad87b8 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -128,7 +128,11 @@ Expects to be bound to `down-mouse-1' in `key-translation-map'." (put newup 'event-kind (get (car event) 'event-kind)) (put newdown 'event-kind (get (car this-event) 'event-kind)) (push (cons newup (cdr event)) unread-command-events) - (vector (cons newdown (cdr this-event)))) + ;; Modify the event in place, so read-key-sequence doesn't + ;; generate a second fake prefix key (see fake_prefixed_keys in + ;; src/keyboard.c). + (setcar this-event newdown) + (vector this-event)) (push event unread-command-events) nil)))))) @@ -759,6 +763,9 @@ at the same position." mouse-1-click-in-non-selected-windows (eq (selected-window) (posn-window pos))) (or (mouse-posn-property pos 'follow-link) + (let ((area (posn-area pos))) + (when area + (key-binding (vector area 'follow-link) nil t pos))) (key-binding [follow-link] nil t pos))))) (cond ((eq action 'mouse-face) diff --git a/lisp/mpc.el b/lisp/mpc.el index a6494575a43..ad7381bb4b7 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -192,7 +192,7 @@ numerically rather than lexicographically." ;; to the fact that MPD tends to disconnect fairly often, although our ;; constant polling often prevents disconnection. (defvar mpc--find-memoize (make-hash-table :test 'equal)) ;; :weakness t -(defvar mpc-tag nil) (make-variable-buffer-local 'mpc-tag) +(defvar-local mpc-tag nil) ;;; Support for the actual connection and MPD command execution ;;;;;;;;;;;; @@ -279,7 +279,9 @@ defaults to 6600 and HOST defaults to localhost." (erase-buffer) (let* ((coding-system-for-read 'utf-8-unix) (coding-system-for-write 'utf-8-unix) - (proc (open-network-stream "MPC" (current-buffer) host port))) + (proc (condition-case err + (open-network-stream "MPC" (current-buffer) host port) + (error (user-error (error-message-string err)))))) (when (processp mpc-proc) ;; Inherit the properties of the previous connection. (let ((plist (process-plist mpc-proc))) @@ -318,10 +320,11 @@ defaults to 6600 and HOST defaults to localhost." (if tmp (push (nreverse tmp) alists)) (nreverse alists))) -(defun mpc-proc () +(defun mpc-proc (&optional restart) (unless (and mpc-proc (buffer-live-p (process-buffer mpc-proc)) - (not (memq (process-status mpc-proc) '(closed)))) + (not (and restart + (memq (process-status mpc-proc) '(closed))))) (mpc--proc-connect mpc-host)) mpc-proc) @@ -354,7 +357,7 @@ otherwise return immediately and call CALLBACK with no argument when the command terminates. CMD can be a string which is passed as-is to MPD or a list of strings which will be concatenated with proper quoting before passing them to MPD." - (let ((proc (mpc-proc))) + (let ((proc (mpc-proc 'restart))) (if (and callback (not (process-get proc 'ready))) (let ((old (process-get proc 'callback))) (process-put proc 'callback @@ -489,10 +492,10 @@ to call FUN for any change whatsoever.") (cancel-timer mpc--status-timer) (setq mpc--status-timer nil))) (defun mpc--status-timer-run () - (when (process-get (mpc-proc) 'ready) (condition-case err - (with-local-quit (mpc-status-refresh)) - (error (message "MPC: %s" err))))) + (when (process-get (mpc-proc) 'ready) + (with-local-quit (mpc-status-refresh))) + (error (message "MPC: %s" err)))) (defvar mpc--status-idle-timer nil) (defun mpc--status-idle-timer-start () @@ -1079,7 +1082,11 @@ If PLAYLIST is t or nil or missing, use the main playlist." (define-key map [C-mouse-2] 'mpc-select-toggle) (define-key map [drag-mouse-2] 'mpc-drag-n-drop) ;; We use `always' because a binding to t is like a binding to nil. - (define-key map [follow-link] 'always) + (define-key map [follow-link] :always) + ;; But follow-link doesn't apply blindly to header-line and + ;; mode-line clicks. + (define-key map [header-line follow-link] 'ignore) + (define-key map [mode-line follow-link] 'ignore) ;; Doesn't work because the first click changes the buffer, so the second ;; is applied elsewhere :-( ;; (define-key map [(double mouse-2)] 'mpc-play-at-point) @@ -1136,17 +1143,18 @@ If PLAYLIST is t or nil or missing, use the main playlist." "Major mode for the features common to all buffers of MPC." (buffer-disable-undo) (setq buffer-read-only t) - (set (make-local-variable 'tool-bar-map) mpc-tool-bar-map) - (set (make-local-variable 'truncate-lines) t)) + (setq-local tool-bar-map mpc-tool-bar-map) + (setq-local truncate-lines t)) ;;; The mpc-status-mode buffer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-derived-mode mpc-status-mode mpc-mode "MPC-Status" "Major mode to display MPC status info." - (set (make-local-variable 'mode-line-format) - '("%e" mode-line-frame-identification mode-line-buffer-identification)) - (set (make-local-variable 'window-area-factor) 3) - (set (make-local-variable 'header-line-format) '("MPC " mpc-volume))) + (setq-local mode-line-format + '("%e" mode-line-frame-identification + mode-line-buffer-identification)) + (setq-local window-area-factor 3) + (setq-local header-line-format '("MPC " mpc-volume))) (defvar mpc-status-buffer-format '("%-5{Time} / %{Duration} %2{Disc--}%4{Track}" "%{Title}" "%{Album}" "%{Artist}" "%128{Cover}")) @@ -1170,14 +1178,15 @@ If PLAYLIST is t or nil or missing, use the main playlist." (defun mpc-status-buffer-show () (interactive) - (let* ((buf (mpc-proc-buffer (mpc-proc) 'status)) - (songs-buf (mpc-proc-buffer (mpc-proc) 'songs)) + (let* ((proc (mpc-proc)) + (buf (mpc-proc-buffer proc 'status)) + (songs-buf (mpc-proc-buffer proc 'songs)) (songs-win (if songs-buf (get-buffer-window songs-buf 0)))) (unless (buffer-live-p buf) (setq buf (get-buffer-create "*MPC-Status*")) (with-current-buffer buf (mpc-status-mode)) - (mpc-proc-buffer (mpc-proc) 'status buf)) + (mpc-proc-buffer proc 'status buf)) (if (null songs-win) (pop-to-buffer buf) (let ((_win (split-window songs-win 20 t))) (set-window-dedicated-p songs-win nil) @@ -1188,8 +1197,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (defvar mpc-separator-ol nil) -(defvar mpc-select nil) -(make-variable-buffer-local 'mpc-select) +(defvar-local mpc-select nil) (defmacro mpc-select-save (&rest body) "Execute BODY and restore the selection afterwards." @@ -1420,20 +1428,18 @@ when constructing the set of constraints." ;;; The TagBrowser mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst mpc-tagbrowser-all-name (propertize "*ALL*" 'face 'italic)) -(defvar mpc-tagbrowser-all-ol nil) -(make-variable-buffer-local 'mpc-tagbrowser-all-ol) -(defvar mpc-tag-name nil) (make-variable-buffer-local 'mpc-tag-name) +(defvar-local mpc-tagbrowser-all-ol nil) +(defvar-local mpc-tag-name nil) (defun mpc-tagbrowser-all-p () (and (eq (point-min) (line-beginning-position)) (equal mpc-tagbrowser-all-name (buffer-substring (point-min) (line-end-position))))) (define-derived-mode mpc-tagbrowser-mode mpc-mode '("MPC-" mpc-tag-name) - (set (make-local-variable 'mode-line-process) '("" mpc-tag-name)) - (set (make-local-variable 'mode-line-format) nil) - (set (make-local-variable 'header-line-format) '("" mpc-tag-name ;; "s" - )) - (set (make-local-variable 'buffer-undo-list) t) + (setq-local mode-line-process '("" mpc-tag-name)) + (setq-local mode-line-format nil) + (setq-local header-line-format '("" mpc-tag-name)) ;; "s" + (setq-local buffer-undo-list t) ) (defun mpc-tagbrowser-refresh () @@ -1539,14 +1545,14 @@ when constructing the set of constraints." (let ((ol (make-overlay (point) (line-beginning-position 2)))) (overlay-put ol 'face 'region) (overlay-put ol 'evaporate t) - (set (make-local-variable 'mpc-tagbrowser-all-ol) ol)))))) + (setq-local mpc-tagbrowser-all-ol ol)))))) ;; (defvar mpc-constraints nil) (defun mpc-separator (active) ;; Place a separator mark. (unless mpc-separator-ol - (set (make-local-variable 'mpc-separator-ol) - (make-overlay (point) (point))) + (setq-local mpc-separator-ol + (make-overlay (point) (point))) (overlay-put mpc-separator-ol 'after-string (propertize "\n" 'face '(:height 0.05 :inverse-video t)))) @@ -1605,7 +1611,7 @@ Return non-nil if a selection was deactivated." (let ((constraints (mpc-constraints-get-current (current-buffer))) (active 'all)) ;; (unless (equal constraints mpc-constraints) - ;; (set (make-local-variable 'mpc-constraints) constraints) + ;; (setq-local mpc-constraints constraints) (dolist (cst constraints) (let ((vals (apply 'mpc-union (mapcar (lambda (val) @@ -1672,7 +1678,7 @@ Return non-nil if a selection was deactivated." ;; '(mpc-tagbrowser-dir-hide-prefix)) (define-derived-mode mpc-tagbrowser-dir-mode mpc-tagbrowser-mode '("MPC-" mpc-tag-name) - ;; (set (make-local-variable 'font-lock-defaults) + ;; (setq-local font-lock-defaults ;; '(mpc-tagbrowser-dir-keywords t)) ) @@ -1688,13 +1694,14 @@ Return non-nil if a selection was deactivated." (mpc-event-set-point event) (let ((name (buffer-substring (line-beginning-position) (line-end-position))) - (prop (intern mpc-tag))) - (if (not (member name (process-get (mpc-proc) prop))) - (process-put (mpc-proc) prop - (cons name (process-get (mpc-proc) prop))) - (let ((new (delete name (process-get (mpc-proc) prop)))) + (prop (intern mpc-tag)) + (proc (mpc-proc))) + (if (not (member name (process-get proc prop))) + (process-put proc prop + (cons name (process-get proc prop))) + (let ((new (delete name (process-get proc prop)))) (setq name (concat name "/")) - (process-put (mpc-proc) prop + (process-put proc prop (delq nil (mapcar (lambda (x) (if (string-prefix-p name x) @@ -1705,10 +1712,9 @@ Return non-nil if a selection was deactivated." ;;; Playlist management ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar mpc-songs-playlist nil +(defvar-local mpc-songs-playlist nil "Name of the currently selected playlist, if any. A value of t means the main playlist.") -(make-variable-buffer-local 'mpc-songs-playlist) (defun mpc-playlist-create (name) "Save current playlist under name NAME." @@ -1775,12 +1781,14 @@ A value of t means the main playlist.") (defvar mpc-volume-map (let ((map (make-sparse-keymap))) - (define-key map [down-mouse-1] 'mpc-volume-mouse-set) - (define-key map [mouse-1] 'ignore) - (define-key map [header-line down-mouse-1] 'mpc-volume-mouse-set) - (define-key map [header-line mouse-1] 'ignore) - (define-key map [mode-line down-mouse-1] 'mpc-volume-mouse-set) - (define-key map [mode-line mouse-1] 'ignore) + ;; Bind the up-events rather than the down-event, so the + ;; `message' isn't canceled by the subsequent up-event binding. + (define-key map [down-mouse-1] 'ignore) + (define-key map [mouse-1] 'mpc-volume-mouse-set) + (define-key map [header-line mouse-1] 'mpc-volume-mouse-set) + (define-key map [header-line down-mouse-1] 'ignore) + (define-key map [mode-line mouse-1] 'mpc-volume-mouse-set) + (define-key map [mode-line down-mouse-1] 'ignore) map)) (defvar mpc-volume nil) (put 'mpc-volume 'risky-local-variable t) @@ -1945,9 +1953,9 @@ This is used so that they can be compared with `eq', which is needed for (search-backward (cdr curline) nil t)) (beginning-of-line) (goto-char (point-min))) - (set (make-local-variable 'mpc-songs-totaltime) - (unless (zerop totaltime) - (list " " (mpc-secs-to-time totaltime)))) + (setq-local mpc-songs-totaltime + (unless (zerop totaltime) + (list " " (mpc-secs-to-time totaltime)))) )))) (let ((mpc-songpointer-set-visible t)) (mpc-songpointer-refresh))) @@ -2056,46 +2064,47 @@ This is used so that they can be compared with `eq', which is needed for (define-derived-mode mpc-songs-mode mpc-mode "MPC-song" (setq mpc-songs-format-description (with-temp-buffer (mpc-format mpc-songs-format 'self) (buffer-string))) - (set (make-local-variable 'header-line-format) - ;; '("MPC " mpc-volume " " mpc-current-song) - (list (propertize " " 'display '(space :align-to 0)) - ;; 'mpc-songs-format-description - '(:eval - (let ((hscroll (window-hscroll))) - (with-temp-buffer - (mpc-format mpc-songs-format 'self hscroll) - ;; That would be simpler than the hscroll handling in - ;; mpc-format, but currently move-to-column does not - ;; recognize :space display properties. - ;; (move-to-column hscroll) - ;; (delete-region (point-min) (point)) - (buffer-string)))))) - (set (make-local-variable 'mode-line-format) - '("%e" mode-line-frame-identification mode-line-buffer-identification - #(" " 0 3 - (help-echo "mouse-1: Select (drag to resize)\nmouse-2: Make current window occupy the whole frame\nmouse-3: Remove current window from display")) - mode-line-position - #(" " 0 2 - (help-echo "mouse-1: Select (drag to resize)\nmouse-2: Make current window occupy the whole frame\nmouse-3: Remove current window from display")) - mpc-songs-totaltime - mpc-current-updating - #(" " 0 2 - (help-echo "mouse-1: Select (drag to resize)\nmouse-2: Make current window occupy the whole frame\nmouse-3: Remove current window from display")) - (mpc--song-search - (:propertize - ("Search=\"" mpc--song-search "\"") - help-echo "mouse-2: kill this search" - follow-link t - mouse-face mode-line-highlight - keymap (keymap (mode-line keymap - (mouse-2 . mpc-songs-kill-search)))) - (:propertize "NoSearch" - help-echo "mouse-2: set a search restriction" - follow-link t - mouse-face mode-line-highlight - keymap (keymap (mode-line keymap (mouse-2 . mpc-songs-search))))))) - - ;; (set (make-local-variable 'mode-line-process) + (setq-local header-line-format + ;; '("MPC " mpc-volume " " mpc-current-song) + (list (propertize " " 'display '(space :align-to 0)) + ;; 'mpc-songs-format-description + '(:eval + (let ((hscroll (window-hscroll))) + (with-temp-buffer + (mpc-format mpc-songs-format 'self hscroll) + ;; That would be simpler than the hscroll handling in + ;; mpc-format, but currently move-to-column does not + ;; recognize :space display properties. + ;; (move-to-column hscroll) + ;; (delete-region (point-min) (point)) + (buffer-string)))))) + (setq-local + mode-line-format + '("%e" mode-line-frame-identification mode-line-buffer-identification + #(" " 0 3 + (help-echo "mouse-1: Select (drag to resize)\nmouse-2: Make current window occupy the whole frame\nmouse-3: Remove current window from display")) + mode-line-position + #(" " 0 2 + (help-echo "mouse-1: Select (drag to resize)\nmouse-2: Make current window occupy the whole frame\nmouse-3: Remove current window from display")) + mpc-songs-totaltime + mpc-current-updating + #(" " 0 2 + (help-echo "mouse-1: Select (drag to resize)\nmouse-2: Make current window occupy the whole frame\nmouse-3: Remove current window from display")) + (mpc--song-search + (:propertize + ("Search=\"" mpc--song-search "\"") + help-echo "mouse-2: kill this search" + follow-link t + mouse-face mode-line-highlight + keymap (keymap (mode-line keymap + (mouse-2 . mpc-songs-kill-search)))) + (:propertize "NoSearch" + help-echo "mouse-2: set a search restriction" + follow-link t + mouse-face mode-line-highlight + keymap (keymap (mode-line keymap (mouse-2 . mpc-songs-search))))))) + + ;; (setq-local mode-line-process ;; '("" ;; mpc-volume " " ;; mpc-songs-totaltime ;; mpc-current-updating)) @@ -2111,7 +2120,7 @@ This is used so that they can be compared with `eq', which is needed for (<= (window-start win) overlay-arrow-position) (< overlay-arrow-position (window-end win))))))) (unless (local-variable-p 'overlay-arrow-position) - (set (make-local-variable 'overlay-arrow-position) (make-marker))) + (setq-local overlay-arrow-position (make-marker))) (move-marker overlay-arrow-position pos) ;; If the arrow was visible, try to keep it that way. (if (and visible pos @@ -2613,8 +2622,8 @@ This is used so that they can be compared with `eq', which is needed for (window-minibuffer-p)) (ignore-errors (select-frame (make-frame mpc-frame-alist))) (with-current-buffer song-buf - (set (make-local-variable 'mpc-previous-window-config) - (current-window-configuration)))) + (setq-local mpc-previous-window-config + (current-window-configuration)))) (let* ((win1 (selected-window)) (win2 (split-window)) (tags mpc-browser-tags)) diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 2b8c7ae145b..f6efc56023a 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -4437,16 +4437,18 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ;;; Define ways of getting at unmodified Emacs primitives, ;;; turning off our handler. -;(defun ange-ftp-run-real-handler (operation args) -; (let ((inhibit-file-name-handlers -; (cons 'ange-ftp-hook-function -; (cons 'ange-ftp-completion-hook-function -; (and (eq inhibit-file-name-operation operation) -; inhibit-file-name-handlers)))) -; (inhibit-file-name-operation operation)) -; (apply operation args))) - -(defalias 'ange-ftp-run-real-handler 'tramp-run-real-handler) +(defun ange-ftp-run-real-handler-orig (operation args) + (let ((inhibit-file-name-handlers + (cons 'ange-ftp-hook-function + (cons 'ange-ftp-completion-hook-function + (and (eq inhibit-file-name-operation operation) + inhibit-file-name-handlers)))) + (inhibit-file-name-operation operation)) + (apply operation args))) + +(defalias 'ange-ftp-run-real-handler + (if (fboundp 'tramp-run-real-handler) + 'tramp-run-real-handler 'ange-ftp-run-real-handler-orig)) (defun ange-ftp-real-file-name-directory (&rest args) (ange-ftp-run-real-handler 'file-name-directory args)) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 19e513a3354..695b7a11424 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -658,9 +658,10 @@ regarding its parameter treatment." ;; URL input (defun browse-url-url-at-point () - (let ((url (thing-at-point 'url))) - (set-text-properties 0 (length url) nil url) - url)) + (or (thing-at-point 'url t) + ;; assume that the user is pointing at something like gnu.org/gnu + (let ((f (thing-at-point 'filename t))) + (and f (concat "http://" f))))) ;; Having this as a separate function called by the browser-specific ;; functions allows them to be stand-alone commands, making it easier diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index cf2cd0f311b..0e9c4fc5c76 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -268,9 +268,12 @@ object is returned instead of a list containing this single Lisp object. ;; Wait until `dbus-call-method-handler' has put the result into ;; `dbus-return-values-table'. If no timeout is given, use the ;; default 25". Events which are not from D-Bus must be restored. + ;; `read-event' performs a redisplay. This must be suppressed; it + ;; hurts when reading D-Bus events asynchronously. (with-timeout ((if timeout (/ timeout 1000.0) 25)) (while (eq (gethash key dbus-return-values-table :ignore) :ignore) - (let ((event (let (unread-command-events) (read-event nil nil 0.1)))) + (let ((event (let ((inhibit-redisplay t) unread-command-events) + (read-event nil nil 0.1)))) (when (and event (not (ignore-errors (dbus-check-event event)))) (setq unread-command-events (append unread-command-events (list event))))))) diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el index b43a8c631e3..8e52a4df4ed 100644 --- a/lisp/net/eudc-export.el +++ b/lisp/net/eudc-export.el @@ -31,16 +31,16 @@ (require 'eudc) -(if (not (featurep 'bbdb)) - (load-library "bbdb")) -(if (not (featurep 'bbdb-com)) - (load-library "bbdb-com")) +;; NOERROR is so we can compile it. +(require 'bbdb nil t) +(require 'bbdb-com nil t) (defun eudc-create-bbdb-record (record &optional silent) "Create a BBDB record using the RECORD alist. RECORD is an alist of (KEY . VALUE) where KEY is a directory attribute name symbol and VALUE is the corresponding value for the record. If SILENT is non-nil then the created BBDB record is not displayed." + (require 'bbdb) ;; This function runs in a special context where lisp symbols corresponding ;; to field names in record are bound to the corresponding values (eval @@ -166,6 +166,7 @@ LOCATION is used as the address location for bbdb." PHONE is either a string supposedly containing a phone number or a list of such strings which are concatenated. LOCATION is used as the phone location for BBDB." + (require 'bbdb) (cond ((stringp phone) (let (phone-list) @@ -188,6 +189,7 @@ LOCATION is used as the phone location for BBDB." (defun eudc-batch-export-records-to-bbdb () "Insert all the records returned by a directory query into BBDB." (interactive) + (require 'bbdb) (goto-char (point-min)) (let ((nbrec 0) record) @@ -203,6 +205,7 @@ LOCATION is used as the phone location for BBDB." "Insert record at point into the BBDB database. This function can only be called from a directory query result buffer." (interactive) + (require 'bbdb) (let ((record (and (overlays-at (point)) (overlay-get (car (overlays-at (point))) 'eudc-record)))) (if (null record) @@ -213,9 +216,8 @@ This function can only be called from a directory query result buffer." (defun eudc-try-bbdb-insert () "Call `eudc-insert-record-at-point-into-bbdb' if on a record." (interactive) - (and (or (featurep 'bbdb) - (prog1 (locate-library "bbdb") (message ""))) - (overlays-at (point)) + (require 'bbdb) + (and (overlays-at (point)) (overlay-get (car (overlays-at (point))) 'eudc-record) (eudc-insert-record-at-point-into-bbdb))) diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el index 9f6dba703b1..d9d2aa5fe85 100644 --- a/lisp/net/eudcb-bbdb.el +++ b/lisp/net/eudcb-bbdb.el @@ -29,10 +29,10 @@ ;;; Code: (require 'eudc) -(if (not (featurep 'bbdb)) - (load-library "bbdb")) -(if (not (featurep 'bbdb-com)) - (load-library "bbdb-com")) + +;; Make it loadable on systems without bbdb. +(require 'bbdb nil t) +(require 'bbdb-com nil t) ;;{{{ Internal cooking @@ -71,6 +71,7 @@ (defun eudc-bbdb-filter-non-matching-record (record) "Return RECORD if it matches `eudc-bbdb-current-query', nil otherwise." + (require 'bbdb) (catch 'unmatch (progn (dolist (condition eudc-bbdb-current-query) @@ -112,6 +113,7 @@ (&optional dont-check-disk already-in-db-buffer)) (defun eudc-bbdb-extract-phones (record) + (require 'bbdb) (mapcar (function (lambda (phone) (if eudc-bbdb-use-locations-as-attribute-names @@ -123,6 +125,7 @@ (bbdb-record-phones record))) (defun eudc-bbdb-extract-addresses (record) + (require 'bbdb) (let (s c val) (mapcar (lambda (address) (setq c (bbdb-address-streets address)) @@ -146,6 +149,7 @@ (defun eudc-bbdb-format-record-as-result (record) "Format the BBDB RECORD as a EUDC query result record. The record is filtered according to `eudc-bbdb-current-return-attributes'" + (require 'bbdb) (let ((attrs (or eudc-bbdb-current-return-attributes '(firstname lastname aka company phones addresses net notes))) attr @@ -188,7 +192,7 @@ QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid BBDB attribute names. RETURN-ATTRS is a list of attributes to return, defaulting to `eudc-default-return-attributes'." - + (require 'bbdb) (let ((eudc-bbdb-current-query query) (eudc-bbdb-current-return-attributes return-attrs) (query-attrs (eudc-bbdb-format-query query)) diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el index 9a6c7b124c7..810d8963ce2 100644 --- a/lisp/net/net-utils.el +++ b/lisp/net/net-utils.el @@ -497,7 +497,7 @@ If your system's ping continues until interrupted, you can try setting (defvar nslookup-mode-map (let ((map (make-sparse-keymap))) - (define-key map "\t" 'comint-dynamic-complete) + (define-key map "\t" 'completion-at-point) map)) ;; Using a derived mode gives us keymaps, hooks, etc. @@ -567,7 +567,7 @@ If your system's ping continues until interrupted, you can try setting (defvar ftp-mode-map (let ((map (make-sparse-keymap))) ;; Occasionally useful - (define-key map "\t" 'comint-dynamic-complete) + (define-key map "\t" 'completion-at-point) map)) (define-derived-mode ftp-mode comint-mode "FTP" diff --git a/lisp/net/rlogin.el b/lisp/net/rlogin.el index 9ad79d694f8..e8d13254557 100644 --- a/lisp/net/rlogin.el +++ b/lisp/net/rlogin.el @@ -36,6 +36,11 @@ ;;; Code: +;; FIXME? +;; Maybe this file should be obsolete. +;; http://lists.gnu.org/archive/html/emacs-devel/2013-02/msg00517.html +;; It only adds rlogin-directory-tracking-mode. Is that useful? + (require 'comint) (require 'shell) @@ -44,13 +49,15 @@ :group 'processes :group 'unix) -(defcustom rlogin-program "rlogin" - "Name of program to invoke rlogin" +(defcustom rlogin-program "ssh" + "Name of program to invoke remote login." + :version "24.4" ; rlogin -> ssh :type 'string :group 'rlogin) -(defcustom rlogin-explicit-args nil - "List of arguments to pass to rlogin on the command line." +(defcustom rlogin-explicit-args '("-t" "-t") + "List of arguments to pass to `rlogin-program' on the command line." + :version "24.4" ; nil -> -t -t :type '(repeat (string :tag "Argument")) :group 'rlogin) @@ -62,13 +69,15 @@ (defcustom rlogin-process-connection-type ;; Solaris 2.x `rlogin' will spew a bunch of ioctl error messages if ;; stdin isn't a tty. - (and (string-match-p "-solaris2" system-configuration) t) + (and (string-match "rlogin" rlogin-program) + (string-match-p "-solaris2" system-configuration) t) "If non-nil, use a pty for the local rlogin process. If nil, use a pipe (if pipes are supported on the local system). Generally it is better not to waste ptys on systems which have a static number of them. On the other hand, some implementations of `rlogin' assume a pty is being used, and errors will result from using a pipe instead." + :set-after '(rlogin-program) :type '(choice (const :tag "pipes" nil) (other :tag "ptys" t)) :group 'rlogin) @@ -98,7 +107,7 @@ re-synching of directories." (make-variable-buffer-local 'rlogin-directory-tracking-mode) (defcustom rlogin-host nil - "The name of the remote host. This variable is buffer-local." + "The name of the default remote host. This variable is buffer-local." :type '(choice (const nil) string) :group 'rlogin) @@ -165,7 +174,9 @@ If you wish to change directory tracking styles during a session, use the function `rlogin-directory-tracking-mode' rather than simply setting the variable." (interactive (list - (read-from-minibuffer "rlogin arguments (hostname first): " + (read-from-minibuffer (format + "Arguments for `%s' (hostname first): " + (file-name-nondirectory rlogin-program)) nil nil nil 'rlogin-history) current-prefix-arg)) (let* ((process-connection-type rlogin-process-connection-type) @@ -297,7 +308,7 @@ local one share the same directories (e.g. through NFS)." "Complete file name if doing directory tracking, or just insert TAB." (interactive) (if rlogin-directory-tracking-mode - (comint-dynamic-complete) + (completion-at-point) (insert "\C-i"))) (provide 'rlogin) diff --git a/lisp/net/snmp-mode.el b/lisp/net/snmp-mode.el index 98a7ea68589..cdefc22cd87 100644 --- a/lisp/net/snmp-mode.el +++ b/lisp/net/snmp-mode.el @@ -85,8 +85,9 @@ ;;; Code: (eval-when-compile - (require 'imenu) ; Need this stuff when compiling for imenu macros, etc. - (require 'tempo)) + (require 'imenu)) ; Need this stuff when compiling for imenu macros, etc. + +(require 'tempo) ;;;---------------------------------------------------------------------------- ;; @@ -540,8 +541,6 @@ lines for the purposes of this function." ;; ;;;---------------------------------------------------------------------------- -(require 'tempo) - ;; Perform a completing-read with info given ;; (defun snmp-completing-read (prompt table &optional pred require init hist) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 415397c4171..d6173e01ecd 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -36,64 +36,67 @@ (require 'wid-edit)) (require 'custom) -;; FIXME this is bad practice, and who is it for anyway, since Emacs -;; has split-string since at least 21.1. -(if (not (fboundp 'split-string)) - (defun split-string (string &optional pattern) - "Return a list of substrings of STRING which are separated by PATTERN. +(eval-and-compile + (if (featurep 'emacs) + (defalias 'socks-split-string 'split-string) ; since at least 21.1 + (if (fboundp 'split-string) + (defalias 'socks-split-string 'split-string) + (defun socks-split-string (string &optional pattern) + "Return a list of substrings of STRING which are separated by PATTERN. If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." - (or pattern - (setq pattern "[ \f\t\n\r\v]+")) - (let (parts (start 0)) - (while (string-match pattern string start) - (setq parts (cons (substring string start (match-beginning 0)) parts) - start (match-end 0))) - (nreverse (cons (substring string start) parts))))) + (or pattern + (setq pattern "[ \f\t\n\r\v]+")) + (let (parts (start 0)) + (while (string-match pattern string start) + (setq parts (cons (substring string start + (match-beginning 0)) parts) + start (match-end 0))) + (nreverse (cons (substring string start) parts))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Custom widgets ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-widget 'dynamic-choice 'menu-choice - "A pretty simple dynamic dropdown list" - :format "%[%t%]: %v" - :tag "Network" - :case-fold t - :void '(item :format "invalid (%t)\n") - :value-create 's5-widget-value-create - :value-delete 'widget-children-value-delete - :value-get 'widget-choice-value-get - :value-inline 'widget-choice-value-inline - :mouse-down-action 'widget-choice-mouse-down-action - :action 'widget-choice-action - :error "Make a choice" - :validate 'widget-choice-validate - :match 's5-dynamic-choice-match - :match-inline 's5-dynamic-choice-match-inline) - -(defun s5-dynamic-choice-match (widget value) - (let ((choices (funcall (widget-get widget :choice-function))) - current found) - (while (and choices (not found)) - (setq current (car choices) - choices (cdr choices) - found (widget-apply current :match value))) - found)) - -(defun s5-dynamic-choice-match-inline (widget value) - (let ((choices (funcall (widget-get widget :choice-function))) - current found) - (while (and choices (not found)) - (setq current (car choices) - choices (cdr choices) - found (widget-match-inline current value))) - found)) - -(defun s5-widget-value-create (widget) - (let ((choices (funcall (widget-get widget :choice-function))) - (value (widget-get widget :value))) - (if (not value) - (widget-put widget :value (widget-value (car choices)))) - (widget-put widget :args choices) - (widget-choice-value-create widget))) +;;; (define-widget 'dynamic-choice 'menu-choice +;;; "A pretty simple dynamic dropdown list" +;;; :format "%[%t%]: %v" +;;; :tag "Network" +;;; :case-fold t +;;; :void '(item :format "invalid (%t)\n") +;;; :value-create 's5-widget-value-create +;;; :value-delete 'widget-children-value-delete +;;; :value-get 'widget-choice-value-get +;;; :value-inline 'widget-choice-value-inline +;;; :mouse-down-action 'widget-choice-mouse-down-action +;;; :action 'widget-choice-action +;;; :error "Make a choice" +;;; :validate 'widget-choice-validate +;;; :match 's5-dynamic-choice-match +;;; :match-inline 's5-dynamic-choice-match-inline) +;;; +;;; (defun s5-dynamic-choice-match (widget value) +;;; (let ((choices (funcall (widget-get widget :choice-function))) +;;; current found) +;;; (while (and choices (not found)) +;;; (setq current (car choices) +;;; choices (cdr choices) +;;; found (widget-apply current :match value))) +;;; found)) +;;; +;;; (defun s5-dynamic-choice-match-inline (widget value) +;;; (let ((choices (funcall (widget-get widget :choice-function))) +;;; current found) +;;; (while (and choices (not found)) +;;; (setq current (car choices) +;;; choices (cdr choices) +;;; found (widget-match-inline current value))) +;;; found)) +;;; +;;; (defun s5-widget-value-create (widget) +;;; (let ((choices (funcall (widget-get widget :choice-function))) +;;; (value (widget-get widget :value))) +;;; (if (not value) +;;; (widget-put widget :value (widget-value (car choices)))) +;;; (widget-put widget :args choices) +;;; (widget-choice-value-create widget))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Customization support @@ -104,65 +107,65 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." :prefix "socks-" :group 'processes) -'(defcustom socks-server-aliases nil - "A list of server aliases for use in access control and filtering rules." - :group 'socks - :type '(repeat (list :format "%v" - :value ("" "" 1080 5) - (string :tag "Alias") - (string :tag "Hostname/IP Address") - (integer :tag "Port #") - (choice :tag "SOCKS Version" - (integer :tag "SOCKS v4" :value 4) - (integer :tag "SOCKS v5" :value 5))))) - -'(defcustom socks-network-aliases - '(("Anywhere" (netmask "0.0.0.0" "0.0.0.0"))) - "A list of network aliases for use in subsequent rules." - :group 'socks - :type '(repeat (list :format "%v" - :value (netmask "" "255.255.255.0") - (string :tag "Alias") - (radio-button-choice - :format "%v" - (list :tag "IP address range" - (const :format "" :value range) - (string :tag "From") - (string :tag "To")) - (list :tag "IP address/netmask" - (const :format "" :value netmask) - (string :tag "IP Address") - (string :tag "Netmask")) - (list :tag "Domain Name" - (const :format "" :value domain) - (string :tag "Domain name")) - (list :tag "Unique hostname/IP address" - (const :format "" :value exact) - (string :tag "Hostname/IP Address")))))) - -'(defun s5-servers-filter () - (if socks-server-aliases - (mapcar (lambda (x) (list 'const :tag (car x) :value (car x))) s5-server-aliases) - '((const :tag "No aliases defined" :value nil)))) - -'(defun s5-network-aliases-filter () - (mapcar (lambda (x) (list 'const :tag (car x) :value (car x))) - socks-network-aliases)) - -'(defcustom socks-redirection-rules - nil - "A list of redirection rules." - :group 'socks - :type '(repeat (list :format "%v" - :value ("Anywhere" nil) - (dynamic-choice :choice-function s5-network-aliases-filter - :tag "Destination network") - (radio-button-choice - :tag "Connection type" - (const :tag "Direct connection" :value nil) - (dynamic-choice :format "%t: %[%v%]" - :choice-function s5-servers-filter - :tag "Proxy chain via"))))) +;;; (defcustom socks-server-aliases nil +;;; "A list of server aliases for use in access control and filtering rules." +;;; :group 'socks +;;; :type '(repeat (list :format "%v" +;;; :value ("" "" 1080 5) +;;; (string :tag "Alias") +;;; (string :tag "Hostname/IP Address") +;;; (integer :tag "Port #") +;;; (choice :tag "SOCKS Version" +;;; (integer :tag "SOCKS v4" :value 4) +;;; (integer :tag "SOCKS v5" :value 5))))) +;;; +;;; (defcustom socks-network-aliases +;;; '(("Anywhere" (netmask "0.0.0.0" "0.0.0.0"))) +;;; "A list of network aliases for use in subsequent rules." +;;; :group 'socks +;;; :type '(repeat (list :format "%v" +;;; :value (netmask "" "255.255.255.0") +;;; (string :tag "Alias") +;;; (radio-button-choice +;;; :format "%v" +;;; (list :tag "IP address range" +;;; (const :format "" :value range) +;;; (string :tag "From") +;;; (string :tag "To")) +;;; (list :tag "IP address/netmask" +;;; (const :format "" :value netmask) +;;; (string :tag "IP Address") +;;; (string :tag "Netmask")) +;;; (list :tag "Domain Name" +;;; (const :format "" :value domain) +;;; (string :tag "Domain name")) +;;; (list :tag "Unique hostname/IP address" +;;; (const :format "" :value exact) +;;; (string :tag "Hostname/IP Address")))))) +;;; +;;; (defun s5-servers-filter () +;;; (if socks-server-aliases +;;; (mapcar (lambda (x) (list 'const :tag (car x) :value (car x))) s5-server-aliases) +;;; '((const :tag "No aliases defined" :value nil)))) +;;; +;;; (defun s5-network-aliases-filter () +;;; (mapcar (lambda (x) (list 'const :tag (car x) :value (car x))) +;;; socks-network-aliases)) +;;; +;;; (defcustom socks-redirection-rules +;;; nil +;;; "A list of redirection rules." +;;; :group 'socks +;;; :type '(repeat (list :format "%v" +;;; :value ("Anywhere" nil) +;;; (dynamic-choice :choice-function s5-network-aliases-filter +;;; :tag "Destination network") +;;; (radio-button-choice +;;; :tag "Connection type" +;;; (const :tag "Direct connection" :value nil) +;;; (dynamic-choice :format "%t: %[%v%]" +;;; :choice-function s5-servers-filter +;;; :tag "Proxy chain via"))))) (defcustom socks-server (list "Default server" "socks" 1080 5) @@ -648,7 +651,8 @@ version.") (progn (setq res (buffer-substring (match-beginning 2) (match-end 2)) - res (mapcar 'string-to-number (split-string res "\\."))))) + res (mapcar 'string-to-number + (socks-split-string res "\\."))))) (kill-buffer (current-buffer))) res) host)) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 2d683a4d3d2..613b2067955 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -155,12 +155,18 @@ pass to the OPERATION." "Return a list of (nil host) tuples allowed to access." (with-timeout (10) (with-temp-buffer - (when (zerop (call-process tramp-adb-program nil t nil "devices")) - (let (result) - (goto-char (point-min)) - (while (search-forward-regexp "^\\(\\S-+\\)[[:space:]]+device$" nil t) - (add-to-list 'result (list nil (match-string 1)))) - result))))) + ;; `call-process' does not react on timer under MS Windows. + ;; That's why we use `start-process'. + (let ((p (start-process + tramp-adb-program (current-buffer) tramp-adb-program "devices")) + result) + (tramp-compat-set-process-query-on-exit-flag p nil) + (while (eq 'run (process-status p)) + (sleep-for 0.1)) + (goto-char (point-min)) + (while (search-forward-regexp "^\\(\\S-+\\)[[:space:]]+device$" nil t) + (add-to-list 'result (list nil (match-string 1)))) + result)))) (defun tramp-adb-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files." @@ -850,7 +856,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (when p (if (yes-or-no-p "A command is running. Kill it? ") (ignore-errors (kill-process p)) - (error "Shell command in progress"))) + (tramp-compat-user-error "Shell command in progress"))) (if current-buffer-p (progn @@ -976,11 +982,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setq args (append (list "-s" (tramp-file-name-host vec)) args))) (with-temp-buffer (prog1 - (unless (zerop (apply 'call-process tramp-adb-program nil t nil args)) + (unless + (zerop (apply 'tramp-call-process tramp-adb-program nil t nil args)) (buffer-string)) - (tramp-message - vec 6 "%s %s\n%s" - tramp-adb-program (mapconcat 'identity args " ") (buffer-string))))) + (tramp-message vec 6 "%s" (buffer-string))))) (defun tramp-adb-find-test-command (vec) "Checks, whether the ash has a builtin \"test\" command. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index d4639817b18..d4115352b34 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -438,20 +438,6 @@ This is, the first, empty, element is omitted. In XEmacs, the first element is not omitted." (delete "" (split-string string pattern))) -(defun tramp-compat-call-process - (program &optional infile destination display &rest args) - "Calls `call-process' on the local host. -This is needed because for some Emacs flavors Tramp has -defadvised `call-process' to behave like `process-file'. The -Lisp error raised when PROGRAM is nil is trapped also, returning 1." - (let ((default-directory - (if (file-remote-p default-directory) - (tramp-compat-temporary-file-directory) - default-directory))) - (if (executable-find program) - (apply 'call-process program infile destination display args) - 1))) - (defun tramp-compat-process-running-p (process-name) "Returns `t' if system process PROCESS-NAME is running for `user-login-name'." (when (stringp process-name) @@ -533,6 +519,11 @@ EOL-TYPE can be one of `dos', `unix', or `mac'." "`dos', `unix', or `mac'"))))) (t (error "Can't change EOL conversion -- is MULE missing?")))) +;; `user-error' has been added to Emacs 24.3. +(defun tramp-compat-user-error (format &rest args) + "Signal a pilot error." + (apply (if (fboundp 'user-error) 'user-error 'error) format args)) + (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-compat 'force))) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index e3850653263..6ba055b8bb8 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -147,13 +147,15 @@ (defconst tramp-gvfs-service-daemon "org.gtk.vfs.Daemon" "The well known name of the GVFS daemon.") -;; Check that GVFS is available. D-Bus integration is available since -;; Emacs 23 on some system types. We don't call `dbus-ping', because -;; this would load dbus.el. -(unless (and (tramp-compat-funcall 'dbus-get-unique-name :session) - (or (tramp-compat-process-running-p "gvfs-fuse-daemon") - (tramp-compat-process-running-p "gvfsd-fuse"))) - (error "Package `tramp-gvfs' not supported")) +;; D-Bus integration is available since Emacs 23 on some system types. +;; We don't call `dbus-ping', because this would load dbus.el. +(defconst tramp-gvfs-enabled + (ignore-errors + (and (featurep 'dbusbind) + (tramp-compat-funcall 'dbus-get-unique-name :session) + (or (tramp-compat-process-running-p "gvfs-fuse-daemon") + (tramp-compat-process-running-p "gvfsd-fuse")))) + "Non-nil when GVFS is available.") (defconst tramp-gvfs-path-mounttracker "/org/gtk/vfs/mounttracker" "The object path of the GVFS daemon.") @@ -482,6 +484,8 @@ Operations not mentioned here will be handled by the default Emacs primitives.") "Invoke the GVFS related OPERATION. First arg specifies the OPERATION, second arg is a list of arguments to pass to the OPERATION." + (unless tramp-gvfs-enabled + (tramp-compat-user-error "Package `tramp-gvfs' not supported")) (let ((fn (assoc operation tramp-gvfs-file-name-handler-alist))) (if fn (save-match-data (apply (cdr fn) args)) @@ -1307,23 +1311,24 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (tramp-set-file-property v "/" "default-location" default-location))))))) -(dbus-register-signal - :session nil tramp-gvfs-path-mounttracker - tramp-gvfs-interface-mounttracker "mounted" - 'tramp-gvfs-handler-mounted-unmounted) -(dbus-register-signal - :session nil tramp-gvfs-path-mounttracker - tramp-gvfs-interface-mounttracker "Mounted" - 'tramp-gvfs-handler-mounted-unmounted) - -(dbus-register-signal - :session nil tramp-gvfs-path-mounttracker - tramp-gvfs-interface-mounttracker "unmounted" - 'tramp-gvfs-handler-mounted-unmounted) -(dbus-register-signal - :session nil tramp-gvfs-path-mounttracker - tramp-gvfs-interface-mounttracker "Unmounted" - 'tramp-gvfs-handler-mounted-unmounted) +(when tramp-gvfs-enabled + (dbus-register-signal + :session nil tramp-gvfs-path-mounttracker + tramp-gvfs-interface-mounttracker "mounted" + 'tramp-gvfs-handler-mounted-unmounted) + (dbus-register-signal + :session nil tramp-gvfs-path-mounttracker + tramp-gvfs-interface-mounttracker "Mounted" + 'tramp-gvfs-handler-mounted-unmounted) + + (dbus-register-signal + :session nil tramp-gvfs-path-mounttracker + tramp-gvfs-interface-mounttracker "unmounted" + 'tramp-gvfs-handler-mounted-unmounted) + (dbus-register-signal + :session nil tramp-gvfs-path-mounttracker + tramp-gvfs-interface-mounttracker "Unmounted" + 'tramp-gvfs-handler-mounted-unmounted)) (defun tramp-gvfs-connection-mounted-p (vec) "Check, whether the location is already mounted." @@ -1451,7 +1456,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." `(:struct ,(tramp-gvfs-dbus-string-to-byte-array mount-pref) ,mount-spec))) -;; Connection functions +;; Connection functions. (defun tramp-gvfs-maybe-open-connection (vec) "Maybe open a connection VEC. @@ -1572,7 +1577,7 @@ COMMAND is usually a command from the gvfs-* utilities. (tramp-gvfs-maybe-open-connection vec) (erase-buffer) (tramp-message vec 6 "%s %s" command (mapconcat 'identity args " ")) - (setq result (apply 'tramp-compat-call-process command nil t nil args)) + (setq result (apply 'tramp-call-process command nil t nil args)) (tramp-message vec 6 "\n%s" (buffer-string)) (zerop result)))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index da2dcc71c5c..e45c2cf8511 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -422,7 +422,7 @@ as given in your `~/.profile'." ;;;###tramp-autoload (defcustom tramp-remote-process-environment - `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "LC_ALL=C" + `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "TMOUT=0" "LC_ALL=C" ,(format "TERM=%s" tramp-terminal-type) "EMACS=t" ;; Deprecated. ,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version) @@ -767,6 +767,16 @@ while (my $data = <STDIN>) { Escape sequence %s is replaced with name of Perl binary. This string is passed to `format', so percent characters need to be doubled.") +(defconst tramp-perl-pack + "%s -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'" + "Perl program to use for encoding a file. +Escape sequence %s is replaced with name of Perl binary.") + +(defconst tramp-perl-unpack + "%s -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'" + "Perl program to use for decoding a file. +Escape sequence %s is replaced with name of Perl binary.") + (defconst tramp-vc-registered-read-file-names "echo \"(\" while read file; do @@ -1309,7 +1319,7 @@ of." ;; without `set-file-times', this function is an alias for this. ;; We are local, so we don't need the UTC settings. (zerop - (tramp-compat-call-process + (tramp-call-process "touch" nil nil nil "-t" (format-time-string "%Y%m%d%H%M.%S" time) (tramp-shell-quote-argument filename))))) @@ -1343,7 +1353,7 @@ be non-negative integers." ;; `set-file-uid-gid'. On W32 "chown" might not work. (let ((uid (or (and (natnump uid) uid) (tramp-get-local-uid 'integer))) (gid (or (and (natnump gid) gid) (tramp-get-local-gid 'integer)))) - (tramp-compat-call-process + (tramp-call-process "chown" nil nil nil (format "%d:%d" uid gid) (tramp-shell-quote-argument filename)))))) @@ -2891,40 +2901,39 @@ the result will be a local, non-Tramp, filename." (rem-enc (save-excursion (with-tramp-progress-reporter - v 3 (format "Encoding remote file %s" filename) + v 3 + (format "Encoding remote file `%s' with `%s'" filename rem-enc) (tramp-barf-unless-okay v (format rem-enc (tramp-shell-quote-argument localname)) "Encoding remote file failed")) - (if (functionp loc-dec) - ;; If local decoding is a function, we call it. We - ;; must disable multibyte, because - ;; `uudecode-decode-region' doesn't handle it - ;; correctly. - (with-temp-buffer - (set-buffer-multibyte nil) - (insert-buffer-substring (tramp-get-buffer v)) - (with-tramp-progress-reporter - v 3 (format "Decoding remote file %s with function %s" - filename loc-dec) + (with-tramp-progress-reporter + v 3 (format "Decoding local file `%s' with `%s'" + tmpfile loc-dec) + (if (functionp loc-dec) + ;; If local decoding is a function, we call it. + ;; We must disable multibyte, because + ;; `uudecode-decode-region' doesn't handle it + ;; correctly. + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-buffer-substring (tramp-get-buffer v)) (funcall loc-dec (point-min) (point-max)) ;; Unset `file-name-handler-alist'. Otherwise, ;; epa-file gets confused. (let (file-name-handler-alist (coding-system-for-write 'binary)) - (write-region (point-min) (point-max) tmpfile)))) - - ;; If tramp-decoding-function is not defined for this - ;; method, we invoke tramp-decoding-command instead. - (let ((tmpfile2 (tramp-compat-make-temp-file filename))) - ;; Unset `file-name-handler-alist'. Otherwise, - ;; epa-file gets confused. - (let (file-name-handler-alist - (coding-system-for-write 'binary)) - (write-region (point-min) (point-max) tmpfile2)) - (with-tramp-progress-reporter - v 3 (format "Decoding remote file %s with command %s" - filename loc-dec) + (write-region (point-min) (point-max) tmpfile))) + + ;; If tramp-decoding-function is not defined for this + ;; method, we invoke tramp-decoding-command instead. + (let ((tmpfile2 (tramp-compat-make-temp-file filename))) + ;; Unset `file-name-handler-alist'. Otherwise, + ;; epa-file gets confused. + (let (file-name-handler-alist + (coding-system-for-write 'binary)) + (with-current-buffer (tramp-get-buffer v) + (write-region (point-min) (point-max) tmpfile2))) (unwind-protect (tramp-call-local-coding-command loc-dec tmpfile2 tmpfile) @@ -3149,28 +3158,25 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." (with-temp-buffer (set-buffer-multibyte nil) ;; Use encoding function or command. - (if (functionp loc-enc) - (with-tramp-progress-reporter - v 3 (format "Encoding region using function `%s'" - loc-enc) - (let ((coding-system-for-read 'binary)) - (insert-file-contents-literally tmpfile)) - ;; The following `let' is a workaround for the - ;; base64.el that comes with pgnus-0.84. If - ;; both of the following conditions are + (with-tramp-progress-reporter + v 3 (format "Encoding local file `%s' using `%s'" + tmpfile loc-enc) + (if (functionp loc-enc) + ;; The following `let' is a workaround for + ;; the base64.el that comes with pgnus-0.84. + ;; If both of the following conditions are ;; satisfied, it tries to write to a local ;; file in default-directory, but at this ;; point, default-directory is remote. ;; (`call-process-region' can't write to ;; remote files, it seems.) The file in ;; question is a tmp file anyway. - (let ((default-directory + (let ((coding-system-for-read 'binary) + (default-directory (tramp-compat-temporary-file-directory))) - (funcall loc-enc (point-min) (point-max)))) + (insert-file-contents-literally tmpfile) + (funcall loc-enc (point-min) (point-max))) - (with-tramp-progress-reporter - v 3 (format "Encoding region using command `%s'" - loc-enc) (unless (zerop (tramp-call-local-coding-command loc-enc tmpfile t)) (tramp-error @@ -3183,8 +3189,8 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." ;; writes to remote file. Because this happens on ;; the remote host, we cannot use the function. (with-tramp-progress-reporter - v 3 - (format "Decoding region into remote file %s" filename) + v 3 (format "Decoding remote file `%s' using `%s'" + filename rem-dec) (goto-char (point-max)) (unless (bolp) (newline)) (tramp-send-command @@ -3204,7 +3210,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." (erase-buffer) (and ;; cksum runs locally, if possible. - (zerop (tramp-compat-call-process "cksum" tmpfile t)) + (zerop (tramp-call-process "cksum" tmpfile t)) ;; cksum runs remotely. (tramp-send-command-and-check v @@ -3382,6 +3388,9 @@ Only send the definition if it has not already been done." (unless (member name scripts) (with-tramp-progress-reporter vec 5 (format "Sending script `%s'" name) ;; The script could contain a call of Perl. This is masked with `%s'. + (when (and (string-match "%s" script) + (not (tramp-get-remote-perl vec))) + (tramp-error vec 'file-error "No Perl available on remote host")) (tramp-barf-unless-okay vec (format "%s () {\n%s\n}" name @@ -3811,11 +3820,6 @@ process to set up. VEC specifies the connection." (tramp-send-command vec (format "unset %s" (mapconcat 'identity unset " ")) t)))) -;; CCC: We should either implement a Perl version of base64 encoding -;; and decoding. Then we just use that in the last item. The other -;; alternative is to use the Perl version of UU encoding. But then -;; we need a Lisp version of uuencode. -;; ;; Old text from documentation of tramp-methods: ;; Using a uuencode/uudecode inline method is discouraged, please use one ;; of the base64 methods instead since base64 encoding is much more @@ -3832,11 +3836,9 @@ process to set up. VEC specifies the connection." (autoload 'uudecode-decode-region "uudecode") (defconst tramp-local-coding-commands - '((b64 base64-encode-region base64-decode-region) + `((b64 base64-encode-region base64-decode-region) (uu tramp-uuencode-region uudecode-decode-region) - (pack - "perl -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'" - "perl -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'")) + (pack ,(format tramp-perl-pack "perl") ,(format tramp-perl-unpack "perl"))) "List of local coding commands for inline transfer. Each item is a list that looks like this: @@ -3871,9 +3873,7 @@ with the encoded or decoded results, respectively.") (uu "uuencode xxx" "uudecode -o -") (uu "uuencode xxx" "uudecode -p") (uu "uuencode xxx" tramp-uudecode) - (pack - "perl -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'" - "perl -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'")) + (pack tramp-perl-pack tramp-perl-unpack)) "List of remote coding commands for inline transfer. Each item is a list that looks like this: @@ -4014,7 +4014,7 @@ INPUT can also be nil which means `/dev/null'. OUTPUT can be a string (which specifies a filename), or t (which means standard output and thus the current buffer), or nil (which means discard it)." - (tramp-compat-call-process + (tramp-call-process tramp-encoding-shell (when (and input (not (string-match "%s" cmd))) input) (if (eq output t) t nil) @@ -4022,7 +4022,7 @@ means discard it)." tramp-encoding-command-switch (concat (if (string-match "%s" cmd) (format cmd input) cmd) - (if (stringp output) (concat "> " output) "")))) + (if (stringp output) (concat " >" output) "")))) (defconst tramp-inline-compress-commands '(("gzip" "gzip -d") @@ -4051,7 +4051,7 @@ Goes through the list `tramp-inline-compress-commands'." decompress (nth 1 item)) (tramp-message vec 5 - "Checking local compress command `%s', `%s' for sanity" + "Checking local compress commands `%s', `%s' for sanity" compress decompress) (unless (zerop @@ -4067,7 +4067,7 @@ Goes through the list `tramp-inline-compress-commands'." (throw 'next nil)) (tramp-message vec 5 - "Checking remote compress command `%s', `%s' for sanity" + "Checking remote compress commands `%s', `%s' for sanity" compress decompress) (unless (tramp-send-command-and-check vec (format "echo %s | %s | %s" magic compress decompress) t) @@ -4981,10 +4981,12 @@ function cell is returned to be applied on a buffer." ;; Windows shells need the program file name after ;; the pipe symbol be quoted if they use forward ;; slashes as directory separators. - (if (and (string-match "local" prop) - (memq system-type '(windows-nt))) - "(%s | \"%s\" >%%s)" - "(%s | %s >%%s)") + (cond + ((and (string-match "local" prop) + (memq system-type '(windows-nt))) + "(%s | \"%s\")") + ((string-match "local" prop) "(%s | %s)") + (t "(%s | %s >%%s)")) coding compress)) (compress (format @@ -4997,7 +4999,9 @@ function cell is returned to be applied on a buffer." "(%s <%%s | %s)") compress coding)) ((string-match "decoding" prop) - (format "%s >%%s" coding)) + (cond + ((string-match "local" prop) (format "%s" coding)) + (t (format "%s >%%s" coding)))) (t (format "%s <%%s" coding))))))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index dc3dffd857b..4ec3a4b7829 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1203,7 +1203,7 @@ their replacement." result (substring result 0 -1)) (unless (y-or-n-p (format "Method %s is obsolete, use %s? " result (substring result 0 -1))) - (error 'file-error "Method \"%s\" not supported" result))) + (tramp-compat-user-error "Method \"%s\" not supported" result))) (add-to-list 'tramp-warned-obsolete-methods result)) ;; This works with the current set of `tramp-obsolete-methods'. ;; Must be improved, if their are more sophisticated replacements. @@ -1249,7 +1249,7 @@ non-nil, the file name parts are not expanded to their default values." (save-match-data (let ((match (string-match (nth 0 tramp-file-name-structure) name))) - (unless match (error "Not a Tramp file name: %s" name)) + (unless match (tramp-compat-user-error "Not a Tramp file name: %s" name)) (let ((method (match-string (nth 1 tramp-file-name-structure) name)) (user (match-string (nth 2 tramp-file-name-structure) name)) (host (match-string (nth 3 tramp-file-name-structure) name)) @@ -1259,7 +1259,12 @@ values." (when (string-match tramp-prefix-ipv6-regexp host) (setq host (replace-match "" nil t host))) (when (string-match tramp-postfix-ipv6-regexp host) - (setq host (replace-match "" nil t host)))) + (setq host (replace-match "" nil t host))) + (when (and (equal tramp-syntax 'ftp) (null method) (null user) + (member host (mapcar 'car tramp-methods)) + (not (tramp-completion-mode-p))) + (tramp-compat-user-error + "Host name must not match method `%s'" host))) (if nodefault (vector method user host localname hop) (vector @@ -1655,23 +1660,16 @@ FILE must be a local file name on a connection identified via VEC." (tramp-compat-font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-connection-property\\>")) -(defalias 'tramp-drop-volume-letter - (if (memq system-type '(cygwin windows-nt)) - (lambda (name) - "Cut off unnecessary drive letter from file NAME. +(defun tramp-drop-volume-letter (name) + "Cut off unnecessary drive letter from file NAME. The functions `tramp-*-handle-expand-file-name' call `expand-file-name' locally on a remote file name. When the local system is a W32 system but the remote system is Unix, this introduces a superfluous drive letter into the file name. This function removes it." - (save-match-data - (if (string-match "\\`[a-zA-Z]:/" name) - (replace-match "/" nil t name) - name))) - - 'identity)) - -(if (featurep 'xemacs) - (defalias 'tramp-drop-volume-letter 'identity)) + (save-match-data + (if (string-match "\\`[a-zA-Z]:/" name) + (replace-match "/" nil t name) + name))) (defun tramp-cleanup (vec) "Cleanup connection VEC, but keep the debug buffer." @@ -1719,7 +1717,7 @@ Example: ;; Windows registry. (and (memq system-type '(cygwin windows-nt)) (zerop - (tramp-compat-call-process + (tramp-call-process "reg" nil nil nil "query" (nth 1 (car v))))) ;; Configuration file. (file-exists-p (nth 1 (car v))))) @@ -2771,7 +2769,7 @@ User may be nil." User is always nil." (if (memq system-type '(windows-nt)) (with-temp-buffer - (when (zerop (tramp-compat-call-process + (when (zerop (tramp-call-process "reg" nil t nil "query" registry-or-dirname)) (goto-char (point-min)) (loop while (not (eobp)) collect @@ -3179,7 +3177,7 @@ User is always nil." (when p (if (yes-or-no-p "A command is running. Kill it? ") (ignore-errors (kill-process p)) - (error "Shell command in progress"))) + (tramp-compat-user-error "Shell command in progress"))) (if current-buffer-p (progn @@ -3899,6 +3897,24 @@ ALIST is of the form ((FROM . TO) ...)." ;;; Compatibility functions section: +(defun tramp-call-process + (program &optional infile destination display &rest args) + "Calls `call-process' on the local host. +This is needed because for some Emacs flavors Tramp has +defadvised `call-process' to behave like `process-file'. The +Lisp error raised when PROGRAM is nil is trapped also, returning 1. +Furthermore, traces are written with verbosity of 6." + (let ((default-directory + (if (file-remote-p default-directory) + (tramp-compat-temporary-file-directory) + default-directory))) + (tramp-message + (vector tramp-current-method tramp-current-user tramp-current-host nil nil) + 6 "%s %s %s" program infile args) + (if (executable-find program) + (apply 'call-process program infile destination display args) + 1))) + ;;;###tramp-autoload (defun tramp-read-passwd (proc &optional prompt) "Read a password from user (compat function). diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 64053c202b7..0e54cd60d98 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -31,7 +31,7 @@ ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.2.7" +(defconst tramp-version "2.2.8-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -44,7 +44,7 @@ (= emacs-major-version 21) (>= emacs-minor-version 4))) "ok" - (format "Tramp 2.2.7 is not fit for %s" + (format "Tramp 2.2.8-pre is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) diff --git a/lisp/newcomment.el b/lisp/newcomment.el index bcb5f721ae8..e10b96f97f9 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -485,27 +485,29 @@ and raises an error or returns nil if NOERROR is non-nil." Moves point to inside the comment and returns the position of the comment-starter. If no comment is found, moves point to LIMIT and raises an error or returns nil if NOERROR is non-nil." - ;; FIXME: If a comment-start appears inside a comment, we may erroneously - ;; stop there. This can be rather bad in general, but since - ;; comment-search-backward is only used to find the comment-column (in - ;; comment-set-column) and to find the comment-start string (via - ;; comment-beginning) in indent-new-comment-line, it should be harmless. - (if (not (re-search-backward comment-start-skip limit t)) - (unless noerror (error "No comment")) - (beginning-of-line) - (let* ((end (match-end 0)) - (cs (comment-search-forward end t)) - (pt (point))) - (if (not cs) - (progn (beginning-of-line) - (comment-search-backward limit noerror)) - (while (progn (goto-char cs) - (comment-forward) - (and (< (point) end) - (setq cs (comment-search-forward end t)))) - (setq pt (point))) - (goto-char pt) - cs)))) + (let (found end) + (while (and (not found) + (re-search-backward comment-start-skip limit t)) + (setq end (match-end 0)) + (unless (and comment-use-syntax + (nth 8 (syntax-ppss (or (match-end 1) + (match-beginning 0))))) + (setq found t))) + (if (not found) + (unless noerror (error "No comment")) + (beginning-of-line) + (let ((cs (comment-search-forward end t)) + (pt (point))) + (if (not cs) + (progn (beginning-of-line) + (comment-search-backward limit noerror)) + (while (progn (goto-char cs) + (comment-forward) + (and (< (point) end) + (setq cs (comment-search-forward end t)))) + (setq pt (point))) + (goto-char pt) + cs))))) (defun comment-beginning () "Find the beginning of the enclosing comment. diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index 2ee73235dd0..c45196f0316 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el @@ -352,11 +352,6 @@ Use `nxml-parent-document-set' to set it.") See the function `xmltok-forward-prolog' for more information.") (make-variable-buffer-local 'nxml-prolog-regions) -(defvar nxml-last-fontify-end nil - "Position where fontification last ended. -It is nil if the buffer changed since the last fontification.") -(make-variable-buffer-local 'nxml-last-fontify-end) - (defvar nxml-degraded nil "Non-nil if currently operating in degraded mode. Degraded mode is enabled when an internal error is encountered in the @@ -538,9 +533,8 @@ Many aspects this mode can be customized using (save-excursion (save-restriction (widen) - (nxml-clear-dependent-regions (point-min) (point-max)) (setq nxml-scan-end (copy-marker (point-min) nil)) - (nxml-with-unmodifying-text-property-changes + (with-silent-modifications (nxml-clear-inside (point-min) (point-max)) (nxml-with-invisible-motion (nxml-scan-prolog))))) @@ -583,12 +577,9 @@ Many aspects this mode can be customized using ;; Clean up fontification. (save-excursion (widen) - (let ((inhibit-read-only t) - (buffer-undo-list t) - (modified (buffer-modified-p))) + (with-silent-modifications (nxml-with-invisible-motion - (remove-text-properties (point-min) (point-max) '(face))) - (set-buffer-modified-p modified))) + (remove-text-properties (point-min) (point-max) '(face))))) (remove-hook 'change-major-mode-hook 'nxml-cleanup t)) (defun nxml-degrade (context err) @@ -601,7 +592,7 @@ Many aspects this mode can be customized using (save-excursion (save-restriction (widen) - (nxml-with-unmodifying-text-property-changes + (with-silent-modifications (nxml-clear-inside (point-min) (point-max)))))) ;;; Change management @@ -625,7 +616,7 @@ Many aspects this mode can be customized using (widen) (save-match-data (nxml-with-invisible-motion - (nxml-with-unmodifying-text-property-changes + (with-silent-modifications (nxml-after-change1 start end pre-change-length))))))))) @@ -638,10 +629,6 @@ the full extent of the area needing refontification. For bookkeeping, call this function even when fontification is disabled." (let ((pre-change-end (+ start pre-change-length))) - (setq start - (nxml-adjust-start-for-dependent-regions start - end - pre-change-length)) ;; If the prolog might have changed, rescan the prolog (when (<= start ;; Add 2 so as to include the < and following char that @@ -902,26 +889,16 @@ Called with `font-lock-beg' and `font-lock-end' dynamically bound." (defun nxml-extend-after-change-region (start end pre-change-length) (unless nxml-degraded - (setq nxml-last-fontify-end nil) - (let ((region (nxml-with-degradation-on-error - 'nxml-extend-after-change-region - (save-excursion - (save-restriction - (widen) - (save-match-data - (nxml-with-invisible-motion - (nxml-with-unmodifying-text-property-changes - (nxml-extend-after-change-region1 - start end pre-change-length))))))))) - (if (consp region) region)))) - -(defun nxml-extend-after-change-region1 (start end pre-change-length) - (let* ((region (nxml-after-change1 start end pre-change-length)) - (font-lock-beg (car region)) - (font-lock-end (cdr region))) - - (nxml-extend-region) - (cons font-lock-beg font-lock-end))) + (nxml-with-degradation-on-error + 'nxml-extend-after-change-region + (save-excursion + (save-restriction + (widen) + (save-match-data + (nxml-with-invisible-motion + (with-silent-modifications + (nxml-after-change1 + start end pre-change-length))))))))) (defun nxml-fontify-matcher (bound) "Called as font-lock keyword matcher." @@ -936,13 +913,12 @@ Called with `font-lock-beg' and `font-lock-end' dynamically bound." (nxml-fontify-prolog) (goto-char nxml-prolog-end)) - (let (xmltok-dependent-regions - xmltok-errors) + (let (xmltok-errors) (while (and (nxml-tokenize-forward) (<= (point) bound)) ; Intervals are open-ended. (nxml-apply-fontify-rule))) - (setq nxml-last-fontify-end (point))) + ) ;; Since we did the fontification internally, tell font-lock to not ;; do anything itself. diff --git a/lisp/nxml/nxml-outln.el b/lisp/nxml/nxml-outln.el index e30aee3de53..dab22f7559f 100644 --- a/lisp/nxml/nxml-outln.el +++ b/lisp/nxml/nxml-outln.el @@ -149,7 +149,7 @@ See the variable `nxml-section-element-name-regexp' for more details." (defun nxml-show-all () "Show all elements in the buffer normally." (interactive) - (nxml-with-unmodifying-text-property-changes + (with-silent-modifications (remove-text-properties (point-min) (point-max) '(nxml-outline-state nil))) @@ -370,7 +370,7 @@ customize which elements are recognized as sections and headings." (get-text-property pos 'nxml-outline-state)) (defun nxml-set-outline-state (pos state) - (nxml-with-unmodifying-text-property-changes + (with-silent-modifications (if state (put-text-property pos (1+ pos) 'nxml-outline-state state) (remove-text-properties pos (1+ pos) '(nxml-outline-state nil))))) diff --git a/lisp/nxml/nxml-rap.el b/lisp/nxml/nxml-rap.el index bc87044cde6..ac4e9ac4cd9 100644 --- a/lisp/nxml/nxml-rap.el +++ b/lisp/nxml/nxml-rap.el @@ -69,18 +69,6 @@ ;; typical proportion of comments, CDATA sections and processing ;; instructions is small relative to other things. Secondly, to scan ;; we just search for the regexp <[!?]. -;; -;; One problem is unclosed comments, processing instructions and CDATA -;; sections. Suppose, for example, we encounter a <!-- but there's no -;; matching -->. This is not an unexpected situation if the user is -;; creating a comment. It is not helpful to treat the whole of the -;; file starting from the <!-- onwards as a single unclosed comment -;; token. Instead we treat just the <!-- as a piece of not well-formed -;; markup and continue. The problem is that if at some later stage a -;; --> gets added to the buffer after the unclosed <!--, we will need -;; to reparse the buffer starting from the <!--. We need to keep -;; track of these reparse dependencies; they are called dependent -;; regions in the code. ;;; Code: @@ -144,8 +132,7 @@ any 'inside' regions and at the beginning of a token." (if (>= start nxml-scan-end) nxml-scan-end (let ((inside-remove-start start) - xmltok-errors - xmltok-dependent-regions) + xmltok-errors) (while (or (when (xmltok-forward-special (min end nxml-scan-end)) (when (memq xmltok-type '(comment @@ -169,9 +156,7 @@ any 'inside' regions and at the beginning of a token." (when inside-end (setq end inside-end) t)))) - (nxml-clear-inside inside-remove-start end) - (nxml-clear-dependent-regions start end) - (nxml-mark-parse-dependent-regions)) + (nxml-clear-inside inside-remove-start end)) (when (> end nxml-scan-end) (set-marker nxml-scan-end end)) end)) @@ -182,63 +167,14 @@ any 'inside' regions and at the beginning of a token." (defun nxml-scan-prolog () (goto-char (point-min)) (let (xmltok-dtd - xmltok-errors - xmltok-dependent-regions) + xmltok-errors) (setq nxml-prolog-regions (xmltok-forward-prolog)) (setq nxml-prolog-end (point)) - (nxml-clear-inside (point-min) nxml-prolog-end) - (nxml-clear-dependent-regions (point-min) nxml-prolog-end) - (nxml-mark-parse-dependent-regions)) + (nxml-clear-inside (point-min) nxml-prolog-end)) (when (< nxml-scan-end nxml-prolog-end) (set-marker nxml-scan-end nxml-prolog-end))) -;;; Dependent regions - -(defun nxml-adjust-start-for-dependent-regions (start end pre-change-length) - (let ((overlays (overlays-in (1- start) start)) - (adjusted-start start)) - (while overlays - (let* ((overlay (car overlays)) - (ostart (overlay-start overlay))) - (when (and (eq (overlay-get overlay 'category) 'nxml-dependent) - (< ostart adjusted-start)) - (let ((funargs (overlay-get overlay 'nxml-funargs))) - (when (apply (car funargs) - (append (list start - end - pre-change-length - ostart - (overlay-end overlay)) - (cdr funargs))) - (setq adjusted-start ostart))))) - (setq overlays (cdr overlays))) - adjusted-start)) - -(defun nxml-mark-parse-dependent-regions () - (while xmltok-dependent-regions - (apply 'nxml-mark-parse-dependent-region - (car xmltok-dependent-regions)) - (setq xmltok-dependent-regions - (cdr xmltok-dependent-regions)))) - -(defun nxml-mark-parse-dependent-region (fun start end &rest args) - (let ((overlay (make-overlay start end nil t t))) - (overlay-put overlay 'category 'nxml-dependent) - (overlay-put overlay 'nxml-funargs (cons fun args)))) - -(put 'nxml-dependent 'evaporate t) - -(defun nxml-clear-dependent-regions (start end) - (let ((overlays (overlays-in start end))) - (while overlays - (let* ((overlay (car overlays)) - (category (overlay-get overlay 'category))) - (when (and (eq category 'nxml-dependent) - (<= start (overlay-start overlay))) - (delete-overlay overlay))) - (setq overlays (cdr overlays))))) - ;;; Random access parsing (defun nxml-token-after () @@ -286,17 +222,14 @@ Sets variables like `nxml-token-after'." (point))) (defun nxml-tokenize-forward () - (let (xmltok-dependent-regions - xmltok-errors) + (let (xmltok-errors) (when (and (xmltok-forward) (> (point) nxml-scan-end)) (cond ((memq xmltok-type '(comment cdata-section processing-instruction)) - (nxml-with-unmodifying-text-property-changes - (nxml-set-inside (1+ xmltok-start) (point) xmltok-type))) - (xmltok-dependent-regions - (nxml-mark-parse-dependent-regions))) + (with-silent-modifications + (nxml-set-inside (1+ xmltok-start) (point) xmltok-type)))) (set-marker nxml-scan-end (point))) xmltok-type)) @@ -304,7 +237,7 @@ Sets variables like `nxml-token-after'." "Move point backwards outside any 'inside' regions or tags. Point will not move past `nxml-prolog-end'. Point will either be at BOUND or a '<' character starting a tag -outside any 'inside' regions. Ignores dependent regions. +outside any 'inside' regions. As a precondition, point must be >= BOUND." (nxml-move-outside-backwards) (when (not (equal (char-after) ?<)) @@ -331,14 +264,13 @@ Leave point unmoved if it is not inside anything special." (when (< nxml-scan-end pos) (save-excursion (goto-char nxml-scan-end) - (let (xmltok-errors - xmltok-dependent-regions) + (let (xmltok-errors) (while (when (xmltok-forward-special pos) (when (memq xmltok-type '(comment processing-instruction cdata-section)) - (nxml-with-unmodifying-text-property-changes + (with-silent-modifications (nxml-set-inside (1+ xmltok-start) (point) xmltok-type))) @@ -346,8 +278,6 @@ Leave point unmoved if it is not inside anything special." t (setq pos (point)) nil))) - (nxml-clear-dependent-regions nxml-scan-end pos) - (nxml-mark-parse-dependent-regions) (set-marker nxml-scan-end pos)))))) ;;; Element scanning diff --git a/lisp/nxml/nxml-util.el b/lisp/nxml/nxml-util.el index b2d9cdde183..6ba6d21f7ed 100644 --- a/lisp/nxml/nxml-util.el +++ b/lisp/nxml/nxml-util.el @@ -78,27 +78,6 @@ This is the inverse of `nxml-make-namespace'." (nxml-degrade ,context ,error-symbol)))) `(progn ,@body))) -(defmacro nxml-with-unmodifying-text-property-changes (&rest body) - "Evaluate BODY without any text property changes modifying the buffer. -Any text properties changes happen as usual but the changes are not treated as -modifications to the buffer." - (let ((modified (make-symbol "modified"))) - `(let ((,modified (buffer-modified-p)) - (inhibit-read-only t) - (inhibit-modification-hooks t) - (buffer-undo-list t) - (deactivate-mark nil) - ;; Apparently these avoid file locking problems. - (buffer-file-name nil) - (buffer-file-truename nil)) - (unwind-protect - (progn ,@body) - (unless ,modified - (restore-buffer-modified-p nil)))))) - -(put 'nxml-with-unmodifying-text-property-changes 'lisp-indent-function 0) -(def-edebug-spec nxml-with-unmodifying-text-property-changes t) - (defmacro nxml-with-invisible-motion (&rest body) "Evaluate body without calling any point motion hooks." `(let ((inhibit-point-motion-hooks t)) diff --git a/lisp/nxml/rng-maint.el b/lisp/nxml/rng-maint.el index 74192f213dc..ff73e3718ec 100644 --- a/lisp/nxml/rng-maint.el +++ b/lisp/nxml/rng-maint.el @@ -259,7 +259,7 @@ (defun rng-validate-buffer () (save-restriction (widen) - (nxml-with-unmodifying-text-property-changes + (with-silent-modifications (rng-clear-cached-state (point-min) (point-max))) ;; 1+ to clear empty overlays at (point-max) (rng-clear-overlays (point-min) (1+ (point-max)))) diff --git a/lisp/nxml/rng-nxml.el b/lisp/nxml/rng-nxml.el index cfb8e33cccb..bc070136adb 100644 --- a/lisp/nxml/rng-nxml.el +++ b/lisp/nxml/rng-nxml.el @@ -380,9 +380,7 @@ set `xmltok-dtd'. Returns the position of the end of the token." (< rng-validate-up-to-date-end pos)) ;; Display percentage validated. (force-mode-line-update) - ;; Force redisplay but don't allow idle timers to run. - (let ((timer-idle-list nil)) - (sit-for 0))) + (sit-for 0)) (message "Parsing...done")) (save-excursion (save-restriction diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el index a87ab2532ce..fb8bd037bdc 100644 --- a/lisp/nxml/rng-valid.el +++ b/lisp/nxml/rng-valid.el @@ -244,7 +244,7 @@ to use for finding the schema." (> (prefix-numeric-value arg) 0))) (save-restriction (widen) - (nxml-with-unmodifying-text-property-changes + (with-silent-modifications (rng-clear-cached-state (point-min) (point-max))) ;; 1+ to clear empty overlays at (point-max) (rng-clear-overlays (point-min) (1+ (point-max))) @@ -305,7 +305,7 @@ The schema is set like `rng-auto-set-schema'." (defun rng-after-change-function (start end pre-change-len) (setq rng-message-overlay-inhibit-point nil) - (nxml-with-unmodifying-text-property-changes + (with-silent-modifications (rng-clear-cached-state start end)) ;; rng-validate-up-to-date-end holds the position before the change ;; Adjust it to reflect the change. @@ -414,26 +414,17 @@ The schema is set like `rng-auto-set-schema'." (defvar rng-validate-display-modified-p nil) (defun rng-validate-while-idle-continue-p () - ;; input-pending-p and sit-for run timers that are - ;; ripe. Binding timer-idle-list to nil prevents - ;; this. If we don't do this, then any ripe timers - ;; will get run, and we won't get any chance to - ;; validate until Emacs becomes idle again or until - ;; the other lower priority timers finish (which - ;; can take a very long time in the case of - ;; jit-lock). - (let ((timer-idle-list nil)) - (and (not (input-pending-p)) - ;; Fake rng-validate-up-to-date-end so that the mode line - ;; shows progress. Also use this to save point. - (let ((rng-validate-up-to-date-end (point))) - (goto-char rng-validate-display-point) - (when (not rng-validate-display-modified-p) - (restore-buffer-modified-p nil)) - (force-mode-line-update) - (let ((continue (sit-for 0))) - (goto-char rng-validate-up-to-date-end) - continue))))) + (and (not (input-pending-p)) + ;; Fake rng-validate-up-to-date-end so that the mode line + ;; shows progress. Also use this to save point. + (let ((rng-validate-up-to-date-end (point))) + (goto-char rng-validate-display-point) + (when (not rng-validate-display-modified-p) + (restore-buffer-modified-p nil)) + (force-mode-line-update) + (let ((continue (sit-for 0))) + (goto-char rng-validate-up-to-date-end) + continue)))) ;; Calling rng-do-some-validation once with a continue-p function, as ;; opposed to calling it repeatedly, helps on initial validation of a @@ -442,24 +433,26 @@ The schema is set like `rng-auto-set-schema'." ;; validation process down. (defun rng-validate-while-idle (buffer) - (with-current-buffer buffer - (if rng-validate-mode - (if (let ((rng-validate-display-point (point)) - (rng-validate-display-modified-p (buffer-modified-p))) - (rng-do-some-validation 'rng-validate-while-idle-continue-p)) - (force-mode-line-update) - (rng-validate-done)) - ;; must have done kill-all-local-variables - (rng-kill-timers)))) + (when (buffer-live-p buffer) ; bug#13999 + (with-current-buffer buffer + (if rng-validate-mode + (if (let ((rng-validate-display-point (point)) + (rng-validate-display-modified-p (buffer-modified-p))) + (rng-do-some-validation 'rng-validate-while-idle-continue-p)) + (force-mode-line-update) + (rng-validate-done)) + ;; must have done kill-all-local-variables + (rng-kill-timers))))) (defun rng-validate-quick-while-idle (buffer) - (with-current-buffer buffer - (if rng-validate-mode - (if (rng-do-some-validation) - (force-mode-line-update) - (rng-validate-done)) - ;; must have done kill-all-local-variables - (rng-kill-timers)))) + (when (buffer-live-p buffer) ; bug#13999 + (with-current-buffer buffer + (if rng-validate-mode + (if (rng-do-some-validation) + (force-mode-line-update) + (rng-validate-done)) + ;; must have done kill-all-local-variables + (rng-kill-timers))))) (defun rng-validate-done () (when (or (not (current-message)) @@ -478,7 +471,7 @@ The schema is set like `rng-auto-set-schema'." (condition-case-unless-debug err (and (rng-validate-prepare) (let ((rng-dt-namespace-context-getter '(nxml-ns-get-context))) - (nxml-with-unmodifying-text-property-changes + (with-silent-modifications (rng-do-some-validation-1 continue-p-function)))) ;; errors signaled from a function run by an idle timer ;; are ignored; if we don't catch them, validation @@ -537,7 +530,6 @@ Return t if there is work to do, nil otherwise." xmltok-replacement xmltok-attributes xmltok-namespace-attributes - xmltok-dependent-regions xmltok-errors) (when (= (point) 1) (let ((regions (xmltok-forward-prolog))) @@ -573,7 +565,6 @@ Return t if there is work to do, nil otherwise." ;; do this before setting rng-validate-up-to-date-end ;; in case we get a quit (rng-mark-xmltok-errors) - (rng-mark-xmltok-dependent-regions) (setq rng-validate-up-to-date-end (marker-position rng-conditional-up-to-date-end)) (rng-clear-conditional-region) @@ -598,7 +589,6 @@ Return t if there is work to do, nil otherwise." (when (not have-remaining-chars) (rng-process-end-document)) (rng-mark-xmltok-errors) - (rng-mark-xmltok-dependent-regions) (setq rng-validate-up-to-date-end pos) (when rng-conditional-up-to-date-end (cond ((<= rng-conditional-up-to-date-end pos) @@ -668,57 +658,9 @@ Return t if there is work to do, nil otherwise." ;; if overlays left over from a previous use ;; of rng-validate-mode that ended with a change of mode (when rng-error-count - (setq rng-error-count (1- rng-error-count))))) - ((and (eq category 'rng-dependent) - (<= beg (overlay-start overlay))) - (delete-overlay overlay)))) + (setq rng-error-count (1- rng-error-count))))))) (setq overlays (cdr overlays)))))) -;;; Dependent regions - -(defun rng-mark-xmltok-dependent-regions () - (while xmltok-dependent-regions - (apply 'rng-mark-xmltok-dependent-region - (car xmltok-dependent-regions)) - (setq xmltok-dependent-regions - (cdr xmltok-dependent-regions)))) - -(defun rng-mark-xmltok-dependent-region (fun start end &rest args) - (let ((overlay (make-overlay start end nil t t))) - (overlay-put overlay 'category 'rng-dependent) - (overlay-put overlay 'rng-funargs (cons fun args)))) - -(put 'rng-dependent 'evaporate t) -(put 'rng-dependent 'modification-hooks '(rng-dependent-region-changed)) -(put 'rng-dependent 'insert-behind-hooks '(rng-dependent-region-changed)) - -(defun rng-dependent-region-changed (overlay - after-p - change-start - change-end - &optional pre-change-length) - (when (and after-p - ;; Emacs sometimes appears to call deleted overlays - (overlay-start overlay) - (let ((funargs (overlay-get overlay 'rng-funargs))) - (save-match-data - (save-excursion - (save-restriction - (widen) - (apply (car funargs) - (append (list change-start - change-end - pre-change-length - (overlay-start overlay) - (overlay-end overlay)) - (cdr funargs)))))))) - (rng-after-change-function (overlay-start overlay) - change-end - (+ pre-change-length - (- (overlay-start overlay) - change-start))) - (delete-overlay overlay))) - ;;; Error state (defun rng-mark-xmltok-errors () @@ -880,9 +822,7 @@ means goto the first error." (< rng-validate-up-to-date-end (point-max))) ;; Display percentage validated. (force-mode-line-update) - ;; Force redisplay but don't allow idle timers to run. - (let ((timer-idle-list nil)) - (sit-for 0)) + (sit-for 0) (setq pos (max pos (1- rng-validate-up-to-date-end))) t))))) @@ -905,9 +845,7 @@ means goto the first error." (while (and (rng-do-some-validation) (< rng-validate-up-to-date-end (min pos (point-max)))) (force-mode-line-update) - ;; Force redisplay but don't allow idle timers to run. - (let ((timer-idle-list nil)) - (sit-for 0))) + (sit-for 0)) (while (and (> arg 0) (setq err (rng-find-previous-error-overlay pos))) (setq pos (overlay-start err)) diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el index 03f05abac43..b80335362a1 100644 --- a/lisp/nxml/xmltok.el +++ b/lisp/nxml/xmltok.el @@ -132,33 +132,6 @@ from referencing the entity in element content and AR is either nil, meaning the replacement text included a <, or a string which is the normalized attribute value.") -(defvar xmltok-dependent-regions nil - "List of descriptors of regions that a parsed token depends on. - -A token depends on a region if the region occurs after the token and a -change in the region may require the token to be reparsed. This only -happens with markup that is not well-formed. For example, if a <? -occurs without a matching ?>, then the <? is returned as a -not-well-formed token. However, this token is dependent on region -from the end of the token to the end of the buffer: if this ever -contains ?> then the buffer must be reparsed from the <?. - -A region descriptor is a list (FUN START END ARG ...), where FUN is a -function to be called when the region changes, START and END are -integers giving the start and end of the region, and ARG... are -additional arguments to be passed to FUN. FUN will be called with 5 -arguments followed by the additional arguments if any: the position of -the start of the changed area in the region, the position of the end -of the changed area in the region, the length of the changed area -before the change, the position of the start of the region, the -position of the end of the region. FUN must return non-nil if the -region needs reparsing. FUN will be called in a `save-excursion' -with match-data saved. - -`xmltok-forward', `xmltok-forward-special' and `xmltok-forward-prolog' -may add entries to the beginning of this list, but will not clear it. -`xmltok-forward' and `xmltok-forward-special' will only add entries -when returning tokens of type not-well-formed.") (defvar xmltok-errors nil "List of errors detected by `xmltok-forward' and `xmltok-forward-prolog'. @@ -176,7 +149,6 @@ indicating the position of the error.") xmltok-replacement xmltok-attributes xmltok-namespace-attributes - xmltok-dependent-regions xmltok-errors) ,@body)) @@ -298,14 +270,6 @@ and VALUE-END, otherwise a STRING giving the value." (or end (point))) xmltok-errors))) -(defun xmltok-add-dependent (fun &optional start end &rest args) - (setq xmltok-dependent-regions - (cons (cons fun - (cons (or start xmltok-start) - (cons (or end (point-max)) - args))) - xmltok-dependent-regions))) - (defun xmltok-forward () (setq xmltok-start (point)) (let* ((case-fold-search nil) @@ -684,14 +648,8 @@ Return the type of the token." (setq xmltok-type 'empty-element)) ((xmltok-after-lt start cdata-section-open) (setq xmltok-type - (if (search-forward "]]>" nil t) - 'cdata-section - (xmltok-add-error "No closing ]]>") - (xmltok-add-dependent 'xmltok-unclosed-reparse-p - nil - nil - "]]>") - 'not-well-formed))) + (progn (search-forward "]]>" nil 'move) + 'cdata-section))) ((xmltok-after-lt start processing-instruction-question) (xmltok-scan-after-processing-instruction-open)) ((xmltok-after-lt start comment-open) @@ -758,68 +716,44 @@ Return the type of the token." ;; xmltok-scan-prolog-after-processing-instruction-open ;; XXX maybe should include rest of line (up to any <,>) in unclosed PI (defun xmltok-scan-after-processing-instruction-open () - (cond ((not (search-forward "?>" nil t)) - (xmltok-add-error "No closing ?>" - xmltok-start - (+ xmltok-start 2)) - (xmltok-add-dependent 'xmltok-unclosed-reparse-p - nil - nil - "?>") - (setq xmltok-type 'not-well-formed)) - (t - (cond ((not (save-excursion - (goto-char (+ 2 xmltok-start)) - (and (looking-at (xmltok-ncname regexp)) - (setq xmltok-name-end (match-end 0))))) - (setq xmltok-name-end (+ xmltok-start 2)) - (xmltok-add-error "<? not followed by name" - (+ xmltok-start 2) - (+ xmltok-start 3))) - ((not (or (memq (char-after xmltok-name-end) - '(?\n ?\t ?\r ? )) - (= xmltok-name-end (- (point) 2)))) - (xmltok-add-error "Target not followed by whitespace" - xmltok-name-end - (1+ xmltok-name-end))) - ((and (= xmltok-name-end (+ xmltok-start 5)) - (save-excursion - (goto-char (+ xmltok-start 2)) - (let ((case-fold-search t)) - (looking-at "xml")))) - (xmltok-add-error "Processing instruction target is xml" - (+ xmltok-start 2) - (+ xmltok-start 5)))) - (setq xmltok-type 'processing-instruction)))) + (search-forward "?>" nil 'move) + (cond ((not (save-excursion + (goto-char (+ 2 xmltok-start)) + (and (looking-at (xmltok-ncname regexp)) + (setq xmltok-name-end (match-end 0))))) + (setq xmltok-name-end (+ xmltok-start 2)) + (xmltok-add-error "<? not followed by name" + (+ xmltok-start 2) + (+ xmltok-start 3))) + ((not (or (memq (char-after xmltok-name-end) + '(?\n ?\t ?\r ? )) + (= xmltok-name-end (- (point) 2)))) + (xmltok-add-error "Target not followed by whitespace" + xmltok-name-end + (1+ xmltok-name-end))) + ((and (= xmltok-name-end (+ xmltok-start 5)) + (save-excursion + (goto-char (+ xmltok-start 2)) + (let ((case-fold-search t)) + (looking-at "xml")))) + (xmltok-add-error "Processing instruction target is xml" + (+ xmltok-start 2) + (+ xmltok-start 5)))) + (setq xmltok-type 'processing-instruction)) (defun xmltok-scan-after-comment-open () - (setq xmltok-type - (cond ((not (search-forward "--" nil t)) - (xmltok-add-error "No closing -->") - (xmltok-add-dependent 'xmltok-unclosed-reparse-p - nil - nil - ;; not --> because - ;; -- is not allowed - ;; in comments in XML - "--") - 'not-well-formed) - ((eq (char-after) ?>) - (goto-char (1+ (point))) - 'comment) - (t - (xmltok-add-dependent - 'xmltok-semi-closed-reparse-p - nil - (point) - "--" - 2) - ;; just include the <!-- in the token - (goto-char (+ xmltok-start 4)) - ;; Need do this after the goto-char because - ;; marked error should just apply to <!-- - (xmltok-add-error "First following `--' not followed by `>'") - 'not-well-formed)))) + (let ((found-- (search-forward "--" nil 'move))) + (setq xmltok-type + (cond ((or (eq (char-after) ?>) (not found--)) + (goto-char (1+ (point))) + 'comment) + (t + ;; just include the <!-- in the token + (goto-char (+ xmltok-start 4)) + ;; Need do this after the goto-char because + ;; marked error should just apply to <!-- + (xmltok-add-error "First following `--' not followed by `>'") + 'not-well-formed))))) (defun xmltok-scan-attributes () (let ((recovering nil) @@ -1124,7 +1058,7 @@ comment, processing-instruction-left, processing-instruction-right, markup-declaration-open, markup-declaration-close, internal-subset-open, internal-subset-close, hash-name, keyword, literal, encoding-name. -Adds to `xmltok-errors' and `xmltok-dependent-regions' as appropriate." +Adds to `xmltok-errors' as appropriate." (let ((case-fold-search nil) xmltok-start xmltok-type @@ -1148,7 +1082,6 @@ Adds to `xmltok-errors' and `xmltok-dependent-regions' as appropriate." (1- xmltok-internal-subset-start) xmltok-internal-subset-start)) (xmltok-parse-entities) - ;; XXX prune dependent-regions for those entirely in prolog (nreverse xmltok-prolog-regions))) (defconst xmltok-bad-xml-decl-regexp @@ -1648,95 +1581,68 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT." (end (save-excursion (goto-char safe-end) (search-forward delim nil t)))) - (or (cond ((not end) - (xmltok-add-dependent 'xmltok-unclosed-reparse-p - nil - nil - delim) - nil) - ((save-excursion - (goto-char end) - (looking-at "[ \t\r\n>%[]")) - (goto-char end) - (setq xmltok-type 'literal)) - ((eq (1+ safe-end) end) - (goto-char end) - (xmltok-add-error (format "Missing space after %s" delim) - safe-end) - (setq xmltok-type 'literal)) - (t - (xmltok-add-dependent 'xmltok-semi-closed-reparse-p - xmltok-start - (1+ end) - delim - 1) - nil)) - (progn - (xmltok-add-error (format "Missing closing %s" delim)) - (goto-char safe-end) - (skip-chars-backward " \t\r\n") - (setq xmltok-type 'not-well-formed))))) + (cond ((or (not end) + (save-excursion + (goto-char end) + (looking-at "[ \t\r\n>%[]"))) + (goto-char end)) + ((eq (1+ safe-end) end) + (goto-char end) + (xmltok-add-error (format "Missing space after %s" delim) + safe-end))) + (setq xmltok-type 'literal))) (defun xmltok-scan-prolog-after-processing-instruction-open () - (cond ((not (search-forward "?>" nil t)) - (xmltok-add-error "No closing ?>" - xmltok-start - (+ xmltok-start 2)) - (xmltok-add-dependent 'xmltok-unclosed-reparse-p - nil - nil - "?>") - (setq xmltok-type 'not-well-formed)) - (t - (let* ((end (point)) - (target - (save-excursion - (goto-char (+ xmltok-start 2)) - (and (looking-at (xmltok-ncname regexp)) - (or (memq (char-after (match-end 0)) - '(?\n ?\t ?\r ? )) - (= (match-end 0) (- end 2))) - (match-string-no-properties 0))))) - (cond ((not target) - (xmltok-add-error "\ + (search-forward "?>" nil 'move) + (let* ((end (point)) + (target + (save-excursion + (goto-char (+ xmltok-start 2)) + (and (looking-at (xmltok-ncname regexp)) + (or (memq (char-after (match-end 0)) + '(?\n ?\t ?\r ? )) + (= (match-end 0) (- end 2))) + (match-string-no-properties 0))))) + (cond ((not target) + (xmltok-add-error "\ Processing instruction does not start with a name" - (+ xmltok-start 2) - (+ xmltok-start 3))) - ((not (and (= (length target) 3) - (let ((case-fold-search t)) - (string-match "xml" target))))) - ((= xmltok-start 1) - (xmltok-add-error "Invalid XML declaration" - xmltok-start - (point))) - ((save-excursion - (goto-char xmltok-start) - (looking-at (xmltok-xml-declaration regexp))) - (xmltok-add-error "XML declaration not at beginning of file" - xmltok-start - (point))) - (t - (xmltok-add-error "Processing instruction has target of xml" - (+ xmltok-start 2) - (+ xmltok-start 5)))) - (xmltok-add-prolog-region 'processing-instruction-left - xmltok-start - (+ xmltok-start - 2 - (if target - (length target) - 0))) - (xmltok-add-prolog-region 'processing-instruction-right - (if target - (save-excursion - (goto-char (+ xmltok-start - (length target) - 2)) - (skip-chars-forward " \t\r\n") - (point)) - (+ xmltok-start 2)) - (point))) - (setq xmltok-type 'processing-instruction)))) + (+ xmltok-start 2) + (+ xmltok-start 3))) + ((not (and (= (length target) 3) + (let ((case-fold-search t)) + (string-match "xml" target))))) + ((= xmltok-start 1) + (xmltok-add-error "Invalid XML declaration" + xmltok-start + (point))) + ((save-excursion + (goto-char xmltok-start) + (looking-at (xmltok-xml-declaration regexp))) + (xmltok-add-error "XML declaration not at beginning of file" + xmltok-start + (point))) + (t + (xmltok-add-error "Processing instruction has target of xml" + (+ xmltok-start 2) + (+ xmltok-start 5)))) + (xmltok-add-prolog-region 'processing-instruction-left + xmltok-start + (+ xmltok-start + 2 + (if target + (length target) + 0))) + (xmltok-add-prolog-region 'processing-instruction-right + (if target + (save-excursion + (goto-char (+ xmltok-start + (length target) + 2)) + (skip-chars-forward " \t\r\n") + (point)) + (+ xmltok-start 2)) + (point))) + (setq xmltok-type 'processing-instruction)) (defun xmltok-parse-entities () (let ((todo xmltok-dtd)) diff --git a/lisp/obsolete/fast-lock.el b/lisp/obsolete/fast-lock.el index 941ba3b4902..98f9b836a3b 100644 --- a/lisp/obsolete/fast-lock.el +++ b/lisp/obsolete/fast-lock.el @@ -855,3 +855,7 @@ See `fast-lock-get-face-properties'." (provide 'fast-lock) ;;; fast-lock.el ends here + +;; Local Variables: +;; byte-compile-warnings: (not obsolete) +;; End: diff --git a/lisp/obsolete/old-whitespace.el b/lisp/obsolete/old-whitespace.el index c421836dd84..359c22c50ea 100644 --- a/lisp/obsolete/old-whitespace.el +++ b/lisp/obsolete/old-whitespace.el @@ -288,12 +288,6 @@ To disable timer scans, set this to zero." :type 'boolean :group 'whitespace) -(defgroup whitespace-faces nil - "Faces used in whitespace." - :prefix "whitespace-" - :group 'whitespace - :group 'faces) - (defface whitespace-highlight '((((class color) (background light)) (:background "green1")) (((class color) (background dark)) @@ -305,7 +299,7 @@ To disable timer scans, set this to zero." (background dark)) (:background "white"))) "Face used for highlighting the bogus whitespaces that exist in the buffer." - :group 'whitespace-faces) + :group 'whitespace) (define-obsolete-face-alias 'whitespace-highlight-face 'whitespace-highlight "22.1") diff --git a/lisp/obsolete/options.el b/lisp/obsolete/options.el index 3c9ebc839b8..f25003e5652 100644 --- a/lisp/obsolete/options.el +++ b/lisp/obsolete/options.el @@ -42,7 +42,7 @@ It is now better to use Customize instead." (princ "This facility is obsolete; we recommend using M-x customize instead.") (mapatoms (function (lambda (sym) - (if (user-variable-p sym) + (if (custom-variable-p sym) (setq vars (cons sym vars)))))) (setq vars (sort vars 'string-lessp)) (while vars diff --git a/lisp/obsolete/pgg-gpg.el b/lisp/obsolete/pgg-gpg.el index 9ff1d310874..bab4fe5eb30 100644 --- a/lisp/obsolete/pgg-gpg.el +++ b/lisp/obsolete/pgg-gpg.el @@ -28,8 +28,9 @@ ;;; Code: (eval-when-compile - (require 'cl) ; for gpg macros - (require 'pgg)) + (require 'cl)) + +(require 'pgg) (defgroup pgg-gpg () "GnuPG interface." diff --git a/lisp/obsolete/pgg-pgp.el b/lisp/obsolete/pgg-pgp.el index f2ac9cbfe0b..1be978c0561 100644 --- a/lisp/obsolete/pgg-pgp.el +++ b/lisp/obsolete/pgg-pgp.el @@ -26,8 +26,9 @@ ;;; Code: (eval-when-compile - (require 'cl) ; for pgg macros - (require 'pgg)) + (require 'cl)) + +(require 'pgg) (defgroup pgg-pgp () "PGP 2.* and 6.* interface." diff --git a/lisp/obsolete/pgg-pgp5.el b/lisp/obsolete/pgg-pgp5.el index 8d380120b4e..c453ce3e08e 100644 --- a/lisp/obsolete/pgg-pgp5.el +++ b/lisp/obsolete/pgg-pgp5.el @@ -26,8 +26,9 @@ ;;; Code: (eval-when-compile - (require 'cl) ; for pgg macros - (require 'pgg)) + (require 'cl)) + +(require 'pgg) (defgroup pgg-pgp5 () "PGP 5.* interface." diff --git a/lisp/term/sup-mouse.el b/lisp/obsolete/sup-mouse.el index 8a207ed01af..8df32dcd06d 100644 --- a/lisp/term/sup-mouse.el +++ b/lisp/obsolete/sup-mouse.el @@ -6,6 +6,7 @@ ;; Maintainer: FSF ;; Created: 21 Nov 1986 ;; Keywords: hardware +;; Obsolete-since: 24.4 ;; (from code originally written by John Robinson@bbn for the bitgraph) @@ -197,4 +198,6 @@ X and Y are 0-based character positions on the frame." (get-window-with-predicate (lambda (w) (coordinates-in-window-p (cons x y) w)))) +(provide 'sup-mouse) + ;;; sup-mouse.el ends here diff --git a/lisp/obsolete/sym-comp.el b/lisp/obsolete/sym-comp.el index 85d427a3317..bd049b85aa2 100644 --- a/lisp/obsolete/sym-comp.el +++ b/lisp/obsolete/sym-comp.el @@ -139,16 +139,23 @@ to be set buffer-locally. Variables `symbol-completion-symbol-function', pattern)) ;; In case the transform needs to access it. (symbol-completion-predicate predicate) - (completion-annotate-function + (completion-extra-properties (if (functionp symbol-completion-transform-function) - (lambda (str) - (car-safe (cdr-safe - (funcall symbol-completion-transform-function - str))))))) + '(:annotation-function + (lambda (str) + (car-safe (cdr-safe + (funcall symbol-completion-transform-function + str)))))))) (completion-in-region (- (point) (length pattern)) (point) completions predicate))) -(eval-when-compile (require 'hippie-exp)) +(defvar he-search-string) +(defvar he-tried-table) +(defvar he-expand-list) +(declare-function he-init-string "hippie-exp" (beg end)) +(declare-function he-string-member "hippie-exp" (str lst &optional trans-case)) +(declare-function he-substitute-string "hippie-exp" (str &optional trans-case)) +(declare-function he-reset-string "hippie-exp" ()) ;;;###autoload (defun symbol-completion-try-complete (old) diff --git a/lisp/obsolete/vc-mcvs.el b/lisp/obsolete/vc-mcvs.el index dd597be32b1..9f9bd7a0e76 100644 --- a/lisp/obsolete/vc-mcvs.el +++ b/lisp/obsolete/vc-mcvs.el @@ -189,6 +189,8 @@ This is only meaningful if you don't use the implicit checkout model ;;; ;;; State-changing functions ;;; +(autoload 'vc-checkout "vc") +(autoload 'vc-switches "vc") (defun vc-mcvs-register (files &optional rev comment) "Register FILES into the Meta-CVS version-control system. @@ -345,6 +347,8 @@ This is only possible if Meta-CVS is responsible for FILE's directory.") (defun vc-mcvs-rename-file (old new) (vc-mcvs-command nil 0 new "move" (file-relative-name old))) +(autoload 'vc-default-revert "vc") + (defun vc-mcvs-revert (file &optional contents-done) "Revert FILE to the working revision it was based on." (vc-default-revert 'MCVS file contents-done) @@ -478,6 +482,10 @@ workspace is immediately moved to that new branch)." (vc-mcvs-command nil 0 dir "branch" name) (vc-mcvs-command nil 0 dir "switch" name))) +;; vc-mcvs-command calls the autoloaded vc-do-command from vc-dispatcher. +(declare-function vc-resynch-buffer "vc-dispatcher" + (file &optional keep noquery reset-vc-info)) + (defun vc-mcvs-retrieve-tag (dir name update) "Retrieve a tag at and below DIR. NAME is the name of the tag; if it is empty, do a `cvs update'. diff --git a/lisp/net/xesam.el b/lisp/obsolete/xesam.el index 461cadd21ad..0830d4248ef 100644 --- a/lisp/net/xesam.el +++ b/lisp/obsolete/xesam.el @@ -4,6 +4,7 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: tools, hypermedia +;; Obsolete-since: 24.4 ;; This file is part of GNU Emacs. @@ -22,6 +23,8 @@ ;;; Commentary: +;; This file is obsolete. + ;; This package provides an interface to Xesam, a D-Bus based "eXtEnsible ;; Search And Metadata specification". It has been tested with ;; @@ -264,8 +267,9 @@ fields are supported.") (declare-function dbus-get-unique-name "dbusbind.c" (bus)) (defvar xesam-dbus-unique-names - (list (cons :system (dbus-get-unique-name :system)) - (cons :session (dbus-get-unique-name :session))) + (ignore-errors + (list (cons :system (dbus-get-unique-name :system)) + (cons :session (dbus-get-unique-name :session)))) "The unique names, under which Emacs is registered at D-Bus.") (defun xesam-dbus-call-method (&rest args) diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index 1bf6fe315c1..7ea780f2aa6 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog @@ -1,3 +1,9 @@ +2013-04-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * org-agenda.el (org-agenda-mode): + * org-indent.el (org-indent-mode): Use the `local' arg of + add-hook/remove-hook. + 2013-03-08 Bastien Guerry <bzg@gnu.org> * org-exp.el (org-export-normalize-links): Fix critical bug: do @@ -119,8 +125,8 @@ (org-agenda-get-blocks): Don't use `org-agenda-no-heading-message', skip the entry. - * org.el (org-agenda-inhibit-startup-visibility-cycling): New - option. + * org.el (org-agenda-inhibit-startup-visibility-cycling): + New option. (org-agenda-prepare-buffers): Use it to speed up the agenda generation. @@ -195,8 +201,8 @@ * org-compat.el (org-condition-case-unless-debug): Delete. - * org-odt.el (org-odt-cleanup-xml-buffers): Use - `condition-case' instead of `org-condition-case-unless-debug', + * org-odt.el (org-odt-cleanup-xml-buffers): + Use `condition-case' instead of `org-condition-case-unless-debug', which is now deleted. * org-capture.el (org-capture-templates-contexts): @@ -227,8 +233,8 @@ 2013-01-13 Michael Albinus <michael.albinus@gmx.de> - * ob-eval.el (org-babel-shell-command-on-region): Use - `executable-find' for local `shell-file-name'. + * ob-eval.el (org-babel-shell-command-on-region): + Use `executable-find' for local `shell-file-name'. 2013-01-09 Achim Gratz <Stromeko@Stromeko.de> @@ -573,8 +579,8 @@ * ob.el (org-babel-temp-file): Fix setting of `temporary-file-directory' on remote hosts. - * ob-eval.el (org-babel-shell-command-on-region): Use - `process-file' instead of `call-process-region'. The latter one + * ob-eval.el (org-babel-shell-command-on-region): + Use `process-file' instead of `call-process-region'. The latter one does not work on remote hosts. 2012-12-13 Bastien Guerry <bzg@gnu.org> @@ -632,8 +638,8 @@ * org-element.el (org-element-context): When point is between two objects, be sure to return the second one. - * org-list.el (org-list-separating-blank-lines-number): When - computing number of blank lines separating items, also count those + * org-list.el (org-list-separating-blank-lines-number): + When computing number of blank lines separating items, also count those in unparsed blocks, like example blocks. * org.el (org-end-of-line): When visual line mode is on, really @@ -717,8 +723,8 @@ when the current buffer is not a file. (org-check-agenda-file): Enhance the message. (org-element-type): Autoload. - (org-element-context, org-element-paragraph-parser): Don't - declare as these two functions are not used in org.el. + (org-element-context, org-element-paragraph-parser): + Don't declare as these two functions are not used in org.el. * org-lparse.el (browse-url-file-url): Declare. @@ -755,22 +761,22 @@ functions. (org-clock-update-time-maybe): Move to org-clock.el. - * org-exp.el (org-insert-export-options-template): Remove - autoload cookie. + * org-exp.el (org-insert-export-options-template): + Remove autoload cookie. * org-clock.el (org-resolve-clocks, org-clock-in) (org-clock-out, org-clock-cancel, org-clock-goto) (org-clock-sum, org-clock-display, org-clock-report) (org-dblock-write:clocktable): Add autoload cookie. - (org-clock-update-time-maybe): Moved from org.el. + (org-clock-update-time-maybe): Move from org.el. * org-beamer.el (org-beamer-sectioning, org-beamer-mode): Ditto. * org-ascii.el (org-export-ascii-preprocess): Ditto. * org-archive.el (org-archive-subtree) - (org-archive-to-archive-sibling, org-toggle-archive-tag): Add - autoload cookie. + (org-archive-to-archive-sibling, org-toggle-archive-tag): + Add autoload cookie. * org-colview.el (org-columns, org-dblock-write:columnview) (org-insert-columns-dblock, org-agenda-columns): Ditto. @@ -804,8 +810,8 @@ (orgtbl-to-tsv, orgtbl-to-csv, orgtbl-to-latex) (orgtbl-to-html, orgtbl-to-texinfo, orgtbl-to-orgtbl): Ditto. - * org.el (turn-on-orgtbl): Moved here from org-table.el. - (org-clock-persistence-insinuate): Moved here from org-clock.el. + * org.el (turn-on-orgtbl): Move here from org-table.el. + (org-clock-persistence-insinuate): Move here from org-clock.el. (org-update-all-dblocks, org-map-entries) (org-require-autoloaded-modules, org-forward-element) (org-backward-element, org-up-element) @@ -821,12 +827,12 @@ * org-capture.el: Do no set `generated-autoload-file' locally. Minor code clean up. - * org-agenda.el (org-agenda-list): Use - `org-clock-get-clocktable'. Do no set + * org-agenda.el (org-agenda-list): + Use `org-clock-get-clocktable'. Do no set `generated-autoload-file' locally. - * org-table.el (org-table-iterate-buffer-tables): Minor - reformatting. + * org-table.el (org-table-iterate-buffer-tables): + Minor reformatting. (turn-on-orgtbl): Move to org.el. * org-html.el (org-export-htmlize-generate-css): Don't autoload. @@ -871,7 +877,7 @@ 2012-10-26 Myles English <mylesenglish@gmail.com> (tiny change) - * org-clock.el (org-clock-in): Moved the call to + * org-clock.el (org-clock-in): Move the call to org-clock-in-prepare-hook until the task's properties can be accessed. @@ -891,11 +897,11 @@ * org.el (org-sparse-tree): Allow to call `org-show-todo-tree' with an argument. - * org-element.el (org-element--get-next-object-candidates): Fix - parsing of objects of the same type in a single paragraph. + * org-element.el (org-element--get-next-object-candidates): + Fix parsing of objects of the same type in a single paragraph. - * org-element.el (org-element-sub/superscript-successor): Fix - parsing of sub/superscript at beginning of item. + * org-element.el (org-element-sub/superscript-successor): + Fix parsing of sub/superscript at beginning of item. (org-element-latex-or-entity-successor): Fix parsing of latex fragments at beginning of item. @@ -937,7 +943,7 @@ (org-unescape-code-in-region): New functions. (org-edit-src-code, org-edit-src-exit): Use new functions. - * org.el (org-strip-protective-commas): Removed function. + * org.el (org-strip-protective-commas): Remove function. * org-exp.el (org-export-select-backend-specific-text): Use new function. @@ -967,8 +973,8 @@ 2012-09-30 Abdó Roig-Maranges <abdo.roig@gmail.com> * org-html.el (org-export-html-preprocess) - (org-export-html-format-image): Use - `org-latex-preview-ltxpng-directory'. + (org-export-html-format-image): + Use `org-latex-preview-ltxpng-directory'. * org-odt.el (org-export-odt-do-preprocess-latex-fragments): Ditto. @@ -984,8 +990,8 @@ variable is true, so act accordingly if it is found unbound. * ob-R.el: Remove initialization with `nil´ from - `ess-ask-for-ess-directory´ and `ess-local-process-name´. Remove - second declaration for `ess-local-process-name´. + `ess-ask-for-ess-directory´ and `ess-local-process-name´. + Remove second declaration for `ess-local-process-name´. * org-gnus.el: Add a missing require for gnus-util. @@ -1001,8 +1007,8 @@ * org.el (org-mode-map): Add keybindings to `org-element-transpose' and `org-narrow-to-element'. (org-metaup): Fall back on `org-element-drag-backward'. - (org-metadown): Fall back on `org-element-drag-forward'. Also - move chunks of declarations and require statements to get rid of + (org-metadown): Fall back on `org-element-drag-forward'. + Also move chunks of declarations and require statements to get rid of compiler warnings. * org-exp-blocks.el (org): Don't require org. Add declarations. @@ -1033,8 +1039,8 @@ * org.el: Use org-check-version. * org.el: Fix a subtle error resulting in version functions - sometimes not being defined and byte-compiling failing. Always - compile in fallback definitions into org.elc -- org-fixup either + sometimes not being defined and byte-compiling failing. + Always compile in fallback definitions into org.elc -- org-fixup either provides re-definitions at compile-time or checks org-version.el and then the git work tree when run uncompiled. So the fallback definitions will only come into effect when org-fixup is not @@ -1077,8 +1083,8 @@ * org.el: Add with-not-warnings around call of (org-fixup). - * org-compat.el (org-find-library-dir): Rename - org-find-library-name (misleading) and implement with a function + * org-compat.el (org-find-library-dir): + Rename org-find-library-name (misleading) and implement with a function that exists identically in Emacs/XEmacs. * org-exp-blocks.el: Change calls to org-find-library-dir. @@ -1188,8 +1194,8 @@ base-dir argument and use (file-name-directory file) to get the file's directory. (org-publish-update-timestamp) - (org-publish-cache-file-needs-publishing): Call - `org-publish-cache-ctime-of-src' with only one argument. + (org-publish-cache-file-needs-publishing): + Call `org-publish-cache-ctime-of-src' with only one argument. * org.el (org-follow-timestamp-link): Fix bug when using sticky agenda. Add a docstring. @@ -1306,8 +1312,8 @@ hook twice. * org-agenda.el (org-agenda-menu-two-column) - (org-finalize-agenda-hook, org-agenda-ndays): Use - `define-obsolete-variable-alias' instead of + (org-finalize-agenda-hook, org-agenda-ndays): + Use `define-obsolete-variable-alias' instead of `make-obsolete-variable'. * org.el (org-link-to-org-use-id): Move to org-id.el. @@ -1472,8 +1478,8 @@ (org-tags-view, org-diary, org-agenda-finalize-entries) (org-agenda-change-all-lines): Use the new names. - * org-agenda.el (org-agenda-local-vars): Remove - Ì€org-agenda-last-arguments' from the list of local variables. + * org-agenda.el (org-agenda-local-vars): + Remove Ì€org-agenda-last-arguments' from the list of local variables. (org-agenda-mode-map): `g' does the same than `r' in buffers with only one agenda view, but its behavior differs when there are several views. In manually appended agendas (with `A'), `g' @@ -1582,20 +1588,20 @@ value. (org-agenda-multi-back-to-pos): New variable. (org-agenda-later): Retrieve `org-agenda-current-span' and - `org-agenda-overriding-arguments' from text properties. Also - handle numeric span. - (org-agenda-later, org-agenda-change-time-span): Set - `org-agenda-overriding-cmd' so that we to take overriding + `org-agenda-overriding-arguments' from text properties. + Also handle numeric span. + (org-agenda-later, org-agenda-change-time-span): + Set `org-agenda-overriding-cmd' so that we to take overriding arguments into account for this command only. - * org-agenda.el (org-agenda-kill, org-agenda-archive-with): Fix - bug when called with a non-nil value of `org-agenda-stick'. + * org-agenda.el (org-agenda-kill, org-agenda-archive-with): + Fix bug when called with a non-nil value of `org-agenda-stick'. * org-agenda.el (org-agenda-refile): Fix bug when refiling an entry from a sticky agenda. - * org-agenda.el (org-prepare-agenda-window): Use - `org-pre-agenda-window-conf' if already set. + * org-agenda.el (org-prepare-agenda-window): + Use `org-pre-agenda-window-conf' if already set. (org-agenda-Quit): Set `org-pre-agenda-window-conf' to nil when quitting. (org-agenda-quit): Ditto. @@ -1618,8 +1624,8 @@ * org-capture.el (org-capture-templates-contexts): Ditto. - * org.el (org-contextualize-agenda-or-capture): Normalize - contexts. + * org.el (org-contextualize-agenda-or-capture): + Normalize contexts. * org.el (org-contextualize-agenda-or-capture): Handle key replacement depending on the contexts. @@ -1653,8 +1659,8 @@ `org-icalendar-use-plain-timestamp' is nil, scheduled and deadline items should not be ignored. - * org.el (org-ds-keyword-length, org-make-tags-matcher): Docstring - clean-up. + * org.el (org-ds-keyword-length, org-make-tags-matcher): + Docstring clean-up. * org-freemind.el (org-freemind-convert-links-from-org): Replace literally to prevent errors when replacing with string containing @@ -1663,8 +1669,8 @@ * org-pcomplete.el (org-thing-at-point): Allow to match (and then complete) a "thing" containing dashes. - * org-table.el (org-table-toggle-coordinate-overlays): Better - message when interactively toggling. + * org-table.el (org-table-toggle-coordinate-overlays): + Better message when interactively toggling. * org-table.el (org-table-number-regexp): Update the docstring to show an example of a decimal number using the comma as a @@ -1677,8 +1683,8 @@ * org-agenda.el (org-search-view, org-agenda-get-todos) (org-agenda-get-timestamps, org-agenda-get-sexps) (org-agenda-get-progress, org-agenda-get-deadlines) - (org-agenda-get-scheduled, org-agenda-get-blocks): Use - `category-pos' instead of `org-category-pos'. + (org-agenda-get-scheduled, org-agenda-get-blocks): + Use `category-pos' instead of `org-category-pos'. * ob-fortran.el (org-babel-fortran-transform-list): Rename from `ob-fortran-transform-list'. @@ -1772,8 +1778,8 @@ and don't allow whitespaces between the hashtag and the plus sign. * org.el (org-refresh-category-properties) - (org-find-dblock, org-dblock-start-re, org-dblock-end-re): Allow - lowercase "#+category" and "#+begin:" dynamic blocks. + (org-find-dblock, org-dblock-start-re, org-dblock-end-re): + Allow lowercase "#+category" and "#+begin:" dynamic blocks. * org.el (org-context): Use case-folding when trying to match clocktables and source blocks contexts. @@ -1832,8 +1838,8 @@ * org-agenda.el (org-agenda-menu-two-column): Rename to `org-agenda-menu-two-columns'. - * ob.el (org-babel-sha1-hash, org-babel-noweb-p): Replace - `org-labels' by `let*'. + * ob.el (org-babel-sha1-hash, org-babel-noweb-p): + Replace `org-labels' by `let*'. * org-bibtex.el (org-bibtex-headline): Ditto. @@ -1842,8 +1848,8 @@ * ob.el (org-babel-get-src-block-info) (org-babel-check-src-block, org-babel-current-result-hash) (org-babel-parse-src-block-match, org-babel-read-link) - (org-babel-insert-result, org-babel-clean-text-properties): Use - Ì€org-no-properties' instead of `org-babel-clean-text-properties'. + (org-babel-insert-result, org-babel-clean-text-properties): + Use Ì€org-no-properties' instead of `org-babel-clean-text-properties'. (org-babel-clean-text-properties): Delete redundant function `org-babel-clean-text-properties'. @@ -1872,8 +1878,8 @@ removal of text properties. (org-capture-fill-template): Use `org-no-properties'. - * org-gnus.el (org-gnus-open, org-gnus-follow-link): Use - `org-no-properties'. + * org-gnus.el (org-gnus-open, org-gnus-follow-link): + Use `org-no-properties'. * org-colview.el (org-columns-display-here): Ditto. @@ -1967,8 +1973,8 @@ * ob.el (org-babel-edit-distance, org-babel-sha1-hash) (org-babel-get-rownames, org-babel-insert-result) (org-babel-merge-params) - (org-babel-expand-noweb-references): Don't use `org-flet'. Also - indent some functions correctly. + (org-babel-expand-noweb-references): Don't use `org-flet'. + Also indent some functions correctly. * ob.el (org-babel-execute-src-block) (org-babel-join-splits-near-ch, org-babel-format-result) @@ -1979,8 +1985,8 @@ * ob-sh.el (org-babel-sh-var-to-string): Ditto. - * ob-tangle.el (org-babel-tangle, org-babel-spec-to-string): Don't - use `org-flet'. + * ob-tangle.el (org-babel-tangle, org-babel-spec-to-string): + Don't use `org-flet'. * org-pcomplete.el (org-compat): Require. @@ -2092,8 +2098,8 @@ * org.el (org-forward-same-level): Fix typo in docstring. - * org-agenda.el (org-agenda-mode-map): Bind - `org-agenda-show-priority' to `C-c,' instead of `P'. + * org-agenda.el (org-agenda-mode-map): + Bind `org-agenda-show-priority' to `C-c,' instead of `P'. (org-agenda-next-item, org-agenda-previous-item): New commands to move by one item down/up in the agenda. (org-agenda-mode-map): Bind `org-agenda-next-item' and @@ -2118,8 +2124,8 @@ (org-element-transpose, org-element-unindent-buffer): Autoload. Require 'org and remove all declarations. - * org.el (org-outline-regexp-bol, org-heading-regexp): Use - variables instead of constants. + * org.el (org-outline-regexp-bol, org-heading-regexp): + Use variables instead of constants. * org-archive.el (org-datetree-find-date-create): Declare. @@ -2127,8 +2133,8 @@ `clean-buffer-list-kill-buffer-names' when the feature 'midnight has been loaded. - * org-icalendar.el (org-print-icalendar-entries): Let - APPT_WARNTIME take precedence over Ì€org-icalendar-alarm-time'. + * org-icalendar.el (org-print-icalendar-entries): + Let APPT_WARNTIME take precedence over Ì€org-icalendar-alarm-time'. * org.el (org-special-properties): New special property CLOCKSUM_T. @@ -2191,8 +2197,8 @@ creating a new output buffer for each shell process. The new buffer is added to `clean-buffer-list-kill-buffer-names'. - * org-mobile.el (org-mobile-create-index-file): Use - `org-global-tags-completion-table' instead of + * org-mobile.el (org-mobile-create-index-file): + Use `org-global-tags-completion-table' instead of `org-tag-alist-for-agenda' to get the tags for the index file. * org.el (org-global-tags-completion-table): Fix typo in @@ -2263,8 +2269,8 @@ (org-mode-flyspell-verify): Exclude keywords from the new constant. - * org-pcomplete.el (pcomplete/org-mode/file-option): Use - `org-options-keywords'. + * org-pcomplete.el (pcomplete/org-mode/file-option): + Use `org-options-keywords'. * org.el (org-toggle-heading): Bugfix: use `org-element-mark-element' instead of `org-mark-list'. @@ -2362,8 +2368,8 @@ * org.el (org-mode-map): Add keybindings to `org-element-transpose' and `org-narrow-to-element'. (org-metaup): Fall back on `org-element-drag-backward'. - (org-metadown): Fall back on `org-element-drag-forward'. Also - move chunks of declarations and require statements to get rid of + (org-metadown): Fall back on `org-element-drag-forward'. + Also move chunks of declarations and require statements to get rid of compiler warnings. * org-exp-blocks.el (org): Don't require org. Add declarations. @@ -2374,8 +2380,8 @@ * org.el (org-timestamp-change): Don't use the `position'. - * org.el (org-clock-history, org-clock-adjust-closest): New - variables. + * org.el (org-clock-history, org-clock-adjust-closest): + New variables. (org-timestamp-change): Maybe adjust the next or previous clock in `org-clock-history'. (org-shiftmetaup, org-shiftmetadown): On clock logs, update the @@ -2479,8 +2485,8 @@ (org-edit-src-code, org-edit-src-continue) (org-edit-fixed-width-region) (org-src-do-key-sequence-at-code-block) - (org-src-font-lock-fontify-block, org-src-fontify-buffer): Fix - typos in docstrings. + (org-src-font-lock-fontify-block, org-src-fontify-buffer): + Fix typos in docstrings. * org-docbook.el (org-export-docbook-emphasis-alist): Fix typo: use "format string" instead of "formatting string". @@ -2490,8 +2496,8 @@ * org-html.el (org-export-html-postamble): Ditto. - * org-latex.el (org-export-latex-hyperref-options-format): New - option. + * org-latex.el (org-export-latex-hyperref-options-format): + New option. (org-export-latex-make-header): Use it. * ob.el (org-babel-confirm-evaluate): Prevent errors when @@ -2550,8 +2556,8 @@ * org-capture.el (org-capture-bookmark): New option. (org-capture-finalize): Use it. - * org-publish.el (org-publish-cache-file-needs-publishing): Make - the column mandatory after #+include:. + * org-publish.el (org-publish-cache-file-needs-publishing): + Make the column mandatory after #+include:. * org-exp.el (org-export-handle-include-files): Ditto. @@ -2561,8 +2567,8 @@ * org-exp.el (org-export-handle-include-files): Allow to use #+include with no column. - * org-publish.el (org-publish-cache-file-needs-publishing): Make - quotes mandatory around the file name and allow spaces in it. + * org-publish.el (org-publish-cache-file-needs-publishing): + Make quotes mandatory around the file name and allow spaces in it. * org-html.el (org-export-as-html): Add link to Org's and Emacs's websites. @@ -2621,8 +2627,8 @@ (org-clock-frame-title-format): New option. (org-frame-title-string): Delete. (org-clock-update-mode-line): Minor code reformatting. - (org-clock-in, org-clock-out, org-clock-cancel): Use - `org-clock-frame-title-format'. + (org-clock-in, org-clock-out, org-clock-cancel): + Use `org-clock-frame-title-format'. * org-clock.el (org-clock-get-clock-string): Add a space. @@ -2648,7 +2654,7 @@ `org-agenda-bulk-unmark-all'. Check against `org-agenda-bulk-marked-entries' before trying to unmark entries. Minor docstring fix. - (org-agenda-bulk-unmark-all): Renamed from + (org-agenda-bulk-unmark-all): Rename from Ì€org-agenda-bulk-remove-all-marks'. * org-agenda.el (org-agenda-bulk-mark-char): New option. @@ -2665,8 +2671,8 @@ (org-set-property): Fix the check against `org-properties-postprocess-alist'. - * org-macs.el (orgstruct++-ignore-org-filling): Set - `def-edebug-spec' correctly. + * org-macs.el (orgstruct++-ignore-org-filling): + Set `def-edebug-spec' correctly. * org-colview.el (org-columns-string-to-number): When computing the values for the colview, match durations and convert them to @@ -2730,8 +2736,8 @@ active region when exporting a subtree/region. * org-clock.el (org-program-exists): Remove. - (org-show-notification, org-clock-play-sound): Use - `executable-find' instead of `org-program-exists'. + (org-show-notification, org-clock-play-sound): + Use `executable-find' instead of `org-program-exists'. * org-agenda.el (org-diary): Prevent failure from `org-compile-prefix-format' when there is no agenda buffer. @@ -2791,8 +2797,8 @@ * org.el (org-goto): Fix docstring and document what C-u does. - * org-publish.el (org-publish-cache-file-needs-publishing): Use - (case-fold-search t) when looking for #+INCLUDE:. + * org-publish.el (org-publish-cache-file-needs-publishing): + Use (case-fold-search t) when looking for #+INCLUDE:. * org.el: Use (case-fold-search t). (org-edit-special, org-ctrl-c-ctrl-c): Ditto. @@ -2826,15 +2832,15 @@ * org-agenda.el (org-toggle-sticky-agenda): Only shout a message when called interactively. - (org-agenda-get-restriction-and-command): Call - `org-toggle-sticky-agenda' interactively. + (org-agenda-get-restriction-and-command): + Call `org-toggle-sticky-agenda' interactively. * org-agenda.el (org-agenda-top-category-filter): New variable for storing the current top-category filter. (org-agenda-redo): Apply a top-category filter, if any. (org-agenda-filter-by-top-category) - (org-agenda-filter-top-category-apply): Set - `org-agenda-top-category-filter' to the right value. + (org-agenda-filter-top-category-apply): + Set `org-agenda-top-category-filter' to the right value. * org-clock.el (org-clock-out, org-clock-cancel) (org-clock-in): Don't modify `frame-title-format' if it is a @@ -2845,8 +2851,8 @@ * org.el (org-read-date): Set cursor-type to nil in the calendar. - * org-faces.el (org-date-selected): Use inverse video. Don't - explicitely set bold to nil as it causes `customize-face' to show + * org-faces.el (org-date-selected): Use inverse video. + Don't explicitely set bold to nil as it causes `customize-face' to show the weight property and thus encourage the user to change it. Warn in the docstring that using bold might cause problems when displaying the calendar. @@ -2926,8 +2932,8 @@ (org-time-stamp, org-read-date, org-read-date-get-relative) (org-display-custom-time, org-get-wdays) (org-time-string-to-absolute, org-closest-date) - (org-timestamp-change): Allow to set hourly repeat cookie. Send - an error when an hourly repeat cookie is set and no hour is + (org-timestamp-change): Allow to set hourly repeat cookie. + Send an error when an hourly repeat cookie is set and no hour is specified in the timestamp. * org-icalendar.el (org-print-icalendar-entries): Handle hourly @@ -2948,8 +2954,8 @@ `org-agenda-filter-by-top-category'. * org-ascii.el (org-export-ascii-underline): Change the default - underlining characters for headlines of level 1 and 2. Also - introduce \. as the underline character for headlines of level 5. + underlining characters for headlines of level 1 and 2. + Also introduce \. as the underline character for headlines of level 5. * org-table.el (org-table-recalculate-buffer-tables) (org-table-iterate-buffer-tables): Add autoload cookie. @@ -3038,8 +3044,8 @@ 2012-09-30 Christoph Dittmann <github@christoph-d.de> (tiny change) - * org-beamer.el (org-beamer-auto-fragile-frames): Make - [fragile] work with overlay specifications. + * org-beamer.el (org-beamer-auto-fragile-frames): + Make [fragile] work with overlay specifications. 2012-09-30 Christophe Junke <christophe.junke@inria.fr> (tiny change) @@ -3251,7 +3257,7 @@ * ob.el (org-babel-result-to-file): New optional description argument. - (org-babel-insert-result): Moved description logic to another + (org-babel-insert-result): Move description logic to another function. * ob.el (org-babel-insert-result): Change name of filelinkdescr to @@ -3279,8 +3285,8 @@ 2012-09-30 Feng Shu <tumashu@gmail.com> - * org.el (org-create-formula-image-with-imagemagick): Use - 'call-process to launch latex so that no shell output buffer will + * org.el (org-create-formula-image-with-imagemagick): + Use 'call-process to launch latex so that no shell output buffer will be shown when previewing formulas. * org.el (org-create-formula-image-with-imagemagick): Fix typo. @@ -3326,7 +3332,7 @@ 2012-09-30 Henning Weiss <hdweiss@gmail.com> - * org-mobile.el (org-mobile-edit): Added handling of addheading, + * org-mobile.el (org-mobile-edit): Add handling of addheading, refile, archive, archive-sibling and delete edit nodes. (org-mobile-locate-entry): Olp links containing only a file are now be located correctly. @@ -3349,8 +3355,8 @@ * org-colview.el (org-columns): New argument `columns-fmt-string'. - * org-colview.el (org-columns-get-format-end-top-level): Split - into `org-columns-get-format' and `org-columns-goto-top-level'. + * org-colview.el (org-columns-get-format-end-top-level): + Split into `org-columns-get-format' and `org-columns-goto-top-level'. * org-colview.el (org-dblock-write:columnview): Add a new parameter :format which specifies the column view format for the @@ -3371,8 +3377,8 @@ * org-odt.el (org-odt-do-image-size): Replace `flet' with equivalent construct. - * org-odt.el (org-odt-cleanup-xml-buffers): Use - `condition-case-no-debug' instead of + * org-odt.el (org-odt-cleanup-xml-buffers): + Use `condition-case-no-debug' instead of `condition-case-unless-debug'. This ensures backward compatibility with Emacs versions < 24.1. @@ -3380,14 +3386,14 @@ (org-odt-cleanup-xml-buffers): New. (org-export-as-odt-and-open, org-export-as-odt) (org-odt-init-outfile, org-odt-save-as-outfile) - (org-export-as-odf, org-export-as-odf-and-open): Use - `org-odt-cleanup-xml-buffers'. + (org-export-as-odf, org-export-as-odf-and-open): + Use `org-odt-cleanup-xml-buffers'. - * org-odt.el (org-export-odt-default-org-styles-alist): Add - default character style. + * org-odt.el (org-export-odt-default-org-styles-alist): + Add default character style. - * org-odt.el (org-export-odt-default-org-styles-alist): Add - default character style. + * org-odt.el (org-export-odt-default-org-styles-alist): + Add default character style. * org-lparse.el (org-do-lparse): Remove stray call to `org-export-html-after-blockquotes-hook'. @@ -3450,7 +3456,7 @@ * org-entities.el (org-entities): Add new entities for characters which could cause formatting changes if typed directly. - * org-entities.el (org-entities): Added \asciicirc entity for ^; + * org-entities.el (org-entities): Add \asciicirc entity for ^; also fixed \circ expansion in latex. * org.el (org-fontify-entities): Fix bug: The entities \sup[123] @@ -3459,16 +3465,16 @@ 2012-09-30 Mats Lidell <matsl@xemacs.org> (tiny change) - * org-element.el (org-element-paragraph-separate): Remove - redundant and misplaced t clause in case. + * org-element.el (org-element-paragraph-separate): + Remove redundant and misplaced t clause in case. 2012-09-30 Matt Lundin <mdl@imapmail.org> * org-datetree.el: Fix regexp to allow datetree to find headings with trailing whitespace. This fixes a bug in which an existing datetree heading (e.g., "* 2012 ") would not be found by - org-datetree-find-year-create if it had trailing whitespace. This - can cause problems, for instance, if one is using column view on + org-datetree-find-year-create if it had trailing whitespace. + This can cause problems, for instance, if one is using column view on the date tree, since editing subheadings with column view adds whitespace at the end of the top heading. @@ -3484,8 +3490,8 @@ (org-bbdb-make-anniv-hash): Fix org-bbdb anniversary functionality to accommodate BBDB 3.x. There are two major changes in BBDB 3.x that need to be taken into account. The first is that - `bbdb-split' reverses the order of its parameters in 3.x. The - second is that `bbdb-record-getprop' is replaced by + `bbdb-split' reverses the order of its parameters in 3.x. + The second is that `bbdb-record-getprop' is replaced by bbdb-record-note in 3.x. 2012-09-30 Max Mikhanosha <max@openchat.com> @@ -3526,15 +3532,15 @@ * ob-tangle.el (org-babel-tangle-collect-blocks): Use dummy string when heading has no text. - * org-capture.el (org-capture-inside-embedded-elisp-p): Improve - parsing. + * org-capture.el (org-capture-inside-embedded-elisp-p): + Improve parsing. * org-feed.el (org-feed-format-entry): Require `org-capture'. Expand Elisp %(...) templates. (org-feed-default-template): Update docstring. - * org-capture.el (org-capture-expand-embedded-elisp): New - function. + * org-capture.el (org-capture-expand-embedded-elisp): + New function. (org-capture-fill-template): Use it. (org-capture-inside-embedded-elisp-p): New function to tell if we are within an Elisp %(...) template. @@ -3550,16 +3556,16 @@ * org.el (org-fill-paragraph): Pass optional argument to `fill-paragraph' to fix compatibility with XEmacs. - * org.el (org-self-insert-cluster-for-undo): Default - `org-self-insert-cluster-for-undo' also on XEmacs. + * org.el (org-self-insert-cluster-for-undo): + Default `org-self-insert-cluster-for-undo' also on XEmacs. * org.el (org-kill-line): Access `visual-line-mode' only if it's bound. 2012-09-30 Muchenxuan Tong <demon386@gmail.com> (tiny change) - * org-timer.el (org-timer-set-mode-line): Check - `org-timer-display' when value is 'off. + * org-timer.el (org-timer-set-mode-line): + Check `org-timer-display' when value is 'off. 2012-09-30 Nicolas Calderon Asselin <nicolas.calderon.asselin@gmail.com> (tiny change) @@ -3581,19 +3587,19 @@ * ob-org.el (org-babel-default-header-args:org): By default, export code from Org src blocks. - * org-element.el (org-element-inline-src-block-successor): Fix - inline-src-block parsing at the beginning of an item. + * org-element.el (org-element-inline-src-block-successor): + Fix inline-src-block parsing at the beginning of an item. - * org-element.el (org-element--collect-affiliated-keywords): Fix - caption parsing. + * org-element.el (org-element--collect-affiliated-keywords): + Fix caption parsing. * org-element.el (org-element--current-element): At the very beginning of a footnote definition or an item, next element is always a paragraph. * org-element.el (org-element-headline-parser): Handle nil titles. - (org-element-inlinetask-parser): Add :raw-value property. Also - handle nil titles. + (org-element-inlinetask-parser): Add :raw-value property. + Also handle nil titles. * org.el (org-set-regexps-and-options): Don't consider tags as a replacement for a missing title in an headline. @@ -3613,7 +3619,7 @@ * org.el (org-mode): Call external initalizers. Now both filling code and comments code have their own independant part in org.el. - (org-setup-filling): Renamed from `org-set-autofill-regexps'. + (org-setup-filling): Rename from `org-set-autofill-regexps'. (org-setup-comments-handling): New function. * org.el (org-fill-paragraph): Refine filling in comments and in @@ -3708,7 +3714,7 @@ * org-element.el (org-element-set-element): Rewrite function. (org-element-adopt-elements): New function. - (org-element-adopt-element): Removed function. + (org-element-adopt-element): Remove function. (org-element--parse-elements, org-element--parse-objects): Use new function. @@ -3788,16 +3794,16 @@ very end of a paragraph. * org.el (org-mode): Set comments related variables. - (org-insert-comment, org-comment-or-uncomment-region): New - functions. + (org-insert-comment, org-comment-or-uncomment-region): + New functions. * org.el (org-fill-context-prefix): Small refactoring. (org-fill-paragraph): Add code comments. * org-element.el (org-element-at-point): Add :parent property to output. - (org-element-context): Add :parent property to output. Also - return a single element or object instead of a list of parents. + (org-element-context): Add :parent property to output. + Also return a single element or object instead of a list of parents. (org-element-forward, org-element-up): Apply changes. * org.el (org-fill-context-prefix): New function. @@ -3848,8 +3854,8 @@ * org-footnote.el (org-footnote-normalize): Fix positionning in HTML export without a footnote section. - * org-list.el (org-list-struct-indent): Follow - `org-list-demote-modify-bullet' specifications for ordered + * org-list.el (org-list-struct-indent): + Follow `org-list-demote-modify-bullet' specifications for ordered bullets. (org-list-indent-item-generic, org-indent-item-tree) (org-outdent-item-tree): Fix bug when operating on a region. @@ -3903,8 +3909,8 @@ 2012-09-30 T.F. Torrey <tftorrey@tftorrey.com> (tiny change) - * org-exp.el (org-export-remember-html-container-classes): Allow - exporting a single subtree with HTML_CONTAINER_CLASS property. + * org-exp.el (org-export-remember-html-container-classes): + Allow exporting a single subtree with HTML_CONTAINER_CLASS property. * org-rmail.el (org-rmail-follow-link): Use `rmail-widen' instead of `widen' and don't toggle header as `rmail-widen' already takes @@ -3920,9 +3926,9 @@ * org-capture.el (org-capture-fill-template): Expand %<num> escape sequences into text entered for <num>'th %^{PROMPT} escape. - * org-capture.el (org-capture-fill-template): Fixed regexp for + * org-capture.el (org-capture-fill-template): Fix regexp for %<n> expandos to match any positive integer. - (org-capture-templates): Updated docstring accordingly. + (org-capture-templates): Update docstring accordingly. * org-agenda.el (org-agenda-skip-timestamp-if-deadline-is-shown): Skip timestamp items in agenda view if item is already shown as a @@ -3956,9 +3962,9 @@ property override :empty-lines when inserting empty lines after captured captured entry. - * org-agenda.el (org-agenda-skip-if, org-agenda-skip-if-todo): Add - new todo-unblocked and nottodo-unblocked skip conditions. These - match as for todo and nottodo, but only for unblocked todo items. + * org-agenda.el (org-agenda-skip-if, org-agenda-skip-if-todo): + Add new todo-unblocked and nottodo-unblocked skip conditions. + These match as for todo and nottodo, but only for unblocked todo items. 2012-09-30 Zachary Kanfer <zkanfer@gmail.com> (tiny change) @@ -3968,8 +3974,8 @@ 2012-09-30 Niels Giesen <niels.giesen@gmail.com> * org-table.el (orgtbl-to-generic): Add check for :skipheadrule. - When present, the :hline following the head will be skipped. This - is necessary to avoid doubling of horizontal rules in LaTeX + When present, the :hline following the head will be skipped. + This is necessary to avoid doubling of horizontal rules in LaTeX longtable environments and consequent width problems. * org-latex.el (org-export-latex-tables-tstart) @@ -4131,8 +4137,8 @@ 2012-04-27 Nicolas Goaziou <n.goaziou@gmail.com> - * org-list.el (org-list-struct-indent): Follow - `org-list-demote-modify-bullet' specifications for ordered + * org-list.el (org-list-struct-indent): + Follow `org-list-demote-modify-bullet' specifications for ordered bullets. (org-list-indent-item-generic, org-indent-item-tree) (org-outdent-item-tree): Fix bug when operating on a region. @@ -4264,7 +4270,7 @@ 2012-04-01 Ilya Shlyakhter <ilya_shl@alum.mit.edu> (tiny change) - * org.el (org-delete-property-globally): Fixed a bug that left + * org.el (org-delete-property-globally): Fix a bug that left blank line in place of the property, instead of removing the line. 2012-04-01 Bastien Guerry <bzg@gnu.org> @@ -4289,8 +4295,8 @@ 2012-04-01 Bastien Guerry <bzg@gnu.org> - * org-table.el (orgtbl-self-insert-command): Use - `backward-delete-char' instead of `delete-backward-char' as this + * org-table.el (orgtbl-self-insert-command): + Use `backward-delete-char' instead of `delete-backward-char' as this last command gets caught by the compiler which says to not use it in programs. `backward-delete-char' is just an alias for `delete-backward-char' which is internally remapped to @@ -4314,8 +4320,8 @@ 2012-04-01 Bastien Guerry <bzg@gnu.org> - * org-mime.el (org-mime-htmlize): Set - `org-export-with-LaTeX-fragments' correctly. + * org-mime.el (org-mime-htmlize): + Set `org-export-with-LaTeX-fragments' correctly. 2012-04-01 Bastien Guerry <bzg@gnu.org> @@ -4338,7 +4344,7 @@ 2012-04-01 Eric Schulte <eric.schulte@gmx.com> - * ob-lob.el (org-babel-lob-get-info): Removed extra []s when + * ob-lob.el (org-babel-lob-get-info): Remove extra []s when parsing inline call_foo lines. 2012-04-01 Eric Schulte <eric.schulte@gmx.com> @@ -4385,8 +4391,8 @@ 2012-04-01 Thomas Morgan <tlm@ziiuu.com> (tiny change) - * org-habit.el (org-habit-insert-consistency-graphs): Fix - alignment of consistency graph in filtered agenda view. + * org-habit.el (org-habit-insert-consistency-graphs): + Fix alignment of consistency graph in filtered agenda view. 2012-04-01 Bastien Guerry <bzg@gnu.org> @@ -4409,8 +4415,8 @@ 2012-04-01 Bastien Guerry <bzg@gnu.org> - * org-agenda.el (org-agenda-custom-commands-local-options): Fix - incorrect custom option definition. + * org-agenda.el (org-agenda-custom-commands-local-options): + Fix incorrect custom option definition. 2012-04-01 Bastien Guerry <bzg@gnu.org> @@ -4447,14 +4453,14 @@ * org-odt.el (org-export-odt-category-strings): New custom variable. - (org-odt-category-map-alist): Modify interpretation. Don't - use the same field to double up as both a OpenDocument + (org-odt-category-map-alist): Modify interpretation. + Don't use the same field to double up as both a OpenDocument variable and a category string. Entries in this list now specify only the OpenDocument variable. Category strings are obtained through an indirect lookup of `org-export-odt-category-strings'. Use same OpenDocument - variables as what LibreOffice uses for various entities. Fix - docstring. + variables as what LibreOffice uses for various entities. + Fix docstring. (org-odt-add-label-definition) (org-odt-format-label-definition) (org-odt-format-label-reference): Propagate above changes. @@ -4501,8 +4507,8 @@ 2012-04-01 Jambunathan K <kjambunathan@gmail.com> * org-lparse.el (org-do-lparse): Make effective setting of - `org-export-headline-levels' available to the ODT exporter. Also - remove some stale comments. + `org-export-headline-levels' available to the ODT exporter. + Also remove some stale comments. 2012-04-01 Jambunathan K <kjambunathan@gmail.com> @@ -4583,7 +4589,7 @@ 2012-04-01 Ilya Shlyakhter <ilya_shl@alum.mit.edu> (tiny change) - * ob-lilypond.el (ly-compile-lilyfile): Fixed misplaced comma in a + * ob-lilypond.el (ly-compile-lilyfile): Fix misplaced comma in a quoting expression. 2012-04-01 Eric Schulte <eric.schulte@gmx.com> @@ -4737,7 +4743,7 @@ 2012-04-01 Eric Schulte <eric.schulte@gmx.com> - * ob.el (org-babel-examplize-region): Fixed bug in examplization. + * ob.el (org-babel-examplize-region): Fix bug in examplization. 2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com> @@ -4835,7 +4841,7 @@ 2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com> * org-list.el (org-list-ending-method, org-list-end-regexp): - Removed variables. + Remove variables. (org-in-item-p, org-list-separating-blank-lines-number) (org-list-parse-list, org-list-struct): Apply changes. @@ -4873,7 +4879,7 @@ 2012-04-01 David Maus <dmaus@ictsoc.de> - * org-clock.el (org-in-clocktable-p): Moved to org.el. + * org-clock.el (org-in-clocktable-p): Move to org.el. * org.el (org-in-clocktable-p): New function. Moved from org-clock.el. @@ -4936,14 +4942,14 @@ 2012-04-01 Eric Schulte <eric.schulte@gmx.com> - * ob.el (org-babel-strip-protective-commas): Use - `org-strip-protective-commas'. + * ob.el (org-babel-strip-protective-commas): + Use `org-strip-protective-commas'. - * org-exp.el (org-export-select-backend-specific-text): Use - `org-strip-protective-commas'. + * org-exp.el (org-export-select-backend-specific-text): + Use `org-strip-protective-commas'. - * org-src.el (org-edit-src-code): Use - `org-strip-protective-commas'. + * org-src.el (org-edit-src-code): + Use `org-strip-protective-commas'. * org.el (org-strip-protective-commas): Single definition for this functionality. @@ -4977,7 +4983,7 @@ 2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com> * org-list.el (org-list-ending-method, org-list-end-regexp): - Removed variables. + Remove variables. (org-in-item-p, org-list-separating-blank-lines-number) (org-list-parse-list, org-list-struct): Apply changes. @@ -5005,8 +5011,8 @@ 2012-04-01 Jambunathan K <kjambunathan@gmail.com> * org-odt.el (org-export-as-odt-to-buffer) - (org-replace-region-by-odt, org-export-region-as-odt): Remove - these interactive functions. They are of questionable value. + (org-replace-region-by-odt, org-export-region-as-odt): + Remove these interactive functions. They are of questionable value. 2012-04-01 Toby S. Cubitt <tsc25@cantab.net> (tiny change) @@ -5049,7 +5055,7 @@ 2012-04-01 David Maus <dmaus@ictsoc.de> - * org-clock.el (org-in-clocktable-p): Moved to org.el. + * org-clock.el (org-in-clocktable-p): Move to org.el. * org.el (org-in-clocktable-p): New function. Moved from org-clock.el. @@ -5071,7 +5077,7 @@ 2012-04-01 Eric Schulte <eric.schulte@gmx.com> - * org-exp-blocks.el (org-export-blocks): Changed the name of + * org-exp-blocks.el (org-export-blocks): Change the name of exporting comment blocks given that it seems regular comment blocks no longer export. @@ -5086,8 +5092,8 @@ 2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com> * ob-exp.el (org-babel-exp-in-export-file) - (org-babel-exp-src-block, org-babel-exp-inline-src-blocks): Allow - org-current-export-file to contain a buffer. + (org-babel-exp-src-block, org-babel-exp-inline-src-blocks): + Allow org-current-export-file to contain a buffer. 2012-04-01 Jambunathan K <kjambunathan@gmail.com> @@ -5162,8 +5168,8 @@ * org-inlinetask.el (org-inlinetask-show-first-star): New option. (org-inlinetask-fontify): Honor `org-inlinetask-show-first-star'. - * org-indent.el (org-indent-set-line-properties): Honor - `org-inlinetask-show-first-star'. + * org-indent.el (org-indent-set-line-properties): + Honor `org-inlinetask-show-first-star'. 2012-04-01 Bastien Guerry <bzg@gnu.org> @@ -5174,8 +5180,8 @@ * org.el (org-at-drawer-p): Normalize the docstring to match other `org-at-*-p' docstrings. - (org-indent-block, org-indent-drawer, org-at-block-p): New - functions. + (org-indent-block, org-indent-drawer, org-at-block-p): + New functions. (org-metaright): Use the new functions to indent a drawer or a block depending on the context. Also update the docstring. @@ -5192,8 +5198,8 @@ 2012-04-01 Bastien Guerry <bzg@gnu.org> - * org-inlinetask.el (org-inlinetask-toggle-visibility): Use - `org-show-entry' instead of `outline-flag-region' to keep the + * org-inlinetask.el (org-inlinetask-toggle-visibility): + Use `org-show-entry' instead of `outline-flag-region' to keep the drawers folded when unfolding an inline task. 2012-04-01 Torsten Anders <torsten.anders@beds.ac.uk> (tiny change) @@ -5389,16 +5395,16 @@ * org-odt.el (org-odt-table-style-format): New. Template for auto-generated table styles. - (org-odt-automatic-styles, org-odt-object-counters): New - variables. + (org-odt-automatic-styles, org-odt-object-counters): + New variables. (org-odt-add-automatic-style): New function. - (org-odt-write-automatic-styles): New function. Create - automatic styles for tables that have custom :rel-width. + (org-odt-write-automatic-styles): New function. + Create automatic styles for tables that have custom :rel-width. (org-odt-begin-table): Parse attributes specified with "#+ATTR_ODT: " option and use it to create an automatic table style. - (org-odt-save-as-outfile): Call - `org-odt-add-write-automatic-styles'. + (org-odt-save-as-outfile): + Call `org-odt-add-write-automatic-styles'. (org-odt-init-outfile): Init newly add variables. (org-odt-section-count): Remove it. (org-odt-begin-section): Use `org-odt-add-automatic-style' to @@ -5473,13 +5479,13 @@ 2012-04-01 Bastien Guerry <bzg@gnu.org> - * org-html.el (org-export-as-html): Initialize - `html-pre-real-contents' correctly. + * org-html.el (org-export-as-html): + Initialize `html-pre-real-contents' correctly. 2012-04-01 Bastien Guerry <bzg@gnu.org> - * org-html.el (org-export-as-html): Initialize - `html-pre-real-contents' correctly. + * org-html.el (org-export-as-html): + Initialize `html-pre-real-contents' correctly. 2012-04-01 Eric Schulte <eric.schulte@gmx.com> @@ -5494,7 +5500,7 @@ 2012-04-01 Eric Schulte <eric.schulte@gmx.com> - * ob-clojure.el (org-babel-execute:clojure): Removed dependency + * ob-clojure.el (org-babel-execute:clojure): Remove dependency on deprecated swank-clojure. 2012-04-01 Eric Schulte <eric.schulte@gmx.com> @@ -5545,8 +5551,8 @@ * ob-exp.el (org-babel-exp-src-block): Use `org-babel-noweb-p'. (org-babel-exp-inline-src-blocks): Use `org-babel-noweb-p'. - * ob-tangle.el (org-babel-tangle-collect-blocks): Use - `org-babel-noweb-p'. + * ob-tangle.el (org-babel-tangle-collect-blocks): + Use `org-babel-noweb-p'. * ob.el (org-babel-execute-src-block): Use `org-babel-noweb-p'. (org-babel-expand-src-block): Use `org-babel-noweb-p'. @@ -5577,7 +5583,7 @@ 2012-04-01 Bernt Hansen <bernt@norang.ca> - * org.el: Honour existing restrictions when regenerating the agenda. + * org.el: Honor existing restrictions when regenerating the agenda. 2012-04-01 Bastien Guerry <bzg@gnu.org> @@ -5715,20 +5721,20 @@ 2012-01-03 Bastien Guerry <bzg@gnu.org> - * org-agenda.el (org-agenda-filter-by-tag): Use - `read-char-exclusive' instead of `read-char'. + * org-agenda.el (org-agenda-filter-by-tag): + Use `read-char-exclusive' instead of `read-char'. 2012-01-03 Carsten Dominik <carsten.dominik@gmail.com> (tiny change) - * org-clock.el (org-clock-in, org-clock-find-position): Remove - erraneous space in regexp. + * org-clock.el (org-clock-in, org-clock-find-position): + Remove erraneous space in regexp. 2012-01-03 Eric Schulte <eric.schulte@gmx.com> * ob.el (org-babel-expand-noweb-references): Rather than using a pure regexp solution to resolve noweb references, actually - check the information of every code block in the buffer. This - will cause a slowdown in noweb reference expansion, but is + check the information of every code block in the buffer. + This will cause a slowdown in noweb reference expansion, but is necessary for correct behavior. 2012-01-03 Bastien Guerry <bzg@gnu.org> @@ -5758,19 +5764,19 @@ 2012-01-03 Eric Schulte <eric.schulte@gmx.com> - * ob.el (org-babel-map-call-lines): Moved this file from + * ob.el (org-babel-map-call-lines): Move this file from ob-lob.el into ob.el to ease dependency pains. 2012-01-03 Bastien Guerry <bzg@gnu.org> - * org-publish.el (org-publish-index-generate-theindex): Use - theindex.inc for storing index entries, and theindex.org for + * org-publish.el (org-publish-index-generate-theindex): + Use theindex.inc for storing index entries, and theindex.org for including theindex.inc. 2012-01-03 Bastien Guerry <bzg@gnu.org> - * org-publish.el (org-publish-index-generate-theindex): Create - proper file target for index entries in subdirectories. + * org-publish.el (org-publish-index-generate-theindex): + Create proper file target for index entries in subdirectories. 2012-01-03 Bastien Guerry <bzg@gnu.org> @@ -5786,11 +5792,11 @@ customize what goes before the document body. Currently it outputs title, author and email, date and toc. (org-odt-begin-document-body): Use `org-odt-format-preamble'. - (org-odt-format-date): Renamed from + (org-odt-format-date): Rename from `org-odt-iso-date-from-org-timestamp'. Also added an additional param for format string. - (org-odt-begin-annotation, org-odt-update-meta-file): Use - `org-odt-format-date'. + (org-odt-begin-annotation, org-odt-update-meta-file): + Use `org-odt-format-date'. 2012-01-03 Bastien Guerry <bzg@gnu.org> @@ -5835,8 +5841,8 @@ overlays. (org-agenda-category-filter-preset): New variable. (org-finalize-agenda, org-agenda-redo) - (org-agenda-filter-make-matcher, org-agenda-filter-apply): Handle - both category and tag filters. + (org-agenda-filter-make-matcher, org-agenda-filter-apply): + Handle both category and tag filters. (org-agenda-filter-show-all-tag): Rename from `org-agenda-filter-by-tag-show-all'. (org-agenda-filter-show-all-cat): New function. @@ -5870,8 +5876,8 @@ 2012-01-03 Bastien Guerry <bzg@gnu.org> - * org.el (org-loop-over-headlines-in-active-region): Fix - docstring. + * org.el (org-loop-over-headlines-in-active-region): + Fix docstring. (org-todo, org-deadline, org-schedule): Honor the 'start-level value of `org-loop-over-headlines-in-active-region'. @@ -5887,8 +5893,8 @@ 2012-01-03 Bastien Guerry <bzg@gnu.org> - * org-agenda.el (org-agenda-filter-by-tag): Use - `read-char-exclusive' instead of `read-char'. + * org-agenda.el (org-agenda-filter-by-tag): + Use `read-char-exclusive' instead of `read-char'. 2012-01-03 Carsten Dominik <carsten.dominik@gmail.com> @@ -5897,8 +5903,8 @@ 2012-01-03 Carsten Dominik <carsten.dominik@gmail.com> (tiny change) - * org-clock.el (org-clock-in, org-clock-find-position): Remove - erraneous space in regexp. + * org-clock.el (org-clock-in, org-clock-find-position): + Remove erraneous space in regexp. 2012-01-03 Jambunathan K <kjambunathan@gmail.com> @@ -5908,8 +5914,8 @@ OpenDocument styles and schema files from. Set this variable explicitly only if the in-built heuristics for locating the above files fails. - (org-odt-styles-dir-list, org-odt-schema-dir-list): New - variables. Pay specific attention to (eval-when-compile ...) + (org-odt-styles-dir-list, org-odt-schema-dir-list): + New variables. Pay specific attention to (eval-when-compile ...) form through which Makefile's $(datadir) - contained in `org-odt-data-dir' - gets compiled in as a "hard coded" constant. @@ -5949,8 +5955,8 @@ * ob.el (org-babel-expand-noweb-references): Rather than using a pure regexp solution to resolve noweb references, actually - check the information of every code block in the buffer. This - will cause a slowdown in noweb reference expansion, but is + check the information of every code block in the buffer. + This will cause a slowdown in noweb reference expansion, but is necessary for correct behavior. 2012-01-03 Bastien Guerry <bzg@gnu.org> @@ -6017,19 +6023,19 @@ 2012-01-03 Eric Schulte <eric.schulte@gmx.com> - * ob.el (org-babel-map-call-lines): Moved this file from + * ob.el (org-babel-map-call-lines): Move this file from ob-lob.el into ob.el to ease dependency pains. 2012-01-03 Bastien Guerry <bzg@gnu.org> - * org-publish.el (org-publish-index-generate-theindex): Use - theindex.inc for storing index entries, and theindex.org for + * org-publish.el (org-publish-index-generate-theindex): + Use theindex.inc for storing index entries, and theindex.org for including theindex.inc. 2012-01-03 Bastien Guerry <bzg@gnu.org> - * org-publish.el (org-publish-index-generate-theindex): Create - proper file target for index entries in subdirectories. + * org-publish.el (org-publish-index-generate-theindex): + Create proper file target for index entries in subdirectories. 2012-01-03 Bastien Guerry <bzg@gnu.org> @@ -6038,18 +6044,18 @@ 2012-01-03 Jambunathan K <kjambunathan@gmail.com> - * org-odt.el (org-export-odt-default-org-styles-alist): Add - styles for title and subtitle. + * org-odt.el (org-export-odt-default-org-styles-alist): + Add styles for title and subtitle. (org-odt-format-toc): New. (org-odt-format-preamble): New. Users can redefine this to customize what goes before the document body. Currently it outputs title, author and email, date and toc. (org-odt-begin-document-body): Use `org-odt-format-preamble'. - (org-odt-format-date): Renamed from + (org-odt-format-date): Rename from `org-odt-iso-date-from-org-timestamp'. Also added an additional param for format string. - (org-odt-begin-annotation, org-odt-update-meta-file): Use - `org-odt-format-date'. + (org-odt-begin-annotation, org-odt-update-meta-file): + Use `org-odt-format-date'. 2012-01-03 Eric Schulte <eric.schulte@gmx.com> @@ -6072,8 +6078,8 @@ 2012-01-03 Dave Abrahams <dave@boostpro.com> (tiny change) - * org-agenda.el (org-agenda-do-tree-to-indirect-buffer): New - function. + * org-agenda.el (org-agenda-do-tree-to-indirect-buffer): + New function. (org-agenda-tree-to-indirect-buffer): Use the new function. 2012-01-03 Bastien Guerry <bzg@gnu.org> @@ -6083,8 +6089,8 @@ 2012-01-03 Jambunathan K <kjambunathan@gmail.com> - * org-odt.el (org-odt-format-source-code-or-example): Try - loading htmlfontify safely. + * org-odt.el (org-odt-format-source-code-or-example): + Try loading htmlfontify safely. 2012-01-03 Bastien Guerry <bzg@gnu.org> @@ -6098,7 +6104,7 @@ 2012-01-03 Eric Schulte <eric.schulte@gmx.com> - * ob.el (org-babel-expand-noweb-references): Fixed regexp. + * ob.el (org-babel-expand-noweb-references): Fix regexp. 2012-01-03 Michael Brand <michael.ch.brand@gmail.com> @@ -6107,8 +6113,8 @@ 2012-01-03 Christian Moe <mail@christianmoe.com> (tiny change) - * org-html.el (org-export-as-html): Apply - `org-export-html-get-todo-kwd-class-name' to the class + * org-html.el (org-export-as-html): + Apply `org-export-html-get-todo-kwd-class-name' to the class attribute of the todo-keyword span tag, not to its text content. @@ -6167,20 +6173,20 @@ 2012-01-03 Bastien Guerry <bzg@gnu.org> - * org-html.el (org-export-html-headline-anchor-format): New - option. + * org-html.el (org-export-html-headline-anchor-format): + New option. (org-html-level-start): Use the new option. 2012-01-03 Rob Giardina <rob@giardina.us> (tiny change) - * org-agenda.el (org-agenda-with-point-at-orig-entry): Small - bugfix. + * org-agenda.el (org-agenda-with-point-at-orig-entry): + Small bugfix. 2012-01-03 Christian Moe <mail@christianmoe.com> (tiny change) * org-special-blocks.el - (org-special-blocks-convert-html-special-cookies): Close - paragraph before opening or closing the <div>, and open + (org-special-blocks-convert-html-special-cookies): + Close paragraph before opening or closing the <div>, and open paragraph after. Also changed newline placement to be the same as for other blocks. @@ -6197,9 +6203,9 @@ 2012-01-03 Jambunathan K <kjambunathan@gmail.com> - * org-odt.el (org-odt-data-dir): Removed. - (org-odt-styles-dir, org-export-odt-schema-dir): New - variables. + * org-odt.el (org-odt-data-dir): Remove. + (org-odt-styles-dir, org-export-odt-schema-dir): + New variables. * org-odt.el, org-lparse.el: New files. @@ -6248,8 +6254,8 @@ 2012-01-03 Bastien Guerry <bzg@gnu.org> - * org.el (org-link-unescape, org-link-unescape-compound): Fix - two typos in docstrings. + * org.el (org-link-unescape, org-link-unescape-compound): + Fix two typos in docstrings. 2012-01-03 Thomas Dye <dk@poto.local> @@ -6272,8 +6278,8 @@ 2012-01-03 Eric Schulte <schulte.eric@gmail.com> - * org-exp.el (org-export-grab-title-from-buffer): Don't - license to kill text inside blocks when getting a title. + * org-exp.el (org-export-grab-title-from-buffer): + Don't license to kill text inside blocks when getting a title. 2012-01-03 Eric Schulte <schulte.eric@gmail.com> @@ -6301,13 +6307,13 @@ 2012-01-03 Eric Schulte <schulte.eric@gmail.com> - * org.el (org-reduce): Added a less functional Org-mode copy of + * org.el (org-reduce): Add a less functional Org-mode copy of the cl reduce function. 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> - * org.el (org-fontify-meta-lines-and-blocks-1): Recognize - "name" as a valid keyword that can preceed a block. + * org.el (org-fontify-meta-lines-and-blocks-1): + Recognize "name" as a valid keyword that can preceed a block. 2012-01-03 Eric Schulte <schulte.eric@gmail.com> @@ -6321,8 +6327,8 @@ 2012-01-03 Eric Schulte <schulte.eric@gmail.com> - * ob.el (org-babel-named-src-block-regexp-for-name): Ensure - that partial names are not matched. + * ob.el (org-babel-named-src-block-regexp-for-name): + Ensure that partial names are not matched. (org-babel-named-data-regexp-for-name): Ensure that partial names are not matched. @@ -6346,15 +6352,15 @@ 2012-01-03 Milan Zamazal <pdm@zamazal.org> - * org.el (org-set-outline-overlay-data): Use - outline-flag-region to make a region invisible. This ensures + * org.el (org-set-outline-overlay-data): + Use outline-flag-region to make a region invisible. This ensures all necessary actions, especially adding isearch-open-invisible property, are applied. 2012-01-03 Eric Schulte <schulte.eric@gmail.com> - * ob-lob.el (org-babel-in-example-or-verbatim): Fix - compilation warning. + * ob-lob.el (org-babel-in-example-or-verbatim): + Fix compilation warning. 2012-01-03 Eric Schulte <schulte.eric@gmail.com> @@ -6363,8 +6369,8 @@ 2012-01-03 Eric Schulte <schulte.eric@gmail.com> - * ob-lisp.el (org-babel-execute:lisp): Fixed typo. - (org-babel-lisp-vector-to-list): Fixed typo. + * ob-lisp.el (org-babel-execute:lisp): Fix typo. + (org-babel-lisp-vector-to-list): Fix typo. 2012-01-03 Eric Schulte <schulte.eric@gmail.com> @@ -6379,11 +6385,11 @@ 2012-01-03 Eric Schulte <schulte.eric@gmail.com> - * ob-exp.el (org-exp-res/src-name-cleanup): Updated Documentation. + * ob-exp.el (org-exp-res/src-name-cleanup): Update Documentation. - * ob-lob.el (org-babel-block-lob-one-liner-regexp): Updated - regular expression. - (org-babel-inline-lob-one-liner-regexp): Updated regular + * ob-lob.el (org-babel-block-lob-one-liner-regexp): + Update regular expression. + (org-babel-inline-lob-one-liner-regexp): Update regular expression. * ob-ref.el (org-babel-ref-resolve): Notice when something that @@ -6391,15 +6397,15 @@ * ob-table.el: Updated documentation. - * ob.el (org-babel-src-name-regexp): Simplified regexp. - (org-babel-get-src-block-info): Updated match strings. - (org-babel-data-names): Simplified acceptable names. + * ob.el (org-babel-src-name-regexp): Simplify regexp. + (org-babel-get-src-block-info): Update match strings. + (org-babel-data-names): Simplify acceptable names. (org-babel-find-named-block): Indentation. - (org-babel-find-named-result): Updated to not return a code block + (org-babel-find-named-result): Update to not return a code block as a result. - * org.el (org-fontify-meta-lines-and-blocks-1): Removing - references to old syntactic elements. + * org.el (org-fontify-meta-lines-and-blocks-1): + Removing references to old syntactic elements. (org-additional-option-like-keywords): Removing references to old syntactic elements. @@ -6713,7 +6719,7 @@ (org-set-regexps-and-options): Create regexps according to the following rule: use spaces only to separate elements from an headline, while allowing mixed tabs and spaces for any indentation job. - (org-nl-done-regexp, org-looking-at-done-regexp): Removed variables. + (org-nl-done-regexp, org-looking-at-done-regexp): Remove variables. (org-set-font-lock-defaults): Fontify again headlines with a keyword and no other text. Use new format strings. (org-get-heading, org-toggle-comment, org-prepare-agenda-buffers) @@ -6784,7 +6790,7 @@ 2012-01-03 Kai Tetzlaff <kai.tetzlaff@web.de> (tiny change) - * org-publish.el (org-publish-file): Added 'eval'ing the value of + * org-publish.el (org-publish-file): Add 'eval'ing the value of the :publishing-directory property before using it as destination of the publishing project. This allows to construct the publish destination directory dynamically at run-time using the return @@ -6856,11 +6862,11 @@ * ob.el: Removing `org-babel-params-from-buffer' and #+PROPERTIES: entirely. - * ob-exp.el (org-babel-exp-src-block): Removing - `org-babel-params-from-buffer' and #+PROPERTIES: entirely. + * ob-exp.el (org-babel-exp-src-block): + Removing `org-babel-params-from-buffer' and #+PROPERTIES: entirely. - * ob-lob.el (org-babel-lob-execute): Removing - `org-babel-params-from-buffer' and #+PROPERTIES: entirely. + * ob-lob.el (org-babel-lob-execute): + Removing `org-babel-params-from-buffer' and #+PROPERTIES: entirely. 2012-01-03 Eric Schulte <schulte.eric@gmail.com> @@ -6916,8 +6922,8 @@ property for consistency. Renamed local variable `aligns' to `cookies'. - * org-html.el (org-format-org-table-html): Use - `org-col-cookies'. Renamed local variable forced-aligns to + * org-html.el (org-format-org-table-html): + Use `org-col-cookies'. Renamed local variable forced-aligns to col-cookies. 2012-01-03 Carsten Dominik <carsten.dominik@gmail.com> @@ -6929,8 +6935,8 @@ (org-format-latex-as-mathml): New functions. (org-format-latex): Add a new local variable block-type that notes the nature of the equation - inline or display. Associate it's - value to `org-latex-src-embed-type' property of dvipng links. Add - mathml as new processing type. + value to `org-latex-src-embed-type' property of dvipng links. + Add mathml as new processing type. 2012-01-03 Sébastien Vauban <wxhgmqzgwmuf@spammotel.com> @@ -6938,8 +6944,8 @@ 2012-01-03 Carsten Dominik <carsten.dominik@gmail.com> - * org-latex.el (org-export-latex-tables): Honor - `org-export-latex-table-caption-above' + * org-latex.el (org-export-latex-tables): + Honor `org-export-latex-table-caption-above' (org-export-latex-table-caption-above): New option. 2012-01-03 Eric Schulte <schulte.eric@gmail.com> @@ -6949,11 +6955,11 @@ 2012-01-03 Eric Schulte <schulte.eric@gmail.com> - * ob.el (org-babel-insert-header-arg): Fixed typo. + * ob.el (org-babel-insert-header-arg): Fix typo. 2012-01-03 Jambunathan K <kjambunathan@gmail.com> - * org-exp.el (org-export-number-lines): Modified. Add a new + * org-exp.el (org-export-number-lines): Modify. Add a new parameter `preprocess' and use this for backend-agnostic handling of literal examples. @@ -7060,8 +7066,8 @@ 2012-01-03 Carsten Dominik <carsten.dominik@gmail.com> * org-agenda.el - (org-agenda-skip-additional-timestamps-same-entry): Change - default value. + (org-agenda-skip-additional-timestamps-same-entry): + Change default value. 2012-01-03 Carsten Dominik <carsten.dominik@gmail.com> @@ -7083,8 +7089,8 @@ 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> * org-list.el (org-list-parents-alist): When no parent is found - for an item, set it as the closest less indented item above. If - none is found, make it a top level item. + for an item, set it as the closest less indented item above. + If none is found, make it a top level item. (org-list-write-struct): Externalize code. (org-list-struct-fix-item-end): New function. (org-list-struct): Remove a now useless fix. @@ -7110,8 +7116,8 @@ 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> - * org-footnote.el (org-footnote-at-definition-p): Remove - useless `org-re'. + * org-footnote.el (org-footnote-at-definition-p): + Remove useless `org-re'. 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> @@ -7154,8 +7160,8 @@ 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> - * ob-asymptote.el (org-babel-asymptote-define-type): Silence - byte-compiler. + * ob-asymptote.el (org-babel-asymptote-define-type): + Silence byte-compiler. 2012-01-03 Eric Schulte <schulte.eric@gmail.com> @@ -7164,8 +7170,8 @@ 2012-01-03 Eric Schulte <schulte.eric@gmail.com> - * org-bibtex.el (org-bibtex-type-property-name): Configurable - property name for bibtex entry types. + * org-bibtex.el (org-bibtex-type-property-name): + Configurable property name for bibtex entry types. (org-bibtex-headline): Use new configurable property name. (org-bibtex-check): Use new configurable property name. (org-bibtex-create): Use new configurable property name. @@ -7191,8 +7197,8 @@ 2012-01-03 Eric Schulte <schulte.eric@gmail.com> - * ob-tangle.el (org-babel-tangle-collect-blocks): Better - delimiting of Org-mode text preceding a code block. + * ob-tangle.el (org-babel-tangle-collect-blocks): + Better delimiting of Org-mode text preceding a code block. 2012-01-03 Eric Schulte <schulte.eric@gmail.com> @@ -7201,8 +7207,8 @@ 2012-01-03 Eric Schulte <schulte.eric@gmail.com> - * ob-tangle.el (org-babel-process-comment-text): Customizable - function to process comment text. + * ob-tangle.el (org-babel-process-comment-text): + Customizable function to process comment text. (org-babel-tangle-collect-blocks): Make use of new customizable processing function. (org-babel-spec-to-string): Call customizable function rather than @@ -7268,8 +7274,8 @@ 2012-01-03 Eric Schulte <schulte.eric@gmail.com> - * org-exp.el (org-export-select-backend-specific-text): Only - remove commas on the front line of a code block. + * org-exp.el (org-export-select-backend-specific-text): + Only remove commas on the front line of a code block. 2012-01-03 Eric Schulte <schulte.eric@gmail.com> @@ -7283,8 +7289,8 @@ 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> - * org-footnote.el (org-footnote-in-valid-context-p): No - footnote in latex fragments. + * org-footnote.el (org-footnote-in-valid-context-p): + No footnote in latex fragments. 2012-01-03 Martin Rudalics <rudalics@gmx.at> @@ -7298,14 +7304,14 @@ 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> - * org-inlinetask.el (org-inlinetask-goto-end): Small - refactoring. + * org-inlinetask.el (org-inlinetask-goto-end): + Small refactoring. 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> * ob-asymptote.el (org-babel-asymptote-var-to-asymptote): refactor code. - (org-babel-asymptote-table-to-array): Removed function. + (org-babel-asymptote-table-to-array): Remove function. 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> @@ -7319,8 +7325,8 @@ 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> - * org-inlinetask.el (org-inlinetask-goto-end): Correctly - detect the end of an inlinetask when the next one starts + * org-inlinetask.el (org-inlinetask-goto-end): + Correctly detect the end of an inlinetask when the next one starts immediately after the current one. Also, return position of point. @@ -7331,8 +7337,8 @@ 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> - * ob-asymptote.el (org-babel-asymptote-define-type): Elisp - floats are asymptote reals. + * ob-asymptote.el (org-babel-asymptote-define-type): + Elisp floats are asymptote reals. 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> @@ -7364,8 +7370,8 @@ 2012-01-03 Bastien Guerry <bzg@gnu.org> * org-agenda.el (org-search-view, org-agenda-get-todos) - (org-agenda-get-deadlines, org-agenda-get-scheduled): Add - `category-pos' in let construct. + (org-agenda-get-deadlines, org-agenda-get-scheduled): + Add `category-pos' in let construct. 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> @@ -7463,8 +7469,8 @@ 2012-01-03 Eric Schulte <schulte.eric@gmail.com> - * org-exp-blocks.el (org-export-blocks-preprocess): Explicitly - cleaning up markers. + * org-exp-blocks.el (org-export-blocks-preprocess): + Explicitly cleaning up markers. 2012-01-03 Eric Schulte <schulte.eric@gmail.com> @@ -7495,8 +7501,8 @@ 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> - * org-list.el (org-list-separating-blank-lines-number): The - behaviour of `org-back-over-empty-lines' depends on the + * org-list.el (org-list-separating-blank-lines-number): + The behaviour of `org-back-over-empty-lines' depends on the associated value of `headline' in `org-blank-before-new-entry', which is out of context in a list. @@ -7507,7 +7513,7 @@ buffer isn't being watched, resume initialization of other watched buffers. In that case, give hand to others idle timers or processes more frequently. - (org-indent-agent-active-delay): Renamed from + (org-indent-agent-active-delay): Rename from `org-indent-agent-process-duration'. (org-indent-agent-passive-delay): New variable. (org-indent-agent-resume-delay): Change value. @@ -7544,7 +7550,7 @@ * org-agenda.el (org-agenda-include-all-todo): Declare this option as no longer working. (org-timeline): Rename the include-all argument to dotodo. - (org-arg-loc): Renamed from` org-include-all-loc'. + (org-arg-loc): Rename from` org-include-all-loc'. (org-agenda-list): Rename the INCLUDE-ALL argument to ARG, because its function has changed. @@ -7562,7 +7568,7 @@ (org-indent-initial-timer, org-indent-initial-resume-timer) (org-indent-initial-process-duration) (org-indent-initial-resume-delay) - (org-indent-initial-lock): Removed variables. + (org-indent-initial-lock): Remove variables. (org-indent-mode): Set up an agent to watch current buffer, or add it to the list of already watched buffers. (org-indent-initialize-agent): New function. @@ -7612,9 +7618,9 @@ 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> - * org-indent.el (org-indent-modified-headline-flag): Renamed from + * org-indent.el (org-indent-modified-headline-flag): Rename from `org-indent-deleted-headline-flag' - (org-indent-notify-modified-headline): Renamed from + (org-indent-notify-modified-headline): Rename from `org-indent-notify-deleted-headline'. Handle situations when the stars of an headline are modified. (org-indent-refresh-maybe): Remove case now handled by @@ -7623,8 +7629,8 @@ 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> - * org-indent.el (org-indent-inlinetask-first-star): New - variable. + * org-indent.el (org-indent-inlinetask-first-star): + New variable. (org-indent-add-properties): Set the first star of inline-tasks' virtual indentation in `org-warning' face. @@ -7635,8 +7641,8 @@ 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> * org-indent.el (org-indent-initial-marker) - (org-indent-initial-timer, org-indent-initial-lock): New - variables. + (org-indent-initial-timer, org-indent-initial-lock): + New variables. (org-indent-mode): At initialization, start an idle timer to indent the whole buffer. When the user is asking for control, interrupt the process, and resume at the same point when idle again. @@ -7670,16 +7676,16 @@ 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> - * org-indent.el (org-indent-fix-section-after-idle-time): Remove - variable. + * org-indent.el (org-indent-fix-section-after-idle-time): + Remove variable. (org-indent-initialize): Remove timer. (org-indent-add-properties): Refactor code. (org-indent-refresh-subtree, org-indent-refresh-section) - (org-indent-refresh-buffer,org-indent-set-initial-properties): Remove - functions. + (org-indent-refresh-buffer,org-indent-set-initial-properties): + Remove functions. (org-indent-deleted-headline): New variable. - (org-indent-notify-deleted-headline,org-indent-refresh-maybe): New - functions. + (org-indent-notify-deleted-headline,org-indent-refresh-maybe): + New functions. (org-indent-mode): Insert new functions into a hook. 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> @@ -7692,8 +7698,8 @@ line, as required by `wrap-prefix' specificity. (org-indent-refresh-section,org-indent-refresh-subtree): Refactor. (org-indent-refresh-view): New function. - (org-indent-refresh-to, org-indent-refresh-section): Removed - functions. + (org-indent-refresh-to, org-indent-refresh-section): + Remove functions. * org.el (org-unfontify-region): Do not remove prefix properties when unfontifying a region. @@ -7714,8 +7720,8 @@ 2012-01-03 Bastien Guerry <bzg@gnu.org> * org-clock.el (org-duration-string-to-minutes) - (org-minutes-to-hh:mm-string, org-hh:mm-string-to-minutes): Move - from org.el. + (org-minutes-to-hh:mm-string, org-hh:mm-string-to-minutes): + Move from org.el. 2012-01-03 Bastien Guerry <bzg@gnu.org> @@ -7741,8 +7747,8 @@ 2012-01-03 Bastien Guerry <bzg@gnu.org> - * org-archive.el (org-archive-to-archive-sibling): Use - `org-outline-regexp' instead of `outline-regexp'. + * org-archive.el (org-archive-to-archive-sibling): + Use `org-outline-regexp' instead of `outline-regexp'. 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> @@ -7788,8 +7794,8 @@ 2012-01-03 Jambunathan K <kjambunathan@gmail.com> - * org-inlinetask.el (org-inlinetask-export-templates): Fixed - template for html so that the exported file is valid + * org-inlinetask.el (org-inlinetask-export-templates): + Fix template for html so that the exported file is valid xhtml. Added template for odt. (org-inlinetask-export-handler): Fix typo in the regexp that trims content. Make sure that the content is flanked by @@ -7909,8 +7915,8 @@ 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> - * org-inlinetask.el (org-inlinetask-export-templates): Fix - docstring. + * org-inlinetask.el (org-inlinetask-export-templates): + Fix docstring. 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> @@ -7934,8 +7940,8 @@ 2012-01-03 Jambunathan K <kjambunathan@gmail.com> - * org-inlinetask.el (org-inlinetask-export-handler): Don't - export inline tasks if the current backend has provided no + * org-inlinetask.el (org-inlinetask-export-handler): + Don't export inline tasks if the current backend has provided no entries in `org-inlinetask-export-templates'. 2012-01-03 Valentin Wüstholz <wuestholz@gmail.com> (tiny change) @@ -7955,24 +7961,24 @@ 2012-01-03 David Maus <dmaus@ictsoc.de> - * org-agenda.el (org-batch-agenda, org-batch-agenda-csv): Use - `org-eval-in-environment. + * org-agenda.el (org-batch-agenda, org-batch-agenda-csv): + Use `org-eval-in-environment. 2012-01-03 David Maus <dmaus@ictsoc.de> - * org-macs.el (org-make-parameter-alist): New function. Turn - flat list of alternating symbol names and values into an alist + * org-macs.el (org-make-parameter-alist): New function. + Turn flat list of alternating symbol names and values into an alist with symbol name in car and value in cdr. 2012-01-03 David Maus <dmaus@ictsoc.de> - * org-agenda.el (org-agenda-with-point-at-orig-entry): Use - macro `org-with-gensyms'. + * org-agenda.el (org-agenda-with-point-at-orig-entry): + Use macro `org-with-gensyms'. 2012-01-03 David Maus <dmaus@ictsoc.de> - * org-macs.el (org-substitute-posix-classes): New - function. Substitute posix classes in regular expression. + * org-macs.el (org-substitute-posix-classes): + New function. Substitute posix classes in regular expression. (org-re): Use new function. 2012-01-03 David Maus <dmaus@ictsoc.de> @@ -8016,8 +8022,8 @@ 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> - * org-footnote.el (org-footnote-label-history): Removed - variable + * org-footnote.el (org-footnote-label-history): + Remove variable (org-footnote-new): Remove call to that variable. 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> @@ -8028,7 +8034,7 @@ 2012-01-03 Eric Schulte <schulte.eric@gmail.com> - * ob.el (org-babel-sha1-hash): Removed use of `copy-seq'. + * ob.el (org-babel-sha1-hash): Remove use of `copy-seq'. 2012-01-03 Eric Schulte <schulte.eric@gmail.com> @@ -8042,8 +8048,8 @@ 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> - * org-footnote.el (org-footnote-in-valid-context-p): Check - `org-protected' property before allowing to match a footnote. + * org-footnote.el (org-footnote-in-valid-context-p): + Check `org-protected' property before allowing to match a footnote. (org-footnote-at-reference-p): Remove an obsolete test. It is now done in the previous function. @@ -8054,8 +8060,8 @@ (org-narrow-to-block, org-in-block-p) (org-indent-line-function): Applied the rename. - * ob-exp.el (org-babel-in-example-or-verbatim): Applied - rename. Also removed a white space. + * ob-exp.el (org-babel-in-example-or-verbatim): + Applied rename. Also removed a white space. 2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com> @@ -8143,7 +8149,7 @@ 2011-09-02 Chong Yidong <cyd@stupidchicken.com> - * org-compat.el (org-pop-to-buffer-same-window): Deleted. + * org-compat.el (org-pop-to-buffer-same-window): Delete. * ob-ref.el (org-babel-ref-goto-headline-id): * org.el (org-get-location, org-tree-to-indirect-buffer) @@ -8184,8 +8190,8 @@ 2011-07-28 Bastien Guerry <bzg@gnu.org> - * org-publish.el (org-publish-index-generate-theindex): Rename - from `org-publish-index-generate-theindex.inc'. Use the file + * org-publish.el (org-publish-index-generate-theindex): + Rename from `org-publish-index-generate-theindex.inc'. Use the file theindex.org directly instead of including theindex.inc. (org-publish-projects): Don't delete .orgx files. (org-publish-aux-preprocess): Use .file.orgx. @@ -8209,8 +8215,8 @@ unless they were already visited. (org-sitemap-sort-files, org-sitemap-sort-folders) (org-sitemap-ignore-case, org-sitemap-requested) - (org-sitemap-date-format, org-sitemap-file-entry-format): Use - a correct prefix. + (org-sitemap-date-format, org-sitemap-file-entry-format): + Use a correct prefix. (org-publish-projects): Make sure to delete .orgx files. (org-publish-index-generate-theindex.inc): Small docstring fix. @@ -8357,8 +8363,8 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> * org.el (org-paste-subtree, org-kill-is-subtree-p) - (org-yank-folding-would-swallow-text, org-yank-generic): Use - `org-with-limited-levels' macro. + (org-yank-folding-would-swallow-text, org-yank-generic): + Use `org-with-limited-levels' macro. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> @@ -8445,8 +8451,8 @@ 2011-07-28 Matt Lundin <mdl@imapmail.org> - * org-bibtex.el (org-bibtex-create, org-bibtex-write): Change - argument of `org-toggle-tag' to 'on. (Other arguments, e.g., t, + * org-bibtex.el (org-bibtex-create, org-bibtex-write): + Change argument of `org-toggle-tag' to 'on. (Other arguments, e.g., t, have no effect). 2011-07-28 Eric Schulte <schulte.eric@gmail.com> @@ -8485,8 +8491,8 @@ (org-fill-paragraph, org-toggle-fixed-width-section) (org-yank-generic, org-yank-folding-would-swallow-text) (org-first-sibling-p, org-goto-sibling) - (org-goto-first-child, org-show-entry): Use - `org-outline-regexp' and `org-outline-regexp-bol'. + (org-goto-first-child, org-show-entry): + Use `org-outline-regexp' and `org-outline-regexp-bol'. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> @@ -8509,8 +8515,8 @@ 2011-07-28 Bastien Guerry <bzg@gnu.org> - * org-latex.el (org-export-latex-image-default-option): Change - default value. + * org-latex.el (org-export-latex-image-default-option): + Change default value. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> @@ -8526,8 +8532,8 @@ 2011-07-28 Jon Anders Skorpen <jonas@ifi.uio.no> (tiny change) - * org-publish.el (org-publish-cache-file-needs-publishing): Regexp - did not find includes with double quoted file names. + * org-publish.el (org-publish-cache-file-needs-publishing): + Regexp did not find includes with double quoted file names. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> @@ -8571,8 +8577,8 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> - * org-latex.el (org-export-latex-list-parameters): Complete - default value with cbtrans option. + * org-latex.el (org-export-latex-list-parameters): + Complete default value with cbtrans option. * org-list.el (org-list-to-latex): Set a more consistent default value. @@ -8597,8 +8603,8 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> - * org-list.el (org-list-delete-item, org-list-send-item): New - functions. + * org-list.el (org-list-delete-item, org-list-send-item): + New functions. 2011-07-28 Bastien Guerry <bzg@gnu.org> @@ -8678,8 +8684,8 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> - * org-list.el (org-plain-list-ordered-item-terminator): Remove - incorrect assumption. + * org-list.el (org-plain-list-ordered-item-terminator): + Remove incorrect assumption. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> @@ -8766,8 +8772,8 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> * org-exp.el (org-export-preprocess-string): If the last subtree - is a task, footnotes may be removed along with the subtree. This - patch ensures footnotes are put at the end of the buffer after the + is a task, footnotes may be removed along with the subtree. + This patch ensures footnotes are put at the end of the buffer after the subtree has been removed. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> @@ -8789,8 +8795,8 @@ 2011-07-28 Eric Schulte <schulte.eric@gmail.com> - * ob-python.el (org-babel-python-evaluate-session): Enough - newlines to ensure a return when ":results output :session". + * ob-python.el (org-babel-python-evaluate-session): + Enough newlines to ensure a return when ":results output :session". 2011-07-28 Eric Schulte <schulte.eric@gmail.com> @@ -8801,8 +8807,8 @@ 2011-07-28 Bastien Guerry <bzg@gnu.org> - * org-table.el (org-table-time-seconds-to-string): Use - `org-format-seconds' instead of `format-seconds'. + * org-table.el (org-table-time-seconds-to-string): + Use `org-format-seconds' instead of `format-seconds'. 2011-07-28 David Maus <dmaus@ictsoc.de> @@ -8828,14 +8834,14 @@ 2011-07-28 David Maus <dmaus@ictsoc.de> - * ob-haskell.el (org-babel-haskell-export-to-lhs): Call - `kill-buffer' with argument indiciating to kill current + * ob-haskell.el (org-babel-haskell-export-to-lhs): + Call `kill-buffer' with argument indiciating to kill current buffer. Emacs 22 compatibility. 2011-07-28 David Maus <dmaus@ictsoc.de> - * org-macs.el (org-without-partial-completion): Toggle - partial-completion-mode only if it is turned on. + * org-macs.el (org-without-partial-completion): + Toggle partial-completion-mode only if it is turned on. 2011-07-28 Bastien Guerry <bzg@gnu.org> @@ -8878,8 +8884,8 @@ 2011-07-28 Eric S Fraga <e.fraga@ucl.ac.uk> - * org-latex.el (org-export-latex-timestamp-inactive-markup): New - option to allow different markup for inactive timestamps. + * org-latex.el (org-export-latex-timestamp-inactive-markup): + New option to allow different markup for inactive timestamps. 2011-07-28 Eric Schulte <schulte.eric@gmail.com> @@ -9082,15 +9088,15 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> - * org-docbook.el (org-export-docbook-footnote-separator): New - variable. + * org-docbook.el (org-export-docbook-footnote-separator): + New variable. (org-export-as-docbook): Add a separator between footnotes. * org-html.el (org-export-html-footnote-separator): New variable. (org-export-as-html): Add a separator between footnotes. - * org-latex.el (org-export-latex-footnote-separator): New - variable. + * org-latex.el (org-export-latex-footnote-separator): + New variable. (org-export-latex-preprocess): Add a separator between footnotes. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> @@ -9108,8 +9114,8 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> - * org-footnote.el (org-footnote-next-reference-or-definition): New - function. + * org-footnote.el (org-footnote-next-reference-or-definition): + New function. * org.el (org-activate-footnote-links): Activate the whole footnote, but only fontify its label. @@ -9153,8 +9159,8 @@ 2011-07-28 Eric Schulte <schulte.eric@gmail.com> - * org-exp.el (org-export-select-backend-specific-text): Strip - protective commas from literal code blocks. + * org-exp.el (org-export-select-backend-specific-text): + Strip protective commas from literal code blocks. 2011-07-28 Eric Schulte <schulte.eric@gmail.com> @@ -9259,10 +9265,10 @@ 2011-07-28 Eric Schulte <schulte.eric@gmail.com> - * ob-lob.el (org-babel-inline-lob-one-liner-regexp): Updated to + * ob-lob.el (org-babel-inline-lob-one-liner-regexp): Update to successfully match optional trailing header arguments in square brackets. - (org-babel-lob-get-info): Updated to match the new regexp. + (org-babel-lob-get-info): Update to match the new regexp. 2011-07-28 Eric Schulte <schulte.eric@gmail.com> @@ -9284,8 +9290,8 @@ 2011-07-28 Jambunathan K <kjambunathan@gmail.com> - * org-exp.el (org-export-format-source-code-or-example): Fix - signature of org-<backend>-format-source-code-or-example function. + * org-exp.el (org-export-format-source-code-or-example): + Fix signature of org-<backend>-format-source-code-or-example function. 2011-07-28 Eric Schulte <schulte.eric@gmail.com> @@ -9294,8 +9300,8 @@ 2011-07-28 Eric Schulte <schulte.eric@gmail.com> - * ob-exp.el (org-babel-exp-lob-one-liners): Appropriate - replacement of inline call blocks with their results. + * ob-exp.el (org-babel-exp-lob-one-liners): + Appropriate replacement of inline call blocks with their results. 2011-07-28 Eric Schulte <schulte.eric@gmail.com> @@ -9347,8 +9353,8 @@ 2011-07-28 Jambunathan K <kjambunathan@gmail.com> - * org-exp.el (org-export-format-source-code-or-example): Add - support for: - custom formatters for existing backends - seamless + * org-exp.el (org-export-format-source-code-or-example): + Add support for: - custom formatters for existing backends - seamless plugging in of new backends. 2011-07-28 Jambunathan K <kjambunathan@gmail.com> @@ -9408,8 +9414,8 @@ 2011-07-28 Eric Schulte <schulte.eric@gmail.com> - * ob-emacs-lisp.el (org-babel-execute:emacs-lisp): Respects - ":results verbatim". + * ob-emacs-lisp.el (org-babel-execute:emacs-lisp): + Respects ":results verbatim". 2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> @@ -9417,8 +9423,8 @@ 2011-07-28 Eric Schulte <schulte.eric@gmail.com> - * ob-python.el (org-babel-python-evaluate-session): Send - comint-send-input after every line when interacting with an + * ob-python.el (org-babel-python-evaluate-session): + Send comint-send-input after every line when interacting with an interactive python process. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> @@ -9651,8 +9657,8 @@ 2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> - * org-html.el (org-export-as-html, org-html-level-start): Only - convert section number underscores to dashes. + * org-html.el (org-export-as-html, org-html-level-start): + Only convert section number underscores to dashes. 2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> @@ -9672,8 +9678,8 @@ 2011-07-28 Eric Schulte <schulte.eric@gmail.com> - * org-exp-blocks.el (org-export-blocks-preprocess): Ensure - balanced nested begin/end blocks in block bodies. + * org-exp-blocks.el (org-export-blocks-preprocess): + Ensure balanced nested begin/end blocks in block bodies. 2011-07-28 Dan Davison <dandavison7@gmail.com> @@ -9681,15 +9687,15 @@ 2011-07-28 Eric Schulte <schulte.eric@gmail.com> - * ob-tangle.el (org-babel-tangle-named-block-combination): Block - combination can now take a number of values. + * ob-tangle.el (org-babel-tangle-named-block-combination): + Block combination can now take a number of values. (org-babel-tangle-combine-named-blocks): More sophisticated block combination behavior. 2011-07-28 Eric Schulte <schulte.eric@gmail.com> - * ob-tangle.el (org-babel-tangle-do-combine-named-blocks): Switch - to turn on the combination of code blocks of the same name. + * ob-tangle.el (org-babel-tangle-do-combine-named-blocks): + Switch to turn on the combination of code blocks of the same name. (org-babel-tangle-combine-named-blocks): Combine blocks of the same name. @@ -9782,8 +9788,8 @@ * org-exp.el (org-export): Use new compatibility function `org-activate-mark'. - * org-compat.el (org-activate-mark): New function. Provide - `activate-mark' if not present (e.g. Emacs 22). + * org-compat.el (org-activate-mark): New function. + Provide `activate-mark' if not present (e.g. Emacs 22). 2011-07-28 David Maus <dmaus@ictsoc.de> @@ -9828,8 +9834,8 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> - * org-latex.el (org-export-latex-preprocess): Add - `original-indentation' property to footnotes so they cannot + * org-latex.el (org-export-latex-preprocess): + Add `original-indentation' property to footnotes so they cannot possibly end a list by being less indented than the item they belong to. @@ -9937,10 +9943,10 @@ 2011-07-28 Roland Kaufmann <rlndkfmn+orgmode@gmail.com> (tiny change) - * org-exp.el (org-remove-formatting-on-newlines-in-region): New - function. - (org-export-format-source-code-or-example): Call - `org-remove-formatting-on-newlines-in-region'. + * org-exp.el (org-remove-formatting-on-newlines-in-region): + New function. + (org-export-format-source-code-or-example): + Call `org-remove-formatting-on-newlines-in-region'. 2011-07-28 David Maus <dmaus@ictsoc.de> @@ -9951,14 +9957,14 @@ * org-html.el (org-export-as-html): Don't expand non-data lines of table.el tables. - (org-html-expand): Removed the (buggy) test for non-data lines + (org-html-expand): Remove the (buggy) test for non-data lines in table.el tables. The test is now done as part of org-export-as-html. (org-format-table-table-html-using-table-generate-source): - Added test for spanning of cells in table.el tables using + Add test for spanning of cells in table.el tables using table.el's own library routine. Optionally suppress export of simple table.el tables. - (org-format-table-html): Removed the (buggy) test for spanned + (org-format-table-html): Remove the (buggy) test for spanned table.el tables. The test is now done as part of org-format-table-table-html-using-table-generate-source. @@ -10002,8 +10008,8 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> - * org-list.el (org-list-separating-blank-lines-number): Fix - confusion between point and item beginning. Now, if no + * org-list.el (org-list-separating-blank-lines-number): + Fix confusion between point and item beginning. Now, if no information is available, truly follow user preference when it inserts blank lines manually. (org-list-insert-item): Send correct argument to the preceding @@ -10084,8 +10090,8 @@ 2011-07-28 Robert P. Goldman <rpgoldman@real-time.com> (tiny change) - * ob-exp.el (org-babel-exp-in-export-file): Bind - `org-link-search-inhibit-query' to t to inhibit prompts. + * ob-exp.el (org-babel-exp-in-export-file): + Bind `org-link-search-inhibit-query' to t to inhibit prompts. 2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> @@ -10136,8 +10142,8 @@ 2011-07-28 Matt Lundin <mdl@imapmail.org> - * org-bibtex.el (org-bibtex-treat-headline-as-title): New - defcustom. + * org-bibtex.el (org-bibtex-treat-headline-as-title): + New defcustom. (org-bibtex-headline): Only use headline text (not TODO or other metadata) to generate title field and auto key. (org-bibtex-fleshout): Allow user to choose whether to treat @@ -10188,7 +10194,7 @@ 2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> - * org.el (org-remove-uninherited-tags): Renamed from + * org.el (org-remove-uninherited-tags): Rename from `org-remove-iniherited-tags'. (org-scan-tags): Fix typo in function call. (org-get-tags-at): Fix typo in function call. @@ -10223,11 +10229,11 @@ 2011-07-28 Eric Schulte <schulte.eric@gmail.com> - * org-bibtex.el (org-bibtex-headline): Renamed flet function `get' + * org-bibtex.el (org-bibtex-headline): Rename flet function `get' which was causing compile problems. - (org-bibtex-fleshout): Renamed flet function `get' which was causing + (org-bibtex-fleshout): Rename flet function `get' which was causing compile problems. - (org-bibtex-write): Renamed flet function `get' which was causing + (org-bibtex-write): Rename flet function `get' which was causing compile problems. 2011-07-28 Christian Egli <christian.egli@sbszh.ch> @@ -10365,8 +10371,8 @@ 2011-07-28 Eric Schulte <schulte.eric@gmail.com> - * ob-ocaml.el (org-babel-ocaml-read-list): Use - `org-babel-script-escape'. + * ob-ocaml.el (org-babel-ocaml-read-list): + Use `org-babel-script-escape'. (org-babel-ocaml-read-array): Use `org-babel-script-escape'. 2011-07-28 Manuel Giraud <manuel.giraud@univ-nantes.fr> @@ -10381,7 +10387,7 @@ 2011-07-28 Eric Schulte <schulte.eric@gmail.com> - * org-src.el (org-src-lang-modes): Added a language alias of "C" + * org-src.el (org-src-lang-modes): Add a language alias of "C" to "c". 2011-07-28 Shaun Johnson <shaun@slugfest.demon.co.uk> (tiny change) @@ -10416,8 +10422,8 @@ 2011-07-28 Eric Schulte <schulte.eric@gmail.com> - * ob-python.el (org-babel-python-evaluate-external-process): Allow - parsing as a table in the case of ":results output table". + * ob-python.el (org-babel-python-evaluate-external-process): + Allow parsing as a table in the case of ":results output table". (org-babel-python-evaluate-session): Allow parsing as a table in the case of ":results output table". @@ -10435,8 +10441,8 @@ 2011-07-28 Julien Danjou <julien@danjou.info> * org.el (org-entry-get, org-entry-delete, org-entry-put) - (org-property-values, org-delete-property-globally): Use - `org-re-property'. + (org-property-values, org-delete-property-globally): + Use `org-re-property'. (org-re-property): New function allowing to build a regexp to match a property. @@ -10455,12 +10461,12 @@ 2011-07-28 Julien Danjou <julien@danjou.info> - * org-table.el (org-table-cleanup-narrow-column-properties): Use - point-min rather than 1 when moving in the buffer. + * org-table.el (org-table-cleanup-narrow-column-properties): + Use point-min rather than 1 when moving in the buffer. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> - * org-list.el (org-list-in-valid-context-p): Renamed from + * org-list.el (org-list-in-valid-context-p): Rename from `org-list-in-valid-block-p'. (org-at-item-p,org-list-search-generic): Use renamed function. @@ -10506,13 +10512,13 @@ 2011-07-28 Lawrence Mitchell <wence@gmx.li> - * org-latex.el (org-export-latex-convert-table.el-table): Fix - format-string for insertion of captions. + * org-latex.el (org-export-latex-convert-table.el-table): + Fix format-string for insertion of captions. 2011-07-28 Nick Dokos <nicholas.dokos@hp.com> (tiny change) - * org-exp.el (org-export-remove-comment-blocks-and-subtrees): Fix - regexp. + * org-exp.el (org-export-remove-comment-blocks-and-subtrees): + Fix regexp. 2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> (tiny change) @@ -10554,8 +10560,8 @@ 2011-07-28 Lawrence Mitchell <wence@gmx.li> - * org-html.el (org-export-as-html, org-html-level-start): Fix - logic for section number printing when NUM is an integer. + * org-html.el (org-export-as-html, org-html-level-start): + Fix logic for section number printing when NUM is an integer. 2011-07-28 Lawrence Mitchell <wence@gmx.li> @@ -10564,8 +10570,8 @@ 2011-07-28 Lawrence Mitchell <wence@gmx.li> - * org.el (org-point-at-end-of-empty-headline): Bind - `case-fold-search' to nil. + * org.el (org-point-at-end-of-empty-headline): + Bind `case-fold-search' to nil. 2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> @@ -10700,8 +10706,8 @@ 2011-07-28 Lawrence Mitchell <wence@gmx.li> * org-html.el (org-export-as-html): Get local value of - org-export-with-section-numbers from the buffer's plist. Deal - specially with the case the resulting value is an integer. + org-export-with-section-numbers from the buffer's plist. + Deal specially with the case the resulting value is an integer. (org-html-level-start): New optional argument of the option plist used instead of `org-export-with-section-numbers'. Also deal specially with the case that the value is an integer. @@ -10734,7 +10740,7 @@ 2011-07-28 Eric Schulte <schulte.eric@gmail.com> - * ob-sh.el (org-babel-sh-var-to-sh): Fixed insertion of tabular + * ob-sh.el (org-babel-sh-var-to-sh): Fix insertion of tabular data into shell variables. 2011-07-28 David Maus <dmaus@ictsoc.de> @@ -10749,8 +10755,8 @@ 2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> - * org-table.el (org-table-formula-handle-first/last-rc): Bind - `char'. + * org-table.el (org-table-formula-handle-first/last-rc): + Bind `char'. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> @@ -10866,8 +10872,8 @@ * org-html.el (org-export-as-html): Handle links with `org-html-handle-links' after we handle special characters conversions. - (org-html-make-link, org-export-html-format-image): Don't - protect html with @ anymore, as links are now handled after + (org-html-make-link, org-export-html-format-image): + Don't protect html with @ anymore, as links are now handled after special characters conversions. 2011-07-28 Julien Danjou <julien@danjou.info> @@ -10949,8 +10955,8 @@ * org-html.el (org-export-html-insert-plist-item): Remove. (org-export-html-preamble): Default to `t'. Accept functions. - (org-export-html-postamble): Default to `auto'. Accept - functions and distinguish between 'auto (no formatting string) + (org-export-html-postamble): Default to `auto'. + Accept functions and distinguish between 'auto (no formatting string) and `t' (default formatting string). (org-export-as-html): Handle org-export-html-preamble and org-export-html-postamble new defaults/allowed values. @@ -10968,7 +10974,7 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> - * org-list.el (org-list-parse-list): Fixed regexp. + * org-list.el (org-list-parse-list): Fix regexp. 2011-07-28 David Maus <dmaus@ictsoc.de> @@ -10984,8 +10990,8 @@ 2011-07-28 David Maus <dmaus@ictsoc.de> - * org-html.el (org-html-make-link, org-html-handle-links): Protect - generated XHTML elements. + * org-html.el (org-html-make-link, org-html-handle-links): + Protect generated XHTML elements. (org-export-as-html): Expand character entities after creating markup for links and timestamps. @@ -11064,8 +11070,8 @@ 2011-07-28 Jason Dunsmore <emacs-orgmode@deathroller.dunsmor.com> (tiny change) - * org.el (org-back-over-empty-lines): Bugfix. Honor - `org-blank-before-new-entry' correctly in various contexts. + * org.el (org-back-over-empty-lines): Bugfix. + Honor `org-blank-before-new-entry' correctly in various contexts. 2011-07-28 Bastien Guerry <bzg@gnu.org> @@ -11087,8 +11093,8 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> * org-list.el (org-update-checkbox-count): Ensure cookies on an - heading are correctly updated when checkboxes are hidden. It - allows, for example, to use C-c C-x C-b on a collapsed tree and + heading are correctly updated when checkboxes are hidden. + It allows, for example, to use C-c C-x C-b on a collapsed tree and still get the update. 2011-07-28 David Maus <dmaus@ictsoc.de> @@ -11147,8 +11153,8 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> - * org.el (org-demote-subtree,org-promote-subtree): Wrap - `org-map-tree' into `org-with-limited-levels' macro, so it avoids + * org.el (org-demote-subtree,org-promote-subtree): + Wrap `org-map-tree' into `org-with-limited-levels' macro, so it avoids operating on inline tasks. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> @@ -11279,8 +11285,8 @@ 2011-07-28 Bastien Guerry <bzg@gnu.org> - * org-exp-bibtex.el (org-export-bibtex-preprocess): Use - `org-export-current-backend'. + * org-exp-bibtex.el (org-export-bibtex-preprocess): + Use `org-export-current-backend'. 2011-07-28 Eric Schulte <schulte.eric@gmail.com> @@ -11295,8 +11301,8 @@ 2011-07-28 Bastien Guerry <bzg@gnu.org> * org-special-blocks.el - (org-special-blocks-make-special-cookies): Use - `org-export-current-backend'. + (org-special-blocks-make-special-cookies): + Use `org-export-current-backend'. 2011-07-28 Eric Schulte <schulte.eric@gmail.com> @@ -11304,7 +11310,7 @@ as an argument. (org-babel-exp-src-block): Explicitly pass language to `org-babel-exp-in-export-file'. - (org-babel-exp-inline-src-blocks): Removed unused code. + (org-babel-exp-inline-src-blocks): Remove unused code. (org-babel-exp-results): Explicitly pass language to `org-babel-exp-in-export-file'. @@ -11357,7 +11363,7 @@ * org-table.el (orgtbl-ctrl-c-ctrl-c): Bind local variable `const-str'. - * org.el (org-eval): Moved function here from org-agenda.el. + * org.el (org-eval): Move function here from org-agenda.el. 2011-07-28 Eric Schulte <schulte.eric@gmail.com> @@ -11468,8 +11474,8 @@ 2011-07-28 Eric Schulte <schulte.eric@gmail.com> - * org-exp-blocks.el (org-export-blocks-format-comment): Explicitly - append a newline to the body. + * org-exp-blocks.el (org-export-blocks-format-comment): + Explicitly append a newline to the body. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> @@ -11523,8 +11529,8 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> * org-list.el (org-cycle-item-indentation): Do not break an - indentation cycle because visibility cycling is requested. This - happens when an item becomes a parent, due to indentation change. + indentation cycle because visibility cycling is requested. + This happens when an item becomes a parent, due to indentation change. Not considered empty anymore, the function cannot change its indentation again. @@ -11587,8 +11593,8 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> - * org-list.el (org-toggle-checkbox, org-update-checkbox-count): No - need to wrap `org-entry-get' in `ignore-errors'. + * org-list.el (org-toggle-checkbox, org-update-checkbox-count): + No need to wrap `org-entry-get' in `ignore-errors'. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> @@ -11599,8 +11605,8 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> - * org-exp.el (org-export-select-backend-specific-text): Add - `original-indentation' property when replacing #+begin_backend and + * org-exp.el (org-export-select-backend-specific-text): + Add `original-indentation' property when replacing #+begin_backend and #+backend blocks with their content. This is needed for lists, as they must know if the block belonged to them. @@ -11635,8 +11641,8 @@ * org.el (org-cycle, org-cycle-internal-local): Separate lists and inline tasks from headlines. - (org-outline-level): Do not consider lists as headlines. Cycling - visibility is using different tools. + (org-outline-level): Do not consider lists as headlines. + Cycling visibility is using different tools. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> @@ -11701,8 +11707,8 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> - * org.el (org-toggle-item): Now accepts a prefix argument. When - used without argument on normal text, it will make the whole + * org.el (org-toggle-item): Now accepts a prefix argument. + When used without argument on normal text, it will make the whole region one item. With an argument, it defaults to old behavior: change each line in region into an item. @@ -11733,23 +11739,23 @@ * org-exp.el (org-export-mark-list-properties): Apply renaming. - * org-list.el (org-list-prevs-alist): Renamed from + * org-list.el (org-list-prevs-alist): Rename from `org-list-struct-prev-alist'. - (org-list-parents-alist): Renamed from `org-list-struct-parent-alist'. - (org-list-write-struct): Renamed from `org-list-struct-fix-struct'. + (org-list-parents-alist): Rename from `org-list-struct-parent-alist'. + (org-list-write-struct): Rename from `org-list-struct-fix-struct'. (org-list-parse-list, org-sort-list, org-list-indent-item-generic) (org-toggle-checkbox, org-update-checkbox-count) (org-cycle-list-bullet, org-list-repair, org-insert-item) (org-move-item-up, org-move-item-up, org-move-item-down) (org-next-item, org-previous-item, org-end-of-item-list) (org-beginning-of-item-list, org-apply-on-list): Apply renaming. - (org-get-bullet): Removed function, as it is not needed anymore. + (org-get-bullet): Remove function, as it is not needed anymore. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> * org-list.el (org-list-insert-item-generic): Change arguments. - The function now accepts structure and previous items alist. This - allows to insert an item programmatically more easily. + The function now accepts structure and previous items alist. + This allows to insert an item programmatically more easily. (org-insert-item): Apply changes to `org-list-insert-item-generic'. The function now takes care about repairing structure and updating checkboxes. @@ -11762,11 +11768,11 @@ * org-list.el (org-list-make-subtree): Function now uses `org-list-parse-list mechanism'. - (org-list-make-subtrees): Removed function. - (org-list-to-generic): Added a parameter and every parameter can + (org-list-make-subtrees): Remove function. + (org-list-to-generic): Add a parameter and every parameter can be a sexp returning a string, for finer control. - (org-list-to-html, org-list-to-latex, org-list-to-texinfo): Slight - modifications to apply changes to `org-list-to-generic'. + (org-list-to-html, org-list-to-latex, org-list-to-texinfo): + Slight modifications to apply changes to `org-list-to-generic'. (org-list-to-subtree): New function. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> @@ -11788,8 +11794,8 @@ (org-list-parse-list): Handle counters and list depth. (org-list-to-generic): A special string is used when an item has a counter. - (org-list-to-latex): Use new special string for counters. This - fixes the counter bug in LaTeX export, as the enumi counter was + (org-list-to-latex): Use new special string for counters. + This fixes the counter bug in LaTeX export, as the enumi counter was the only one modified. * org-latex.el (org-export-latex-lists): Use new @@ -11808,9 +11814,9 @@ * org-list.el (org-alphabetical-lists): New variable (org-item-re, org-list-full-item, org-cycle-list-bullet) - (org-list-struct-fix-bul, org-list-inc-bullet-maybe): Reflect - introduction of the new variable. - (org-item-beginning-re): Changed into a function, so any + (org-list-struct-fix-bul, org-list-inc-bullet-maybe): + Reflect introduction of the new variable. + (org-item-beginning-re): Change into a function, so any modification of `org-alphabetical-lists' will not require reloading Org. (org-at-item-p, org-toggle-checkbox, org-update-checkbox-count) @@ -11841,7 +11847,7 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> - * org-list.el (org-list-end-re): Removed function and made it a + * org-list.el (org-list-end-re): Remove function and made it a variable. There's no need for the overhead of calling the function every at every line in a list. User will have to reload Org if he change value of either `org-list-end-regexp' or @@ -11851,8 +11857,8 @@ * org-exp.el (org-export-mark-list-end) (org-export-mark-list-properties): Apply change. - * org-latex.el (org-export-latex-lists): Apply change. Also - prevent items with org-example property to be considered as real + * org-latex.el (org-export-latex-lists): Apply change. + Also prevent items with org-example property to be considered as real items. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> @@ -11880,8 +11886,8 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> - * org-list.el (org-list-automatic-rules): Removed insert rule. - (org-list-insert-item-generic): Removed code preventing user to + * org-list.el (org-list-automatic-rules): Remove insert rule. + (org-list-insert-item-generic): Remove code preventing user to insert another item in a block within a list. It is because new list context make it impossible to see if a point in a block is also in a list. @@ -11895,7 +11901,7 @@ can easily be included in lists. (org-export-mark-list-end): New function. (org-export-mark-list-properties): New function. - (org-export-mark-lists): Removed function. It was split into the + (org-export-mark-lists): Remove function. It was split into the two preceding functions. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> @@ -11913,19 +11919,19 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> - * org-list.el (org-list-forbidden-blocks): Renamed from + * org-list.el (org-list-forbidden-blocks): Rename from `org-list-blocks'. (org-list-export-context): New variable. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> - * org-list.el (org-list-search-generic): Renamed form + * org-list.el (org-list-search-generic): Rename form `org-search-unenclosed-generic' to reflect the new behavior. Now, match can only be in a valid context for lists, as determined by `org-list-context'. - (org-list-search-backward): Renamed from + (org-list-search-backward): Rename from `org-search-backward-unenclosed'. - (org-list-search-forward): Renamed from + (org-list-search-forward): Rename from `org-search-forward-unenclosed'. (org-toggle-checkbox,org-update-checkbox-count): Use new functions. @@ -11948,7 +11954,7 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> - * org.el (org-get-string-indentation): Moved in generally useful + * org.el (org-get-string-indentation): Move in generally useful functions section, as it wasn't specific to plain lists and that no code was using it in org-list.el. @@ -11969,8 +11975,8 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> - * org-list.el (org-apply-on-list): Use new structures. Function - is now applied in reverse order so modifications do not change + * org-list.el (org-apply-on-list): Use new structures. + Function is now applied in reverse order so modifications do not change positions of items in buffer. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> @@ -11984,7 +11990,7 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> - * org-list.el (org-list-has-child-p): Renamed from + * org-list.el (org-list-has-child-p): Rename from `org-list-get-child'. Returning first child is only useful as a predicate, as we are allowing an item to have more than one sub-list. @@ -12036,34 +12042,34 @@ * org-list.el (org-list-in-item-p): Unify methods for this predicate. - (org-list-in-item-p-with-indent): Removed function. - (org-list-ending-between): Removed function. - (org-list-maybe-skip-block): Removed function. - (org-list-in-item-p-with-regexp): Removed function. - (org-list-top-point-with-regexp): Removed function. - (org-list-top-point-with-indent): Removed function. - (org-list-bottom-point-with-indent): Removed function. - (org-list-bottom-point-with-regexp): Removed function. - (org-list-get-item-same-level): Removed function. - (org-list-top-point): Removed function. - (org-list-bottom-point): Removed function. - (org-get-item-beginning): Renamed to `org-list-get-item-begin' to + (org-list-in-item-p-with-indent): Remove function. + (org-list-ending-between): Remove function. + (org-list-maybe-skip-block): Remove function. + (org-list-in-item-p-with-regexp): Remove function. + (org-list-top-point-with-regexp): Remove function. + (org-list-top-point-with-indent): Remove function. + (org-list-bottom-point-with-indent): Remove function. + (org-list-bottom-point-with-regexp): Remove function. + (org-list-get-item-same-level): Remove function. + (org-list-top-point): Remove function. + (org-list-bottom-point): Remove function. + (org-get-item-beginning): Rename to `org-list-get-item-begin' to be consistent with naming policy of non-interactive functions. - (org-get-beginning-of-list): Removed function. + (org-get-beginning-of-list): Remove function. (org-beginning-of-item-list): Use new accessors. - (org-get-end-of-list): Removed function. + (org-get-end-of-list): Remove function. (org-end-of-list): Use new accessors. - (org-get-end-of-item): Removed function. + (org-get-end-of-item): Remove function. (org-end-of-item): Use new accessors. - (org-get-previous-item): Removed function. + (org-get-previous-item): Remove function. (org-previous-item): Use new accessors. - (org-get-next-item): Removed function. + (org-get-next-item): Remove function. (org-next-item): Use new accessors. (org-list-get-item-end-before-blank): Use new accessors. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> - * org-list.el (org-list-repair): Removed optional argument + * org-list.el (org-list-repair): Remove optional argument FORCE-BULLET. The job of this interactive function is to completely fix a list at point. Changing bullets is a separate task. Also removed others optional arguments TOP and BOTTOM to @@ -12078,8 +12084,8 @@ (org-list-insert-item-generic): Reflect changes to `org-list-repair'. (org-list-exchange-items): Use new accessors. Now modify struct to avoid re-reading it later. - (org-move-item-down): Reflect changes to `org-list-repair'. Use - new accessors. + (org-move-item-down): Reflect changes to `org-list-repair'. + Use new accessors. (org-move-item-up): Reflect changes to `org-list-repair'. Use new accessors. (org-cycle-list-bullet): Use new structures. Also use a shortcut @@ -12123,7 +12129,7 @@ new accessors. (org-list-struct-fix-ind): Make use of new accessors. (org-list-struct-fix-box): New function. - (org-list-struct-fix-checkboxes): Removed function. + (org-list-struct-fix-checkboxes): Remove function. (org-list-struct-outdent): Use new accessors. Use the fact that there is no longer a virtual item at beginning of structure. (org-list-struct-indent): Use helper functions @@ -12134,7 +12140,7 @@ first. (org-list-struct-apply-struct): Comment function. Rewrite using new accessors. Use new variable `org-list-full-item-re'. - (org-list-shift-item-indentation): Removed function, now included + (org-list-shift-item-indentation): Remove function, now included in `org-list-struct-apply-struct' because it is too specific. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> @@ -12146,7 +12152,7 @@ 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> * org-list.el (org-list-struct-fix-checkboxes): New function. - (org-checkbox-blocked-p): Removed function. + (org-checkbox-blocked-p): Remove function. 2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> @@ -12163,8 +12169,8 @@ (org-list-struct-fix-bul): Use new accessors. (org-list-repair): Use new accessors. (org-list-indent-item-generic): Make use of accessors. - (org-list-get-parent): Renamed from `org-list-struct-get-parent'. - (org-list-get-child): Renamed from `org-list-struct-get-child'. + (org-list-get-parent): Rename from `org-list-struct-get-parent'. + (org-list-get-child): Rename from `org-list-struct-get-child'. (org-list-struct-fix-ind): Make use of accessors. (org-list-get-next-item): New function. (org-list-get-subtree): New function. @@ -12188,8 +12194,8 @@ 2011-07-28 David Maus <dmaus@ictsoc.de> * org-protocol.el (org-protocol-unhex-single-byte-sequence) - (org-protocol-unhex-string, org-protocol-unhex-compound): Change - date of obsolete declaration to 2011-02-17. + (org-protocol-unhex-string, org-protocol-unhex-compound): + Change date of obsolete declaration to 2011-02-17. 2011-07-28 David Maus <dmaus@ictsoc.de> @@ -12276,8 +12282,8 @@ 2011-07-28 Sebastian Rose <sebastian_rose@gmx.de> - * org-protocol.el (org-protocol-unhex-single-byte-sequence): New - function. Decode hex-encoded singly byte sequences. + * org-protocol.el (org-protocol-unhex-single-byte-sequence): + New function. Decode hex-encoded singly byte sequences. (org-protocol-unhex-compound): Use new function if decoding sequence as Unicode character failed. @@ -12287,8 +12293,8 @@ 2011-07-28 Bastien Guerry <bzg@gnu.org> - * org-publish.el (org-publish-cache-ctime-of-src): Improve - docstring. + * org-publish.el (org-publish-cache-ctime-of-src): + Improve docstring. (org-publish-find-title): New option to explicitly reset the title in the cache. (org-publish-format-file-entry): Use this new option. @@ -12301,13 +12307,13 @@ 2011-07-28 Dan Davison <dandavison7@gmail.com> - * org-exp.el (org-export-format-source-code-or-example): Allow - empty string as second element in minted/listings options. + * org-exp.el (org-export-format-source-code-or-example): + Allow empty string as second element in minted/listings options. 2011-07-28 Dan Davison <dandavison7@gmail.com> - * org-exp.el (org-export-format-source-code-or-example): Support - new user-customizable options. + * org-exp.el (org-export-format-source-code-or-example): + Support new user-customizable options. (org-export-latex-custom-lang-environments): Ensure new variable is defined. (org-export-latex-listings-options): Ensure new variable is defined. @@ -12409,8 +12415,8 @@ 2011-07-28 Bastien Guerry <bzg@gnu.org> - * org-latex.el (org-export-latex-hyperref-format): Update - docstring. + * org-latex.el (org-export-latex-hyperref-format): + Update docstring. 2011-07-28 Tom Dye <tsd@tsdye.com> @@ -12513,8 +12519,8 @@ 2011-07-28 Eric Schulte <schulte.eric@gmail.com> - * org-exp-blocks.el (org-export-blocks-format-ditaa): This - function is begin deprecated in favor of begin_src blocks. + * org-exp-blocks.el (org-export-blocks-format-ditaa): + This function is begin deprecated in favor of begin_src blocks. (org-export-blocks-format-dot): This function is begin deprecated in favor of begin_src blocks. @@ -12543,8 +12549,8 @@ 2011-07-28 Julien Danjou <julien@danjou.info> - * org-agenda.el (org-agenda): Kill all local variables. This - assures we are not keeping buffer variable from an old agenda view + * org-agenda.el (org-agenda): Kill all local variables. + This assures we are not keeping buffer variable from an old agenda view when switching to a new custom agenda. 2011-07-28 Julien Danjou <julien@danjou.info> @@ -12605,8 +12611,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. The - agenda will show repeating stamps for entries matching these TODO + 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) (org-agenda-get-scheduled): Allow the use of a list of keywords in @@ -12657,8 +12663,8 @@ 2011-07-28 Bastien Guerry <bzg@gnu.org> - * org-latex.el (org-export-latex-emphasis-alist): Use - \protectedtexttt for the =...= emphasis and \verb for the ~...~ + * org-latex.el (org-export-latex-emphasis-alist): + Use \protectedtexttt for the =...= emphasis and \verb for the ~...~ emphasis. (org-export-latex-use-verb): Now defaults to t. (org-export-latex-emph-format): Distinguish between =...= and @@ -12715,18 +12721,18 @@ 2011-07-28 Eric Schulte <schulte.eric@gmail.com> - * ob-exp.el (org-babel-exp-do-export): Simplified, no longer need + * ob-exp.el (org-babel-exp-do-export): Simplify, no longer need to do anything to export code. (org-babel-exp-results): No longer returns a replacement for the code block. - (org-babel-exp-inline-src-blocks): Simplified. - (org-babel-exp-src-block): Removed unnecessary pluralization from + (org-babel-exp-inline-src-blocks): Simplify. + (org-babel-exp-src-block): Remove unnecessary pluralization from function name. 2011-07-28 Eric Schulte <schulte.eric@gmail.com> - * ob-exp.el (org-babel-exp-inline-src-blocks): Simplified - exportation of inline code blocks using normal code block + * ob-exp.el (org-babel-exp-inline-src-blocks): + Simplify exportation of inline code blocks using normal code block execution mechanism to insert results. (org-babel-exp-results): Results exportation mechanism is unified for both inline and regular code blocks. @@ -13029,8 +13035,8 @@ (org-entry-properties): Remove refresh - this is now done in org-get-category. - * org-clock.el (org-clock-insert-selection-line): Let - `org-get-category' do the property refresh. + * org-clock.el (org-clock-insert-selection-line): + Let `org-get-category' do the property refresh. * org-archive.el (org-archive-subtree): Force a refresh of category properties. @@ -13089,7 +13095,7 @@ 2011-07-28 Eric Schulte <schulte.eric@gmail.com> - * ob.el (org-babel-execute-src-block): Removed unused flet + * ob.el (org-babel-execute-src-block): Remove unused flet function. 2011-07-28 Dan Davison <dandavison7@gmail.com> @@ -13178,13 +13184,13 @@ 2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> - * org-capture.el (org-capture-set-target-location): Use - `current-time'. + * org-capture.el (org-capture-set-target-location): + Use `current-time'. 2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> - * org-capture.el (org-capture-set-target-location): Use - `current-time'. + * org-capture.el (org-capture-set-target-location): + Use `current-time'. 2011-07-28 Bernt Hansen <bernt@norang.ca> @@ -13227,8 +13233,8 @@ 2011-07-28 Julien Danjou <julien@danjou.info> - * org-capture.el (org-capture-fill-template): Use - `org-set-property' directly. + * org-capture.el (org-capture-fill-template): + Use `org-set-property' directly. 2011-07-28 Julien Danjou <julien@danjou.info> @@ -13277,8 +13283,8 @@ 2011-07-28 Konrad Hinsen <konrad.hinsen@fastmail.net> - * ob-python.el (org-babel-python-initiate-session-by-key): Make - sure that py-which-bufname is initialized, as otherwise it will be + * ob-python.el (org-babel-python-initiate-session-by-key): + Make sure that py-which-bufname is initialized, as otherwise it will be overwritten the first time a Python buffer is created. 2011-07-28 Eric Schulte <schulte.eric@gmail.com> @@ -13322,8 +13328,8 @@ 2011-07-28 Åukasz Stelmach <lukasz.stelmach@iem.pw.edu.pl> - * org-html.el (org-export-html-mathjax-template): Displaymath - environment and MathJax. + * org-html.el (org-export-html-mathjax-template): + Displaymath environment and MathJax. 2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> @@ -14342,7 +14348,7 @@ 2010-11-11 Eric Schulte <schulte.eric@gmail.com> - * ob.el (org-babel-demarcate-block): Updated to reflect the new + * ob.el (org-babel-demarcate-block): Update to reflect the new info list contents. 2010-11-11 Dan Davison <davison@stats.ox.ac.uk> @@ -14382,7 +14388,7 @@ 2010-11-11 Eric Schulte <schulte.eric@gmail.com> - * ob-table.el (sbe): Simplified to reflect to var resolution. + * ob-table.el (sbe): Simplify to reflect to var resolution. 2010-11-11 Eric Schulte <schulte.eric@gmail.com> @@ -15281,7 +15287,7 @@ (org-speed-command-default-hook): The default hook for org-speed-command-hook. Factored out from org-self-insert-command and mimics existing behavior. - (org-self-insert-command): Modified to use org-speed-command-hook. + (org-self-insert-command): Modify to use org-speed-command-hook. 2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> @@ -15769,8 +15775,8 @@ 2010-11-11 Dan Davison <davison@stats.ox.ac.uk> * org.el (org-fontify-meta-lines-and-blocks): Alter main regexp to - match code blocks with switches and header args. Call - `org-src-font-lock-fontify-block' for automatic fontification of + match code blocks with switches and header args. + Call `org-src-font-lock-fontify-block' for automatic fontification of code in code blocks, controlled by variable `org-src-fontify-natively'. (org-src-fontify-natively): New variable. @@ -15939,8 +15945,8 @@ change. * org-list.el (org-indent-item-tree): Prevent whole list from - being moved when user is not moving subtree. Thus - `org-cycle-item-indentation' will not allow to move the list. + being moved when user is not moving subtree. + Thus `org-cycle-item-indentation' will not allow to move the list. 2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> @@ -16032,7 +16038,7 @@ `org-toggle-checkbox' is trying to insert a checkbox at a description item. - * org-list.el (org-item-re): Modified regexp so it can catch + * org-list.el (org-item-re): Modify regexp so it can catch correct number of white space before item body. * org-list.el (org-list-at-regexp-after-bullet-p): Take into @@ -16644,7 +16650,7 @@ 2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> - * org.el (org-make-link-regexps): Modified regexp of + * org.el (org-make-link-regexps): Modify regexp of org-plain-link-re. 2010-11-11 Noorul Islam <noorul@noorul.com> (tiny change) @@ -16769,7 +16775,7 @@ * org-feed.el (xml-substitute-special): Declare function for byte compiler. - (org-feed-unescape): Removed. + (org-feed-unescape): Remove. (org-feed-parse-rss-entry, org-feed-parse-atom-entry): Use `xml-substitute-special' to unescape XML entities. @@ -17103,7 +17109,7 @@ 2010-11-11 Eric Schulte <schulte.eric@gmail.com> - * ob-R.el (org-babel-R-evaluate): Improved prompt-stripping regexp. + * ob-R.el (org-babel-R-evaluate): Improve prompt-stripping regexp. 2010-11-11 Eric Schulte <schulte.eric@gmail.com> @@ -21694,7 +21700,7 @@ 2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> - * org.el (org-cycle-internal-local): Improved version of finding + * org.el (org-cycle-internal-local): Improve version of finding next visible line. (org-cycle-hide-drawers): Only hide drawers if this is really necessary. diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 79217b6a6e6..764b15ff6c5 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -2015,10 +2015,10 @@ The following commands are available: (org-add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local) (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local) ;; Make sure properties are removed when copying text - (make-local-variable 'filter-buffer-substring-functions) (add-hook 'filter-buffer-substring-functions (lambda (fun start end delete) - (substring-no-properties (funcall fun start end delete)))) + (substring-no-properties (funcall fun start end delete))) + nil t) (unless org-agenda-keep-modes (setq org-agenda-follow-mode org-agenda-start-with-follow-mode org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el index 6e6f2bf1589..9719a1fa035 100644 --- a/lisp/org/org-indent.el +++ b/lisp/org/org-indent.el @@ -182,11 +182,11 @@ during idle time." (org-set-local 'org-hide-leading-stars-before-indent-mode org-hide-leading-stars) (org-set-local 'org-hide-leading-stars t)) - (make-local-variable 'filter-buffer-substring-functions) (add-hook 'filter-buffer-substring-functions (lambda (fun start end delete) (org-indent-remove-properties-from-string - (funcall fun start end delete)))) + (funcall fun start end delete))) + nil t) (org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local) (org-add-hook 'before-change-functions 'org-indent-notify-modified-headline nil 'local) @@ -213,7 +213,8 @@ during idle time." (remove-hook 'filter-buffer-substring-functions (lambda (fun start end delete) (org-indent-remove-properties-from-string - (funcall fun start end delete)))) + (funcall fun start end delete))) + t) (remove-hook 'after-change-functions 'org-indent-refresh-maybe 'local) (remove-hook 'before-change-functions 'org-indent-notify-modified-headline 'local) diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el index e2b5dd9fb3b..7ae80b02e2f 100644 --- a/lisp/org/org-pcomplete.el +++ b/lisp/org/org-pcomplete.el @@ -46,6 +46,7 @@ ;;;; Customization variables +;; Unused. Cf org-completion. (defgroup org-complete nil "Outline-based notes management and organizer." :tag "Org" diff --git a/lisp/paren.el b/lisp/paren.el index a9d3be60622..6f386573b01 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -37,11 +37,6 @@ :prefix "show-paren-" :group 'paren-matching) -;; This is the overlay used to highlight the matching paren. -(defvar show-paren-overlay nil) -;; This is the overlay used to highlight the closeparen right before point. -(defvar show-paren-overlay-1 nil) - (defcustom show-paren-style 'parenthesis "Style used when showing a matching paren. Valid styles are `parenthesis' (meaning show the matching paren), @@ -107,7 +102,14 @@ active, you must toggle the mode off and on again for this to take effect." (defvar show-paren-highlight-openparen t "Non-nil turns on openparen highlighting when matching forward.") -(defvar show-paren-idle-timer nil) +(defvar show-paren--idle-timer nil) +(defvar show-paren--overlay + (let ((ol (make-overlay (point) (point) nil t))) (delete-overlay ol) ol) + "Overlay used to highlight the matching paren.") +(defvar show-paren--overlay-1 + (let ((ol (make-overlay (point) (point) nil t))) (delete-overlay ol) ol) + "Overlay used to highlight the paren at point.") + ;;;###autoload (define-minor-mode show-paren-mode @@ -120,154 +122,148 @@ Show Paren mode is a global minor mode. When enabled, any matching parenthesis is highlighted in `show-paren-style' after `show-paren-delay' seconds of Emacs idle time." :global t :group 'paren-showing - ;; Enable or disable the mechanism. - ;; First get rid of the old idle timer. - (if show-paren-idle-timer - (cancel-timer show-paren-idle-timer)) - (setq show-paren-idle-timer nil) - ;; If show-paren-mode is enabled in some buffer now, - ;; set up a new timer. - (when (memq t (mapcar (lambda (buffer) - (with-current-buffer buffer - show-paren-mode)) - (buffer-list))) - (setq show-paren-idle-timer (run-with-idle-timer - show-paren-delay t - 'show-paren-function))) - (unless show-paren-mode - (and show-paren-overlay - (eq (overlay-buffer show-paren-overlay) (current-buffer)) - (delete-overlay show-paren-overlay)) - (and show-paren-overlay-1 - (eq (overlay-buffer show-paren-overlay-1) (current-buffer)) - (delete-overlay show-paren-overlay-1)))) + ;; Enable or disable the mechanism. + ;; First get rid of the old idle timer. + (when show-paren--idle-timer + (cancel-timer show-paren--idle-timer) + (setq show-paren--idle-timer nil)) + (setq show-paren--idle-timer (run-with-idle-timer + show-paren-delay t + #'show-paren-function)) + (unless show-paren-mode + (delete-overlay show-paren--overlay) + (delete-overlay show-paren--overlay-1))) + +(defvar show-paren-data-function #'show-paren--default + "Function to find the opener/closer at 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 +\(HERE-BEG HERE-END THERE-BEG THERE-END MISMATCH) +Where HERE-BEG..HERE-END is expected to be around 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) + ;; + ;; 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)))))))) ;; Find the place to show, if there is one, ;; and show it until input arrives. (defun show-paren-function () - (if show-paren-mode - (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))))))) - pos mismatch face) - ;; - ;; 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. - (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. - (when (integerp pos) - (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)))))))))))) - ;; - ;; Highlight the other end of the sexp, or unhighlight if none. - (if (not pos) - (progn - ;; If not at a paren that has a match, - ;; turn off any previous paren highlighting. - (and show-paren-overlay (overlay-buffer show-paren-overlay) - (delete-overlay show-paren-overlay)) - (and show-paren-overlay-1 (overlay-buffer show-paren-overlay-1) - (delete-overlay show-paren-overlay-1))) - ;; - ;; Use the correct face. - (if mismatch - (progn - (if show-paren-ring-bell-on-mismatch - (beep)) - (setq face 'show-paren-mismatch)) - (setq face 'show-paren-match)) - ;; - ;; If matching backwards, highlight the closeparen - ;; before point as well as its matching open. - ;; If matching forward, and the openparen is unbalanced, - ;; highlight the paren at point to indicate misbalance. - ;; Otherwise, turn off any such highlighting. - (if (and (not show-paren-highlight-openparen) (= dir 1) (integerp pos)) - (when (and show-paren-overlay-1 - (overlay-buffer show-paren-overlay-1)) - (delete-overlay show-paren-overlay-1)) - (let ((from (if (= dir 1) - (point) - (- (point) 1))) - (to (if (= dir 1) - (+ (point) 1) - (point)))) - (if show-paren-overlay-1 - (move-overlay show-paren-overlay-1 from to (current-buffer)) - (setq show-paren-overlay-1 (make-overlay from to nil t))) - ;; Always set the overlay face, since it varies. - (overlay-put show-paren-overlay-1 'priority show-paren-priority) - (overlay-put show-paren-overlay-1 'face face))) - ;; - ;; Turn on highlighting for the matching paren, if found. - ;; If it's an unmatched paren, turn off any such highlighting. - (if (not (integerp pos)) - (when show-paren-overlay (delete-overlay show-paren-overlay)) - (let ((to (if (or (eq show-paren-style 'expression) - (and (eq show-paren-style 'mixed) - (not (pos-visible-in-window-p pos)))) - (point) - pos)) - (from (if (or (eq show-paren-style 'expression) - (and (eq show-paren-style 'mixed) - (not (pos-visible-in-window-p pos)))) - pos - (save-excursion - (goto-char pos) - (- (point) dir))))) - (if show-paren-overlay - (move-overlay show-paren-overlay from to (current-buffer)) - (setq show-paren-overlay (make-overlay from to nil t)))) - ;; Always set the overlay face, since it varies. - (overlay-put show-paren-overlay 'priority show-paren-priority) - (overlay-put show-paren-overlay 'face face)))) - ;; show-paren-mode is nil in this buffer. - (and show-paren-overlay - (delete-overlay show-paren-overlay)) - (and show-paren-overlay-1 - (delete-overlay show-paren-overlay-1)))) + (let ((data (and show-paren-mode (funcall show-paren-data-function)))) + (if (not data) + (progn + ;; If show-paren-mode is nil in this buffer or if not at a paren that + ;; has a match, turn off any previous paren highlighting. + (delete-overlay show-paren--overlay) + (delete-overlay show-paren--overlay-1)) + + ;; Found something to highlight. + (let* ((here-beg (nth 0 data)) + (here-end (nth 1 data)) + (there-beg (nth 2 data)) + (there-end (nth 3 data)) + (mismatch (nth 4 data)) + (face + (if mismatch + (progn + (if show-paren-ring-bell-on-mismatch + (beep)) + 'show-paren-mismatch) + 'show-paren-match))) + ;; + ;; If matching backwards, highlight the closeparen + ;; before point as well as its matching open. + ;; If matching forward, and the openparen is unbalanced, + ;; highlight the paren at point to indicate misbalance. + ;; Otherwise, turn off any such highlighting. + (if (or (not here-beg) + (and (not show-paren-highlight-openparen) + (> here-end (point)) + (integerp there-beg))) + (delete-overlay show-paren--overlay-1) + (move-overlay show-paren--overlay-1 + here-beg here-end (current-buffer)) + ;; Always set the overlay face, since it varies. + (overlay-put show-paren--overlay-1 'priority show-paren-priority) + (overlay-put show-paren--overlay-1 'face face)) + ;; + ;; Turn on highlighting for the matching paren, if found. + ;; If it's an unmatched paren, turn off any such highlighting. + (if (not there-beg) + (delete-overlay show-paren--overlay) + (if (or (eq show-paren-style 'expression) + (and (eq show-paren-style 'mixed) + (let ((closest (if (< there-beg here-beg) + (1- there-end) (1+ there-beg)))) + (not (pos-visible-in-window-p closest))))) + (move-overlay show-paren--overlay + (point) + (if (< there-beg here-beg) there-beg there-end) + (current-buffer)) + (move-overlay show-paren--overlay + there-beg there-end (current-buffer))) + ;; Always set the overlay face, since it varies. + (overlay-put show-paren--overlay 'priority show-paren-priority) + (overlay-put show-paren--overlay 'face face)))))) (provide 'paren) diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el index 91b146fdc78..fb31984facc 100644 --- a/lisp/pcmpl-gnu.el +++ b/lisp/pcmpl-gnu.el @@ -158,7 +158,8 @@ "Completion for the GNU tar utility." ;; options that end in an equal sign will want further completion... (let (saw-option complete-within) - (let ((pcomplete-suffix-list (cons ?= pcomplete-suffix-list))) + (let ((pcomplete-suffix-list (if (boundp 'pcomplete-suffix-list) + (cons ?= pcomplete-suffix-list)))) (while (pcomplete-match "^-" 0) (setq saw-option t) (if (pcomplete-match "^--" 0) diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el index 7e7bfe28713..a946f0885ac 100644 --- a/lisp/pcmpl-linux.el +++ b/lisp/pcmpl-linux.el @@ -31,9 +31,10 @@ (require 'pcomplete) -(defgroup pcmpl-linux nil - "Functions for dealing with GNU/Linux completions." - :group 'pcomplete) +;; Unused. +;;; (defgroup pcmpl-linux nil +;;; "Functions for dealing with GNU/Linux completions." +;;; :group 'pcomplete) ;; Functions: diff --git a/lisp/pcmpl-x.el b/lisp/pcmpl-x.el new file mode 100644 index 00000000000..86d8dc652c3 --- /dev/null +++ b/lisp/pcmpl-x.el @@ -0,0 +1,251 @@ +;;; pcmpl-x.el --- completion for miscellaneous tools -*- lexical-binding: t; -*- + +;; Copyright (C) 2013 Free Software Foundation, Inc. + +;; Author: Leo Liu <sdl.web@gmail.com> +;; Keywords: processes, tools, convenience +;; Package: pcomplete + +;; 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/>. + +;;; Code: + +(eval-when-compile (require 'cl-lib)) +(require 'pcomplete) + + +;;;; tlmgr - http://www.tug.org/texlive/tlmgr.html + +(defcustom pcmpl-x-tlmgr-program "tlmgr" + "Name of the tlmgr program." + :type 'file + :group 'pcomplete) + +(defvar pcmpl-x-tlmgr-common-options + '("--repository" + "--gui" + "--gui-lang" + "--machine-readable" + "--package-logfile" + "--pause" + "--persistent-downloads" + "--no-persistent-downloads" + "--no-execute-actions" + "--debug-translation" + "--help" + "--version")) + +(defvar pcmpl-x-tlmgr-actions + '(("help") + ("version") + ("gui") + ("install") + ("update") + ("backup") + ("restore") + ("remove") + ("repository" ("list" "add" "remove" "set")) + ("candidates") + ("option" ("show" + "showall" + "repository" + "formats" + "postcode" + "docfiles" + "srcfiles" + "backupdir" + "autobackup" + "sys_bin" + "sys_man" + "sys_info" + "desktop_integration" + "fileassocs" + "multiuser")) + ("conf" ("texmf" "tlmgr")) + ("paper" + ("a4" "letter" "xdvi" "pdftex" "dvips" "dvipdfmx" "dvipdfm" "context") + (lambda () + (unless (member (pcomplete-arg 1) '("a4" "letter")) + (pcomplete-here* '("paper")) + (pcomplete-here* '("a4" "letter"))))) + ("platform" ("list" "add" "remove")) + ("print-platform" ("collections" "schemes")) + ("arch" ("list" "add" "remove")) + ("print-arch" ("collections" "schemes")) + ("info" ("collections" "schemes")) + ("search") + ("dump-tlpdb") + ("check" ("files" "depends" "executes" "runfiles" "all")) + ("path" ("add" "remove")) + ("postaction" ("install" "remove") ("shortcut" "fileassoc" "script")) + ("uninstall") + ("generate" ("language" + "language.dat" + "language.def" + "language.dat.lua" + "fmtutil")))) + +(defvar pcmpl-x-tlmgr-options-cache (make-hash-table :size 31 :test 'equal)) + +(defun pcmpl-x-tlmgr-action-options (action) + "Get the list of long options for ACTION." + (if (eq (gethash action pcmpl-x-tlmgr-options-cache 'missing) 'missing) + (with-temp-buffer + (when (zerop + (call-process pcmpl-x-tlmgr-program nil t nil action "-h")) + (goto-char (point-min)) + (puthash action + (cons "--help" + (cl-loop while (re-search-forward + "^[ \t]+\\(--[[:alnum:]-]+=?\\)" + nil t) + collect (match-string 1))) + pcmpl-x-tlmgr-options-cache) + (pcmpl-x-tlmgr-action-options action))) + (gethash action pcmpl-x-tlmgr-options-cache))) + +;;;###autoload +(defun pcomplete/tlmgr () + "Completion for the `tlmgr' command." + (while (pcomplete-match "^--" 0) + (pcomplete-here* pcmpl-x-tlmgr-common-options) + (unless (or (pcomplete-match "^--" 0) + (all-completions (pcomplete-arg 0) pcmpl-x-tlmgr-actions)) + (pcomplete-here* (pcomplete-dirs-or-entries)))) + (pcomplete-here* pcmpl-x-tlmgr-actions) + (let ((action (substring-no-properties (pcomplete-arg 1)))) + (while t + (if (pcomplete-match "^--" 0) + (pcomplete-here* (pcmpl-x-tlmgr-action-options action)) + (dolist (completions (cdr (assoc action pcmpl-x-tlmgr-actions))) + (cond ((functionp completions) + (funcall completions)) + ((all-completions (pcomplete-arg 0) completions) + (pcomplete-here* completions)) + (t (pcomplete-here* (pcomplete-dirs-or-entries))))) + (unless (pcomplete-match "^--" 0) + (pcomplete-here* (pcomplete-dirs-or-entries))))))) + + +;;;; ack - http://betterthangrep.com + +;; Usage: +;; - To complete short options type '-' first +;; - To complete long options type '--' first +;; - Color name completion is supported following +;; --color-filename=, --color-match= and --color-lineno= +;; - Type completion is supported following --type= + +(defcustom pcmpl-x-ack-program + (file-name-nondirectory (or (executable-find "ack-grep") + (executable-find "ack") + "ack")) + "Name of the ack program." + :type 'file + :group 'pcomplete) + +(defvar pcmpl-x-ack-color-options + '("clear" + "reset" + "dark" + "bold" + "underline" + "underscore" + "blink" + "reverse" + "concealed" + "black" + "red" + "green" + "yellow" + "blue" + "magenta" + "on_black" + "on_red" + "on_green" + "on_yellow" + "on_blue" + "on_magenta" + "on_cyan" + "on_white") + "Color names for the `ack' command.") + +(defun pcmpl-x-ack-run (buffer &rest args) + "Run ack with ARGS and send the output to BUFFER." + (condition-case nil + (apply 'call-process (or pcmpl-x-ack-program "ack") nil buffer nil args) + (file-error -1))) + +(defun pcmpl-x-ack-short-options () + "Short options for the `ack' command." + (with-temp-buffer + (let (options) + (when (zerop (pcmpl-x-ack-run t "--help")) + (goto-char (point-min)) + (while (re-search-forward "^ -\\([^-]\\)" nil t) + (push (match-string 1) options)) + (mapconcat 'identity (nreverse options) ""))))) + +(defun pcmpl-x-ack-long-options (&optional arg) + "Long options for the `ack' command." + (with-temp-buffer + (let (options) + (when (zerop (pcmpl-x-ack-run t (or arg "--help"))) + (goto-char (point-min)) + (while (re-search-forward + "\\(?: ?\\|, \\)\\(--\\(\\[no\\]\\)?\\([[:alnum:]-]+=?\\)\\)" + nil t) + (if (not (match-string 2)) + (push (match-string 1) options) + (push (concat "--" (match-string 3)) options) + (push (concat "--no" (match-string 3)) options))) + (nreverse options))))) + +(defun pcmpl-x-ack-type-options () + "A list of types for the `ack' command." + (pcmpl-x-ack-long-options "--help-types")) + +;;;###autoload +(defun pcomplete/ack () + "Completion for the `ack' command. +Start an argument with '-' to complete short options and '--' for +long options." + ;; No space after = + (while t + (if (pcomplete-match "^-" 0) + (cond + ((pcomplete-match "^--color-\\w+=\\(\\S-*\\)" 0) + (pcomplete-here* pcmpl-x-ack-color-options + (pcomplete-match-string 1 0) t)) + ((pcomplete-match "^--\\(?:no\\)?ignore-dir=\\(\\S-*\\)" 0) + (pcomplete-here* (pcomplete-dirs) + (pcomplete-match-string 1 0) t)) + ((pcomplete-match "^--type=\\(\\S-*\\)" 0) + (pcomplete-here* (mapcar (lambda (type-option) + (substring type-option 2)) + (pcmpl-x-ack-type-options)) + (pcomplete-match-string 1 0) t)) + ((pcomplete-match "^--" 0) + (pcomplete-here* (append (pcmpl-x-ack-long-options) + (pcmpl-x-ack-type-options)))) + (t (pcomplete-opt (pcmpl-x-ack-short-options)))) + (pcomplete-here* (pcomplete-dirs-or-entries))))) + +;;;###autoload +(defalias 'pcomplete/ack-grep 'pcomplete/ack) + +(provide 'pcmpl-x) +;;; pcmpl-x.el ends here diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index db525fe531f..9d48d36bb30 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -1,4 +1,4 @@ -;;; dunnet.el --- text adventure for Emacs -*- byte-compile-warnings: nil -*- +;;; dunnet.el --- text adventure for Emacs ;; Copyright (C) 1992-1993, 2001-2013 Free Software Foundation, Inc. @@ -1386,7 +1386,7 @@ for a moment, then straighten yourself up. (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) (zippy . dun-zippy))) + (cat . dun-cat))) (setq dun-dos-verbs '((dir . dun-dos-dir) (type . dun-dos-type) (exit . dun-dos-exit) (command . dun-dos-spawn) @@ -2996,9 +2996,6 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..") (dun-mprincl "Ascii files only.") (dun-mprincl "File not found.")))))))) -(defun dun-zippy (args) - (dun-mprincl (yow))) - (defun dun-rlogin-endgame () (if (not (= (dun-score nil) 90)) (dun-mprincl @@ -3356,3 +3353,7 @@ File not found"))) (provide 'dunnet) ;;; dunnet.el ends here + +;; Local Variables: +;; byte-compile-warnings: (not free-vars lexical) +;; End: diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el index dd33d067246..19fa8f38a70 100644 --- a/lisp/play/tetris.el +++ b/lisp/play/tetris.el @@ -77,20 +77,13 @@ If the return value is a number, it is used as the timer period." ["blue" "white" "yellow" "magenta" "cyan" "green" "red"] "Vector of colors of the various shapes in text mode." :group 'tetris - :type (let ((names `("Shape 1" "Shape 2" "Shape 3" - "Shape 4" "Shape 5" "Shape 6" "Shape 7")) - (result nil)) - (while names - (add-to-list 'result - (cons 'choice - (cons :tag - (cons (car names) - (mapcar (lambda (color) - (list 'const color)) - (defined-colors))))) - t) - (setq names (cdr names))) - result)) + :type '(vector (color :tag "Shape 1") + (color :tag "Shape 2") + (color :tag "Shape 3") + (color :tag "Shape 4") + (color :tag "Shape 5") + (color :tag "Shape 6") + (color :tag "Shape 7"))) (defcustom tetris-x-colors [[0 0 1] [0.7 0 1] [1 1 0] [1 0 1] [0 1 1] [0 1 0] [1 0 0]] diff --git a/lisp/printing.el b/lisp/printing.el index bf50aa8f679..18b2b89363b 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -1342,6 +1342,10 @@ Used by `pr-menu-bind' and `pr-update-menus'.") ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; GNU Emacs Definitions +(eval-and-compile + (unless (featurep 'xemacs) + (defvar pr-menu-bar nil + "Specify Printing menu-bar entry."))) (cond ((featurep 'xemacs) ; XEmacs @@ -1372,9 +1376,6 @@ Used by `pr-menu-bind' and `pr-update-menus'.") (defun pr-menu-char-width () (frame-char-width)) - (defvar pr-menu-bar nil - "Specify Printing menu-bar entry.") - ;; GNU Emacs ;; Menu binding ;; Replace existing "print" item by "Printing" item. diff --git a/lisp/profiler.el b/lisp/profiler.el index 07192a39bef..093a01a8602 100644 --- a/lisp/profiler.el +++ b/lisp/profiler.el @@ -5,18 +5,20 @@ ;; Author: Tomohiro Matsuyama <tomo@cx4a.org> ;; Keywords: lisp -;; This program is free software; you can redistribute it and/or modify +;; 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. -;; This program is distributed in the hope that it will be useful, +;; 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 this program. If not, see <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index 3709aa26bbe..805444d08b9 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -457,15 +457,8 @@ The extensions should include a `.' if needed.") (defvar ada-mode-extra-prefix "\C-c\C-q" "Prefix key to access `ada-mode-extra-map' functions.") -(defvar ada-mode-abbrev-table nil +(define-abbrev-table 'ada-mode-abbrev-table () "Local abbrev table for Ada mode.") -(define-abbrev-table 'ada-mode-abbrev-table ()) - -(defvar ada-mode-syntax-table nil - "Syntax table to be used for editing Ada source code.") - -(defvar ada-mode-symbol-syntax-table nil - "Syntax table for Ada, where `_' is a word constituent.") (eval-when-compile ;; These values are used in eval-when-compile expressions. @@ -845,61 +838,58 @@ the 4 file locations can be clicked on and jumped to." ;; better is available on XEmacs. ;;------------------------------------------------------------------------- -(defun ada-create-syntax-table () - "Create the two syntax tables use in the Ada mode. -The standard table declares `_' as a symbol constituent, the second one -declares it as a word constituent." - (interactive) - (setq ada-mode-syntax-table (make-syntax-table)) - - ;; define string brackets (`%' is alternative string bracket, but - ;; almost never used as such and throws font-lock and indentation - ;; off the track.) - (modify-syntax-entry ?% "$" ada-mode-syntax-table) - (modify-syntax-entry ?\" "\"" ada-mode-syntax-table) - - (modify-syntax-entry ?: "." ada-mode-syntax-table) - (modify-syntax-entry ?\; "." ada-mode-syntax-table) - (modify-syntax-entry ?& "." ada-mode-syntax-table) - (modify-syntax-entry ?\| "." ada-mode-syntax-table) - (modify-syntax-entry ?+ "." ada-mode-syntax-table) - (modify-syntax-entry ?* "." ada-mode-syntax-table) - (modify-syntax-entry ?/ "." ada-mode-syntax-table) - (modify-syntax-entry ?= "." ada-mode-syntax-table) - (modify-syntax-entry ?< "." ada-mode-syntax-table) - (modify-syntax-entry ?> "." ada-mode-syntax-table) - (modify-syntax-entry ?$ "." ada-mode-syntax-table) - (modify-syntax-entry ?\[ "." ada-mode-syntax-table) - (modify-syntax-entry ?\] "." ada-mode-syntax-table) - (modify-syntax-entry ?\{ "." ada-mode-syntax-table) - (modify-syntax-entry ?\} "." ada-mode-syntax-table) - (modify-syntax-entry ?. "." ada-mode-syntax-table) - (modify-syntax-entry ?\\ "." ada-mode-syntax-table) - (modify-syntax-entry ?\' "." ada-mode-syntax-table) - - ;; a single hyphen is punctuation, but a double hyphen starts a comment - (modify-syntax-entry ?- ". 12" ada-mode-syntax-table) - - ;; See the comment above on grammar related function for the special - ;; setup for '#'. - (if (featurep 'xemacs) - (modify-syntax-entry ?# "<" ada-mode-syntax-table) - (modify-syntax-entry ?# "$" ada-mode-syntax-table)) - - ;; and \f and \n end a comment - (modify-syntax-entry ?\f "> " ada-mode-syntax-table) - (modify-syntax-entry ?\n "> " ada-mode-syntax-table) - - ;; define what belongs in Ada symbols - (modify-syntax-entry ?_ "_" ada-mode-syntax-table) - - ;; define parentheses to match - (modify-syntax-entry ?\( "()" ada-mode-syntax-table) - (modify-syntax-entry ?\) ")(" ada-mode-syntax-table) - - (setq ada-mode-symbol-syntax-table (copy-syntax-table ada-mode-syntax-table)) - (modify-syntax-entry ?_ "w" ada-mode-symbol-syntax-table) - ) +(defvar ada-mode-syntax-table + (let ((st (make-syntax-table))) + ;; Define string brackets (`%' is alternative string bracket, but + ;; almost never used as such and throws font-lock and indentation + ;; off the track.) + (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) + + ;; A single hyphen is punctuation, but a double hyphen starts a comment. + (modify-syntax-entry ?- ". 12" st) + + ;; See the comment above on grammar related function for the special + ;; setup for '#'. + (modify-syntax-entry ?# (if (featurep 'xemacs) "<" "$") st) + + ;; And \f and \n end a comment. + (modify-syntax-entry ?\f "> " st) + (modify-syntax-entry ?\n "> " st) + + ;; Define what belongs in Ada symbols. + (modify-syntax-entry ?_ "_" st) + + ;; Define parentheses to match. + (modify-syntax-entry ?\( "()" st) + (modify-syntax-entry ?\) ")(" st) + st) + "Syntax table to be used for editing Ada source code.") + +(defvar ada-mode-symbol-syntax-table + (let ((st (make-syntax-table ada-mode-syntax-table))) + (modify-syntax-entry ?_ "w" st) + st) + "Syntax table for Ada, where `_' is a word constituent.") ;; Support of special characters in XEmacs (see the comments at the beginning ;; of the section on Grammar related functions). @@ -1293,7 +1283,7 @@ the file name." (if ada-popup-key (define-key ada-mode-map ada-popup-key 'ada-popup-menu)) - ;; Support for Abbreviations (the user still need to "M-x abbrev-mode" + ;; Support for Abbreviations (the user still needs to "M-x abbrev-mode"). (setq local-abbrev-table ada-mode-abbrev-table) ;; Support for which-function mode @@ -1625,9 +1615,8 @@ ARG is the prefix the user entered with \\[universal-argument]." (let ((lastk last-command-event)) (with-syntax-table ada-mode-symbol-syntax-table - (cond ((or (eq lastk ?\n) - (eq lastk ?\r)) - ;; horrible kludge + (cond ((memq lastk '(?\n ?\r)) + ;; Horrible kludge. (insert " ") (ada-adjust-case) ;; horrible dekludge @@ -1706,9 +1695,7 @@ ARG is ignored, and is there for compatibility with `capitalize-word' only." (interactive) (let ((end (save-excursion (skip-syntax-forward "w") (point))) (begin (save-excursion (skip-syntax-backward "w") (point)))) - (modify-syntax-entry ?_ "_") - (capitalize-region begin end) - (modify-syntax-entry ?_ "w"))) + (capitalize-region begin end))) (defun ada-adjust-case-region (from to) "Adjust the case of all words in the region between FROM and TO. @@ -2165,7 +2152,7 @@ and the offset." (unwind-protect (with-syntax-table ada-mode-symbol-syntax-table - ;; This need to be done here so that the advice is not always + ;; This needs to be done here so that the advice is not always ;; activated (this might interact badly with other modes) (if (featurep 'xemacs) (ad-activate 'parse-partial-sexp t)) @@ -3419,27 +3406,23 @@ Stop the search at LIMIT." If BACKWARD is non-nil, jump to the beginning of the previous word. Return the new position of point or nil if not found." (let ((match-cons nil) - (orgpoint (point)) - (old-syntax (char-to-string (char-syntax ?_)))) - (modify-syntax-entry ?_ "w") + (orgpoint (point))) (unless backward - (skip-syntax-forward "w")) + (skip-syntax-forward "w_")) (if (setq match-cons - (ada-search-ignore-string-comment "\\w" backward nil t)) + (ada-search-ignore-string-comment "\\sw\\|\\s_" backward nil t)) ;; ;; move to the beginning of the word found ;; (progn (goto-char (car match-cons)) - (skip-syntax-backward "w") + (skip-syntax-backward "w_") (point)) ;; ;; if not found, restore old position of point ;; (goto-char orgpoint) - 'nil) - (modify-syntax-entry ?_ old-syntax)) - ) + 'nil))) (defun ada-check-matching-start (keyword) @@ -5431,9 +5414,6 @@ This function typically is to be hooked into `ff-file-created-hook'." (ada-create-keymap) (ada-create-menu) -;; Create the syntax tables, but do not activate them -(ada-create-syntax-table) - ;; Add the default extensions (and set up speedbar) (ada-add-extensions ".ads" ".adb") ;; This two files are generated by GNAT when running with -gnatD diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el index 8a99ad6e1b3..e6eaea985af 100644 --- a/lisp/progmodes/autoconf.el +++ b/lisp/progmodes/autoconf.el @@ -41,10 +41,10 @@ "Hook run by `autoconf-mode'.") (defconst autoconf-definition-regexp - "A\\(?:H_TEMPLATE\\|C_\\(?:SUBST\\|DEFINE\\(?:_UNQUOTED\\)?\\)\\)(\\[*\\(\\sw+\\)\\]*") + "A\\(?:H_TEMPLATE\\|C_\\(?:SUBST\\|DEFINE\\(?:_UNQUOTED\\)?\\)\\)(\\[*\\(\\(?:\\sw\\|\\s_\\)+\\)\\]*") (defvar autoconf-font-lock-keywords - `(("\\_<A[CHMS]_\\sw+" . font-lock-keyword-face) + `(("\\_<A[CHMS]_\\(?:\\sw\\|\\s_\\)+" . font-lock-keyword-face) (,autoconf-definition-regexp 1 font-lock-function-name-face) ;; Are any other M4 keywords really appropriate for configure.ac, @@ -67,13 +67,11 @@ This version looks back for an AC_DEFINE or AC_SUBST. It will stop searching backwards at another AC_... command." (save-excursion - (with-syntax-table (copy-syntax-table autoconf-mode-syntax-table) - (modify-syntax-entry ?_ "w") - (skip-syntax-forward "w" (line-end-position)) - (if (re-search-backward autoconf-definition-regexp - (save-excursion (beginning-of-defun) (point)) - t) - (match-string-no-properties 1))))) + (skip-syntax-forward "w_" (line-end-position)) + (if (re-search-backward autoconf-definition-regexp + (save-excursion (beginning-of-defun) (point)) + t) + (match-string-no-properties 1)))) ;;;###autoload (define-derived-mode autoconf-mode prog-mode "Autoconf" @@ -85,9 +83,8 @@ searching backwards at another AC_... command." (setq-local syntax-propertize-function (syntax-propertize-rules ("\\<dnl\\>" (0 "<")))) (setq-local font-lock-defaults - `(autoconf-font-lock-keywords nil nil (("_" . "w")))) + `(autoconf-font-lock-keywords nil nil)) (setq-local imenu-generic-expression autoconf-imenu-generic-expression) - (setq-local imenu-syntax-alist '(("_" . "w"))) (setq-local indent-line-function #'indent-relative) (setq-local add-log-current-defun-function #'autoconf-current-defun-function)) diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el index e41455f7883..337a5292417 100644 --- a/lisp/progmodes/cc-bytecomp.el +++ b/lisp/progmodes/cc-bytecomp.el @@ -232,6 +232,9 @@ perhaps a `cc-bytecomp-restore-environment' is forgotten somewhere")) (cc-bytecomp-setup-environment) t)))) +(defvar cc-bytecomp-noruntime-functions nil + "Saved value of `byte-compile-noruntime-functions'.") + (defmacro cc-require (cc-part) "Force loading of the corresponding .el file in the current directory during compilation, but compile in a `require'. Don't use within @@ -240,7 +243,16 @@ during compilation, but compile in a `require'. Don't use within Having cyclic cc-require's will result in infinite recursion. That's somewhat intentional." `(progn - (eval-when-compile (cc-bytecomp-load (symbol-name ,cc-part))) + (eval-when-compile + (setq cc-bytecomp-noruntime-functions byte-compile-noruntime-functions) + (cc-bytecomp-load (symbol-name ,cc-part))) + ;; Hack to suppress spurious "might not be defined at runtime" warnings. + ;; The basic issue is that + ;; (eval-when-compile (require 'foo)) + ;; (require 'foo) + ;; produces bogus noruntime warnings about functions from foo. + (eval-when-compile + (setq byte-compile-noruntime-functions cc-bytecomp-noruntime-functions)) (require ,cc-part))) (defmacro cc-provide (feature) @@ -266,7 +278,7 @@ somewhat intentional." during compilation, but do a compile time `require' otherwise. Don't use within `eval-when-compile'." `(eval-when-compile - (if (and (featurep 'cc-bytecomp) + (if (and (fboundp 'cc-bytecomp-is-compiling) (cc-bytecomp-is-compiling)) (if (or (not load-in-progress) (not (featurep ,cc-part))) diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 0bb804799dc..dc6ed1348d1 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -45,7 +45,6 @@ (cc-require 'cc-engine) ;; Silence the compiler. -(cc-bytecomp-defun delete-forward-p) ; XEmacs (cc-bytecomp-defvar filladapt-mode) ; c-fill-paragraph contains a kludge ; which looks at this. diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 48236c2dca2..b90a01dcb3b 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -48,16 +48,12 @@ ;; Silence the compiler. (cc-bytecomp-defvar c-enable-xemacs-performance-kludge-p) ; In cc-vars.el -(cc-bytecomp-defun buffer-syntactic-context-depth) ; XEmacs (cc-bytecomp-defun region-active-p) ; XEmacs -(cc-bytecomp-defvar zmacs-region-stays) ; XEmacs -(cc-bytecomp-defvar zmacs-regions) ; XEmacs (cc-bytecomp-defvar mark-active) ; Emacs (cc-bytecomp-defvar deactivate-mark) ; Emacs (cc-bytecomp-defvar inhibit-point-motion-hooks) ; Emacs (cc-bytecomp-defvar parse-sexp-lookup-properties) ; Emacs (cc-bytecomp-defvar text-property-default-nonsticky) ; Emacs 21 -(cc-bytecomp-defvar lookup-syntax-properties) ; XEmacs (cc-bytecomp-defun string-to-syntax) ; Emacs 21 @@ -93,7 +89,7 @@ ;;; Variables also used at compile time. -(defconst c-version "5.32.4" +(defconst c-version "5.32.5" "CC Mode version number.") (defconst c-version-sym (intern c-version)) @@ -334,6 +330,8 @@ to it is returned. This function does not modify the point or the mark." (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 @@ -343,7 +341,7 @@ to it is returned. This function does not modify the point or the mark." (defmacro c-set-region-active (activate) ;; Activate the region if ACTIVE is non-nil, deactivate it ;; otherwise. Covers the differences between Emacs and XEmacs. - (if (cc-bytecomp-fboundp 'zmacs-activate-region) + (if (fboundp 'zmacs-activate-region) ;; XEmacs. `(if ,activate (zmacs-activate-region) @@ -707,9 +705,9 @@ be after it." ;; `c-parse-state'. `(progn - (if (and ,(cc-bytecomp-fboundp 'buffer-syntactic-context-depth) + (if (and ,(fboundp 'buffer-syntactic-context-depth) c-enable-xemacs-performance-kludge-p) - ,(when (cc-bytecomp-fboundp 'buffer-syntactic-context-depth) + ,(when (fboundp 'buffer-syntactic-context-depth) ;; XEmacs only. This can improve the performance of ;; c-parse-state to between 3 and 60 times faster when ;; braces are hung. It can also degrade performance by @@ -1606,7 +1604,7 @@ non-nil, a caret is prepended to invert the set." (let ((buf (generate-new-buffer " test")) parse-sexp-lookup-properties parse-sexp-ignore-comments - lookup-syntax-properties) + lookup-syntax-properties) ; XEmacs (with-current-buffer buf (set-syntax-table (make-syntax-table)) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 368b1fc50dc..b0c0bfd7bde 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -147,9 +147,6 @@ (cc-require-when-compile 'cc-langs) (cc-require 'cc-vars) -;; Silence the compiler. -(cc-bytecomp-defun buffer-syntactic-context) ; XEmacs - ;; Make declarations for all the `c-lang-defvar' variables in cc-langs. @@ -2180,32 +2177,45 @@ comment at the start of cc-engine.el for more info." ;; reduced by buffer changes, and increased by invocations of ;; `c-state-literal-at'. FIXME!!! -(defsubst c-state-pp-to-literal (from to) +(defsubst c-state-pp-to-literal (from to &optional not-in-delimiter) ;; Do a parse-partial-sexp from FROM to TO, returning either ;; (STATE TYPE (BEG . END)) if TO is in a literal; or ;; (STATE) otherwise, ;; where STATE is the parsing state at TO, TYPE is the type of the literal ;; (one of 'c, 'c++, 'string) and (BEG . END) is the boundaries of the literal. ;; + ;; Unless NOT-IN-DELIMITER is non-nil, when TO is inside a two-character + ;; comment opener, this is recognized as being in a comment literal. + ;; ;; Only elements 3 (in a string), 4 (in a comment), 5 (following a quote), ;; 7 (comment type) and 8 (start of comment/string) (and possibly 9) of ;; STATE are valid. (save-excursion (let ((s (parse-partial-sexp from to)) - ty) - (when (or (nth 3 s) (nth 4 s)) ; in a string or comment + ty co-st) + (cond + ((or (nth 3 s) (nth 4 s)) ; in a string or comment (setq ty (cond ((nth 3 s) 'string) - ((eq (nth 7 s) t) 'c++) + ((nth 7 s) 'c++) (t 'c))) (parse-partial-sexp (point) (point-max) - nil ; TARGETDEPTH - nil ; STOPBEFORE - s ; OLDSTATE - 'syntax-table)) ; stop at end of literal - (if ty - `(,s ,ty (,(nth 8 s) . ,(point))) - `(,s))))) + nil ; TARGETDEPTH + nil ; STOPBEFORE + s ; OLDSTATE + 'syntax-table) ; stop at end of literal + `(,s ,ty (,(nth 8 s) . ,(point)))) + + ((and (not not-in-delimiter) ; inside a comment starter + (not (bobp)) + (progn (backward-char) + (looking-at c-comment-start-regexp))) + (setq ty (if (looking-at c-block-comment-start-regexp) 'c 'c++) + co-st (point)) + (forward-comment 1) + `(,s ,ty (,co-st . ,(point)))) + + (t `(,s)))))) (defun c-state-safe-place (here) ;; Return a buffer position before HERE which is "safe", i.e. outside any @@ -3143,10 +3153,13 @@ comment at the start of cc-engine.el for more info." ;; This function is called from c-after-change. ;; The caches of non-literals: - (if (< here c-state-nonlit-pos-cache-limit) - (setq c-state-nonlit-pos-cache-limit here)) - (if (< here c-state-semi-nonlit-pos-cache-limit) - (setq c-state-semi-nonlit-pos-cache-limit here)) + ;; Note that we use "<=" for the possibility of the second char of a two-char + ;; comment opener being typed; this would invalidate any cache position at + ;; HERE. + (if (<= here c-state-nonlit-pos-cache-limit) + (setq c-state-nonlit-pos-cache-limit (1- here))) + (if (<= here c-state-semi-nonlit-pos-cache-limit) + (setq c-state-semi-nonlit-pos-cache-limit (1- here))) ;; `c-state-cache': ;; Case 1: if `here' is in a literal containing point-min, everything @@ -4444,19 +4457,12 @@ comment at the start of cc-engine.el for more info." (lim (or lim (c-state-semi-safe-place pos))) (pp-to-lit (save-restriction (widen) - (c-state-pp-to-literal lim pos))) + (c-state-pp-to-literal lim pos not-in-delimiter))) (state (car pp-to-lit)) (lit-limits (car (cddr pp-to-lit)))) (cond (lit-limits) - ((and (not not-in-delimiter) - (not (elt state 5)) - (eq (char-before) ?/) - (looking-at "[/*]")) ; FIXME!!! use c-line/block-comment-starter. 2008-09-28. - ;; We're standing in a comment starter. - (backward-char 1) - (cons (point) (progn (c-forward-single-comment) (point)))) (near (goto-char pos) @@ -6466,6 +6472,52 @@ comment at the start of cc-engine.el for more info." (c-go-list-forward) t))) +(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 + ;; the function's arglist. Otherwise return nil, leaving point unchanged. + (let ((here (point)) + (paren-state (c-parse-state)) + res) + + (setq res + (catch 'done + (if (not (c-at-toplevel-p)) + (progn + (while (not (c-at-toplevel-p)) + (goto-char (c-pull-open-brace paren-state))) + (c-backward-syntactic-ws) + (when (not (c-simple-skip-symbol-backward)) + (throw 'done nil)) + (c-backward-syntactic-ws)) + (c-backward-syntactic-ws) + (when (memq (char-before) '(?\) ?})) + (when (not (c-go-list-backward)) + (throw 'done nil)) + (c-backward-syntactic-ws)) + (when (c-simple-skip-symbol-backward) + (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)) + + (and + (eq (char-before) ?:) + (c-just-after-func-arglist-p)))) + + (or res (goto-char here)) + res)) + ;; Handling of large scale constructs like statements and declarations. @@ -9668,18 +9720,13 @@ comment at the start of cc-engine.el for more info." ;; 2007-11-09) )))) - ;; CASE 5B: After a function header but before the body (or - ;; the ending semicolon if there's no body). + ;; CASE 5R: Member init list. (Used to be part of CASE 5B.1) + ;; Note there is no limit on the backward search here, since member + ;; init lists can, in practice, be very large. ((save-excursion - (when (setq placeholder (c-just-after-func-arglist-p - (max lim (c-determine-limit 500)))) + (when (setq placeholder (c-back-over-member-initializers)) (setq tmp-pos (point)))) - (cond - - ;; CASE 5B.1: Member init list. - ((eq (char-after tmp-pos) ?:) - (if (or (>= tmp-pos indent-point) - (= (c-point 'bosws) (1+ tmp-pos))) + (if (= (c-point 'bosws) (1+ tmp-pos)) (progn ;; There is no preceding member init clause. ;; Indent relative to the beginning of indentation @@ -9692,6 +9739,23 @@ comment at the start of cc-engine.el for more info." (c-forward-syntactic-ws) (c-add-syntax 'member-init-cont (point)))) + ;; CASE 5B: After a function header but before the body (or + ;; the ending semicolon if there's no body). + ((save-excursion + (when (setq placeholder (c-just-after-func-arglist-p + (max lim (c-determine-limit 500)))) + (setq tmp-pos (point)))) + (cond + + ;; CASE 5B.1: Member init list. + ((eq (char-after tmp-pos) ?:) + ;; There is no preceding member init clause. + ;; Indent relative to the beginning of indentation + ;; for the topmost-intro line that contains the + ;; prototype's open paren. + (goto-char placeholder) + (c-add-syntax 'member-init-intro (c-point 'boi))) + ;; CASE 5B.2: K&R arg decl intro ((and c-recognize-knr-p (c-in-knr-argdecl lim)) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index f6c47f5bb4d..6a4bfd9e875 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -176,7 +176,6 @@ 'font-lock-negation-char-face)) (cc-bytecomp-defun face-inverse-video-p) ; Only in Emacs. -(cc-bytecomp-defun face-property-instance) ; Only in XEmacs. (defun c-make-inverse-face (oldface newface) ;; Emacs and XEmacs have completely different face manipulation @@ -2486,7 +2485,7 @@ need for `pike-font-lock-extra-types'.") (setq comment-beg nil)) (setq region-beg comment-beg)) - (if (eq (elt (parse-partial-sexp comment-beg (+ comment-beg 2)) 7) t) + (if (elt (parse-partial-sexp comment-beg (+ comment-beg 2)) 7) ;; Collect a sequence of doc style line comments. (progn (goto-char comment-beg) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index ba9c42e4c89..af52ad53aad 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -812,8 +812,8 @@ Assumed to not contain any submatches or \\| operators." (c-lang-defconst c-anchored-cpp-prefix "Regexp matching the prefix of a cpp directive anchored to BOL, in the languages that have a macro preprocessor." - t (if (c-lang-const c-opt-cpp-prefix) - (concat "^" (c-lang-const c-opt-cpp-prefix)))) + t "^\\s *\\(#\\)\\s *" + (java awk) nil) (c-lang-defvar c-anchored-cpp-prefix (c-lang-const c-anchored-cpp-prefix)) (c-lang-defconst c-opt-cpp-start diff --git a/lisp/progmodes/cc-menus.el b/lisp/progmodes/cc-menus.el index a06eaf566d8..067a4df13dd 100644 --- a/lisp/progmodes/cc-menus.el +++ b/lisp/progmodes/cc-menus.el @@ -161,49 +161,132 @@ A sample value might look like: `\\(_P\\|_PROTO\\)'.") cc-imenu-c++-generic-expression "Imenu generic expression for C mode. See `imenu-generic-expression'.") -(defvar cc-imenu-java-generic-expression + +;; Auxiliary regexps for Java try to match their trailing whitespace where +;; appropriate, but _not_ starting whitespace. + +(defconst cc-imenu-java-ellipsis-regexp + (concat + "\\.\\{3\\}" + "[ \t\n\r]*")) + +(defun cc-imenu-java-build-type-args-regex (depth) + "Builds regexp for type arguments list with DEPTH allowed +nested angle brackets constructs." + (if (> depth 0) + (concat "<" + "[][.," c-alnum "_? \t\n\r]+" + (if (> depth 1) + "\\(") + (cc-imenu-java-build-type-args-regex (1- depth)) + (if (> depth 1) + (concat "[][.," c-alnum "_? \t\n\r]*" + "\\)*")) + ">"))) + +(defconst cc-imenu-java-type-spec-regexp + (concat + ;; zero or more identifiers followed by a dot + "\\(" + "[" c-alpha "_][" c-alnum "_]*\\." + "\\)*" + ;; a single mandatory identifier without a dot + "[" c-alpha "_][" c-alnum "_]*" + ;; then choice: + "\\(" + ;; (option 1) type arguments list which _may_ be followed with brackets + ;; and/or spaces, then optional variable arity + "[ \t\n\r]*" + (cc-imenu-java-build-type-args-regex 3) + "[][ \t\n\r]*" + "\\(" cc-imenu-java-ellipsis-regexp "\\)?" + "\\|" + ;; (option 2) just brackets and/or spaces (there should be at least one), + ;; then optional variable arity + "[][ \t\n\r]+" + "\\(" cc-imenu-java-ellipsis-regexp "\\)?" + "\\|" + ;; (option 3) just variable arity + cc-imenu-java-ellipsis-regexp + "\\)")) + +(defconst cc-imenu-java-comment-regexp + (concat + "/" + "\\(" + ;; a traditional comment + "\\*" + "\\(" + "[^*]" + "\\|" + "\\*+[^/*]" + "\\)*" + "\\*+/" + "\\|" + ;; an end-of-line comment + "/[^\n\r]*[\n\r]" + "\\)" + "[ \t\n\r]*" + )) + +;; Comments are allowed before the argument, after any of the +;; modifiers and after the identifier. +(defconst cc-imenu-java-method-arg-regexp + (concat + "\\(" cc-imenu-java-comment-regexp "\\)*" + ;; optional modifiers + "\\(" + ;; a modifier is either an annotation or "final" + "\\(" + "@[" c-alpha "_]" + "[" c-alnum "._]*" + ;; TODO support element-value pairs! + "\\|" + "final" + "\\)" + ;; a modifier ends with comments and/or ws + "\\(" + "\\(" cc-imenu-java-comment-regexp "\\)+" + "\\|" + "[ \t\n\r]+" + "\\(" cc-imenu-java-comment-regexp "\\)*" + "\\)" + "\\)*" + ;; type spec + cc-imenu-java-type-spec-regexp + ;; identifier + "[" c-alpha "_]" + "[" c-alnum "_]*" + ;; optional comments and/or ws + "[ \t\n\r]*" + "\\(" cc-imenu-java-comment-regexp "\\)*" + )) + +(defconst cc-imenu-java-generic-expression `((nil ,(concat - "[" c-alpha "_][\]\[." c-alnum "_<> ]+[ \t\n\r]+" ; type spec - "\\([" c-alpha "_][" c-alnum "_]*\\)" ; method name + cc-imenu-java-type-spec-regexp + "\\(" ; method name which gets captured + ; into index + "[" c-alpha "_]" + "[" c-alnum "_]*" + "\\)" "[ \t\n\r]*" - ;; An argument list htat is either empty or contains any number - ;; of arguments. An argument is any number of annotations - ;; followed by a type spec followed by a word. A word is an - ;; identifier. A type spec is an identifier, possibly followed - ;; by < typespec > possibly followed by []. - (concat "(" - "\\(" - "[ \t\n\r]*" - "\\(" - "@" - "[" c-alpha "_]" - "[" c-alnum "._]""*" - "[ \t\n\r]+" - "\\)*" - "\\(" - "[" c-alpha "_]" - "[\]\[" c-alnum "_.]*" - "\\(" - - "<" - "[ \t\n\r]*" - "[\]\[.," c-alnum "_<> \t\n\r]*" - ">" - "\\)?" - "\\(\\[\\]\\)?" - "[ \t\n\r]+" - "\\)" - "[" c-alpha "_]" - "[" c-alnum "_]*" - "[ \t\n\r,]*" - "\\)*" - ")" - "[.," c-alnum " \t\n\r]*" - "{" - )) 1)) + ;; An argument list that contains zero or more arguments. + (concat + "(" + "[ \t\n\r]*" + "\\(" + "\\(" cc-imenu-java-method-arg-regexp ",[ \t\n\r]*\\)*" + cc-imenu-java-method-arg-regexp + "\\)?" + ")" + "[.,_" c-alnum " \t\n\r]*" ; throws etc. + "{" + )) 7)) "Imenu generic expression for Java mode. See `imenu-generic-expression'.") + ;; Internal variables (defvar cc-imenu-objc-generic-expression-noreturn-index nil) (defvar cc-imenu-objc-generic-expression-general-func-index nil) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 3c3a5766582..36c9f72fa18 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -86,8 +86,8 @@ (load "cc-bytecomp" nil t))) (cc-require 'cc-defs) -(cc-require-when-compile 'cc-langs) (cc-require 'cc-vars) +(cc-require-when-compile 'cc-langs) (cc-require 'cc-engine) (cc-require 'cc-styles) (cc-require 'cc-cmds) @@ -97,7 +97,6 @@ ;; Silence the compiler. (cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs -(cc-bytecomp-defun set-keymap-parents) ; XEmacs (cc-bytecomp-defun run-mode-hooks) ; Emacs 21.1 ;; We set these variables during mode init, yet we don't require @@ -212,7 +211,7 @@ control). See \"cc-mode.el\" for more info." ((cc-bytecomp-fboundp 'set-keymap-parent) (set-keymap-parent map c-mode-base-map)) ;; XEmacs - ((cc-bytecomp-fboundp 'set-keymap-parents) + ((fboundp 'set-keymap-parents) (set-keymap-parents map c-mode-base-map)) ;; incompatible (t (error "CC Mode is incompatible with this version of Emacs"))) @@ -936,7 +935,8 @@ Note that the style variables are always made local to the buffer." ;; Add needed properties to each CPP construct in the region. (goto-char c-new-BEG) - (let ((pps-position c-new-BEG) pps-state mbeg) + (skip-chars-backward " \t") + (let ((pps-position (point)) pps-state mbeg) (while (and (< (point) c-new-END) (search-forward-regexp c-anchored-cpp-prefix c-new-END t)) ;; If we've found a "#" inside a string/comment, ignore it. @@ -945,14 +945,12 @@ Note that the style variables are always made local to the buffer." pps-position (point)) (unless (or (nth 3 pps-state) ; in a string? (nth 4 pps-state)) ; in a comment? - (goto-char (match-beginning 0)) + (goto-char (match-beginning 1)) (setq mbeg (point)) (if (> (c-syntactic-end-of-macro) mbeg) (progn (c-neutralize-CPP-line mbeg (point)) - (c-set-cpp-delimiters mbeg (point)) - ;(setq pps-position (point)) - ) + (c-set-cpp-delimiters mbeg (point))) (forward-line)) ; no infinite loop with, e.g., "#//" ))))) @@ -1060,7 +1058,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. - (c-save-buffer-state () + (c-save-buffer-state (case-fold-search) ;; When `combine-after-change-calls' is used we might get calls ;; with regions outside the current narrowing. This has been ;; observed in Emacs 20.7. @@ -1078,12 +1076,13 @@ Note that the style variables are always made local to the buffer." (setq beg end))) ;; C-y is capable of spuriously converting category properties - ;; c-</>-as-paren-syntax into hard syntax-table properties. Remove - ;; these when it happens. + ;; 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) (c-trim-found-types beg end old-len) ; maybe we don't need all of these. (c-invalidate-sws-region-after beg end) @@ -1161,9 +1160,6 @@ Note that the style variables are always made local to the buffer." ;; `c-set-fl-decl-start' for the detailed functionality. (cons (c-set-fl-decl-start beg) end)) -(defvar c-standard-font-lock-fontify-region-function nil - "Standard value of `font-lock-fontify-region-function'") - (defun c-font-lock-fontify-region (beg end &optional verbose) ;; Effectively advice around `font-lock-fontify-region' which extends the ;; region (BEG END), for example, to avoid context fontification chopping @@ -1188,17 +1184,14 @@ Note that the style variables are always made local to the buffer." (setq new-region (funcall fn new-beg new-end)) (setq new-beg (car new-region) new-end (cdr new-region))) c-before-context-fontification-functions)))) - (funcall c-standard-font-lock-fontify-region-function + (funcall (default-value 'font-lock-fontify-region-function) new-beg new-end verbose))) (defun c-after-font-lock-init () ;; Put on `font-lock-mode-hook'. This function ensures our after-change - ;; function will get executed before the font-lock one. Amongst other - ;; things. + ;; function will get executed before the font-lock one. (remove-hook 'after-change-functions 'c-after-change t) - (add-hook 'after-change-functions 'c-after-change nil t) - (setq c-standard-font-lock-fontify-region-function - (default-value 'font-lock-fontify-region-function))) + (add-hook 'after-change-functions 'c-after-change nil t)) (defun c-font-lock-init () "Set up the font-lock variables for using the font-lock support in CC Mode. diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 66ff217c73e..c89402c63a3 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -42,23 +42,25 @@ (cc-require 'cc-defs) -;; Silence the compiler. -(cc-bytecomp-defun get-char-table) ; XEmacs - (cc-eval-when-compile (require 'custom) (require 'widget)) ;;; Helpers -;; This widget exists in newer versions of the Custom library -(or (get 'other 'widget-type) - (define-widget 'other 'sexp - "Matches everything, but doesn't let the user edit the value. + +;; Emacs has 'other since at least version 21.1. +;; FIXME this is probably broken, since the widget is defined +;; in wid-edit, which this file does not load. So we will always +;; define the widget, even when we don't need to. +(when (featurep 'xemacs) + (or (get 'other 'widget-type) + (define-widget 'other 'sexp + "Matches everything, but doesn't let the user edit the value. Useful as last item in a `choice' widget." - :tag "Other" - :format "%t%n" - :value 'other)) + :tag "Other" + :format "%t%n" + :value 'other))) ;; The next defun will supersede c-const-symbol. (eval-and-compile @@ -1622,11 +1624,30 @@ names).")) ) (make-variable-buffer-local 'c-macro-with-semi-re) +(defvar c-macro-names-with-semicolon + '("Q_OBJECT" "Q_PROPERTY" "Q_DECLARE" "Q_ENUMS") + "List of #defined symbols whose expansion ends with a semicolon. +Alternatively it can be a string, a regular expression which +matches all such symbols. + +The \"symbols\" must be syntactically valid identifiers in the +target language \(C, C++, Objective C), or \(as the case may be) +the regular expression must match only valid identifiers. + +If you change this variable's value, call the function +`c-make-macros-with-semi-re' to set the necessary internal +variables. + +Note that currently \(2008-11-04) this variable is a prototype, +and is likely to disappear or change its form soon.") +(make-variable-buffer-local 'c-macro-names-with-semicolon) + (defun c-make-macro-with-semi-re () ;; Convert `c-macro-names-with-semicolon' into the regexp ;; `c-macro-with-semi-re' (or just copy it if it's already a re). (setq c-macro-with-semi-re (and + (boundp 'c-opt-cpp-macro-define) c-opt-cpp-macro-define (cond ((stringp c-macro-names-with-semicolon) @@ -1643,24 +1664,6 @@ names).")) c-macro-names-with-semicolon: %s" c-macro-names-with-semicolon)))))) -(defvar c-macro-names-with-semicolon - '("Q_OBJECT" "Q_PROPERTY" "Q_DECLARE" "Q_ENUMS") - "List of #defined symbols whose expansion ends with a semicolon. -Alternatively it can be a string, a regular expression which -matches all such symbols. - -The \"symbols\" must be syntactically valid identifiers in the -target language \(C, C++, Objective C), or \(as the case may be) -the regular expression must match only valid identifiers. - -If you change this variable's value, call the function -`c-make-macros-with-semi-re' to set the necessary internal -variables. - -Note that currently \(2008-11-04) this variable is a prototype, -and is likely to disappear or change its form soon.") -(make-variable-buffer-local 'c-macro-names-with-semicolon) - (defvar c-file-style nil "Variable interface for setting style via File Local Variables. In a file's Local Variable section, you can set this variable to a diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index 74b81b0cd01..11eb0eeaf49 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el @@ -30,11 +30,13 @@ ;; 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 ;; `cfengine3-mode' (3.x) will be picked, depending on the buffer ;; contents: -;; (add-to-list 'auto-mode-alist '("\\.cf\\'" . cfengine-mode)) +;; (add-to-list 'auto-mode-alist '("\\.cf\\'" . cfengine-auto-mode)) ;; OR you can choose to always use a specific version, if you prefer ;; it: @@ -181,7 +183,7 @@ This includes those for cfservd as well as cfagent.") ("$(\\([[:alnum:]_]+\\))" 1 font-lock-variable-name-face) ("${\\([[:alnum:]_]+\\)}" 1 font-lock-variable-name-face) ;; Variable definitions. - ("\\<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face) + ("\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face) ;; File, acl &c in group: { token ... } ("{[ \t]*\\([^ \t\n]+\\)" 1 font-lock-constant-face))) @@ -189,9 +191,9 @@ This includes those for cfservd as well as cfagent.") `( ;; Defuns. This happens early so they don't get caught by looser ;; patterns. - (,(concat "\\<" cfengine3-defuns-regex "\\>" - "[ \t]+\\<\\([[:alnum:]_.:]+\\)\\>" - "[ \t]+\\<\\([[:alnum:]_.:]+\\)" + (,(concat "\\_<" cfengine3-defuns-regex "\\_>" + "[ \t]+\\_<\\([[:alnum:]_.:]+\\)\\_>" + "[ \t]+\\_<\\([[:alnum:]_.:]+\\)" ;; Optional parentheses with variable names inside. "\\(?:(\\([^)]*\\))\\)?") (1 font-lock-builtin-face) @@ -212,10 +214,10 @@ This includes those for cfservd as well as cfagent.") ("[@$]{\\([[:alnum:]_.:]+\\)}" 1 font-lock-variable-name-face) ;; Variable definitions. - ("\\<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face) + ("\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face) ;; Variable types. - (,(concat "\\<" (eval-when-compile (regexp-opt cfengine3-vartypes t)) "\\>") + (,(concat "\\_<" (eval-when-compile (regexp-opt cfengine3-vartypes t)) "\\_>") 1 font-lock-type-face))) (defvar cfengine2-imenu-expression @@ -223,9 +225,9 @@ This includes those for cfservd as well as cfagent.") (regexp-opt cfengine2-actions t)) ":[^:]") 1) - ("Variables/classes" "\\<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1) - ("Variables/classes" "\\<define=\\([[:alnum:]_]+\\)" 1) - ("Variables/classes" "\\<DefineClass\\>[ \t]+\\([[:alnum:]_]+\\)" 1)) + ("Variables/classes" "\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1) + ("Variables/classes" "\\_<define=\\([[:alnum:]_]+\\)" 1) + ("Variables/classes" "\\_<DefineClass\\>[ \t]+\\([[:alnum:]_]+\\)" 1)) "`imenu-generic-expression' for CFEngine mode.") (defun cfengine2-outline-level () @@ -338,7 +340,7 @@ Intended as the value of `indent-line-function'." Treats body/bundle blocks as defuns." (unless (<= (current-column) (current-indentation)) (end-of-line)) - (if (re-search-backward (concat "^[ \t]*" cfengine3-defuns-regex "\\>") nil t) + (if (re-search-backward (concat "^[ \t]*" cfengine3-defuns-regex "\\_>") nil t) (beginning-of-line) (goto-char (point-min))) t) @@ -347,7 +349,7 @@ Treats body/bundle blocks as defuns." "`end-of-defun' function for Cfengine 3 mode. Treats body/bundle blocks as defuns." (end-of-line) - (if (re-search-forward (concat "^[ \t]*" cfengine3-defuns-regex "\\>") nil t) + (if (re-search-forward (concat "^[ \t]*" cfengine3-defuns-regex "\\_>") nil t) (beginning-of-line) (goto-char (point-max))) t) @@ -366,7 +368,7 @@ Intended as the value of `indent-line-function'." (cond ;; Body/bundle blocks start at 0. - ((looking-at (concat cfengine3-defuns-regex "\\>")) + ((looking-at (concat cfengine3-defuns-regex "\\_>")) (indent-line-to 0)) ;; Categories are indented one step. ((looking-at (concat cfengine3-category-regex "[ \t]*\\(#.*\\)*$")) @@ -583,7 +585,7 @@ on the buffer contents" (save-restriction (goto-char (point-min)) (while (not (or (eobp) v3)) - (setq v3 (looking-at (concat cfengine3-defuns-regex "\\>"))) + (setq v3 (looking-at (concat cfengine3-defuns-regex "\\_>"))) (forward-line))) (if v3 (cfengine3-mode) (cfengine2-mode)))) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 9e9e2f0b090..d6f136ec92d 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1814,6 +1814,7 @@ Returns the compilation buffer created." (define-key map [follow-link] 'mouse-face) (define-key map "\C-c\C-c" 'compile-goto-error) (define-key map "\C-m" 'compile-goto-error) + (define-key map "\C-o" 'compilation-display-error) (define-key map "\C-c\C-k" 'kill-compilation) (define-key map "\M-n" 'compilation-next-error) (define-key map "\M-p" 'compilation-previous-error) @@ -1858,6 +1859,7 @@ Returns the compilation buffer created." (define-key map [follow-link] 'mouse-face) (define-key map "\C-c\C-c" 'compile-goto-error) (define-key map "\C-m" 'compile-goto-error) + (define-key map "\C-o" 'compilation-display-error) (define-key map "\C-c\C-k" 'kill-compilation) (define-key map "\M-n" 'compilation-next-error) (define-key map "\M-p" 'compilation-previous-error) @@ -2299,6 +2301,12 @@ Prefix arg N says how many files to move backwards (or forwards, if negative)." (interactive "p") (compilation-next-file (- n))) +(defun compilation-display-error () + "Display the source for current error in another window." + (interactive) + (setq compilation-current-error (point)) + (next-error-no-select 0)) + (defun kill-compilation () "Kill the process made by the \\[compile] or \\[grep] commands." (interactive) @@ -2374,10 +2382,12 @@ This is the value of `next-error-function' in Compilation buffers." ;; (setq timestamp compilation-buffer-modtime))) ) (with-current-buffer - (compilation-find-file - marker - (caar (compilation--loc->file-struct loc)) - (cadr (car (compilation--loc->file-struct loc)))) + (apply #'compilation-find-file + marker + (caar (compilation--loc->file-struct loc)) + (cadr (car (compilation--loc->file-struct loc))) + (compilation--file-struct->formats + (compilation--loc->file-struct loc))) (let ((screen-columns ;; Obey the compilation-error-screen-columns of the target ;; buffer if its major mode set it buffer-locally. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index e8678fe6281..910e7c49d2a 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -565,6 +565,7 @@ If nil, the value of `cperl-indent-level' will be used." "*Non-nil means that the _ (underline) should be treated as word char." :type 'boolean :group 'cperl) +(make-obsolete-variable 'cperl-under-as-char 'superword-mode "24.4") (defcustom cperl-extra-perl-args "" "*Extra arguments to use when starting Perl. @@ -1905,7 +1906,7 @@ or as help on variables `cperl-tips', `cperl-problems', (and (boundp 'msb-menu-cond) (not cperl-msb-fixed) (cperl-msb-fix)) - (if (featurep 'easymenu) + (if (fboundp 'easy-menu-add) (easy-menu-add cperl-menu)) ; A NOP in Emacs. (run-mode-hooks 'cperl-mode-hook) (if cperl-hook-after-change @@ -6529,6 +6530,9 @@ side-effect of memorizing only. Examples in `cperl-style-examples'." (let ((perl-dbg-flags (concat cperl-extra-perl-args " -wc"))) (eval '(mode-compile)))) ; Avoid a warning +(declare-function Info-find-node "info" + (filename nodename &optional no-going-back)) + (defun cperl-info-buffer (type) ;; Returns buffer with documentation. Creates if missing. ;; If TYPE, this vars buffer. @@ -6667,10 +6671,13 @@ Customized by setting variables `cperl-shrink-wrap-info-frame', (buffer-substring (match-beginning 1) (match-end 1))) +(declare-function imenu-choose-buffer-index "imenu" (&optional prompt alist)) + (defun cperl-imenu-on-info () "Shows imenu for Perl Info Buffer. Opens Perl Info buffer if needed." (interactive) + (require 'imenu) (let* ((buffer (current-buffer)) imenu-create-index-function imenu-prev-index-position-function @@ -7130,6 +7137,10 @@ Use as (defvar cperl-hierarchy '(() ()) "Global hierarchy of classes.") +;; Follows call to (autoloaded) visit-tags-table. +(declare-function file-of-tag "etags" (&optional relative)) +(declare-function etags-snarf-tag "etags" (&optional use-explicit)) + (defun cperl-tags-hier-fill () ;; Suppose we are in a tag table cooked by cperl. (goto-char 1) @@ -7173,6 +7184,7 @@ Use as (end-of-line)))) (declare-function x-popup-menu "menu.c" (position menu)) +(declare-function etags-goto-tag-location "etags" (tag-info)) (defun cperl-tags-hier-init (&optional update) "Show hierarchical menu of classes and methods. @@ -8516,6 +8528,8 @@ the appropriate statement modifier." ;;(error "Not at `if', `unless', `while', `until', `for' or `foreach'") (cperl-invert-if-unless-modifiers))) +(declare-function Man-getpage-in-background "man" (topic)) + ;;; By Anthony Foiani <afoiani@uswest.com> ;;; Getting help on modules in C-h f ? ;;; This is a modified version of `man'. diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el index 674d98b8dc3..d332d8bff31 100644 --- a/lisp/progmodes/cpp.el +++ b/lisp/progmodes/cpp.el @@ -136,13 +136,18 @@ Each entry is a list with the following elements: ("true" . t) ("both" . both))) +;; FIXME Gets clobbered by cpp-choose-face, so why is even it a defcustom? (defcustom cpp-face-default-list nil "Alist of faces you can choose from for cpp conditionals. Each element has the form (STRING . FACE), where STRING serves as a name (for `cpp-highlight-buffer' only) and FACE is either a face (a symbol) or a cons cell (background-color . COLOR)." - :type '(repeat (cons string (choice face (cons (const background-color) string)))) + :type '(alist :key-type (string :tag "Name") + :value-type (choice face + (const invisible) + (cons (const background-color) + (string :tag "Color")))) :group 'cpp) (defcustom cpp-face-light-name-list diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index dba1d6a2f9b..9bde2900a67 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -247,15 +247,36 @@ (defcustom f90-smart-end 'blink "Qualification of END statements according to the matching block start. -For example, the END that closes an IF block is changed to END -IF. If the block has a label, this is added as well. Allowed -values are 'blink, 'no-blink, and nil. If nil, nothing is done. -The other two settings have the same effect, but 'blink +For example, change the END that closes an IF block to END IF. +If the block has a label, add it as well (unless `f90-smart-end-names' +says not to). Allowed values are `blink', `no-blink', and nil. If nil, +nothing is done. The other two settings have the same effect, but `blink' additionally blinks the cursor to the start of the block." :type '(choice (const blink) (const no-blink) (const nil)) :safe (lambda (value) (memq value '(blink no-blink nil))) :group 'f90) +;; Optional: program, module, type, function, subroutine +;; Not optional: block data?, forall, if, select case/type, associate, do, +;; where, interface, critical +;; No labels: enum +(defcustom f90-smart-end-names t + "Whether completion of END statements should insert optional block names. +For example, when closing a \"PROGRAM PROGNAME\" block, \"PROGNAME\" is +optional in the \"END PROGRAM\" statement. The same is true for modules, +functions, subroutines, and types. Some people prefer to omit the name +from the END statement, since it makes it easier to change the name. + +This does not apply to named DO, IF, etc. blocks. If such blocks +start with a label, they must end with one. + +If an end statement has a name that does not match the start, it is always +corrected, regardless of the value of this variable." + :type 'boolean + :safe 'booleanp + :group 'f90 + :version "24.4") + (defcustom f90-break-delimiters "[-+\\*/><=,% \t]" "Regexp matching delimiter characters at which lines may be broken. There are some common two-character tokens where one or more of @@ -298,55 +319,61 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil." ;; User options end here. (defconst f90-keywords-re - (regexp-opt '("allocatable" "allocate" "assign" "assignment" "backspace" - "block" "call" "case" "character" "close" "common" "complex" - "contains" "continue" "cycle" "data" "deallocate" - "dimension" "do" "double" "else" "elseif" "elsewhere" "end" - "enddo" "endfile" "endif" "entry" "equivalence" "exit" - "external" "forall" "format" "function" "goto" "if" - "implicit" "include" "inquire" "integer" "intent" - "interface" "intrinsic" "logical" "module" "namelist" "none" - "nullify" "only" "open" "operator" "optional" "parameter" - "pause" "pointer" "precision" "print" "private" "procedure" - "program" "public" "read" "real" "recursive" "result" "return" - "rewind" "save" "select" "sequence" "stop" "subroutine" - "target" "then" "type" "use" "where" "while" "write" - ;; F95 keywords. - "elemental" "pure" - ;; F2003 - "abstract" "associate" "asynchronous" "bind" "class" - "deferred" "enum" "enumerator" "extends" "extends_type_of" - "final" "generic" "import" "non_intrinsic" "non_overridable" - "nopass" "pass" "protected" "same_type_as" "value" "volatile" - ;; F2008. - "contiguous" "submodule" "concurrent" "codimension" - "sync all" "sync memory" "critical" "image_index" - ) 'words) + (concat + "\\_<" + (regexp-opt '("allocatable" "allocate" "assign" "assignment" "backspace" + "block" "call" "case" "character" "close" "common" "complex" + "contains" "continue" "cycle" "data" "deallocate" + "dimension" "do" "double" "else" "elseif" "elsewhere" "end" + "enddo" "endfile" "endif" "entry" "equivalence" "exit" + "external" "forall" "format" "function" "goto" "if" + "implicit" "include" "inquire" "integer" "intent" + "interface" "intrinsic" "logical" "module" "namelist" "none" + "nullify" "only" "open" "operator" "optional" "parameter" + "pause" "pointer" "precision" "print" "private" "procedure" + "program" "public" "read" "real" "recursive" "result" "return" + "rewind" "save" "select" "sequence" "stop" "subroutine" + "target" "then" "type" "use" "where" "while" "write" + ;; F95 keywords. + "elemental" "pure" + ;; F2003 + "abstract" "associate" "asynchronous" "bind" "class" + "deferred" "enum" "enumerator" "extends" "extends_type_of" + "final" "generic" "import" "non_intrinsic" "non_overridable" + "nopass" "pass" "protected" "same_type_as" "value" "volatile" + ;; F2008. + "contiguous" "submodule" "concurrent" "codimension" + "sync all" "sync memory" "critical" "image_index" + )) + "\\_>") "Regexp used by the function `f90-change-keywords'.") (defconst f90-keywords-level-3-re - (regexp-opt - '("allocatable" "allocate" "assign" "assignment" "backspace" - "close" "deallocate" "dimension" "endfile" "entry" "equivalence" - "external" "inquire" "intent" "intrinsic" "nullify" "only" "open" - ;; FIXME operator and assignment should be F2003 procedures? - "operator" "optional" "parameter" "pause" "pointer" "print" "private" - "public" "read" "recursive" "result" "rewind" "save" "select" - "sequence" "target" "write" - ;; F95 keywords. - "elemental" "pure" - ;; F2003. asynchronous separate. - "abstract" "deferred" "import" "final" "non_intrinsic" "non_overridable" - "nopass" "pass" "protected" "value" "volatile" - ;; F2008. - ;; "concurrent" is only in the sense of "do [,] concurrent", but given - ;; the [,] it's simpler to just do every instance (cf "do while"). - "contiguous" "concurrent" "codimension" "sync all" "sync memory" - ) 'words) + (concat + "\\_<" + (regexp-opt + '("allocatable" "allocate" "assign" "assignment" "backspace" + "close" "deallocate" "dimension" "endfile" "entry" "equivalence" + "external" "inquire" "intent" "intrinsic" "nullify" "only" "open" + ;; FIXME operator and assignment should be F2003 procedures? + "operator" "optional" "parameter" "pause" "pointer" "print" "private" + "public" "read" "recursive" "result" "rewind" "save" "select" + "sequence" "target" "write" + ;; F95 keywords. + "elemental" "pure" + ;; F2003. asynchronous separate. + "abstract" "deferred" "import" "final" "non_intrinsic" "non_overridable" + "nopass" "pass" "protected" "value" "volatile" + ;; F2008. + ;; "concurrent" is only in the sense of "do [,] concurrent", but given + ;; the [,] it's simpler to just do every instance (cf "do while"). + "contiguous" "concurrent" "codimension" "sync all" "sync memory" + )) + "\\_>") "Keyword-regexp for font-lock level >= 3.") (defconst f90-procedures-re - (concat "\\<" + (concat "\\_<" (regexp-opt '("abs" "achar" "acos" "adjustl" "adjustr" "aimag" "aint" "all" "allocated" "anint" "any" "asin" "associated" @@ -407,61 +434,67 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil." "Regexp matching intrinsic operators.") (defconst f90-hpf-keywords-re - (regexp-opt - ;; Intrinsic procedures. - '("all_prefix" "all_scatter" "all_suffix" "any_prefix" - "any_scatter" "any_suffix" "copy_prefix" "copy_scatter" - "copy_suffix" "count_prefix" "count_scatter" "count_suffix" - "grade_down" "grade_up" - "hpf_alignment" "hpf_distribution" "hpf_template" "iall" "iall_prefix" - "iall_scatter" "iall_suffix" "iany" "iany_prefix" "iany_scatter" - "iany_suffix" "ilen" "iparity" "iparity_prefix" - "iparity_scatter" "iparity_suffix" "leadz" "maxval_prefix" - "maxval_scatter" "maxval_suffix" "minval_prefix" "minval_scatter" - "minval_suffix" "number_of_processors" "parity" - "parity_prefix" "parity_scatter" "parity_suffix" "popcnt" "poppar" - "processors_shape" "product_prefix" "product_scatter" - "product_suffix" "sum_prefix" "sum_scatter" "sum_suffix" - ;; Directives. - "align" "distribute" "dynamic" "independent" "inherit" "processors" - "realign" "redistribute" "template" - ;; Keywords. - "block" "cyclic" "extrinsic" "new" "onto" "pure" "with") 'words) + (concat + "\\_<" + (regexp-opt + ;; Intrinsic procedures. + '("all_prefix" "all_scatter" "all_suffix" "any_prefix" + "any_scatter" "any_suffix" "copy_prefix" "copy_scatter" + "copy_suffix" "count_prefix" "count_scatter" "count_suffix" + "grade_down" "grade_up" + "hpf_alignment" "hpf_distribution" "hpf_template" "iall" "iall_prefix" + "iall_scatter" "iall_suffix" "iany" "iany_prefix" "iany_scatter" + "iany_suffix" "ilen" "iparity" "iparity_prefix" + "iparity_scatter" "iparity_suffix" "leadz" "maxval_prefix" + "maxval_scatter" "maxval_suffix" "minval_prefix" "minval_scatter" + "minval_suffix" "number_of_processors" "parity" + "parity_prefix" "parity_scatter" "parity_suffix" "popcnt" "poppar" + "processors_shape" "product_prefix" "product_scatter" + "product_suffix" "sum_prefix" "sum_scatter" "sum_suffix" + ;; Directives. + "align" "distribute" "dynamic" "independent" "inherit" "processors" + "realign" "redistribute" "template" + ;; Keywords. + "block" "cyclic" "extrinsic" "new" "onto" "pure" "with")) + "\\_>") "Regexp for all HPF keywords, procedures and directives.") (defconst f90-constants-re - (regexp-opt '( ;; F2003 iso_fortran_env constants. - "iso_fortran_env" - "input_unit" "output_unit" "error_unit" - "iostat_end" "iostat_eor" - "numeric_storage_size" "character_storage_size" - "file_storage_size" - ;; F2003 iso_c_binding constants. - "iso_c_binding" - "c_int" "c_short" "c_long" "c_long_long" "c_signed_char" - "c_size_t" - "c_int8_t" "c_int16_t" "c_int32_t" "c_int64_t" - "c_int_least8_t" "c_int_least16_t" "c_int_least32_t" - "c_int_least64_t" - "c_int_fast8_t" "c_int_fast16_t" "c_int_fast32_t" - "c_int_fast64_t" - "c_intmax_t" "c_intptr_t" - "c_float" "c_double" "c_long_double" - "c_float_complex" "c_double_complex" "c_long_double_complex" - "c_bool" "c_char" - "c_null_char" "c_alert" "c_backspace" "c_form_feed" - "c_new_line" "c_carriage_return" "c_horizontal_tab" - "c_vertical_tab" - "c_ptr" "c_funptr" "c_null_ptr" "c_null_funptr" - "ieee_exceptions" - "ieee_arithmetic" - "ieee_features" - ;; F2008 iso_fortran_env constants. - "character_kinds" "int8" "int16" "int32" "int64" - "integer_kinds" "iostat_inquire_internal_unit" - "logical_kinds" "real_kinds" "real32" "real64" "real128" - "lock_type" "atomic_int_kind" "atomic_logical_kind" - ) 'words) + (concat + "\\_<" + (regexp-opt '( ;; F2003 iso_fortran_env constants. + "iso_fortran_env" + "input_unit" "output_unit" "error_unit" + "iostat_end" "iostat_eor" + "numeric_storage_size" "character_storage_size" + "file_storage_size" + ;; F2003 iso_c_binding constants. + "iso_c_binding" + "c_int" "c_short" "c_long" "c_long_long" "c_signed_char" + "c_size_t" + "c_int8_t" "c_int16_t" "c_int32_t" "c_int64_t" + "c_int_least8_t" "c_int_least16_t" "c_int_least32_t" + "c_int_least64_t" + "c_int_fast8_t" "c_int_fast16_t" "c_int_fast32_t" + "c_int_fast64_t" + "c_intmax_t" "c_intptr_t" + "c_float" "c_double" "c_long_double" + "c_float_complex" "c_double_complex" "c_long_double_complex" + "c_bool" "c_char" + "c_null_char" "c_alert" "c_backspace" "c_form_feed" + "c_new_line" "c_carriage_return" "c_horizontal_tab" + "c_vertical_tab" + "c_ptr" "c_funptr" "c_null_ptr" "c_null_funptr" + "ieee_exceptions" + "ieee_arithmetic" + "ieee_features" + ;; F2008 iso_fortran_env constants. + "character_kinds" "int8" "int16" "int32" "int64" + "integer_kinds" "iostat_inquire_internal_unit" + "logical_kinds" "real_kinds" "real32" "real64" "real128" + "lock_type" "atomic_int_kind" "atomic_logical_kind" + )) + "\\_>") "Regexp for Fortran intrinsic constants.") ;; cf f90-looking-at-type-like. @@ -470,16 +503,16 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil." Set the match data so that subexpression 1,2 are the TYPE, and type-name parts, respectively." (let (found l) - (while (and (re-search-forward "\\<\\(\\(?:end[ \t]*\\)?type\\)\\>[ \t]*" + (while (and (re-search-forward "\\_<\\(\\(?:end[ \t]*\\)?type\\)\\_>[ \t]*" limit t) (not (setq found (progn (setq l (match-data)) - (unless (looking-at "\\(is\\>\\|(\\)") - (when (if (looking-at "\\(\\sw+\\)") + (unless (looking-at "\\(is\\_>\\|(\\)") + (when (if (looking-at "\\(\\(?:\\sw\\|\\s_\\)+\\)") (goto-char (match-end 0)) (re-search-forward - "[ \t]*::[ \t]*\\(\\sw+\\)" + "[ \t]*::[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)" (line-end-position) t)) ;; 0 is wrong, but we don't use it. (set-match-data @@ -491,33 +524,33 @@ type-name parts, respectively." (defvar f90-font-lock-keywords-1 (list ;; Special highlighting of "module procedure". - '("\\<\\(module[ \t]*procedure\\)\\>\\([^()\n]*::\\)?[ \t]*\\([^&!\n]*\\)" + '("\\_<\\(module[ \t]*procedure\\)\\_>\\([^()\n]*::\\)?[ \t]*\\([^&!\n]*\\)" (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t)) ;; Highlight definition of derived type. -;;; '("\\<\\(\\(?:end[ \t]*\\)?type\\)\\>\\([^()\n]*::\\)?[ \t]*\\(\\sw+\\)" +;;; '("\\_<\\(\\(?:end[ \t]*\\)?type\\)\\_>\\([^()\n]*::\\)?[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)" ;;; (1 font-lock-keyword-face) (3 font-lock-function-name-face)) '(f90-typedef-matcher (1 font-lock-keyword-face) (2 font-lock-function-name-face)) ;; F2003. Prevent operators being highlighted as functions. - '("\\<\\(\\(?:end[ \t]*\\)?interface[ \t]*\\(?:assignment\\|operator\\|\ + '("\\_<\\(\\(?:end[ \t]*\\)?interface[ \t]*\\(?:assignment\\|operator\\|\ read\\|write\\)\\)[ \t]*(" (1 font-lock-keyword-face t)) ;; Other functions and declarations. Named interfaces = F2003. ;; F2008: end submodule submodule_name. - '("\\<\\(\\(?:end[ \t]*\\)?\\(program\\|\\(?:sub\\)?module\\|\ + '("\\_<\\(\\(?:end[ \t]*\\)?\\(program\\|\\(?:sub\\)?module\\|\ function\\|associate\\|subroutine\\|interface\\)\\|use\\|call\\)\ -\\>[ \t]*\\(\\sw+\\)?" +\\_>[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)?" (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t)) ;; F2008: submodule (parent_name) submodule_name. - '("\\<\\(submodule\\)\\>[ \t]*([^)\n]+)[ \t]*\\(\\sw+\\)?" + '("\\_<\\(submodule\\)\\_>[ \t]*([^)\n]+)[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)?" (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) ;; F2003. - '("\\<\\(use\\)[ \t]*,[ \t]*\\(\\(?:non_\\)?intrinsic\\)[ \t]*::[ \t]*\ -\\(\\sw+\\)" + '("\\_<\\(use\\)[ \t]*,[ \t]*\\(\\(?:non_\\)?intrinsic\\)[ \t]*::[ \t]*\ +\\(\\(?:\\sw\\|\\s_\\)+\\)" (1 font-lock-keyword-face) (2 font-lock-keyword-face) (3 font-lock-function-name-face)) - "\\<\\(\\(end[ \t]*\\)?block[ \t]*data\\|contains\\)\\>" + "\\_<\\(\\(end[ \t]*\\)?block[ \t]*data\\|contains\\)\\_>" ;; "abstract interface" is F2003. - '("\\<abstract[ \t]*interface\\>" (0 font-lock-keyword-face t))) + '("\\_<abstract[ \t]*interface\\_>" (0 font-lock-keyword-face t))) "This does fairly subdued highlighting of comments and function calls.") ;; NB not explicitly handling this, yet it seems to work. @@ -529,7 +562,7 @@ and variable-name parts, respectively." ;; Matcher functions must return nil only when there are no more ;; matches within the search range. (let (found l) - (while (and (re-search-forward "\\<\\(type\\|class\\)[ \t]*(" limit t) + (while (and (re-search-forward "\\_<\\(type\\|class\\)[ \t]*(" limit t) (not (setq found (condition-case nil @@ -544,7 +577,7 @@ and variable-name parts, respectively." (when (re-search-forward ;; type (foo) bar, qux - (if (looking-at "\\sw+") + (if (looking-at "\\(?:\\sw\\|\\s_\\)+") "\\([^&!\n]+\\)" ;; type (foo), stuff :: bar, qux "::[ \t]*\\([^&!\n]+\\)") @@ -587,53 +620,53 @@ enumerator\\|generic\\|procedure\\|logical\\|double[ \t]*precision\\)\ ;; integer( kind=1 ) function foo() ;; thanks to the happy accident described above. ;; Not anchored, so don't need to worry about "pure" etc. - '("\\<\\(\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\ + '("\\_<\\(\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\ logical\\|double[ \t]*precision\\|\ -\\(?:type\\|class\\)[ \t]*([ \t]*\\sw+[ \t]*)\\)[ \t]*\\)\ -\\(function\\)\\>[ \t]*\\(\\sw+\\)[ \t]*\\(([^&!\n]*)\\)" +\\(?:type\\|class\\)[ \t]*([ \t]*\\(?:\\sw\\|\\s_\\)+[ \t]*)\\)[ \t]*\\)\ +\\(function\\)\\_>[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)[ \t]*\\(([^&!\n]*)\\)" (1 font-lock-type-face t) (4 font-lock-keyword-face t) (5 font-lock-function-name-face t) (6 'default t)) ;; enum (F2003; must be followed by ", bind(C)"). - '("\\<\\(enum\\)[ \t]*," (1 font-lock-keyword-face)) + '("\\_<\\(enum\\)[ \t]*," (1 font-lock-keyword-face)) ;; end do, enum (F2003), if, select, where, and forall constructs. ;; block, critical (F2008). ;; Note that "block data" may get somewhat mixed up with F2008 blocks, ;; but since the former is obsolete I'm not going to worry about it. - '("\\<\\(end[ \t]*\\(do\\|if\\|enum\\|select\\|forall\\|where\\|\ -block\\|critical\\)\\)\\>\ -\\([ \t]+\\(\\sw+\\)\\)?" + '("\\_<\\(end[ \t]*\\(do\\|if\\|enum\\|select\\|forall\\|where\\|\ +block\\|critical\\)\\)\\_>\ +\\([ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)\\)?" (1 font-lock-keyword-face) (3 font-lock-constant-face nil t)) - '("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|\ + '("^[ \t0-9]*\\(\\(\\(?:\\sw\\|\\s_\\)+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|\ do\\([ \t]*while\\)?\\|select[ \t]*\\(?:case\\|type\\)\\|where\\|\ -forall\\|block\\|critical\\)\\)\\>" +forall\\|block\\|critical\\)\\)\\_>" (2 font-lock-constant-face nil t) (3 font-lock-keyword-face)) ;; Implicit declaration. - '("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\ + '("\\_<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\ \\|enumerator\\|procedure\\|\ -logical\\|double[ \t]*precision\\|type[ \t]*(\\sw+)\\|none\\)[ \t]*" +logical\\|double[ \t]*precision\\|type[ \t]*(\\(?:\\sw\\|\\s_\\)+)\\|none\\)[ \t]*" (1 font-lock-keyword-face) (2 font-lock-type-face)) - '("\\<\\(namelist\\|common\\)[ \t]*\/\\(\\sw+\\)?\/" + '("\\_<\\(namelist\\|common\\)[ \t]*\/\\(\\(?:\\sw\\|\\s_\\)+\\)?\/" (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) - "\\<else\\([ \t]*if\\|where\\)?\\>" + "\\_<else\\([ \t]*if\\|where\\)?\\_>" '("\\(&\\)[ \t]*\\(!\\|$\\)" (1 font-lock-keyword-face)) - "\\<\\(then\\|continue\\|format\\|include\\|stop\\|return\\)\\>" - '("\\<\\(exit\\|cycle\\)[ \t]*\\(\\sw+\\)?\\>" + "\\_<\\(then\\|continue\\|format\\|include\\|stop\\|return\\)\\_>" + '("\\_<\\(exit\\|cycle\\)[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)?\\_>" (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) - '("\\<\\(case\\)[ \t]*\\(default\\|(\\)" . 1) + '("\\_<\\(case\\)[ \t]*\\(default\\|(\\)" . 1) ;; F2003 "class default". - '("\\<\\(class\\)[ \t]*default" . 1) + '("\\_<\\(class\\)[ \t]*default" . 1) ;; F2003 "type is" in a "select type" block. - '("\\<\\(\\(type\\|class\\)[ \t]*is\\)[ \t]*(" (1 font-lock-keyword-face t)) - '("\\<\\(do\\|go[ \t]*to\\)\\>[ \t]*\\([0-9]+\\)" + '("\\_<\\(\\(type\\|class\\)[ \t]*is\\)[ \t]*(" (1 font-lock-keyword-face t)) + '("\\_<\\(do\\|go[ \t]*to\\)\\_>[ \t]*\\([0-9]+\\)" (1 font-lock-keyword-face) (2 font-lock-constant-face)) ;; Line numbers (lines whose first character after number is letter). '("^[ \t]*\\([0-9]+\\)[ \t]*[a-z]+" (1 font-lock-constant-face t)) ;; Override eg for "#include". - '("^#[ \t]*\\w+" (0 font-lock-preprocessor-face t) - ("\\<defined\\>" nil nil (0 font-lock-preprocessor-face))) + '("^#[ \t]*\\(?:\\sw\\|\\s_\\)+" (0 font-lock-preprocessor-face t) + ("\\_<defined\\_>" nil nil (0 font-lock-preprocessor-face))) '("^#" ("\\(&&\\|||\\)" nil nil (0 font-lock-constant-face t))) - '("^#[ \t]*define[ \t]+\\(\\w+\\)(" (1 font-lock-function-name-face)) - '("^#[ \t]*define[ \t]+\\(\\w+\\)" (1 font-lock-variable-name-face)) + '("^#[ \t]*define[ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)(" (1 font-lock-function-name-face)) + '("^#[ \t]*define[ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)" (1 font-lock-variable-name-face)) '("^#[ \t]*include[ \t]+\\(<.+>\\)" (1 font-lock-string-face)))) "Highlights declarations, do-loops and other constructs.") @@ -645,9 +678,9 @@ logical\\|double[ \t]*precision\\|type[ \t]*(\\sw+)\\|none\\)[ \t]*" ;; FIXME why isn't this font-lock-builtin-face, which ;; otherwise we hardly use, as in fortran.el? (list f90-procedures-re '(1 font-lock-keyword-face keep)) - "\\<real\\>" ; avoid overwriting real defs + "\\_<real\\_>" ; avoid overwriting real defs ;; As an attribute, but not as an optional argument. - '("\\<\\(asynchronous\\)[ \t]*[^=]" . 1))) + '("\\_<\\(asynchronous\\)[ \t]*[^=]" . 1))) "Highlights all F90 keywords and intrinsic procedures.") (defvar f90-font-lock-keywords-4 @@ -666,8 +699,7 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") (let ((table (make-syntax-table))) (modify-syntax-entry ?\! "<" table) ; begin comment (modify-syntax-entry ?\n ">" table) ; end comment - ;; FIXME: This goes against the convention: it should be "_". - (modify-syntax-entry ?_ "w" table) ; underscore in names + (modify-syntax-entry ?_ "_" table) ; underscore in names (modify-syntax-entry ?\' "\"" table) ; string quote (modify-syntax-entry ?\" "\"" table) ; string quote ;; FIXME: We used to set ` to word syntax for the benefit of abbrevs, but @@ -822,14 +854,14 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") ;; Regexps for finding program structures. (defconst f90-blocks-re - (concat "\\(block[ \t]*data\\|" + (concat "\\(\\(?:block[ \t]*data\\|" (regexp-opt '("do" "if" "interface" "function" "module" "program" "select" "subroutine" "type" "where" "forall" ;; F2003. "enum" "associate" ;; F2008. "submodule" "block" "critical")) - "\\)\\>") + "\\)\\_>\\)") "Regexp potentially indicating a \"block\" of F90 code.") (defconst f90-program-block-re @@ -845,15 +877,15 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") (defconst f90-end-if-re (concat "end[ \t]*" (regexp-opt '("if" "select" "where" "forall") 'paren) - "\\>") + "\\_>") "Regexp matching the end of an IF, SELECT, WHERE, FORALL block.") (defconst f90-end-type-re - "end[ \t]*\\(type\\|enum\\|interface\\|block[ \t]*data\\)\\>" + "end[ \t]*\\(type\\|enum\\|interface\\|block[ \t]*data\\)\\_>" "Regexp matching the end of a TYPE, ENUM, INTERFACE, BLOCK DATA section.") (defconst f90-end-associate-re - "end[ \t]*associate\\>" + "end[ \t]*associate\\_>" "Regexp matching the end of an ASSOCIATE block.") ;; This is for a TYPE block, not a variable of derived TYPE. @@ -864,12 +896,12 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") ;; type, stuff :: word ;; type, bind(c) :: word ;; NOT "type (" - "\\<\\(type\\)\\>\\(?:\\(?:[^()\n]*\\|\ -.*,[ \t]*bind[ \t]*([ \t]*c[ \t]*)[ \t]*\\)::\\)?[ \t]*\\(\\sw+\\)" + "\\_<\\(type\\)\\_>\\(?:\\(?:[^()\n]*\\|\ +.*,[ \t]*bind[ \t]*([ \t]*c[ \t]*)[ \t]*\\)::\\)?[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)" "Regexp matching the definition of a derived type.") (defconst f90-typeis-re - "\\<\\(class\\|type\\)[ \t]*is[ \t]*(" + "\\_<\\(class\\|type\\)[ \t]*is[ \t]*(" "Regexp matching a CLASS/TYPE IS statement.") (defconst f90-no-break-re @@ -888,12 +920,12 @@ allowed. This minor issue currently only affects \"(/\" and \"/)\".") ;; Hideshow support. (defconst f90-end-block-re - (concat "^[ \t0-9]*\\<end[ \t]*" + (concat "^[ \t0-9]*\\_<end[ \t]*" (regexp-opt '("do" "if" "forall" "function" "interface" "module" "program" "select" "subroutine" "type" "where" "enum" "associate" "submodule" "block" "critical") t) - "\\>") + "\\_>") "Regexp matching the end of an F90 \"block\", from the line start. Used in the F90 entry in `hs-special-modes-alist'.") @@ -903,11 +935,11 @@ Used in the F90 entry in `hs-special-modes-alist'.") (concat "^[ \t0-9]*" ; statement number "\\(\\(" - "\\(\\sw+[ \t]*:[ \t]*\\)?" ; structure label + "\\(\\(?:\\sw\\|\\s_\\)+[ \t]*:[ \t]*\\)?" ; structure label "\\(do\\|select[ \t]*\\(case\\|type\\)\\|" ;; See comments in fortran-start-block-re for the problems of IF. "if[ \t]*(\\(.*\\|" - ".*\n\\([^if]*\\([^i].\\|.[^f]\\|.\\>\\)\\)\\)\\<then\\|" + ".*\n\\([^if]*\\([^i].\\|.[^f]\\|.\\_>\\)\\)\\)\\_<then\\|" ;; Distinguish WHERE block from isolated WHERE. "\\(where\\|forall\\)[ \t]*(.*)[ \t]*\\(!\\|$\\)\\)\\)" "\\|" @@ -917,7 +949,7 @@ Used in the F90 entry in `hs-special-modes-alist'.") "type[ \t,]\\(" "[^i(!\n\"\& \t]\\|" ; not-i( "i[^s!\n\"\& \t]\\|" ; i not-s - "is\\sw\\)\\|" + "is\\(?:\\sw\\|\\s_\\)\\)\\|" ;; "abstract interface" is F2003; "submodule" is F2008. "program\\|\\(?:abstract[ \t]*\\)?interface\\|\\(?:sub\\)?module\\|" ;; "enum", but not "enumerator". @@ -945,10 +977,10 @@ Set subexpression 1 in the match-data to the name of the type." (not (setq found (save-excursion (goto-char (match-end 0)) - (unless (looking-at "\\(is\\>\\|(\\)") - (or (looking-at "\\(\\sw+\\)") + (unless (looking-at "\\(is\\_>\\|(\\)") + (or (looking-at "\\(\\(?:\\sw\\|\\s_\\)+\\)") (re-search-forward - "[ \t]*::[ \t]*\\(\\sw+\\)" + "[ \t]*::[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)" (line-end-position) t)))))))) found)) @@ -957,36 +989,35 @@ Set subexpression 1 in the match-data to the name of the type." (not-n "[^n!\n\"\& \t]") (not-d "[^d!\n\"\& \t]") ;; (not-ib "[^i(!\n\"\& \t]") (not-s "[^s!\n\"\& \t]") ) - (list - '(nil "^[ \t0-9]*program[ \t]+\\(\\sw+\\)" 1) - '("Submodules" "^[ \t0-9]*submodule[ \t]*([^)\n]+)[ \t]*\ -\\(\\sw+\\)[ \t]*\\(!\\|$\\)" 1) - '("Modules" "^[ \t0-9]*module[ \t]+\\(\\sw+\\)[ \t]*\\(!\\|$\\)" 1) - (list "Types" 'f90-imenu-type-matcher 1) - ;; Does not handle: "type[, stuff] :: foo". -;;; (format "^[ \t0-9]*type[ \t]+\\(\\(%s\\|i%s\\|is\\sw\\)\\sw*\\)" -;;; not-ib not-s) -;;; 1) - ;; Can't get the subexpression numbers to match in the two branches. -;;; (format "^[ \t0-9]*type\\([ \t]*,.*\\(::\\)[ \t]*\\(\\sw+\\)\\|[ \t]+\\(\\(%s\\|i%s\\|is\\sw\\)\\sw*\\)\\)" not-ib not-s) -;;; 3) - (list - "Procedures" - (concat - "^[ \t0-9]*" - "\\(" - ;; At least three non-space characters before function/subroutine. - ;; Check that the last three non-space characters do not spell E N D. - "[^!\"\&\n]*\\(" - not-e good-char good-char "\\|" - good-char not-n good-char "\\|" - good-char good-char not-d "\\)" - "\\|" - ;; Less than three non-space characters before function/subroutine. - good-char "?" good-char "?" - "\\)" - "[ \t]*\\(function\\|subroutine\\)[ \t]+\\(\\sw+\\)") - 4))) + `((nil "^[ \t0-9]*program[ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)" 1) + ("Submodules" "^[ \t0-9]*submodule[ \t]*([^)\n]+)[ \t]*\ +\\(\\(?:\\sw\\|\\s_\\)+\\)[ \t]*\\(!\\|$\\)" 1) + ("Modules" "^[ \t0-9]*module[ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)[ \t]*\\(!\\|$\\)" 1) + ("Types" f90-imenu-type-matcher 1) + ;; Does not handle: "type[, stuff] :: foo". + ;;(format "^[ \t0-9]*type[ \t]+\\(\\(%s\\|i%s\\|is\\(?:\\sw\\|\\s_\\)\\)\\(?:\\sw\\|\\s_\\)*\\)" + ;; not-ib not-s) + ;;1) + ;; Can't get the subexpression numbers to match in the two branches. + ;; FIXME: Now with \(?N:..\) we can get the numbers to match! + ;;(format "^[ \t0-9]*type\\([ \t]*,.*\\(::\\)[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)\\|[ \t]+\\(\\(%s\\|i%s\\|is\\(?:\\sw\\|\\s_\\)\\)\\(?:\\sw\\|\\s_\\)*\\)\\)" not-ib not-s) + ;;3) + ("Procedures" + ,(concat + "^[ \t0-9]*" + "\\(" + ;; At least three non-space characters before function/subroutine. + ;; Check that the last three non-space characters do not spell E N D. + "[^!\"\&\n]*\\(" + not-e good-char good-char "\\|" + good-char not-n good-char "\\|" + good-char good-char not-d "\\)" + "\\|" + ;; Less than three non-space characters before function/subroutine. + good-char "?" good-char "?" + "\\)" + "[ \t]*\\(function\\|subroutine\\)[ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)") + 4))) "Value for `imenu-generic-expression' in F90 mode.") (defun f90-add-imenu-menu () @@ -1119,11 +1150,11 @@ Variables controlling indentation style and extra features: Automatic insertion of \& at beginning of continuation lines (default t). `f90-smart-end' From an END statement, check and fill the end using matching block start. - Allowed values are 'blink, 'no-blink, and nil, which determine - whether to blink the matching beginning (default 'blink). + Allowed values are `blink', `no-blink', and nil, which determine + whether to blink the matching beginning (default `blink'). `f90-auto-keyword-case' Automatic change of case of keywords (default nil). - The possibilities are 'downcase-word, 'upcase-word, 'capitalize-word. + The possibilities are `downcase-word', `upcase-word', `capitalize-word'. `f90-leave-line-no' Do not left-justify line numbers (default nil). @@ -1235,13 +1266,13 @@ whitespace, if any." (defsubst f90-looking-at-do () "Return (\"do\" NAME) if a do statement starts after point. NAME is nil if the statement has no label." - (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(do\\)\\>") + (if (looking-at "\\(\\(\\(?:\\sw\\|\\s_\\)+\\)[ \t]*:\\)?[ \t]*\\(do\\)\\_>") (list (match-string 3) (match-string 2)))) (defsubst f90-looking-at-select-case () "Return (\"select\" NAME) if a select statement starts after point. NAME is nil if the statement has no label." - (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\ + (if (looking-at "\\(\\(\\(?:\\sw\\|\\s_\\)+\\)[ \t]*:\\)?[ \t]*\ \\(select\\)[ \t]*\\(case\\|type\\)[ \t]*(") (list (match-string 3) (match-string 2)))) @@ -1249,50 +1280,50 @@ NAME is nil if the statement has no label." "Return (\"if\" NAME) if an if () then statement starts after point. NAME is nil if the statement has no label." (save-excursion - (when (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(if\\)\\>") + (when (looking-at "\\(\\(\\(?:\\sw\\|\\s_\\)+\\)[ \t]*:\\)?[ \t]*\\(if\\)\\_>") (let ((struct (match-string 3)) (label (match-string 2)) (pos (scan-lists (point) 1 0))) (and pos (goto-char pos)) (skip-chars-forward " \t") - (if (or (looking-at "then\\>") + (if (or (looking-at "then\\_>") (when (f90-line-continued) (f90-next-statement) (skip-chars-forward " \t0-9&") - (looking-at "then\\>"))) + (looking-at "then\\_>"))) (list struct label)))))) ;; FIXME label? (defsubst f90-looking-at-associate () "Return (\"associate\") if an associate block starts after point." - (if (looking-at "\\<\\(associate\\)[ \t]*(") + (if (looking-at "\\_<\\(associate\\)[ \t]*(") (list (match-string 1)))) (defsubst f90-looking-at-critical () "Return (KIND NAME) if a critical or block block starts after point." - (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(critical\\|block\\)\\>") + (if (looking-at "\\(\\(\\(?:\\sw\\|\\s_\\)+\\)[ \t]*:\\)?[ \t]*\\(critical\\|block\\)\\_>") (let ((struct (match-string 3)) (label (match-string 2))) (if (or (not (string-equal "block" struct)) (save-excursion (skip-chars-forward " \t") - (not (looking-at "data\\>")))) + (not (looking-at "data\\_>")))) (list struct label))))) (defsubst f90-looking-at-end-critical () "Return non-nil if a critical or block block ends after point." - (if (looking-at "end[ \t]*\\(critical\\|block\\)\\>") + (if (looking-at "end[ \t]*\\(critical\\|block\\)\\_>") (or (not (string-equal "block" (match-string 1))) (save-excursion (skip-chars-forward " \t") - (not (looking-at "data\\>")))))) + (not (looking-at "data\\_>")))))) (defsubst f90-looking-at-where-or-forall () "Return (KIND NAME) if a where or forall block starts after point. NAME is nil if the statement has no label." (save-excursion - (when (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\ -\\(where\\|forall\\)\\>") + (when (looking-at "\\(\\(\\(?:\\sw\\|\\s_\\)+\\)[ \t]*:\\)?[ \t]*\ +\\(where\\|forall\\)\\_>") (let ((struct (match-string 3)) (label (match-string 2)) (pos (scan-lists (point) 1 0))) @@ -1305,43 +1336,43 @@ NAME is nil if the statement has no label." NAME is non-nil only for type and certain interfaces." (cond ((save-excursion - (and (looking-at "\\<type\\>[ \t]*") + (and (looking-at "\\_<type\\_>[ \t]*") (goto-char (match-end 0)) - (not (looking-at "\\(is\\>\\|(\\)")) - (or (looking-at "\\(\\sw+\\)") - (re-search-forward "[ \t]*::[ \t]*\\(\\sw+\\)" + (not (looking-at "\\(is\\_>\\|(\\)")) + (or (looking-at "\\(\\(?:\\sw\\|\\s_\\)+\\)") + (re-search-forward "[ \t]*::[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)" (line-end-position) t)))) (list "type" (match-string 1))) ;;; ((and (not (looking-at f90-typeis-re)) ;;; (looking-at f90-type-def-re)) ;;; (list (match-string 1) (match-string 2))) - ((looking-at "\\<\\(interface\\)\\>[ \t]*") + ((looking-at "\\_<\\(interface\\)\\_>[ \t]*") (list (match-string 1) (save-excursion (goto-char (match-end 0)) (if (or (looking-at "\\(operator\\|assignment\\|read\\|\ write\\)[ \t]*([^)\n]*)") - (looking-at "\\sw+")) + (looking-at "\\(?:\\sw\\|\\s_\\)+")) (match-string 0))))) - ((looking-at "\\(enum\\|block[ \t]*data\\)\\>") + ((looking-at "\\(enum\\|block[ \t]*data\\)\\_>") (list (match-string 1) nil)) - ((looking-at "abstract[ \t]*\\(interface\\)\\>") + ((looking-at "abstract[ \t]*\\(interface\\)\\_>") (list (match-string 1) nil)))) (defsubst f90-looking-at-program-block-start () "Return (KIND NAME) if a program block with name NAME starts after point." ;;;NAME is nil for an un-named main PROGRAM block." (cond - ((looking-at "\\(program\\)[ \t]+\\(\\sw+\\)\\>") + ((looking-at "\\(program\\)[ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)\\_>") (list (match-string 1) (match-string 2))) - ((and (not (looking-at "module[ \t]*procedure\\>")) - (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>")) + ((and (not (looking-at "module[ \t]*procedure\\_>")) + (looking-at "\\(module\\)[ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)\\_>")) (list (match-string 1) (match-string 2))) - ((looking-at "\\(submodule\\)[ \t]*([^)\n]+)[ \t]*\\(\\sw+\\)\\>") + ((looking-at "\\(submodule\\)[ \t]*([^)\n]+)[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)\\_>") (list (match-string 1) (match-string 2))) ((and (not (looking-at "end[ \t]*\\(function\\|subroutine\\)")) (looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)[ \t]+\ -\\(\\sw+\\)")) +\\(\\(?:\\sw\\|\\s_\\)+\\)")) (list (match-string 1) (match-string 2))))) ;; Following will match an un-named main program block; however ;; one needs to check if there is an actual PROGRAM statement after @@ -1357,7 +1388,7 @@ write\\)[ \t]*([^)\n]*)") \\(?:assignment\\|operator\\|read\\|write\\)[ \t]*([^)\n]*)\\)") (list (match-string 1) (match-string 2))) ((looking-at (concat "end[ \t]*" f90-blocks-re - "?\\([ \t]+\\(\\sw+\\)\\)?\\>")) + "?\\([ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)\\)?\\_>")) (list (match-string 1) (match-string 3))))) (defsubst f90-comment-indent () @@ -1414,10 +1445,10 @@ if all else fails." (not (or (looking-at "end") (looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\ \\|select[ \t]*\\(case\\|type\\)\\|case\\|where\\|forall\\|\ -block\\|critical\\)\\>") +block\\|critical\\)\\_>") (looking-at "\\(program\\|\\(?:sub\\)?module\\|\ -\\(?:abstract[ \t]*\\)?interface\\|block[ \t]*data\\)\\>") - (looking-at "\\(contains\\|\\sw+[ \t]*:\\)") +\\(?:abstract[ \t]*\\)?interface\\|block[ \t]*data\\)\\_>") + (looking-at "\\(contains\\|\\(?:\\sw\\|\\s_\\)+[ \t]*:\\)") (looking-at f90-type-def-re) (re-search-forward "\\(function\\|subroutine\\)" (line-end-position) t))))) @@ -1483,7 +1514,7 @@ Does not check type and subprogram indentation." (setq icol (- icol f90-associate-indent))) ((f90-looking-at-end-critical) (setq icol (- icol f90-critical-indent))) - ((looking-at "end[ \t]*do\\>") + ((looking-at "end[ \t]*do\\_>") (setq icol (- icol f90-do-indent)))) (end-of-line)) icol))) @@ -1550,7 +1581,7 @@ Does not check type and subprogram indentation." (cond ((or (looking-at f90-else-like-re) (looking-at f90-end-if-re)) (setq icol (- icol f90-if-indent))) - ((looking-at "end[ \t]*do\\>") + ((looking-at "end[ \t]*do\\_>") (setq icol (- icol f90-do-indent))) ((looking-at f90-end-type-re) (setq icol (- icol f90-type-indent))) @@ -1671,7 +1702,7 @@ Interactively, pushes mark before moving point." (setq start-list (cons start-this start-list) ; not add-to-list! count (1+ count))) ((looking-at (concat "end[ \t]*" f90-blocks-re - "[ \t]*\\(\\sw+\\)?")) + "[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)?")) (setq end-type (match-string 1) end-label (match-string 2) count (1- count)) @@ -1716,7 +1747,7 @@ Interactively, pushes mark before moving point." (skip-chars-forward " \t0-9") (cond ((or (f90-in-string) (f90-in-comment))) ((looking-at (concat "end[ \t]*" f90-blocks-re - "[ \t]*\\(\\sw+\\)?")) + "[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)?")) (setq end-list (cons (list (match-string 1) (match-string 2)) end-list) count (1+ count))) @@ -1962,7 +1993,7 @@ If run in the middle of a line, the line is not broken." (car end-struct) (cadr end-struct)))) (setq ind-b (cond ((looking-at f90-end-if-re) f90-if-indent) - ((looking-at "end[ \t]*do\\>") f90-do-indent) + ((looking-at "end[ \t]*do\\_>") f90-do-indent) ((looking-at f90-end-type-re) f90-type-indent) ((looking-at f90-end-associate-re) f90-associate-indent) @@ -2108,12 +2139,19 @@ Like `join-line', but handles F90 syntax." (zmacs-deactivate-region) (deactivate-mark)))) +(defconst f90-end-block-optional-name + '("program" "module" "subroutine" "function" "type") + "Block types where including the name in the end statement is optional.") + (defun f90-block-match (beg-block beg-name end-block end-name) "Match end-struct with beg-struct and complete end-block if possible. BEG-BLOCK is the type of block as indicated at the start (e.g., do). BEG-NAME is the block start name (may be nil). END-BLOCK is the type of block as indicated at the end (may be nil). END-NAME is the block end name (may be nil). +If the block type matches `f90-end-block-optional-name', do not add +an end name if `f90-smart-end-names' is nil, but always update an +incorrect end name if there already was one. Leave point at the end of line." ;; Hack to deal with the case when this is called from ;; f90-indent-region on a program block without an explicit PROGRAM @@ -2133,8 +2171,11 @@ Leave point at the end of line." (if (f90-equal-symbols beg-name end-name) (and end-name (search-forward end-name)) (cond ((and beg-name (not end-name)) - (message "Inserting %s." beg-name) - (insert (concat " " beg-name))) + (unless (and (not f90-smart-end-names) + (member-ignore-case beg-block + f90-end-block-optional-name)) + (message "Inserting %s." beg-name) + (insert (concat " " beg-name)))) ((and beg-name end-name) (message "Replacing %s with %s." end-name beg-name) (search-forward end-name) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 0f92df95a9d..99b48e8d0db 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1,4 +1,4 @@ -;;; flymake.el -- a universal on-the-fly syntax checker +;;; flymake.el --- a universal on-the-fly syntax checker ;; Copyright (C) 2003-2013 Free Software Foundation, Inc. @@ -68,6 +68,9 @@ ;;;; [[ cross-emacs compatibility routines (defsubst flymake-makehash (&optional test) + "Create and return a new hash table using TEST to compare keys. +It uses the function `make-hash-table' to make a hash-table if +you use GNU Emacs, otherwise it uses `makehash'." (if (fboundp 'make-hash-table) (if test (make-hash-table :test test) (make-hash-table)) (with-no-warnings @@ -106,10 +109,12 @@ Zero-length substrings at the beginning and end of the list are omitted." (lambda () temporary-file-directory))) (defun flymake-posn-at-point-as-event (&optional position window dx dy) - "Return pixel position of top left corner of glyph at POSITION, -relative to top left corner of WINDOW, as a mouse-1 click -event (identical to the event that would be triggered by clicking -mouse button 1 at the top left corner of the glyph). + "Return pixel position of top left corner of glyph at POSITION. + +The position is relative to top left corner of WINDOW, as a +mouse-1 click event (identical to the event that would be +triggered by clicking mouse button 1 at the top left corner of +the glyph). POSITION and WINDOW default to the position of point in the selected window. @@ -164,7 +169,9 @@ See `x-popup-menu' for the menu specifier format." (if (featurep 'xemacs) (progn -(defun flymake-nop ()) +(defun flymake-nop () + "Do nothing." + nil) (defun flymake-make-xemacs-menu (menu-data) "Return a menu specifier using MENU-DATA." @@ -187,6 +194,7 @@ See `x-popup-menu' for the menu specifier format." (count-lines (window-start) (point)))) (defun flymake-selected-frame () + "Return the frame that is now selected." (if (fboundp 'window-edges) (selected-frame) (selected-window))) @@ -217,31 +225,41 @@ See `x-popup-menu' for the menu specifier format." :group 'flymake :type 'integer) + +;; (defcustom flymake-log-file-name "~/flymake.log" +;; "Where to put the flymake log if logging is enabled. +;; +;; See `flymake-log-level' if you want to control what is logged." +;; :group 'flymake +;; :type 'string) + (defun flymake-log (level text &rest args) "Log a message at level LEVEL. If LEVEL is higher than `flymake-log-level', the message is ignored. Otherwise, it is printed using `message'. TEXT is a format control string, and the remaining arguments ARGS -are the string substitutions (see `format')." +are the string substitutions (see the function `format')." (if (<= level flymake-log-level) (let* ((msg (apply 'format text args))) (message "%s" msg) ;;(with-temp-buffer ;; (insert msg) ;; (insert "\n") - ;; (flymake-save-buffer-in-file "d:/flymake.log" t) ; make log file name customizable + ;; (flymake-save-buffer-in-file "~/flymake.log") ; make log file name customizable ;;) ))) (defun flymake-ins-after (list pos val) - "Insert VAL into LIST after position POS." - (let ((tmp (copy-sequence list))) ; (???) + "Insert VAL into LIST after position POS. +POS counts from zero." + (let ((tmp (copy-sequence list))) (setcdr (nthcdr pos tmp) (cons val (nthcdr (1+ pos) tmp))) tmp)) (defun flymake-set-at (list pos val) - "Set VAL at position POS in LIST." - (let ((tmp (copy-sequence list))) ; (???) + "Set VAL at position POS in LIST. +POS counts from zero." + (let ((tmp (copy-sequence list))) (setcar (nthcdr pos tmp) val) tmp)) @@ -249,7 +267,6 @@ are the string substitutions (see `format')." "List of currently active flymake processes.") (defvar flymake-output-residual nil) - (make-variable-buffer-local 'flymake-output-residual) (defgroup flymake nil @@ -257,6 +274,13 @@ are the string substitutions (see `format')." :version "23.1" :group 'tools) +(defcustom flymake-xml-program + (if (executable-find "xmlstarlet") "xmlstarlet" "xml") + "Program to use for XML validation." + :type 'file + :group 'flymake + :version "24.4") + (defcustom flymake-allowed-file-name-masks '(("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'" flymake-simple-make-init) ("\\.xml\\'" flymake-xml-init) @@ -279,16 +303,31 @@ are the string substitutions (see `format')." ;; ("[ \t]*\\input[ \t]*{\\(.*\\)\\(%s\\)}" 1 2 )) ;; ("\\.tex\\'" 1) ) - "Files syntax checking is allowed for." + "Files syntax checking is allowed for. +This is an alist with elements of the form: + REGEXP INIT [CLEANUP [NAME]] +REGEXP is a regular expression that matches a file name. +INIT is the init function to use. +CLEANUP is the cleanup function to use, default `flymake-simple-cleanup'. +NAME is the file name function to use, default `flymake-get-real-file-name'." :group 'flymake - :type '(repeat (string symbol symbol symbol))) + :type '(alist :key-type (regexp :tag "File regexp") + :value-type + (list :tag "Handler functions" + (function :tag "Init function") + (choice :tag "Cleanup function" + (const :tag "flymake-simple-cleanup" nil) + function) + (choice :tag "Name function" + (const :tag "flymake-get-real-file-name" nil) + function)))) (defun flymake-get-file-name-mode-and-masks (file-name) "Return the corresponding entry from `flymake-allowed-file-name-masks'." (unless (stringp file-name) (error "Invalid file-name")) (let ((fnm flymake-allowed-file-name-masks) - (mode-and-masks nil)) + (mode-and-masks nil)) (while (and (not mode-and-masks) fnm) (if (string-match (car (car fnm)) file-name) (setq mode-and-masks (cdr (car fnm)))) @@ -314,18 +353,22 @@ Return nil if we cannot, non-nil if we can." 'flymake-simple-cleanup)) (defun flymake-get-real-file-name-function (file-name) - (or (nth 2 (flymake-get-file-name-mode-and-masks file-name)) + (or (nth 4 (flymake-get-file-name-mode-and-masks file-name)) 'flymake-get-real-file-name)) (defvar flymake-find-buildfile-cache (flymake-makehash 'equal)) (defun flymake-get-buildfile-from-cache (dir-name) + "Look up DIR-NAME in cache and return its associated value. +If DIR-NAME is not found, return nil." (gethash dir-name flymake-find-buildfile-cache)) (defun flymake-add-buildfile-to-cache (dir-name buildfile) + "Associate DIR-NAME with BUILDFILE in the buildfile cache." (puthash dir-name buildfile flymake-find-buildfile-cache)) (defun flymake-clear-buildfile-cache () + "Clear the buildfile cache." (clrhash flymake-find-buildfile-cache)) (defun flymake-find-buildfile (buildfile-name source-dir-name) @@ -372,9 +415,11 @@ Return t if so, nil if not." (defun flymake-find-possible-master-files (file-name master-file-dirs masks) "Find (by name and location) all possible master files. -Master files include .cpp and .c for .h. Files are searched for -starting from the .h directory and max max-level parent dirs. -File contents are not checked." + +Name is specified by FILE-NAME and location is specified by +MASTER-FILE-DIRS. Master files include .cpp and .c for .h. +Files are searched for starting from the .h directory and max +max-level parent dirs. File contents are not checked." (let* ((dirs master-file-dirs) (files nil) (done nil)) @@ -571,6 +616,8 @@ Find master file, patch and save it." nil)))) (defun flymake-save-buffer-in-file (file-name) + "Save the entire buffer contents into file FILE-NAME. +Create parent directories as needed." (make-directory (file-name-directory file-name) 1) (write-region nil nil file-name nil 566) (flymake-log 3 "saved buffer %s in file %s" (buffer-name) file-name)) @@ -1837,7 +1884,9 @@ Use CREATE-TEMP-F for creating temp copy." ;;;; xml-specific init-cleanup routines (defun flymake-xml-init () - (list "xml" (list "val" (flymake-init-create-temp-buffer-copy 'flymake-create-temp-inplace)))) + (list flymake-xml-program + (list "val" (flymake-init-create-temp-buffer-copy + 'flymake-create-temp-inplace)))) (provide 'flymake) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 8ba2822c3a3..0b52302a98d 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -91,7 +91,7 @@ (require 'gud) (require 'json) (require 'bindat) -(eval-when-compile (require 'cl-lib)) +(require 'cl-lib) (declare-function speedbar-change-initial-expansion-list "speedbar" (new-default)) @@ -206,8 +206,8 @@ Only used for files that Emacs can't find.") (defvar gdb-last-command nil) (defvar gdb-prompt-name nil) (defvar gdb-token-number 0) -(defvar gdb-handler-alist '()) -(defvar gdb-handler-number nil) +(defvar gdb-handler-list '() + "List of gdb-handler keeping track of all pending GDB commands.") (defvar gdb-source-file-list nil "List of source files for the current executable.") (defvar gdb-first-done-or-error t) @@ -242,33 +242,114 @@ Possible values are these symbols: disposition of output generated by commands that gdb mode sends to gdb on its own behalf.") -;; Pending triggers prevent congestion: Emacs won't send two similar -;; consecutive requests. - -(defvar gdb-pending-triggers '() - "A list of trigger functions which have not yet been handled. - -Elements are either function names or pairs (buffer . function)") - -(defmacro gdb-add-pending (item) - `(push ,item gdb-pending-triggers)) -(defmacro gdb-pending-p (item) - `(member ,item gdb-pending-triggers)) -(defmacro gdb-delete-pending (item) - `(setq gdb-pending-triggers - (delete ,item gdb-pending-triggers))) +(defcustom gdb-discard-unordered-replies t + "Non-nil means discard any out-of-order GDB replies. +This protects against lost GDB replies, assuming that GDB always +replies in the same order as Emacs sends commands. When receiving a +reply with a given token-number, assume any pending messages with a +lower token-number are out-of-order." + :type 'boolean + :group 'gud + :version "24.4") + +(cl-defstruct gdb-handler + "Data required to handle the reply of a command sent to GDB." + ;; Prefix of the command sent to GDB. The GDB reply for this command + ;; will be prefixed with this same TOKEN-NUMBER + (token-number nil :read-only t) + ;; Callback to invoke when the reply is received from GDB + (function nil :read-only t) + ;; PENDING-TRIGGER is used to prevent congestion: Emacs won't send + ;; two requests with the same PENDING-TRIGGER until a reply is received + ;; for the first one." + (pending-trigger nil)) + +(defun gdb-add-handler (token-number handler-function &optional pending-trigger) + "Insert a new GDB command handler in `gdb-handler-list'. +Handlers are used to keep track of the commands sent to GDB +and to handle the replies received. +Upon reception of a reply prefixed with TOKEN-NUMBER, +invoke the callback HANDLER-FUNCTION. +If PENDING-TRIGGER is specified, no new GDB commands will be +sent with this same PENDING-TRIGGER until a reply is received +for this handler." + + (push (make-gdb-handler :token-number token-number + :function handler-function + :pending-trigger pending-trigger) + gdb-handler-list)) + +(defun gdb-delete-handler (token-number) + "Remove the handler TOKEN-NUMBER from `gdb-handler-list'. +Additionally, if `gdb-discard-unordered-replies' is non-nil, +discard all handlers having a token number less than TOKEN-NUMBER." + (if gdb-discard-unordered-replies + + (setq gdb-handler-list + (cl-delete-if + (lambda (handler) + "Discard any HANDLER with a token number `<=' than TOKEN-NUMBER." + (when (< (gdb-handler-token-number handler) token-number) + (message (format + "WARNING! Discarding GDB handler with token #%d\n" + (gdb-handler-token-number handler)))) + (<= (gdb-handler-token-number handler) token-number)) + gdb-handler-list)) + + (setq gdb-handler-list + (cl-delete-if + (lambda (handler) + "Discard any HANDLER with a token number `eq' to TOKEN-NUMBER." + (eq (gdb-handler-token-number handler) token-number)) + gdb-handler-list)))) + +(defun gdb-get-handler-function (token-number) + "Return the function callback registered with the handler TOKEN-NUMBER." + (gdb-handler-function + (cl-find-if (lambda (handler) (eq (gdb-handler-token-number handler) + token-number)) + gdb-handler-list))) + + +(defun gdb-pending-handler-p (pending-trigger) + "Return non-nil if a command handler is pending with trigger PENDING-TRIGGER." + (cl-find-if (lambda (handler) (eq (gdb-handler-pending-trigger handler) + pending-trigger)) + gdb-handler-list)) + + +(defun gdb-handle-reply (token-number) + "Handle the GDB reply TOKEN-NUMBER. +This invokes the handler registered with this token number +in `gdb-handler-list' and clears all pending handlers invalidated +by the reception of this reply." + (let ((handler-function (gdb-get-handler-function token-number))) + (when handler-function + (funcall handler-function) + (gdb-delete-handler token-number)))) + +(defun gdb-remove-all-pending-triggers () + "Remove all pending triggers from gdb-handler-list. +The handlers are left in gdb-handler-list so that replies received +from GDB could still be handled. However, removing the pending triggers +allows Emacs to send new commands even if replies of previous commands +were not yet received." + (dolist (handler gdb-handler-list) + (setf (gdb-handler-pending-trigger handler) nil))) (defmacro gdb-wait-for-pending (&rest body) - "Wait until `gdb-pending-triggers' is empty and evaluate FORM. - -This function checks `gdb-pending-triggers' value every -`gdb-wait-for-pending' seconds." - (run-with-timer - 0.5 nil - `(lambda () - (if (not gdb-pending-triggers) - (progn ,@body) - (gdb-wait-for-pending ,@body))))) + "Wait for all pending GDB commands to finish and evaluate BODY. + +This function checks every 0.5 seconds if there are any pending +triggers in `gdb-handler-list'." + `(run-with-timer + 0.5 nil + '(lambda () + (if (not (cl-find-if (lambda (handler) + (gdb-handler-pending-trigger handler)) + gdb-handler-list)) + (progn ,@body) + (gdb-wait-for-pending ,@body))))) ;; Publish-subscribe @@ -574,21 +655,20 @@ NOARG must be t when this macro is used outside `gud-def'" (concat (gdb-gud-context-command ,cmd1 ,noall) " " ,cmd2) ,(when (not noarg) 'arg))) -(defun gdb--check-interpreter (proc string) +(defun gdb--check-interpreter (filter proc string) (unless (zerop (length string)) - (let ((filter (process-get proc 'gud-normal-filter))) - (set-process-filter proc filter) - (unless (memq (aref string 0) '(?^ ?~ ?@ ?& ?* ?=)) - ;; Apparently we're not running with -i=mi. - (let ((msg "Error: you did not specify -i=mi on GDB's command line!")) - (message msg) - (setq string (concat (propertize msg 'font-lock-face 'error) - "\n" string))) - ;; Use the old gud-gbd filter, not because it works, but because it - ;; will properly display GDB's answers rather than hanging waiting for - ;; answers that aren't coming. - (set (make-local-variable 'gud-marker-filter) #'gud-gdb-marker-filter)) - (funcall filter proc string)))) + (remove-function (process-filter proc) #'gdb--check-interpreter) + (unless (memq (aref string 0) '(?^ ?~ ?@ ?& ?* ?=)) + ;; Apparently we're not running with -i=mi. + (let ((msg "Error: you did not specify -i=mi on GDB's command line!")) + (message msg) + (setq string (concat (propertize msg 'font-lock-face 'error) + "\n" string))) + ;; Use the old gud-gbd filter, not because it works, but because it + ;; will properly display GDB's answers rather than hanging waiting for + ;; answers that aren't coming. + (set (make-local-variable 'gud-marker-filter) #'gud-gdb-marker-filter)) + (funcall filter proc string))) (defvar gdb-control-level 0) @@ -662,8 +742,7 @@ detailed description of this mode. ;; Setup a temporary process filter to warn when GDB was not started ;; with -i=mi. (let ((proc (get-buffer-process gud-comint-buffer))) - (process-put proc 'gud-normal-filter (process-filter proc)) - (set-process-filter proc #'gdb--check-interpreter)) + (add-function :around (process-filter proc) #'gdb--check-interpreter)) (set (make-local-variable 'gud-minor-mode) 'gdbmi) (set (make-local-variable 'gdb-control-level) 0) @@ -822,14 +901,12 @@ detailed description of this mode. gdb-frame-number nil gdb-thread-number nil gdb-var-list nil - gdb-pending-triggers nil gdb-output-sink 'user gdb-location-alist nil gdb-source-file-list nil gdb-last-command nil gdb-token-number 0 - gdb-handler-alist '() - gdb-handler-number nil + gdb-handler-list '() gdb-prompt-name nil gdb-first-done-or-error t gdb-buffer-fringe-width (car (window-fringes)) @@ -1109,17 +1186,15 @@ With arg, enter name of variable to be watched in the minibuffer." (message-box "No symbol \"%s\" in current context." expr)))) (defun gdb-speedbar-update () - (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame) - (not (gdb-pending-p 'gdb-speedbar-timer))) + (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) ;; Dummy command to update speedbar even when idle. - (gdb-input "-environment-pwd" 'gdb-speedbar-timer-fn) - ;; Keep gdb-pending-triggers non-nil till end. - (gdb-add-pending 'gdb-speedbar-timer))) + (gdb-input "-environment-pwd" + 'gdb-speedbar-timer-fn + 'gdb-speedbar-update))) (defun gdb-speedbar-timer-fn () (if gdb-speedbar-auto-raise (raise-frame speedbar-frame)) - (gdb-delete-pending 'gdb-speedbar-timer) (speedbar-timer-fn)) (defun gdb-var-evaluate-expression-handler (varnum changed) @@ -1209,9 +1284,9 @@ With arg, enter name of variable to be watched in the minibuffer." ; Uses "-var-update --all-values". Needs GDB 6.4 onwards. (defun gdb-var-update () - (if (not (gdb-pending-p 'gdb-var-update)) - (gdb-input "-var-update --all-values *" 'gdb-var-update-handler)) - (gdb-add-pending 'gdb-var-update)) + (gdb-input "-var-update --all-values *" + 'gdb-var-update-handler + 'gdb-var-update)) (defun gdb-var-update-handler () (let ((changelist (bindat-get-field (gdb-json-partial-output) 'changelist))) @@ -1274,8 +1349,6 @@ With arg, enter name of variable to be watched in the minibuffer." (push var1 var-list)) (setq var1 (pop temp-var-list))) (setq gdb-var-list (nreverse var-list)))))))) - (setq gdb-pending-triggers - (delq 'gdb-var-update gdb-pending-triggers)) (gdb-speedbar-update)) (defun gdb-speedbar-expand-node (text token indent) @@ -1729,18 +1802,25 @@ All embedded quotes, newlines, and backslashes are preceded with a backslash." (setq string (replace-regexp-in-string "\n" "\\n" string t t)) (concat "\"" string "\"")) -(defun gdb-input (command handler-function) +(defun gdb-input (command handler-function &optional trigger-name) "Send COMMAND to GDB via the MI interface. Run the function HANDLER-FUNCTION, with no arguments, once the command is -complete." - (if gdb-enable-debug (push (list 'send-item command handler-function) - gdb-debug-log)) - (setq gdb-token-number (1+ gdb-token-number)) - (setq command (concat (number-to-string gdb-token-number) command)) - (push (cons gdb-token-number handler-function) gdb-handler-alist) - (if gdbmi-debug-mode (message "gdb-input: %s" command)) - (process-send-string (get-buffer-process gud-comint-buffer) - (concat command "\n"))) +complete. Do not send COMMAND to GDB if TRIGGER-NAME is non-nil and +Emacs is still waiting for a reply from another command previously +sent with the same TRIGGER-NAME." + (when (or (not trigger-name) + (not (gdb-pending-handler-p trigger-name))) + (setq gdb-token-number (1+ gdb-token-number)) + (setq command (concat (number-to-string gdb-token-number) command)) + + (if gdb-enable-debug (push (list 'send-item command handler-function) + gdb-debug-log)) + + (gdb-add-handler gdb-token-number handler-function trigger-name) + + (if gdbmi-debug-mode (message "gdb-input: %s" command)) + (process-send-string (get-buffer-process gud-comint-buffer) + (concat command "\n")))) ;; NOFRAME is used for gud execution control commands (defun gdb-current-context-command (command) @@ -1776,7 +1856,7 @@ If `gdb-thread-number' is nil, just wrap NAME in asterisks." (defun gdb-resync() (setq gud-running nil) (setq gdb-output-sink 'user) - (setq gdb-pending-triggers nil)) + (gdb-remove-all-pending-triggers)) (defun gdb-update (&optional no-proc) "Update buffers showing status of debug session. @@ -2149,19 +2229,23 @@ the end of the current result or async record is reached." ;; Search the data stream for the end of the current record: (let* ((newline-pos (string-match "\n" gud-marker-acc gdbmi-bnf-offset)) (is-progressive (equal (cdr class-command) 'progressive)) - (is-complete (not (null newline-pos))) - result-str) + (is-complete (not (null newline-pos))) + result-str) + + (when gdbmi-debug-mode + (message "gdbmi-bnf-incomplete-record-result: %s" + (substring gud-marker-acc gdbmi-bnf-offset newline-pos))) ;; Update the gdbmi-bnf-offset only if the current chunk of data can ;; be processed by the class-command handler: (when (or is-complete is-progressive) - (setq result-str + (setq result-str (substring gud-marker-acc gdbmi-bnf-offset newline-pos)) - (setq gdbmi-bnf-offset (+ 1 newline-pos))) - (if gdbmi-debug-mode - (message "gdbmi-bnf-incomplete-record-result: %s" - (substring gud-marker-acc gdbmi-bnf-offset newline-pos))) + ;; Move gdbmi-bnf-offset past the end of the chunk. + (setq gdbmi-bnf-offset (+ gdbmi-bnf-offset (length result-str))) + (when newline-pos + (setq gdbmi-bnf-offset (1+ gdbmi-bnf-offset)))) ;; Update the parsing state before invoking the handler in class-command ;; to make sure it's not left in an invalid state if the handler was @@ -2253,9 +2337,9 @@ Unset `gdb-thread-number' if current thread exited and update threads list." (if (string= gdb-thread-number thread-id) (gdb-setq-thread-number nil)) ;; When we continue current thread and it quickly exits, - ;; gdb-pending-triggers left after gdb-running disallow us to - ;; properly call -thread-info without --thread option. Thus we - ;; need to use gdb-wait-for-pending. + ;; the pending triggers in gdb-handler-list left after gdb-running + ;; disallow us to properly call -thread-info without --thread option. + ;; Thus we need to use gdb-wait-for-pending. (gdb-wait-for-pending (gdb-emit-signal gdb-buf-publisher 'update-threads)))) @@ -2270,9 +2354,10 @@ Sets `gdb-thread-number' to new id." ;; by `=thread-selected` notification. `^done` causes `gdb-update` ;; as usually. Things happen to fast and second call (from ;; gdb-thread-selected handler) gets cut off by our beloved - ;; gdb-pending-triggers. - ;; Solution is `gdb-wait-for-pending` macro: it guarantees that its - ;; body will get executed when `gdb-pending-triggers` is empty. + ;; pending triggers. + ;; Solution is `gdb-wait-for-pending' macro: it guarantees that its + ;; body will get executed when `gdb-handler-list' if free of + ;; pending triggers. (gdb-wait-for-pending (gdb-update)))) @@ -2291,8 +2376,7 @@ Sets `gdb-thread-number' to new id." (propertize gdb-inferior-status 'face font-lock-type-face)) (when (not gdb-non-stop) (setq gud-running t)) - (setq gdb-active-process t) - (gdb-emit-signal gdb-buf-publisher 'update-threads)) + (setq gdb-active-process t)) (defun gdb-starting (_output-field _result) ;; CLI commands don't emit ^running at the moment so use gdb-running too. @@ -2300,11 +2384,7 @@ Sets `gdb-thread-number' to new id." (gdb-force-mode-line-update (propertize gdb-inferior-status 'face font-lock-type-face)) (setq gdb-active-process t) - (setq gud-running t) - ;; GDB doesn't seem to respond to -thread-info before first stop or - ;; thread exit (even in non-stop mode), so this is useless. - ;; Behavior may change in the future. - (gdb-emit-signal gdb-buf-publisher 'update-threads)) + (setq gud-running t)) ;; -break-insert -t didn't give a reason before gdb 6.9 @@ -2436,10 +2516,7 @@ current thread and update GDB buffers." (when (and token-number is-complete) (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) - (funcall - (cdr (assoc (string-to-number token-number) gdb-handler-alist)))) - (setq gdb-handler-alist - (assq-delete-all token-number gdb-handler-alist))) + (gdb-handle-reply (string-to-number token-number)))) (when is-complete (gdb-clear-partial-output)))) @@ -2657,27 +2734,23 @@ trigger argument when describing buffer types with (when (or (not ,signal-list) (memq signal ,signal-list)) - (when (not (gdb-pending-p - (cons (current-buffer) ',trigger-name))) - (gdb-input ,gdb-command - (gdb-bind-function-to-buffer ',handler-name (current-buffer))) - (gdb-add-pending (cons (current-buffer) ',trigger-name)))))) + (gdb-input ,gdb-command + (gdb-bind-function-to-buffer ',handler-name (current-buffer)) + (cons (current-buffer) ',trigger-name))))) ;; Used by disassembly buffer only, the rest use ;; def-gdb-trigger-and-handler -(defmacro def-gdb-auto-update-handler (handler-name trigger-name custom-defun +(defmacro def-gdb-auto-update-handler (handler-name custom-defun &optional nopreserve) - "Define a handler HANDLER-NAME for TRIGGER-NAME with CUSTOM-DEFUN. + "Define a handler HANDLER-NAME calling CUSTOM-DEFUN. Handlers are normally called from the buffers they put output in. -Delete ((current-buffer) . TRIGGER-NAME) from -`gdb-pending-triggers', erase current buffer and evaluate -CUSTOM-DEFUN. Then `gdb-update-buffer-name' is called. +Erase current buffer and evaluate CUSTOM-DEFUN. +Then call `gdb-update-buffer-name'. If NOPRESERVE is non-nil, window point is not restored after CUSTOM-DEFUN." `(defun ,handler-name () - (gdb-delete-pending (cons (current-buffer) ',trigger-name)) (let* ((inhibit-read-only t) ,@(unless nopreserve '((window (get-buffer-window (current-buffer) 0)) @@ -2705,7 +2778,7 @@ See `def-gdb-auto-update-handler'." ,gdb-command ,handler-name ,signal-list) (def-gdb-auto-update-handler ,handler-name - ,trigger-name ,custom-defun))) + ,custom-defun))) @@ -3622,7 +3695,6 @@ DOC is an optional documentation string." (def-gdb-auto-update-handler gdb-disassembly-handler - gdb-invalidate-disassembly gdb-disassembly-handler-custom t) @@ -4114,21 +4186,19 @@ member." ;; Needs GDB 6.4 onwards (used to fail with no stack). (defun gdb-get-changed-registers () - (when (and (gdb-get-buffer 'gdb-registers-buffer) - (not (gdb-pending-p 'gdb-get-changed-registers))) + (when (gdb-get-buffer 'gdb-registers-buffer) (gdb-input "-data-list-changed-registers" - 'gdb-changed-registers-handler) - (gdb-add-pending 'gdb-get-changed-registers))) + 'gdb-changed-registers-handler + 'gdb-get-changed-registers))) (defun gdb-changed-registers-handler () - (gdb-delete-pending 'gdb-get-changed-registers) (setq gdb-changed-registers nil) (dolist (register-number (bindat-get-field (gdb-json-partial-output) 'changed-registers)) (push register-number gdb-changed-registers))) (defun gdb-register-names-handler () - ;; Don't use gdb-pending-triggers because this handler is called + ;; Don't use pending triggers because this handler is called ;; only once (in gdb-init-1) (setq gdb-register-names nil) (dolist (register-name @@ -4152,16 +4222,13 @@ is set in them." (defun gdb-get-main-selected-frame () "Trigger for `gdb-frame-handler' which uses main current thread. Called from `gdb-update'." - (if (not (gdb-pending-p 'gdb-get-main-selected-frame)) - (progn - (gdb-input (gdb-current-context-command "-stack-info-frame") - 'gdb-frame-handler) - (gdb-add-pending 'gdb-get-main-selected-frame)))) + (gdb-input (gdb-current-context-command "-stack-info-frame") + 'gdb-frame-handler + 'gdb-get-main-selected-frame)) (defun gdb-frame-handler () "Set `gdb-selected-frame' and `gdb-selected-file' to show overlay arrow in source buffer." - (gdb-delete-pending 'gdb-get-main-selected-frame) (let ((frame (bindat-get-field (gdb-json-partial-output) 'frame))) (when frame (setq gdb-selected-frame (bindat-get-field frame 'func)) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 1e152c6d751..46af51e1f97 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -410,7 +410,9 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies (0 '(face nil compilation-message nil help-echo nil mouse-face nil) t) (1 grep-error-face) (2 grep-error-face nil t)) - ("^.+?-[0-9]+-.*\n" (0 grep-context-face))) + ;; "filename-linenumber-" format is used for context lines in GNU grep, + ;; "filename=linenumber=" for lines with function names in "git grep -p". + ("^.+?[-=][0-9]+[-=].*\n" (0 grep-context-face))) "Additional things to highlight in grep output. This gets tacked on the end of the generated expressions.") diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index d339495d76a..c549d9eedef 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -46,11 +46,8 @@ (defvar gdb-show-changed-values) (defvar gdb-source-window) (defvar gdb-var-list) -(defvar gdb-speedbar-auto-raise) -(defvar gud-tooltip-mode) (defvar hl-line-mode) (defvar hl-line-sticky-flag) -(defvar tool-bar-map) ;; ====================================================================== @@ -416,7 +413,7 @@ we're in the GUD buffer)." ;; ====================================================================== ;; speedbar support functions and variables. -(eval-when-compile (require 'speedbar)) ;For speedbar-with-attached-buffer. +(eval-when-compile (require 'dframe)) ; for dframe-with-attached-buffer (defvar gud-last-speedbar-stackframe nil "Description of the currently displayed GUD stack. @@ -425,19 +422,24 @@ The value t means that there is no stack, and we are in display-file mode.") (defvar gud-speedbar-key-map nil "Keymap used when in the buffers display mode.") +;; At runtime, will be pulled in as a require of speedbar. +(declare-function dframe-message "dframe" (fmt &rest args)) + (defun gud-speedbar-item-info () "Display the data type of the watch expression element." (let ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list))) (if (nth 7 var) - (speedbar-message "%s: %s" (nth 7 var) (nth 3 var)) - (speedbar-message "%s" (nth 3 var))))) + (dframe-message "%s: %s" (nth 7 var) (nth 3 var)) + (dframe-message "%s" (nth 3 var))))) + +(declare-function speedbar-make-specialized-keymap "speedbar" ()) +(declare-function speedbar-add-expansion-list "speedbar" (new-list)) +(defvar speedbar-mode-functions-list) (defun gud-install-speedbar-variables () "Install those variables used by speedbar to enhance gud/gdb." - (if gud-speedbar-key-map - nil + (unless gud-speedbar-key-map (setq gud-speedbar-key-map (speedbar-make-specialized-keymap)) - (define-key gud-speedbar-key-map "j" 'speedbar-edit-line) (define-key gud-speedbar-key-map "e" 'speedbar-edit-line) (define-key gud-speedbar-key-map "\C-m" 'speedbar-edit-line) @@ -486,6 +488,13 @@ The value t means that there is no stack, and we are in display-file mode.") DIRECTORY and ZERO are not used, but are required by the caller." (gud-speedbar-buttons gud-comint-buffer)) +(declare-function speedbar-make-tag-line "speedbar" + (type char func data tag tfunc tdata tface depth)) +(declare-function speedbar-remove-localized-speedbar-support "speedbar" + (buffer)) +(declare-function speedbar-insert-button "speedbar" + (text face mouse function &optional token prevline)) + (defun gud-speedbar-buttons (buffer) "Create a speedbar display based on the current state of GUD. If the GUD BUFFER is not running a supported debugger, then turn @@ -707,6 +716,16 @@ The option \"--fullname\" must be included in this value." (defvar gud-filter-pending-text nil "Non-nil means this is text that has been saved for later in `gud-filter'.") +;; One of the nice features of GDB is its impressive support for +;; context-sensitive command completion. We preserve that feature +;; in the GUD buffer by using a GDB command designed just for Emacs. + +(defvar gud-gdb-completion-function nil + "Completion function for GDB commands. +It receives two arguments: COMMAND, the prefix for which we seek +completion; and CONTEXT, the text before COMMAND on the line. +It should return a list of completion strings.") + ;; If in gdb mode, gdb-mi is loaded. (declare-function gdb-restore-windows "gdb-mi" ()) @@ -767,16 +786,6 @@ directory and source-file directory for your debugger." (setq gud-filter-pending-text nil) (run-hooks 'gud-gdb-mode-hook)) -;; One of the nice features of GDB is its impressive support for -;; context-sensitive command completion. We preserve that feature -;; in the GUD buffer by using a GDB command designed just for Emacs. - -(defvar gud-gdb-completion-function nil - "Completion function for GDB commands. -It receives two arguments: COMMAND, the prefix for which we seek -completion; and CONTEXT, the text before COMMAND on the line. -It should return a list of completion strings.") - ;; The completion process filter indicates when it is finished. (defvar gud-gdb-fetch-lines-in-progress) @@ -884,9 +893,14 @@ It is passed through `gud-gdb-marker-filter' before we look at it." ;; gdb speedbar functions +;; Part of the macro expansion of dframe-with-attached-buffer. +;; At runtime, will be pulled in as a require of speedbar. +(declare-function dframe-select-attached-frame "dframe" (&optional frame)) +(declare-function dframe-maybee-jump-to-attached-frame "dframe" ()) + (defun gud-gdb-goto-stackframe (_text token _indent) "Goto the stackframe described by TEXT, TOKEN, and INDENT." - (speedbar-with-attached-buffer + (dframe-with-attached-buffer (gud-basic-call (concat "server frame " (nth 1 token))) (sit-for 1))) @@ -1487,14 +1501,38 @@ into one that invokes an Emacs-enabled debugging session. (let ((output "")) ;; Process all the complete markers in this chunk. - (while (string-match "\032\032\\(\\([a-zA-Z]:\\)?[^:\n]*\\):\\([0-9]*\\):.*\n" - gud-marker-acc) + ;; + ;; Here I match the string coming out of perldb. + ;; The strings can look like any of + ;; + ;; "\032\032/tmp/tst.pl:6:0\n" + ;; "\032\032(eval 5)[/tmp/tst.pl:6]:3:0\n" + ;; "\032\032(eval 17)[Basic/Core/Core.pm.PL (i.e. PDL::Core.pm):2931]:1:0\n" + ;; + ;; From those I want the filename and the line number. First I look for + ;; the eval case. If that doesn't match, I look for the "normal" case. + (while + (string-match + (eval-when-compile + (let ((file-re "\\(?:[a-zA-Z]:\\)?[^:\n]*")) + (concat "\032\032\\(?:" + (concat + "(eval [0-9]+)\\[" + "\\(" file-re "\\)" ; Filename. + "\\(?: (i\\.e\\. [^)]*)\\)?" + ":\\([0-9]*\\)\\]") ; Line number. + "\\|" + (concat + "\\(?1:" file-re "\\)" ; Filename. + ":\\(?2:[0-9]*\\)") ; Line number. + "\\):.*\n"))) + gud-marker-acc) (setq ;; Extract the frame position from the marker. gud-last-frame (cons (match-string 1 gud-marker-acc) - (string-to-number (match-string 3 gud-marker-acc))) + (string-to-number (match-string 2 gud-marker-acc))) ;; Append any text before the marker to the output we're going ;; to return - we don't include the marker in this text. @@ -2612,6 +2650,8 @@ It is saved for when this flag is not set.") (add-to-list 'overlay-arrow-variable-list 'gud-overlay-arrow-position) (declare-function gdb-reset "gdb-mi" ()) +(declare-function speedbar-change-initial-expansion-list "speedbar" (new)) +(defvar speedbar-previously-used-expansion-list-name) (defun gud-sentinel (proc msg) (cond ((null (buffer-name (process-buffer proc))) @@ -2619,7 +2659,7 @@ It is saved for when this flag is not set.") ;; Stop displaying an arrow in a source file. (setq gud-overlay-arrow-position nil) (set-process-buffer proc nil) - (if (and (boundp 'speedbar-frame) + (if (and (boundp 'speedbar-initial-expansion-list-name) (string-equal speedbar-initial-expansion-list-name "GUD")) (speedbar-change-initial-expansion-list speedbar-previously-used-expansion-list-name)) @@ -3312,6 +3352,9 @@ only tooltips in the buffer containing the overlay arrow." :group 'gud :group 'tooltip) +(make-obsolete-variable 'gud-tooltip-echo-area + "disable Tooltip mode instead" "24.4" 'set) + ;;; Reacting on mouse movements (defun gud-tooltip-change-major-mode () @@ -3363,9 +3406,6 @@ ACTIVATEP non-nil means activate mouse motion events." ;;; Tips for `gud' -(defvar gud-tooltip-original-filter nil - "Process filter to restore after GUD output has been received.") - (defvar gud-tooltip-dereference nil "Non-nil means print expressions with a `*' in front of them. For C this would dereference a pointer expression.") @@ -3396,12 +3436,13 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference." ; the tooltip incompletely and spill over into the gud buffer. ; Switching the process-filter creates timing problems and ; it may be difficult to do better. Using GDB/MI as in -; gdb-mi.el gets round this problem. +; gdb-mi.el gets around this problem. (defun gud-tooltip-process-output (process output) "Process debugger output and show it in a tooltip window." - (set-process-filter process gud-tooltip-original-filter) + (remove-function (process-filter process) #'gud-tooltip-process-output) (tooltip-show (tooltip-strip-prompt process output) - (or gud-tooltip-echo-area tooltip-use-echo-area))) + (or gud-tooltip-echo-area tooltip-use-echo-area + (not tooltip-mode)))) (defun gud-tooltip-print-command (expr) "Return a suitable command to print the expression EXPR." @@ -3411,7 +3452,7 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference." ((or `xdb `pdb) (concat "p " expr)) (`sdb (concat expr "/")))) -(declare-function gdb-input "gdb-mi" (command handler)) +(declare-function gdb-input "gdb-mi" (command handler &optional trigger)) (declare-function tooltip-expr-to-print "tooltip" (event)) (declare-function tooltip-event-buffer "tooltip" (event)) @@ -3444,7 +3485,8 @@ This function must return nil if it doesn't handle EVENT." (unless (null define-elt) (tooltip-show (cdr define-elt) - (or gud-tooltip-echo-area tooltip-use-echo-area)) + (or gud-tooltip-echo-area tooltip-use-echo-area + (not tooltip-mode))) expr)))) (when gud-tooltip-dereference (setq expr (concat "*" expr))) @@ -3466,8 +3508,8 @@ so they have been disabled.")) (gdb-input (concat cmd "\n") `(lambda () (gdb-tooltip-print ,expr)))) - (setq gud-tooltip-original-filter (process-filter process)) - (set-process-filter process 'gud-tooltip-process-output) + (add-function :override (process-filter process) + #'gud-tooltip-process-output) (gud-basic-call cmd)) expr)))))))) diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index 749b0b65576..7060cae5080 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -90,16 +90,15 @@ Defaults to `browse-url-browser-function', which see." (defcustom idlwave-help-browser-generic-program browse-url-generic-program "Program to run if using `browse-url-generic-program'." :group 'idlwave-online-help - :type 'string) - -(defvar browse-url-generic-args) + :type '(choice (const nil) string)) +;; AFAICS, never used since it was introduced in 2004. (defcustom idlwave-help-browser-generic-args (if (boundp 'browse-url-generic-args) browse-url-generic-args "") "Program args to use if using `browse-url-generic-program'." :group 'idlwave-online-help - :type 'string) + :type '(repeat string)) (defcustom idlwave-help-browser-is-local nil "Whether the browser will display locally in an Emacs window. @@ -1179,7 +1178,7 @@ Useful when source code is displayed as help. See the option (if (featurep 'font-lock) (let ((major-mode 'idlwave-mode) (font-lock-verbose - (if (interactive-p) font-lock-verbose nil)) + (if (called-interactively-p 'interactive) font-lock-verbose nil)) (syntax-table (syntax-table))) (unwind-protect (progn diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index aeaf1acb2ac..ba9a632b949 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -5078,11 +5078,14 @@ Cache to disk for quick recovery." ;; The sequence here is important because earlier definitions shadow ;; later ones. We assume that if things in the buffers are newer ;; then in the shell of the system, they are meant to be different. - (setcdr idlwave-last-system-routine-info-cons-cell - (append idlwave-buffer-routines - idlwave-compiled-routines - idlwave-library-catalog-routines - idlwave-user-catalog-routines)) + (let ((temp (append idlwave-buffer-routines + idlwave-compiled-routines + idlwave-library-catalog-routines + idlwave-user-catalog-routines))) + ;; Not actually used for anything? + (if idlwave-last-system-routine-info-cons-cell + (setcdr idlwave-last-system-routine-info-cons-cell temp) + (setq idlwave-last-system-routine-info-cons-cell (cons temp nil)))) (setq idlwave-class-alist nil) ;; Give a message with information about the number of routines we have. @@ -5481,30 +5484,21 @@ directories and save the routine info. (message "Creating user catalog file...") (kill-buffer "*idlwave-scan.pro*") (kill-buffer (get-buffer-create "*IDLWAVE Widget*")) - (let ((font-lock-maximum-size 0) - (auto-mode-alist nil)) - (find-file idlwave-user-catalog-file)) - (if (and (boundp 'font-lock-mode) - font-lock-mode) - (font-lock-mode 0)) - (erase-buffer) - (insert ";; IDLWAVE user catalog file\n") - (insert (format ";; Created %s\n\n" (current-time-string))) - - ;; Define the routine info list - (insert "\n(setq idlwave-user-catalog-routines\n '(") - (let ((standard-output (current-buffer))) - (mapc (lambda (x) - (insert "\n ") - (prin1 x) - (goto-char (point-max))) - idlwave-user-catalog-routines)) - (insert (format "))\n\n;;; %s ends here\n" - (file-name-nondirectory idlwave-user-catalog-file))) - (goto-char (point-min)) - ;; Save the buffer - (save-buffer 0) - (kill-buffer (current-buffer))) + (with-temp-buffer + (insert ";; IDLWAVE user catalog file\n") + (insert (format ";; Created %s\n\n" (current-time-string))) + + ;; Define the routine info list + (insert "\n(setq idlwave-user-catalog-routines\n '(") + (let ((standard-output (current-buffer))) + (mapc (lambda (x) + (insert "\n ") + (prin1 x) + (goto-char (point-max))) + idlwave-user-catalog-routines)) + (insert (format "))\n\n;;; %s ends here\n" + (file-name-nondirectory idlwave-user-catalog-file))) + (write-region nil nil idlwave-user-catalog-file))) (message "Creating user catalog file...done") (message "Info for %d routines saved in %s" (length idlwave-user-catalog-routines) @@ -5522,31 +5516,23 @@ directories and save the routine info. (defun idlwave-write-paths () (interactive) (when (and idlwave-path-alist idlwave-system-directory) - (let ((font-lock-maximum-size 0) - (auto-mode-alist nil)) - (find-file idlwave-path-file)) - (if (and (boundp 'font-lock-mode) - font-lock-mode) - (font-lock-mode 0)) - (erase-buffer) - (insert ";; IDLWAVE paths\n") - (insert (format ";; Created %s\n\n" (current-time-string))) + (with-temp-buffer + (insert ";; IDLWAVE paths\n") + (insert (format ";; Created %s\n\n" (current-time-string))) ;; Define the variable which knows the value of "!DIR" - (insert (format "\n(setq idlwave-system-directory \"%s\")\n" - idlwave-system-directory)) - - ;; Define the variable which contains a list of all scanned directories - (insert "\n(setq idlwave-path-alist\n '(") - (let ((standard-output (current-buffer))) - (mapc (lambda (x) - (insert "\n ") - (prin1 x) - (goto-char (point-max))) - idlwave-path-alist)) - (insert "))\n") - (save-buffer 0) - (kill-buffer (current-buffer)))) - + (insert (format "\n(setq idlwave-system-directory \"%s\")\n" + idlwave-system-directory)) + + ;; Define the variable which contains a list of all scanned directories + (insert "\n(setq idlwave-path-alist\n '(") + (let ((standard-output (current-buffer))) + (mapc (lambda (x) + (insert "\n ") + (prin1 x) + (goto-char (point-max))) + idlwave-path-alist)) + (insert "))\n") + (write-region nil nil idlwave-path-file)))) (defun idlwave-expand-path (path &optional default-dir) ;; Expand parts of path starting with '+' recursively into directory list. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 2ea78fc321c..28ee859f9db 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -55,7 +55,6 @@ (eval-when-compile (require 'cl-lib) - (require 'comint) (require 'ido)) (defvar inferior-moz-buffer) @@ -2217,6 +2216,9 @@ marker." (defvar find-tag-marker-ring) ; etags +;; etags loads ring. +(declare-function ring-insert "ring" (ring item)) + (defun js-find-symbol (&optional arg) "Read a JavaScript symbol and jump to it. With a prefix argument, restrict symbols to those from the @@ -2639,6 +2641,11 @@ with `js--js-encode-value'." ;; order to catch a prompt that's only partially arrived (save-excursion (forward-line 0) (point)))) +;; Presumably "inferior-moz-process" loads comint. +(declare-function comint-send-string "comint" (process string)) +(declare-function comint-send-input "comint" + (&optional no-newline artificial)) + (defun js--js-enter-repl () (inferior-moz-process) ; called for side-effect (with-current-buffer inferior-moz-buffer @@ -2697,6 +2704,10 @@ with `js--js-encode-value'." (defsubst js--js-true (value) (not (js--js-not value))) +;; The somewhat complex code layout confuses the byte-compiler into +;; thinking this function "might not be defined at runtime". +(declare-function js--optimize-arglist "js" (arglist)) + (eval-and-compile (defun js--optimize-arglist (arglist) "Convert immediate js< and js! references to deferred ones." @@ -2824,6 +2835,8 @@ If nil, the whole Array is treated as a JS symbol.") (`error (signal 'js-js-error (list (cl-second result)))) (x (error "Unmatched case in js--js-decode-retval: %S" x)))) +(defvar comint-last-input-end) + (defun js--js-funcall (function &rest arguments) "Call the Mozilla function FUNCTION with arguments ARGUMENTS. If function is a string, look it up as a property on the global @@ -2996,6 +3009,8 @@ left-to-right." (defvar js-read-tab-history nil) +(declare-function ido-chop "ido" (items elem)) + (defun js--read-tab (prompt) "Read a Mozilla tab with prompt PROMPT. Return a cons of (TYPE . OBJECT). TYPE is either 'window or diff --git a/lisp/progmodes/ld-script.el b/lisp/progmodes/ld-script.el index 34d1525bbab..ffb425ee1e9 100644 --- a/lisp/progmodes/ld-script.el +++ b/lisp/progmodes/ld-script.el @@ -48,7 +48,7 @@ (modify-syntax-entry ?\) ")(" st) (modify-syntax-entry ?\[ "(]" st) (modify-syntax-entry ?\] ")[" st) - (modify-syntax-entry ?_ "w" st) + (modify-syntax-entry ?_ "_" st) (modify-syntax-entry ?. "_" st) (modify-syntax-entry ?\\ "\\" st) (modify-syntax-entry ?: "." st) @@ -154,10 +154,10 @@ (defvar ld-script-font-lock-keywords (append - `((,(regexp-opt ld-script-keywords 'words) - 1 font-lock-keyword-face) - (,(regexp-opt ld-script-builtins 'words) - 1 font-lock-builtin-face) + `((,(concat "\\_<" (regexp-opt ld-script-keywords) "\\_>") + 0 font-lock-keyword-face) + (,(concat "\\_<" (regexp-opt ld-script-builtins) "\\_>") + 0 font-lock-builtin-face) ;; 3.6.7 Output Section Discarding ;; 3.6.4.1 Input Section Basics ;; 3.6.8.7 Output Section Phdr diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el index 0641fc776de..4ba2ae1ded9 100644 --- a/lisp/progmodes/m4-mode.el +++ b/lisp/progmodes/m4-mode.el @@ -45,15 +45,10 @@ :prefix "m4-" :group 'languages) -(defcustom m4-program - (cond - ((file-exists-p "/usr/local/bin/m4") "/usr/local/bin/m4") - ((file-exists-p "/usr/bin/m4") "/usr/bin/m4") - ((file-exists-p "/bin/m4") "/bin/m4") - ((file-exists-p "/usr/ccs/bin/m4") "/usr/ccs/bin/m4") - ( t "m4") - ) - "File name of the m4 executable." +(defcustom m4-program "m4" + "File name of the m4 executable. +If m4 is not in your PATH, set this to an absolute file name." + :version "24.4" :type 'file :group 'm4) @@ -85,19 +80,24 @@ :group 'm4) ;;this may still need some work -(defvar m4-mode-syntax-table nil +(defvar m4-mode-syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?` "('" table) + (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) + ;; FIXME: These three chars with word syntax look wrong. + (modify-syntax-entry ?* "w" table) + (modify-syntax-entry ?\" "w" table) + (modify-syntax-entry ?\" "w" table) + table) "Syntax table used while in `m4-mode'.") -(setq m4-mode-syntax-table (make-syntax-table)) -(modify-syntax-entry ?` "('" m4-mode-syntax-table) -(modify-syntax-entry ?' ")`" m4-mode-syntax-table) -(modify-syntax-entry ?# "<\n" m4-mode-syntax-table) -(modify-syntax-entry ?\n ">#" m4-mode-syntax-table) -(modify-syntax-entry ?{ "_" m4-mode-syntax-table) -(modify-syntax-entry ?} "_" m4-mode-syntax-table) -(modify-syntax-entry ?* "w" m4-mode-syntax-table) -(modify-syntax-entry ?_ "w" m4-mode-syntax-table) -(modify-syntax-entry ?\" "w" m4-mode-syntax-table) -(modify-syntax-entry ?\" "w" m4-mode-syntax-table) (defvar m4-mode-map (let ((map (make-sparse-keymap)) @@ -117,12 +117,6 @@ :help "Send contents of the current region to m4")) map)) -(defvar m4-mode-abbrev-table nil - "Abbrev table used while in `m4-mode'.") - -(unless m4-mode-abbrev-table - (define-abbrev-table 'm4-mode-abbrev-table ())) - (defun m4-m4-buffer () "Send contents of the current buffer to m4." (interactive) @@ -151,7 +145,6 @@ ;;;###autoload (define-derived-mode m4-mode prog-mode "m4" "A major mode to edit m4 macro files." - :abbrev-table m4-mode-abbrev-table (setq-local comment-start "#") (setq-local parse-sexp-ignore-comments t) (setq-local add-log-current-defun-function #'m4-current-defun-name) diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 20673866bc4..3069c790e1c 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -241,7 +241,7 @@ to MODIFY A FILE WITHOUT YOUR CONFIRMATION when \"it seems necessary\"." "List of special targets. You will be offered to complete on one of those in the minibuffer whenever you enter a \".\" at the beginning of a line in `makefile-mode'." - :type '(repeat (list string)) + :type '(repeat string) :group 'makefile) (put 'makefile-special-targets-list 'risky-local-variable t) diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el index b090435ac9b..6a150667f19 100644 --- a/lisp/progmodes/meta-mode.el +++ b/lisp/progmodes/meta-mode.el @@ -794,6 +794,7 @@ The environment marked is the one that contains point or follows point." (defvar meta-common-mode-syntax-table (let ((st (make-syntax-table))) + ;; FIXME: This goes against the convention! ;; underscores are word constituents (modify-syntax-entry ?_ "w" st) ;; miscellaneous non-word symbols diff --git a/lisp/progmodes/octave-inf.el b/lisp/progmodes/octave-inf.el deleted file mode 100644 index de7ca32befe..00000000000 --- a/lisp/progmodes/octave-inf.el +++ /dev/null @@ -1,386 +0,0 @@ -;;; octave-inf.el --- running Octave as an inferior Emacs process - -;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc. - -;; Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> -;; John Eaton <jwe@bevo.che.wisc.edu> -;; Maintainer: FSF -;; Keywords: languages -;; Package: octave-mod - -;; 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 'octave-mod) -(require 'comint) - -(defgroup octave-inferior nil - "Running Octave as an inferior Emacs process." - :group 'octave) - -(defcustom inferior-octave-program "octave" - "Program invoked by `inferior-octave'." - :type 'string - :group 'octave-inferior) - -(defcustom inferior-octave-prompt - "\\(^octave\\(\\|.bin\\|.exe\\)\\(-[.0-9]+\\)?\\(:[0-9]+\\)?\\|^debug\\|^\\)>+ " - "Regexp to match prompts for the inferior Octave process." - :type 'regexp - :group 'octave-inferior) - -(defcustom inferior-octave-startup-file nil - "Name of the inferior Octave startup file. -The contents of this file are sent to the inferior Octave process on -startup." - :type '(choice (const :tag "None" nil) - file) - :group 'octave-inferior) - -(defcustom inferior-octave-startup-args nil - "List of command line arguments for the inferior Octave process. -For example, for suppressing the startup message and using `traditional' -mode, set this to (\"-q\" \"--traditional\")." - :type '(repeat string) - :group 'octave-inferior) - -(defvar inferior-octave-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map comint-mode-map) - (define-key map "\t" 'comint-dynamic-complete) - (define-key map "\M-?" 'comint-dynamic-list-filename-completions) - (define-key map "\C-c\C-l" 'inferior-octave-dynamic-list-input-ring) - (define-key map [menu-bar inout list-history] - '("List Input History" . inferior-octave-dynamic-list-input-ring)) - ;; FIXME: free C-h so it can do the describe-prefix-bindings. - (define-key map "\C-c\C-h" 'info-lookup-symbol) - map) - "Keymap used in Inferior Octave mode.") - -(defvar inferior-octave-mode-syntax-table - (let ((table (make-syntax-table octave-mode-syntax-table))) - table) - "Syntax table in use in inferior-octave-mode buffers.") - -(defcustom inferior-octave-mode-hook nil - "Hook to be run when Inferior Octave mode is started." - :type 'hook - :group 'octave-inferior) - -(defvar inferior-octave-font-lock-keywords - (list - (cons inferior-octave-prompt 'font-lock-type-face)) - ;; Could certainly do more font locking in inferior Octave ... - "Additional expressions to highlight in Inferior Octave mode.") - - -;;; Compatibility functions -(if (not (fboundp 'comint-line-beginning-position)) - ;; comint-line-beginning-position is defined in Emacs 21 - (defun comint-line-beginning-position () - "Returns the buffer position of the beginning of the line, after any prompt. -The prompt is assumed to be any text at the beginning of the line matching -the regular expression `comint-prompt-regexp', a buffer local variable." - (save-excursion (comint-bol nil) (point)))) - - -(defvar inferior-octave-output-list nil) -(defvar inferior-octave-output-string nil) -(defvar inferior-octave-receive-in-progress nil) - -(defvar inferior-octave-startup-hook nil) - -(defvar inferior-octave-complete-impossible nil - "Non-nil means that `inferior-octave-complete' is impossible.") - -(defvar inferior-octave-has-built-in-variables nil - "Non-nil means that Octave has built-in variables.") - -(defvar inferior-octave-dynamic-complete-functions - '(inferior-octave-completion-at-point comint-filename-completion) - "List of functions called to perform completion for inferior Octave. -This variable is used to initialize `comint-dynamic-complete-functions' -in the Inferior Octave buffer.") - -(defvar info-lookup-mode) - -(define-derived-mode inferior-octave-mode comint-mode "Inferior Octave" - "Major mode for interacting with an inferior Octave process. -Runs Octave as a subprocess of Emacs, with Octave I/O through an Emacs -buffer. - -Entry to this mode successively runs the hooks `comint-mode-hook' and -`inferior-octave-mode-hook'." - (setq comint-prompt-regexp inferior-octave-prompt - mode-line-process '(":%s") - local-abbrev-table octave-abbrev-table) - - (set (make-local-variable 'comment-start) octave-comment-start) - (set (make-local-variable 'comment-end) "") - (set (make-local-variable 'comment-column) 32) - (set (make-local-variable 'comment-start-skip) octave-comment-start-skip) - - (set (make-local-variable 'font-lock-defaults) - '(inferior-octave-font-lock-keywords nil nil)) - - (set (make-local-variable 'info-lookup-mode) 'octave-mode) - - (setq comint-input-ring-file-name - (or (getenv "OCTAVE_HISTFILE") "~/.octave_hist") - comint-input-ring-size (or (getenv "OCTAVE_HISTSIZE") 1024)) - (set (make-local-variable 'comint-dynamic-complete-functions) - inferior-octave-dynamic-complete-functions) - (add-hook 'comint-input-filter-functions - 'inferior-octave-directory-tracker nil t) - (comint-read-input-ring t)) - -;;;###autoload -(defun inferior-octave (&optional arg) - "Run an inferior Octave process, I/O via `inferior-octave-buffer'. -This buffer is put in Inferior Octave mode. See `inferior-octave-mode'. - -Unless ARG is non-nil, switches to this buffer. - -The elements of the list `inferior-octave-startup-args' are sent as -command line arguments to the inferior Octave process on startup. - -Additional commands to be executed on startup can be provided either in -the file specified by `inferior-octave-startup-file' or by the default -startup file, `~/.emacs-octave'." - (interactive "P") - (let ((buffer inferior-octave-buffer)) - (get-buffer-create buffer) - (if (comint-check-proc buffer) - () - (with-current-buffer buffer - (comint-mode) - (inferior-octave-startup) - (inferior-octave-mode))) - (if (not arg) - (pop-to-buffer buffer)))) - -;;;###autoload -(defalias 'run-octave 'inferior-octave) - -(defun inferior-octave-startup () - "Start an inferior Octave process." - (let ((proc (comint-exec-1 - (substring inferior-octave-buffer 1 -1) - inferior-octave-buffer - inferior-octave-program - (append (list "-i" "--no-line-editing") - inferior-octave-startup-args)))) - (set-process-filter proc 'inferior-octave-output-digest) - (setq comint-ptyp process-connection-type - inferior-octave-process proc - inferior-octave-output-list nil - inferior-octave-output-string nil - inferior-octave-receive-in-progress t) - - ;; This may look complicated ... However, we need to make sure that - ;; we additional startup code only AFTER Octave is ready (otherwise, - ;; output may be mixed up). Hence, we need to digest the Octave - ;; output to see when it issues a prompt. - (while inferior-octave-receive-in-progress - (accept-process-output inferior-octave-process)) - (goto-char (point-max)) - (set-marker (process-mark proc) (point)) - (insert-before-markers - (concat - (if (not (bobp)) " \n") - (if inferior-octave-output-list - (concat (mapconcat - 'identity inferior-octave-output-list "\n") - "\n")))) - - ;; Find out whether Octave has built-in variables. - (inferior-octave-send-list-and-digest - (list "exist \"LOADPATH\"\n")) - (setq inferior-octave-has-built-in-variables - (string-match "101$" (car inferior-octave-output-list))) - - ;; An empty secondary prompt, as e.g. obtained by '--braindead', - ;; means trouble. - (inferior-octave-send-list-and-digest (list "PS2\n")) - (if (string-match "\\(PS2\\|ans\\) = *$" (car inferior-octave-output-list)) - (inferior-octave-send-list-and-digest - (list (if inferior-octave-has-built-in-variables - "PS2 = \"> \"\n" - "PS2 (\"> \");\n")))) - - ;; O.k., now we are ready for the Inferior Octave startup commands. - (let* (commands - (program (file-name-nondirectory inferior-octave-program)) - (file (or inferior-octave-startup-file - (concat "~/.emacs-" program)))) - (setq commands - (list "more off;\n" - (if (not (string-equal - inferior-octave-output-string ">> ")) - (if inferior-octave-has-built-in-variables - "PS1=\"\\\\s> \";\n" - "PS1 (\"\\\\s> \");\n")) - (if (file-exists-p file) - (format "source (\"%s\");\n" file)))) - (inferior-octave-send-list-and-digest commands)) - (insert-before-markers - (concat - (if inferior-octave-output-list - (concat (mapconcat - 'identity inferior-octave-output-list "\n") - "\n")) - inferior-octave-output-string)) - ;; Next, we check whether Octave supports `completion_matches' ... - (inferior-octave-send-list-and-digest - (list "exist \"completion_matches\"\n")) - (setq inferior-octave-complete-impossible - (not (string-match "5$" (car inferior-octave-output-list)))) - - ;; And finally, everything is back to normal. - (set-process-filter proc 'inferior-octave-output-filter) - (run-hooks 'inferior-octave-startup-hook) - (run-hooks 'inferior-octave-startup-hook) - ;; Just in case, to be sure a cd in the startup file - ;; won't have detrimental effects. - (inferior-octave-resync-dirs))) - - -(defun inferior-octave-completion-at-point () - "Return the data to complete the Octave symbol at point." - (let* ((end (point)) - (start - (save-excursion - (skip-syntax-backward "w_" (comint-line-beginning-position)) - (point)))) - (cond ((eq start end) nil) - (inferior-octave-complete-impossible - (message (concat - "Your Octave does not have `completion_matches'. " - "Please upgrade to version 2.X.")) - nil) - (t - (list - start end - (completion-table-dynamic - (lambda (command) - (inferior-octave-send-list-and-digest - (list (concat "completion_matches (\"" command "\");\n"))) - (sort (delete-dups inferior-octave-output-list) - 'string-lessp)))))))) - -(define-obsolete-function-alias 'inferior-octave-complete - 'completion-at-point "24.1") - -(defun inferior-octave-dynamic-list-input-ring () - "List the buffer's input history in a help buffer." - ;; We cannot use `comint-dynamic-list-input-ring', because it replaces - ;; "completion" by "history reference" ... - (interactive) - (if (or (not (ring-p comint-input-ring)) - (ring-empty-p comint-input-ring)) - (message "No history") - (let ((history nil) - (history-buffer " *Input History*") - (index (1- (ring-length comint-input-ring))) - (conf (current-window-configuration))) - ;; We have to build up a list ourselves from the ring vector. - (while (>= index 0) - (setq history (cons (ring-ref comint-input-ring index) history) - index (1- index))) - ;; Change "completion" to "history reference" - ;; to make the display accurate. - (with-output-to-temp-buffer history-buffer - (display-completion-list history) - (set-buffer history-buffer)) - (message "Hit space to flush") - (let ((ch (read-event))) - (if (eq ch ?\ ) - (set-window-configuration conf) - (setq unread-command-events (list ch))))))) - -(defun inferior-octave-strip-ctrl-g (string) - "Strip leading `^G' character. -If STRING starts with a `^G', ring the bell and strip it." - (if (string-match "^\a" string) - (progn - (ding) - (setq string (substring string 1)))) - string) - -(defun inferior-octave-output-filter (proc string) - "Standard output filter for the inferior Octave process. -Ring Emacs bell if process output starts with an ASCII bell, and pass -the rest to `comint-output-filter'." - (comint-output-filter proc (inferior-octave-strip-ctrl-g string))) - -(defun inferior-octave-output-digest (_proc string) - "Special output filter for the inferior Octave process. -Save all output between newlines into `inferior-octave-output-list', and -the rest to `inferior-octave-output-string'." - (setq string (concat inferior-octave-output-string string)) - (while (string-match "\n" string) - (setq inferior-octave-output-list - (append inferior-octave-output-list - (list (substring string 0 (match-beginning 0)))) - string (substring string (match-end 0)))) - (if (string-match inferior-octave-prompt string) - (setq inferior-octave-receive-in-progress nil)) - (setq inferior-octave-output-string string)) - -(defun inferior-octave-send-list-and-digest (list) - "Send LIST to the inferior Octave process and digest the output. -The elements of LIST have to be strings and are sent one by one. All -output is passed to the filter `inferior-octave-output-digest'." - (let* ((proc inferior-octave-process) - (filter (process-filter proc)) - string) - (set-process-filter proc 'inferior-octave-output-digest) - (setq inferior-octave-output-list nil) - (unwind-protect - (while (setq string (car list)) - (setq inferior-octave-output-string nil - inferior-octave-receive-in-progress t) - (comint-send-string proc string) - (while inferior-octave-receive-in-progress - (accept-process-output proc)) - (setq list (cdr list))) - (set-process-filter proc filter)))) - -(defun inferior-octave-directory-tracker (string) - "Tracks `cd' commands issued to the inferior Octave process. -Use \\[inferior-octave-resync-dirs] to resync if Emacs gets confused." - (cond - ((string-match "^[ \t]*cd[ \t;]*$" string) - (cd "~")) - ((string-match "^[ \t]*cd[ \t]+\\([^ \t\n;]*\\)[ \t\n;]*" string) - (cd (substring string (match-beginning 1) (match-end 1)))))) - -(defun inferior-octave-resync-dirs () - "Resync the buffer's idea of the current directory. -This command queries the inferior Octave process about its current -directory and makes this the current buffer's default directory." - (interactive) - (inferior-octave-send-list-and-digest '("disp (pwd ())\n")) - (cd (car inferior-octave-output-list))) - -;;; provide ourself - -(provide 'octave-inf) - -;;; octave-inf.el ends here diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el deleted file mode 100644 index 806afe5a537..00000000000 --- a/lisp/progmodes/octave-mod.el +++ /dev/null @@ -1,1152 +0,0 @@ -;;; octave-mod.el --- editing Octave source files under Emacs - -;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc. - -;; Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> -;; John Eaton <jwe@octave.org> -;; Maintainer: FSF -;; Keywords: languages - -;; 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 Emacs support for Octave. -;; It defines Octave mode, a major mode for editing -;; Octave code. - -;; The file octave-inf.el contains code for interacting with an inferior -;; Octave process using comint. - -;; See the documentation of `octave-mode' and -;; `run-octave' for further information on usage and customization. - -;;; Code: -(require 'custom) - -(defgroup octave nil - "Major mode for editing Octave source files." - :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) - :group 'languages) - -(defvar inferior-octave-output-list nil) -(defvar inferior-octave-output-string nil) -(defvar inferior-octave-receive-in-progress nil) - -(declare-function inferior-octave-send-list-and-digest "octave-inf" (list)) - -(defconst octave-maintainer-address - "Kurt Hornik <Kurt.Hornik@wu-wien.ac.at>, bug-gnu-emacs@gnu.org" - "Current maintainer of the Emacs Octave package.") - -(define-abbrev-table 'octave-abbrev-table - (mapcar (lambda (e) (append e '(nil 0 t))) - '(("`a" "all_va_args") - ("`b" "break") - ("`cs" "case") - ("`ca" "catch") - ("`c" "continue") - ("`el" "else") - ("`eli" "elseif") - ("`et" "end_try_catch") - ("`eu" "end_unwind_protect") - ("`ef" "endfor") - ("`efu" "endfunction") - ("`ei" "endif") - ("`es" "endswitch") - ("`ew" "endwhile") - ("`f" "for") - ("`fu" "function") - ("`gl" "global") - ("`gp" "gplot") - ("`gs" "gsplot") - ("`if" "if ()") - ("`o" "otherwise") - ("`rp" "replot") - ("`r" "return") - ("`s" "switch") - ("`t" "try") - ("`u" "until ()") - ("`up" "unwind_protect") - ("`upc" "unwind_protect_cleanup") - ("`w" "while ()"))) - "Abbrev table for Octave's reserved words. -Used in `octave-mode' and inferior-octave-mode buffers. -All Octave abbrevs start with a grave accent (`)." - :regexp "\\(?:[^`]\\|^\\)\\(\\(?:\\<\\|`\\)\\w+\\)\\W*") - -(defvar octave-comment-char ?# - "Character to start an Octave comment.") -(defvar octave-comment-start - (string octave-comment-char ?\s) - "String to insert to start a new Octave in-line comment.") -(defvar octave-comment-start-skip "\\s<+\\s-*" - "Regexp to match the start of an Octave comment up to its body.") - -(defvar octave-begin-keywords - '("do" "for" "function" "if" "switch" "try" "unwind_protect" "while")) -(defvar octave-else-keywords - '("case" "catch" "else" "elseif" "otherwise" "unwind_protect_cleanup")) -(defvar octave-end-keywords - '("endfor" "endfunction" "endif" "endswitch" "end_try_catch" - "end_unwind_protect" "endwhile" "until" "end")) - -(defvar octave-reserved-words - (append octave-begin-keywords - octave-else-keywords - octave-end-keywords - '("break" "continue" "end" "global" "persistent" "return")) - "Reserved words in Octave.") - -(defvar octave-text-functions - '("casesen" "cd" "chdir" "clear" "diary" "dir" "document" "echo" - "edit_history" "format" "help" "history" "hold" - "load" "ls" "more" "run_history" "save" "type" - "which" "who" "whos") - "Text functions in Octave.") - -(defvar octave-variables - '("DEFAULT_EXEC_PATH" "DEFAULT_LOADPATH" - "EDITOR" "EXEC_PATH" "F_DUPFD" "F_GETFD" "F_GETFL" "F_SETFD" - "F_SETFL" "I" "IMAGE_PATH" "Inf" "J" - "NaN" "OCTAVE_VERSION" "O_APPEND" "O_CREAT" "O_EXCL" - "O_NONBLOCK" "O_RDONLY" "O_RDWR" "O_TRUNC" "O_WRONLY" "PAGER" "PS1" - "PS2" "PS4" "PWD" "SEEK_CUR" "SEEK_END" "SEEK_SET" "__F_DUPFD__" - "__F_GETFD__" "__F_GETFL__" "__F_SETFD__" "__F_SETFL__" "__I__" - "__Inf__" "__J__" "__NaN__" "__OCTAVE_VERSION__" "__O_APPEND__" - "__O_CREAT__" "__O_EXCL__" "__O_NONBLOCK__" "__O_RDONLY__" - "__O_RDWR__" "__O_TRUNC__" "__O_WRONLY__" "__PWD__" "__SEEK_CUR__" - "__SEEK_END__" "__SEEK_SET__" "__argv__" "__e__" "__eps__" - "__i__" "__inf__" "__j__" "__nan__" "__pi__" - "__program_invocation_name__" "__program_name__" "__realmax__" - "__realmin__" "__stderr__" "__stdin__" "__stdout__" "ans" "argv" - "beep_on_error" "completion_append_char" - "crash_dumps_octave_core" "default_save_format" - "e" "echo_executing_commands" "eps" - "error_text" "gnuplot_binary" "history_file" - "history_size" "ignore_function_time_stamp" - "inf" "nan" "nargin" "output_max_field_width" "output_precision" - "page_output_immediately" "page_screen_output" "pi" - "print_answer_id_name" "print_empty_dimensions" - "program_invocation_name" "program_name" - "realmax" "realmin" "return_last_computed_value" "save_precision" - "saving_history" "sighup_dumps_octave_core" "sigterm_dumps_octave_core" - "silent_functions" "split_long_rows" "stderr" "stdin" "stdout" - "string_fill_char" "struct_levels_to_print" - "suppress_verbose_help_message") - "Builtin variables in Octave.") - -(defvar octave-function-header-regexp - (concat "^\\s-*\\_<\\(function\\)\\_>" - "\\([^=;\n]*=[ \t]*\\|[ \t]*\\)\\(\\(?:\\w\\|\\s_\\)+\\)\\_>") - "Regexp to match an Octave function header. -The string `function' and its name are given by the first and third -parenthetical grouping.") - -(defvar octave-font-lock-keywords - (list - ;; Fontify all builtin keywords. - (cons (concat "\\_<\\(" - (regexp-opt (append octave-reserved-words - octave-text-functions)) - "\\)\\_>") - 'font-lock-keyword-face) - ;; Fontify all builtin operators. - (cons "\\(&\\||\\|<=\\|>=\\|==\\|<\\|>\\|!=\\|!\\)" - (if (boundp 'font-lock-builtin-face) - 'font-lock-builtin-face - 'font-lock-preprocessor-face)) - ;; Fontify all builtin variables. - (cons (concat "\\_<" (regexp-opt octave-variables) "\\_>") - 'font-lock-variable-name-face) - ;; Fontify all function declarations. - (list octave-function-header-regexp - '(1 font-lock-keyword-face) - '(3 font-lock-function-name-face nil t))) - "Additional Octave expressions to highlight.") - -(defun octave-syntax-propertize-function (start end) - (goto-char start) - (octave-syntax-propertize-sqs end) - (funcall (syntax-propertize-rules - ;; Try to distinguish the string-quotes from the transpose-quotes. - ("[[({,; ]\\('\\)" - (1 (prog1 "\"'" (octave-syntax-propertize-sqs end))))) - (point) end)) - -(defun octave-syntax-propertize-sqs (end) - "Propertize the content/end of single-quote strings." - (when (eq (nth 3 (syntax-ppss)) ?\') - ;; A '..' string. - (when (re-search-forward - "\\(?:\\=\\|[^']\\)\\(?:''\\)*\\('\\)\\($\\|[^']\\)" end 'move) - (goto-char (match-beginning 2)) - (when (eq (char-before (match-beginning 1)) ?\\) - ;; Backslash cannot escape a single quote. - (put-text-property (1- (match-beginning 1)) (match-beginning 1) - 'syntax-table (string-to-syntax "."))) - (put-text-property (match-beginning 1) (match-end 1) - 'syntax-table (string-to-syntax "\"'"))))) - -(defcustom inferior-octave-buffer "*Inferior Octave*" - "Name of buffer for running an inferior Octave process." - :type 'string - :group 'octave-inferior) - -(defvar inferior-octave-process nil) - -(defvar octave-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "`" 'octave-abbrev-start) - (define-key map "\e\n" 'octave-indent-new-comment-line) - (define-key map "\M-\C-q" 'octave-indent-defun) - (define-key map "\C-c\C-b" 'octave-submit-bug-report) - (define-key map "\C-c\C-p" 'octave-previous-code-line) - (define-key map "\C-c\C-n" 'octave-next-code-line) - (define-key map "\C-c\C-a" 'octave-beginning-of-line) - (define-key map "\C-c\C-e" 'octave-end-of-line) - (define-key map [remap down-list] 'smie-down-list) - (define-key map "\C-c\M-\C-h" 'octave-mark-block) - (define-key map "\C-c]" 'smie-close-block) - (define-key map "\C-c/" 'smie-close-block) - (define-key map "\C-c\C-f" 'octave-insert-defun) - ;; FIXME: free C-h so it can do the describe-prefix-bindings. - (define-key map "\C-c\C-h" 'info-lookup-symbol) - (define-key map "\C-c\C-il" 'octave-send-line) - (define-key map "\C-c\C-ib" 'octave-send-block) - (define-key map "\C-c\C-if" 'octave-send-defun) - (define-key map "\C-c\C-ir" 'octave-send-region) - (define-key map "\C-c\C-is" 'octave-show-process-buffer) - (define-key map "\C-c\C-ih" 'octave-hide-process-buffer) - (define-key map "\C-c\C-ik" 'octave-kill-process) - (define-key map "\C-c\C-i\C-l" 'octave-send-line) - (define-key map "\C-c\C-i\C-b" 'octave-send-block) - (define-key map "\C-c\C-i\C-f" 'octave-send-defun) - (define-key map "\C-c\C-i\C-r" 'octave-send-region) - (define-key map "\C-c\C-i\C-s" 'octave-show-process-buffer) - ;; FIXME: free C-h so it can do the describe-prefix-bindings. - (define-key map "\C-c\C-i\C-h" 'octave-hide-process-buffer) - (define-key map "\C-c\C-i\C-k" 'octave-kill-process) - map) - "Keymap used in Octave mode.") - - - -(easy-menu-define octave-mode-menu octave-mode-map - "Menu for Octave mode." - '("Octave" - ("Lines" - ["Previous Code Line" octave-previous-code-line t] - ["Next Code Line" octave-next-code-line t] - ["Begin of Continuation" octave-beginning-of-line t] - ["End of Continuation" octave-end-of-line t] - ["Split Line at Point" octave-indent-new-comment-line t]) - ("Blocks" - ["Mark Block" octave-mark-block t] - ["Close Block" smie-close-block t]) - ("Functions" - ["Indent Function" octave-indent-defun t] - ["Insert Function" octave-insert-defun t]) - "-" - ("Debug" - ["Send Current Line" octave-send-line t] - ["Send Current Block" octave-send-block t] - ["Send Current Function" octave-send-defun t] - ["Send Region" octave-send-region t] - ["Show Process Buffer" octave-show-process-buffer t] - ["Hide Process Buffer" octave-hide-process-buffer t] - ["Kill Process" octave-kill-process t]) - "-" - ["Indent Line" indent-according-to-mode t] - ["Complete Symbol" completion-at-point t] - "-" - ["Toggle Abbrev Mode" abbrev-mode - :style toggle :selected abbrev-mode] - ["Toggle Auto-Fill Mode" auto-fill-mode - :style toggle :selected auto-fill-function] - "-" - ["Submit Bug Report" octave-submit-bug-report t] - "-" - ["Describe Octave Mode" describe-mode t] - ["Lookup Octave Index" info-lookup-symbol t])) - -(defvar octave-mode-syntax-table - (let ((table (make-syntax-table))) - (modify-syntax-entry ?\r " " 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) - (modify-syntax-entry ?| "." table) - (modify-syntax-entry ?! "." table) - (modify-syntax-entry ?\\ "\\" table) - (modify-syntax-entry ?\' "." table) - ;; Was "w" for abbrevs, but now that it's not necessary any more, - (modify-syntax-entry ?\` "." table) - (modify-syntax-entry ?\" "\"" table) - (modify-syntax-entry ?. "_" table) - (modify-syntax-entry ?_ "_" table) - ;; The "b" flag only applies to the second letter of the comstart - ;; and the first letter of the comend, i.e. the "4b" below is ineffective. - ;; If we try to put `b' on the single-line comments, we get a similar - ;; problem where the % and # chars appear as first chars of the 2-char - ;; comend, so the multi-line ender is also turned into style-b. - ;; So we need the new "c" comment style. - (modify-syntax-entry ?\% "< 13" table) - (modify-syntax-entry ?\# "< 13" table) - (modify-syntax-entry ?\{ "(} 2c" table) - (modify-syntax-entry ?\} "){ 4c" table) - (modify-syntax-entry ?\n ">" table) - table) - "Syntax table in use in `octave-mode' buffers.") - -(defcustom octave-blink-matching-block t - "Control the blinking of matching Octave block keywords. -Non-nil means show matching begin of block when inserting a space, -newline or semicolon after an else or end keyword." - :type 'boolean - :group 'octave) - -(defcustom octave-block-offset 2 - "Extra indentation applied to statements in Octave block structures." - :type 'integer - :group 'octave) - -(defvar octave-block-comment-start - (concat (make-string 2 octave-comment-char) " ") - "String to insert to start a new Octave comment on an empty line.") - -(defcustom octave-continuation-offset 4 - "Extra indentation applied to Octave continuation lines." - :type 'integer - :group 'octave) -(eval-and-compile - (defconst octave-continuation-marker-regexp "\\\\\\|\\.\\.\\.")) -(defvar octave-continuation-regexp - (concat "[^#%\n]*\\(" octave-continuation-marker-regexp - "\\)\\s-*\\(\\s<.*\\)?$")) -(defcustom octave-continuation-string "\\" - "Character string used for Octave continuation lines. Normally \\." - :type 'string - :group 'octave) - -(defvar octave-completion-alist nil - "Alist of Octave symbols for completion in Octave mode. -Each element looks like (VAR . VAR), where the car and cdr are the same -symbol (an Octave command or variable name). -Currently, only builtin variables can be completed.") - -(defvar octave-mode-imenu-generic-expression - (list - ;; Functions - (list nil octave-function-header-regexp 3)) - "Imenu expression for Octave mode. See `imenu-generic-expression'.") - -(defcustom octave-mode-hook nil - "Hook to be run when Octave mode is started." - :type 'hook - :group 'octave) - -(defcustom octave-send-show-buffer t - "Non-nil means display `inferior-octave-buffer' after sending to it." - :type 'boolean - :group 'octave) -(defcustom octave-send-line-auto-forward t - "Control auto-forward after sending to the inferior Octave process. -Non-nil means always go to the next Octave code line after sending." - :type 'boolean - :group 'octave) -(defcustom octave-send-echo-input t - "Non-nil means echo input sent to the inferior Octave process." - :type 'boolean - :group 'octave) - - -;;; SMIE indentation - -(require 'smie) - -(defconst octave-operator-table - '((assoc ";" "\n") (assoc ",") ; The doc claims they have equal precedence!? - (right "=" "+=" "-=" "*=" "/=") - (assoc "&&") (assoc "||") ; The doc claims they have equal precedence!? - (assoc "&") (assoc "|") ; The doc claims they have equal precedence!? - (nonassoc "<" "<=" "==" ">=" ">" "!=" "~=") - (nonassoc ":") ;No idea what this is. - (assoc "+" "-") - (assoc "*" "/" "\\" ".\\" ".*" "./") - (nonassoc "'" ".'") - (nonassoc "++" "--" "!" "~") ;And unary "+" and "-". - (right "^" "**" ".^" ".**") - ;; It's not really an operator, but for indentation purposes it - ;; could be convenient to treat it as one. - (assoc "..."))) - -(defconst octave-smie-bnf-table - '((atom) - ;; We can't distinguish the first element in a sequence with - ;; precedence grammars, so we can't distinguish the condition - ;; if the `if' from the subsequent body, for example. - ;; This has to be done later in the indentation rules. - (exp (exp "\n" exp) - ;; We need to mention at least one of the operators in this part - ;; of the grammar: if the BNF and the operator table have - ;; no overlap, SMIE can't know how they relate. - (exp ";" exp) - ("try" exp "catch" exp "end_try_catch") - ("try" exp "catch" exp "end") - ("unwind_protect" exp - "unwind_protect_cleanup" exp "end_unwind_protect") - ("unwind_protect" exp "unwind_protect_cleanup" exp "end") - ("for" exp "endfor") - ("for" exp "end") - ("do" exp "until" atom) - ("while" exp "endwhile") - ("while" exp "end") - ("if" exp "endif") - ("if" exp "else" exp "endif") - ("if" exp "elseif" exp "else" exp "endif") - ("if" exp "elseif" exp "elseif" exp "else" exp "endif") - ("if" exp "elseif" exp "elseif" exp "else" exp "end") - ("switch" exp "case" exp "endswitch") - ("switch" exp "case" exp "otherwise" exp "endswitch") - ("switch" exp "case" exp "case" exp "otherwise" exp "endswitch") - ("switch" exp "case" exp "case" exp "otherwise" exp "end") - ("function" exp "endfunction") - ("function" exp "end")) - ;; (fundesc (atom "=" atom)) - )) - -(defconst octave-smie-grammar - (smie-prec2->grammar - (smie-merge-prec2s - (smie-bnf->prec2 octave-smie-bnf-table - '((assoc "\n" ";"))) - - (smie-precs->prec2 octave-operator-table)))) - -;; Tokenizing needs to be refined so that ";;" is treated as two -;; tokens and also so as to recognize the \n separator (and -;; corresponding continuation lines). - -(defconst octave-operator-regexp - (regexp-opt (apply 'append (mapcar 'cdr octave-operator-table)))) - -(defun octave-smie-backward-token () - (let ((pos (point))) - (forward-comment (- (point))) - (cond - ((and (not (eq (char-before) ?\;)) ;Coalesce ";" and "\n". - (> pos (line-end-position)) - (if (looking-back octave-continuation-marker-regexp (- (point) 3)) - (progn - (goto-char (match-beginning 0)) - (forward-comment (- (point))) - nil) - t) - ;; Ignore it if it's within parentheses. - (let ((ppss (syntax-ppss))) - (not (and (nth 1 ppss) - (eq ?\( (char-after (nth 1 ppss))))))) - (skip-chars-forward " \t") - ;; Why bother distinguishing \n and ;? - ";") ;;"\n" - ((and (looking-back octave-operator-regexp (- (point) 3) 'greedy) - ;; Don't mistake a string quote for a transpose. - (not (looking-back "\\s\"" (1- (point))))) - (goto-char (match-beginning 0)) - (match-string-no-properties 0)) - (t - (smie-default-backward-token))))) - -(defun octave-smie-forward-token () - (skip-chars-forward " \t") - (when (looking-at (eval-when-compile - (concat "\\(" octave-continuation-marker-regexp - "\\)[ \t]*\\($\\|[%#]\\)"))) - (goto-char (match-end 1)) - (forward-comment 1)) - (cond - ((and (looking-at "$\\|[%#]") - ;; Ignore it if it's within parentheses. - (prog1 (let ((ppss (syntax-ppss))) - (not (and (nth 1 ppss) - (eq ?\( (char-after (nth 1 ppss)))))) - (forward-comment (point-max)))) - ;; Why bother distinguishing \n and ;? - ";") ;;"\n" - ((looking-at ";[ \t]*\\($\\|[%#]\\)") - ;; Combine the ; with the subsequent \n. - (goto-char (match-beginning 1)) - (forward-comment 1) - ";") - ((and (looking-at octave-operator-regexp) - ;; Don't mistake a string quote for a transpose. - (not (looking-at "\\s\""))) - (goto-char (match-end 0)) - (match-string-no-properties 0)) - (t - (smie-default-forward-token)))) - -(defun octave-smie-rules (kind token) - (pcase (cons kind token) - ;; We could set smie-indent-basic instead, but that would have two - ;; disadvantages: - ;; - changes to octave-block-offset wouldn't take effect immediately. - ;; - edebug wouldn't show the use of this variable. - (`(:elem . basic) octave-block-offset) - ;; Since "case" is in the same BNF rules as switch..end, SMIE by default - ;; aligns it with "switch". - (`(:before . "case") (if (not (smie-rule-sibling-p)) octave-block-offset)) - (`(:after . ";") - (if (smie-rule-parent-p "function" "if" "while" "else" "elseif" "for" - "otherwise" "case" "try" "catch" "unwind_protect" - "unwind_protect_cleanup") - (smie-rule-parent octave-block-offset) - ;; For (invalid) code between switch and case. - ;; (if (smie-parent-p "switch") 4) - 0)))) - -(defvar electric-layout-rules) - -;;;###autoload -(define-derived-mode octave-mode prog-mode "Octave" - "Major mode for editing Octave code. - -This mode makes it easier to write Octave code by helping with -indentation, doing some of the typing for you (with Abbrev mode) and by -showing keywords, comments, strings, etc. in different faces (with -Font Lock mode on terminals that support it). - -Octave itself is a high-level language, primarily intended for numerical -computations. It provides a convenient command line interface for -solving linear and nonlinear problems numerically. Function definitions -can also be stored in files, and it can be used in a batch mode (which -is why you need this mode!). - -The latest released version of Octave is always available via anonymous -ftp from ftp.octave.org in the directory `/pub/octave'. Complete -source and binaries for several popular systems are available. - -Type \\[list-abbrevs] to display the built-in abbrevs for Octave keywords. - -Keybindings -=========== - -\\{octave-mode-map} - -Variables you can use to customize Octave mode -============================================== - -`octave-blink-matching-block' - Non-nil means show matching begin of block when inserting a space, - newline or semicolon after an else or end keyword. Default is t. - -`octave-block-offset' - Extra indentation applied to statements in block structures. - Default is 2. - -`octave-continuation-offset' - Extra indentation applied to Octave continuation lines. - Default is 4. - -`octave-continuation-string' - String used for Octave continuation lines. - Default is a backslash. - -`octave-send-echo-input' - Non-nil means always display `inferior-octave-buffer' after sending a - command to the inferior Octave process. - -`octave-send-line-auto-forward' - Non-nil means always go to the next unsent line of Octave code after - sending a line to the inferior Octave process. - -`octave-send-echo-input' - Non-nil means echo input sent to the inferior Octave process. - -Turning on Octave mode runs the hook `octave-mode-hook'. - -To begin using this mode for all `.m' files that you edit, add the -following lines to your init file: - - (add-to-list 'auto-mode-alist '(\"\\\\.m\\\\'\" . octave-mode)) - -To automatically turn on the abbrev and auto-fill features, -add the following lines to your init file as well: - - (add-hook 'octave-mode-hook - (lambda () - (abbrev-mode 1) - (auto-fill-mode 1))) - -To submit a problem report, enter \\[octave-submit-bug-report] from \ -an Octave mode buffer. -This automatically sets up a mail buffer with version information -already added. You just need to add a description of the problem, -including a reproducible test case and send the message." - (setq local-abbrev-table octave-abbrev-table) - - (smie-setup octave-smie-grammar #'octave-smie-rules - :forward-token #'octave-smie-forward-token - :backward-token #'octave-smie-backward-token) - (set (make-local-variable 'smie-indent-basic) 'octave-block-offset) - - (set (make-local-variable 'smie-blink-matching-triggers) - (cons ?\; smie-blink-matching-triggers)) - (unless octave-blink-matching-block - (remove-hook 'post-self-insert-hook #'smie-blink-matching-open 'local)) - - (set (make-local-variable 'electric-indent-chars) - (cons ?\; electric-indent-chars)) - ;; IIUC matlab-mode takes the opposite approach: it makes RET insert - ;; a ";" at those places where it's correct (i.e. outside of parens). - (set (make-local-variable 'electric-layout-rules) '((?\; . after))) - - (set (make-local-variable 'comment-start) octave-comment-start) - (set (make-local-variable 'comment-end) "") - ;; Don't set it here: it's not really a property of the language, - ;; just a personal preference of the author. - ;; (set (make-local-variable 'comment-column) 32) - (set (make-local-variable 'comment-start-skip) "\\s<+\\s-*") - (set (make-local-variable 'comment-add) 1) - - (set (make-local-variable 'parse-sexp-ignore-comments) t) - (set (make-local-variable 'paragraph-start) - (concat "\\s-*$\\|" page-delimiter)) - (set (make-local-variable 'paragraph-separate) paragraph-start) - (set (make-local-variable 'paragraph-ignore-fill-prefix) t) - (set (make-local-variable 'fill-paragraph-function) 'octave-fill-paragraph) - ;; FIXME: Why disable it? - ;; (set (make-local-variable 'adaptive-fill-regexp) nil) - ;; Again, this is not a property of the language, don't set it here. - ;; (set (make-local-variable 'fill-column) 72) - (set (make-local-variable 'normal-auto-fill-function) 'octave-auto-fill) - - (set (make-local-variable 'font-lock-defaults) - '(octave-font-lock-keywords)) - - (set (make-local-variable 'syntax-propertize-function) - #'octave-syntax-propertize-function) - - (set (make-local-variable 'imenu-generic-expression) - octave-mode-imenu-generic-expression) - (set (make-local-variable 'imenu-case-fold-search) nil) - - (add-hook 'completion-at-point-functions - 'octave-completion-at-point-function nil t) - (set (make-local-variable 'beginning-of-defun-function) - 'octave-beginning-of-defun) - - (easy-menu-add octave-mode-menu) - (octave-initialize-completions)) - -;;; Miscellaneous useful functions - -(defsubst octave-in-comment-p () - "Return t if point is inside an Octave comment." - (nth 4 (syntax-ppss))) - -(defsubst octave-in-string-p () - "Return t if point is inside an Octave string." - (nth 3 (syntax-ppss))) - -(defsubst octave-not-in-string-or-comment-p () - "Return t if point is not inside an Octave string or comment." - (let ((pps (syntax-ppss))) - (not (or (nth 3 pps) (nth 4 pps))))) - - -(defun octave-looking-at-kw (regexp) - "Like `looking-at', but sets `case-fold-search' nil." - (let ((case-fold-search nil)) - (looking-at regexp))) - -(defun octave-maybe-insert-continuation-string () - (if (or (octave-in-comment-p) - (save-excursion - (beginning-of-line) - (looking-at octave-continuation-regexp))) - nil - (delete-horizontal-space) - (insert (concat " " octave-continuation-string)))) - -;;; Indentation - -(defun octave-indent-new-comment-line () - "Break Octave line at point, continuing comment if within one. -If within code, insert `octave-continuation-string' before breaking the -line. If within a string, signal an error. -The new line is properly indented." - (interactive) - (delete-horizontal-space) - (cond - ((octave-in-comment-p) - (indent-new-comment-line)) - ((octave-in-string-p) - (error "Cannot split a code line inside a string")) - (t - (insert (concat " " octave-continuation-string)) - (reindent-then-newline-and-indent)))) - -(defun octave-indent-defun () - "Properly indent the Octave function which contains point." - (interactive) - (save-excursion - (mark-defun) - (message "Indenting function...") - (indent-region (point) (mark) nil)) - (message "Indenting function...done.")) - - -;;; Motion -(defun octave-next-code-line (&optional arg) - "Move ARG lines of Octave code forward (backward if ARG is negative). -Skips past all empty and comment lines. Default for ARG is 1. - -On success, return 0. Otherwise, go as far as possible and return -1." - (interactive "p") - (or arg (setq arg 1)) - (beginning-of-line) - (let ((n 0) - (inc (if (> arg 0) 1 -1))) - (while (and (/= arg 0) (= n 0)) - (setq n (forward-line inc)) - (while (and (= n 0) - (looking-at "\\s-*\\($\\|\\s<\\)")) - (setq n (forward-line inc))) - (setq arg (- arg inc))) - n)) - -(defun octave-previous-code-line (&optional arg) - "Move ARG lines of Octave code backward (forward if ARG is negative). -Skips past all empty and comment lines. Default for ARG is 1. - -On success, return 0. Otherwise, go as far as possible and return -1." - (interactive "p") - (or arg (setq arg 1)) - (octave-next-code-line (- arg))) - -(defun octave-beginning-of-line () - "Move point to beginning of current Octave line. -If on an empty or comment line, go to the beginning of that line. -Otherwise, move backward to the beginning of the first Octave code line -which is not inside a continuation statement, i.e., which does not -follow a code line ending in `...' or `\\', or is inside an open -parenthesis list." - (interactive) - (beginning-of-line) - (if (not (looking-at "\\s-*\\($\\|\\s<\\)")) - (while (or (condition-case nil - (progn - (up-list -1) - (beginning-of-line) - t) - (error nil)) - (and (or (looking-at "\\s-*\\($\\|\\s<\\)") - (save-excursion - (if (zerop (octave-previous-code-line)) - (looking-at octave-continuation-regexp)))) - (zerop (forward-line -1))))))) - -(defun octave-end-of-line () - "Move point to end of current Octave line. -If on an empty or comment line, go to the end of that line. -Otherwise, move forward to the end of the first Octave code line which -does not end in `...' or `\\' or is inside an open parenthesis list." - (interactive) - (end-of-line) - (if (save-excursion - (beginning-of-line) - (looking-at "\\s-*\\($\\|\\s<\\)")) - () - (while (or (condition-case nil - (progn - (up-list 1) - (end-of-line) - t) - (error nil)) - (and (save-excursion - (beginning-of-line) - (or (looking-at "\\s-*\\($\\|\\s<\\)") - (looking-at octave-continuation-regexp))) - (zerop (forward-line 1))))) - (end-of-line))) - -(defun octave-mark-block () - "Put point at the beginning of this Octave block, mark at the end. -The block marked is the one that contains point or follows point." - (interactive) - (if (and (looking-at "\\sw\\|\\s_") - (looking-back "\\sw\\|\\s_" (1- (point)))) - (skip-syntax-forward "w_")) - (unless (or (looking-at "\\s(") - (save-excursion - (let* ((token (funcall smie-forward-token-function)) - (level (assoc token smie-grammar))) - (and level (not (numberp (cadr level))))))) - (backward-up-list 1)) - (mark-sexp)) - -(defun octave-beginning-of-defun (&optional arg) - "Move backward to the beginning of an Octave function. -With positive ARG, do it that many times. Negative argument -N means -move forward to Nth following beginning of a function. -Returns t unless search stops at the beginning or end of the buffer." - (let* ((arg (or arg 1)) - (inc (if (> arg 0) 1 -1)) - (found nil) - (case-fold-search nil)) - (and (not (eobp)) - (not (and (> arg 0) (looking-at "\\_<function\\_>"))) - (skip-syntax-forward "w")) - (while (and (/= arg 0) - (setq found - (re-search-backward "\\_<function\\_>" inc))) - (if (octave-not-in-string-or-comment-p) - (setq arg (- arg inc)))) - (if found - (progn - (and (< inc 0) (goto-char (match-beginning 0))) - t)))) - - -;;; Filling -(defun octave-auto-fill () - "Perform auto-fill in Octave mode. -Returns nil if no feasible place to break the line could be found, and t -otherwise." - (let (fc give-up) - (if (or (null (setq fc (current-fill-column))) - (save-excursion - (beginning-of-line) - (and auto-fill-inhibit-regexp - (octave-looking-at-kw auto-fill-inhibit-regexp)))) - nil ; Can't do anything - (if (and (not (octave-in-comment-p)) - (> (current-column) fc)) - (setq fc (- fc (+ (length octave-continuation-string) 1)))) - (while (and (not give-up) (> (current-column) fc)) - (let* ((opoint (point)) - (fpoint - (save-excursion - (move-to-column (+ fc 1)) - (skip-chars-backward "^ \t\n") - ;; If we're at the beginning of the line, break after - ;; the first word - (if (bolp) - (re-search-forward "[ \t]" opoint t)) - ;; If we're in a comment line, don't break after the - ;; comment chars - (if (save-excursion - (skip-syntax-backward " <") - (bolp)) - (re-search-forward "[ \t]" (line-end-position) - 'move)) - ;; If we're not in a comment line and just ahead the - ;; continuation string, don't break here. - (if (and (not (octave-in-comment-p)) - (looking-at - (concat "\\s-*" - (regexp-quote - octave-continuation-string) - "\\s-*$"))) - (end-of-line)) - (skip-chars-backward " \t") - (point)))) - (if (save-excursion - (goto-char fpoint) - (not (or (bolp) (eolp)))) - (let ((prev-column (current-column))) - (if (save-excursion - (skip-chars-backward " \t") - (= (point) fpoint)) - (progn - (octave-maybe-insert-continuation-string) - (indent-new-comment-line t)) - (save-excursion - (goto-char fpoint) - (octave-maybe-insert-continuation-string) - (indent-new-comment-line t))) - (if (>= (current-column) prev-column) - (setq give-up t))) - (setq give-up t)))) - (not give-up)))) - -(defun octave-fill-paragraph (&optional _arg) - "Fill paragraph of Octave code, handling Octave comments." - ;; FIXME: difference with generic fill-paragraph: - ;; - code lines are only split, never joined. - ;; - \n that end comments are never removed. - ;; - insert continuation marker when splitting code lines. - (interactive "P") - (save-excursion - (let ((end (progn (forward-paragraph) (copy-marker (point) t))) - (beg (progn - (forward-paragraph -1) - (skip-chars-forward " \t\n") - (beginning-of-line) - (point))) - (cfc (current-fill-column)) - comment-prefix) - (goto-char beg) - (while (< (point) end) - (condition-case nil - (indent-according-to-mode) - (error nil)) - (move-to-column cfc) - ;; First check whether we need to combine non-empty comment lines - (if (and (< (current-column) cfc) - (octave-in-comment-p) - (not (save-excursion - (beginning-of-line) - (looking-at "^\\s-*\\s<+\\s-*$")))) - ;; This is a nonempty comment line which does not extend - ;; past the fill column. If it is followed by a nonempty - ;; comment line with the same comment prefix, try to - ;; combine them, and repeat this until either we reach the - ;; fill-column or there is nothing more to combine. - (progn - ;; Get the comment prefix - (save-excursion - (beginning-of-line) - (while (and (re-search-forward "\\s<+") - (not (octave-in-comment-p)))) - (setq comment-prefix (match-string 0))) - ;; And keep combining ... - (while (and (< (current-column) cfc) - (save-excursion - (forward-line 1) - (and (looking-at - (concat "^\\s-*" - comment-prefix - "\\S<")) - (not (looking-at - (concat "^\\s-*" - comment-prefix - "\\s-*$")))))) - (delete-char 1) - (re-search-forward comment-prefix) - (delete-region (match-beginning 0) (match-end 0)) - (fixup-whitespace) - (move-to-column cfc)))) - ;; We might also try to combine continued code lines> Perhaps - ;; some other time ... - (skip-chars-forward "^ \t\n") - (delete-horizontal-space) - (if (or (< (current-column) cfc) - (and (= (current-column) cfc) (eolp))) - (forward-line 1) - (if (not (eolp)) (insert " ")) - (or (octave-auto-fill) - (forward-line 1)))) - t))) - - -;;; Completions -(defun octave-initialize-completions () - "Create an alist for Octave completions." - (if octave-completion-alist - () - (setq octave-completion-alist - (append octave-reserved-words - octave-text-functions - octave-variables)))) - -(defun octave-completion-at-point-function () - "Find the text to complete and the corresponding table." - (let* ((beg (save-excursion (skip-syntax-backward "w_") (point))) - (end (point))) - (if (< beg (point)) - ;; Extend region past point, if applicable. - (save-excursion (skip-syntax-forward "w_") - (setq end (point)))) - (list beg end octave-completion-alist))) - -(define-obsolete-function-alias 'octave-complete-symbol - 'completion-at-point "24.1") - -;;; Electric characters && friends - -(defun octave-abbrev-start () - "Start entering an Octave abbreviation. -If Abbrev mode is turned on, typing ` (grave accent) followed by ? or -\\[help-command] lists all Octave abbrevs. Any other key combination is -executed normally. -Note that all Octave mode abbrevs start with a grave accent." - (interactive) - (self-insert-command 1) - (when abbrev-mode - (set-temporary-overlay-map - (let ((map (make-sparse-keymap))) - (define-key map [??] 'list-abbrevs) - (define-key map (vector help-char) 'list-abbrevs) - map)))) - -(define-skeleton octave-insert-defun - "Insert an Octave function skeleton. -Prompt for the function's name, arguments and return values (to be -entered without parens)." - (let* ((defname (substring (buffer-name) 0 -2)) - (name (read-string (format "Function name (default %s): " defname) - nil nil defname)) - (args (read-string "Arguments: ")) - (vals (read-string "Return values: "))) - (format "%s%s (%s)" - (cond - ((string-equal vals "") vals) - ((string-match "[ ,]" vals) (concat "[" vals "] = ")) - (t (concat vals " = "))) - name - args)) - \n "function " > str \n \n - octave-block-comment-start "usage: " str \n - octave-block-comment-start \n octave-block-comment-start - \n _ \n - "endfunction" > \n) - -;;; Communication with the inferior Octave process -(defun octave-kill-process () - "Kill inferior Octave process and its buffer." - (interactive) - (if inferior-octave-process - (progn - (process-send-string inferior-octave-process "quit;\n") - (accept-process-output inferior-octave-process))) - (if inferior-octave-buffer - (kill-buffer inferior-octave-buffer))) - -(defun octave-show-process-buffer () - "Make sure that `inferior-octave-buffer' is displayed." - (interactive) - (if (get-buffer inferior-octave-buffer) - (display-buffer inferior-octave-buffer) - (message "No buffer named %s" inferior-octave-buffer))) - -(defun octave-hide-process-buffer () - "Delete all windows that display `inferior-octave-buffer'." - (interactive) - (if (get-buffer inferior-octave-buffer) - (delete-windows-on inferior-octave-buffer) - (message "No buffer named %s" inferior-octave-buffer))) - -(defun octave-send-region (beg end) - "Send current region to the inferior Octave process." - (interactive "r") - (inferior-octave t) - (let ((proc inferior-octave-process) - (string (buffer-substring-no-properties beg end)) - line) - (with-current-buffer inferior-octave-buffer - (setq inferior-octave-output-list nil) - (while (not (string-equal string "")) - (if (string-match "\n" string) - (setq line (substring string 0 (match-beginning 0)) - string (substring string (match-end 0))) - (setq line string string "")) - (setq inferior-octave-receive-in-progress t) - (inferior-octave-send-list-and-digest (list (concat line "\n"))) - (while inferior-octave-receive-in-progress - (accept-process-output proc)) - (insert-before-markers - (mapconcat 'identity - (append - (if octave-send-echo-input (list line) (list "")) - (mapcar 'inferior-octave-strip-ctrl-g - inferior-octave-output-list) - (list inferior-octave-output-string)) - "\n"))))) - (if octave-send-show-buffer - (display-buffer inferior-octave-buffer))) - -(defun octave-send-block () - "Send current Octave block to the inferior Octave process." - (interactive) - (save-excursion - (octave-mark-block) - (octave-send-region (point) (mark)))) - -(defun octave-send-defun () - "Send current Octave function to the inferior Octave process." - (interactive) - (save-excursion - (mark-defun) - (octave-send-region (point) (mark)))) - -(defun octave-send-line (&optional arg) - "Send current Octave code line to the inferior Octave process. -With positive prefix ARG, send that many lines. -If `octave-send-line-auto-forward' is non-nil, go to the next unsent -code line." - (interactive "P") - (or arg (setq arg 1)) - (if (> arg 0) - (let (beg end) - (beginning-of-line) - (setq beg (point)) - (octave-next-code-line (- arg 1)) - (end-of-line) - (setq end (point)) - (if octave-send-line-auto-forward - (octave-next-code-line 1)) - (octave-send-region beg end)))) - -(defun octave-eval-print-last-sexp () - "Evaluate Octave sexp before point and print value into current buffer." - (interactive) - (inferior-octave t) - (let ((standard-output (current-buffer)) - (print-escape-newlines nil) - (opoint (point))) - (terpri) - (prin1 - (save-excursion - (forward-sexp -1) - (inferior-octave-send-list-and-digest - (list (concat (buffer-substring-no-properties (point) opoint) - "\n"))) - (mapconcat 'identity inferior-octave-output-list "\n"))) - (terpri))) - -;;; Bug reporting -(defun octave-submit-bug-report () - "Submit a bug report on the Emacs Octave package via mail." - (interactive) - (require 'reporter) - (and - (y-or-n-p "Do you want to submit a bug report? ") - (reporter-submit-bug-report - octave-maintainer-address - (concat "Emacs version " emacs-version) - (list - 'octave-blink-matching-block - 'octave-block-offset - 'octave-comment-char - 'octave-continuation-offset - 'octave-continuation-string - 'octave-send-echo-input - 'octave-send-line-auto-forward - 'octave-send-show-buffer)))) - -;; provide ourself - -(provide 'octave-mod) - -;;; octave-mod.el ends here diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el new file mode 100644 index 00000000000..c6e19fe3a15 --- /dev/null +++ b/lisp/progmodes/octave.el @@ -0,0 +1,1732 @@ +;;; octave.el --- editing octave source files under emacs -*- lexical-binding: t; -*- + +;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc. + +;; Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> +;; John Eaton <jwe@octave.org> +;; Maintainer: FSF +;; Keywords: languages + +;; 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 emacs support for Octave. It defines a major +;; mode for editing Octave code and contains code for interacting with +;; an inferior Octave process using comint. + +;; See the documentation of `octave-mode' and `run-octave' for further +;; information on usage and customization. + +;;; Code: +(require 'comint) + +;;; For emacs < 24.3. +(require 'newcomment) +(eval-and-compile + (unless (fboundp 'user-error) + (defalias 'user-error 'error)) + (unless (fboundp 'delete-consecutive-dups) + (defalias 'delete-consecutive-dups 'delete-dups))) +(eval-when-compile + (unless (fboundp 'setq-local) + (defmacro setq-local (var val) + "Set variable VAR to value VAL in current buffer." + (list 'set (list 'make-local-variable (list 'quote var)) val)))) + +(defgroup octave nil + "Editing Octave code." + :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) + :group 'languages) + +(define-obsolete-function-alias 'octave-submit-bug-report + 'report-emacs-bug "24.4") + +(define-abbrev-table 'octave-abbrev-table nil + "Abbrev table for Octave's reserved words. +Used in `octave-mode' and `inferior-octave-mode' buffers.") + +(defvar octave-comment-char ?# + "Character to start an Octave comment.") + +(defvar octave-comment-start (char-to-string octave-comment-char) + "Octave-specific `comment-start' (which see).") + +(defvar octave-comment-start-skip "\\(^\\|\\S<\\)\\(?:%!\\|\\s<+\\)\\s-*" + "Octave-specific `comment-start-skip' (which see).") + +(defvar octave-begin-keywords + '("classdef" "do" "enumeration" "events" "for" "function" "if" "methods" + "parfor" "properties" "switch" "try" "unwind_protect" "while")) + +(defvar octave-else-keywords + '("case" "catch" "else" "elseif" "otherwise" "unwind_protect_cleanup")) + +(defvar octave-end-keywords + '("endclassdef" "endenumeration" "endevents" "endfor" "endfunction" "endif" + "endmethods" "endparfor" "endproperties" "endswitch" "end_try_catch" + "end_unwind_protect" "endwhile" "until" "end")) + +(defvar octave-reserved-words + (append octave-begin-keywords + octave-else-keywords + octave-end-keywords + '("break" "continue" "global" "persistent" "return")) + "Reserved words in Octave.") + +(defvar octave-function-header-regexp + (concat "^\\s-*\\_<\\(function\\)\\_>" + "\\([^=;\n]*=[ \t]*\\|[ \t]*\\)\\(\\(?:\\w\\|\\s_\\)+\\)\\_>") + "Regexp to match an Octave function header. +The string `function' and its name are given by the first and third +parenthetical grouping.") + + +(defvar octave-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\M-." 'octave-find-definition) + (define-key map "\M-\C-j" 'octave-indent-new-comment-line) + (define-key map "\C-c\C-p" 'octave-previous-code-line) + (define-key map "\C-c\C-n" 'octave-next-code-line) + (define-key map "\C-c\C-a" 'octave-beginning-of-line) + (define-key map "\C-c\C-e" 'octave-end-of-line) + (define-key map [remap down-list] 'smie-down-list) + (define-key map "\C-c\M-\C-h" 'octave-mark-block) + (define-key map "\C-c]" 'smie-close-block) + (define-key map "\C-c/" 'smie-close-block) + (define-key map "\C-c;" 'octave-update-function-file-comment) + (define-key map "\C-hd" 'octave-help) + (define-key map "\C-c\C-f" 'octave-insert-defun) + (define-key map "\C-c\C-il" 'octave-send-line) + (define-key map "\C-c\C-ib" 'octave-send-block) + (define-key map "\C-c\C-if" 'octave-send-defun) + (define-key map "\C-c\C-ir" 'octave-send-region) + (define-key map "\C-c\C-is" 'octave-show-process-buffer) + (define-key map "\C-c\C-iq" 'octave-hide-process-buffer) + (define-key map "\C-c\C-ik" 'octave-kill-process) + (define-key map "\C-c\C-i\C-l" 'octave-send-line) + (define-key map "\C-c\C-i\C-b" 'octave-send-block) + (define-key map "\C-c\C-i\C-f" 'octave-send-defun) + (define-key map "\C-c\C-i\C-r" 'octave-send-region) + (define-key map "\C-c\C-i\C-s" 'octave-show-process-buffer) + (define-key map "\C-c\C-i\C-q" 'octave-hide-process-buffer) + (define-key map "\C-c\C-i\C-k" 'octave-kill-process) + map) + "Keymap used in Octave mode.") + + + +(easy-menu-define octave-mode-menu octave-mode-map + "Menu for Octave mode." + '("Octave" + ["Split Line at Point" octave-indent-new-comment-line t] + ["Previous Code Line" octave-previous-code-line t] + ["Next Code Line" octave-next-code-line t] + ["Begin of Line" octave-beginning-of-line t] + ["End of Line" octave-end-of-line t] + ["Mark Block" octave-mark-block t] + ["Close Block" smie-close-block t] + "---" + ["Start Octave Process" run-octave t] + ["Documentation Lookup" info-lookup-symbol t] + ["Help on Function" octave-help t] + ["Find Function Definition" octave-find-definition t] + ["Insert Function" octave-insert-defun t] + ["Update Function File Comment" octave-update-function-file-comment t] + "---" + ["Function Syntax Hints" (call-interactively + (if (fboundp 'eldoc-post-insert-mode) + 'eldoc-post-insert-mode + 'eldoc-mode)) + :style toggle :selected (or eldoc-post-insert-mode eldoc-mode) + :help "Display function signatures after typing `SPC' or `('"] + ["Delimiter Matching" smie-highlight-matching-block-mode + :style toggle :selected smie-highlight-matching-block-mode + :help "Highlight matched pairs such as `if ... end'" + :visible (fboundp 'smie-highlight-matching-block-mode)] + ["Auto Fill" auto-fill-mode + :style toggle :selected auto-fill-function + :help "Automatic line breaking"] + ["Electric Layout" electric-layout-mode + :style toggle :selected electric-layout-mode + :help "Automatically insert newlines around some chars"] + "---" + ("Debug" + ["Send Current Line" octave-send-line t] + ["Send Current Block" octave-send-block t] + ["Send Current Function" octave-send-defun t] + ["Send Region" octave-send-region t] + ["Show Process Buffer" octave-show-process-buffer t] + ["Hide Process Buffer" octave-hide-process-buffer t] + ["Kill Process" octave-kill-process t]) + "---" + ["Customize Octave" (customize-group 'octave) t] + ["Submit Bug Report" report-emacs-bug t])) + +(defvar octave-mode-syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\r " " 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) + (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) + ;; The "b" flag only applies to the second letter of the comstart + ;; and the first letter of the comend, i.e. the "4b" below is ineffective. + ;; If we try to put `b' on the single-line comments, we get a similar + ;; problem where the % and # chars appear as first chars of the 2-char + ;; comend, so the multi-line ender is also turned into style-b. + ;; So we need the new "c" comment style. + (modify-syntax-entry ?\% "< 13" table) + (modify-syntax-entry ?\# "< 13" table) + (modify-syntax-entry ?\{ "(} 2c" table) + (modify-syntax-entry ?\} "){ 4c" table) + (modify-syntax-entry ?\n ">" table) + table) + "Syntax table in use in `octave-mode' buffers.") + +(defcustom octave-font-lock-texinfo-comment t + "Control whether to highlight the texinfo comment block." + :type 'boolean + :group 'octave + :version "24.4") + +(defcustom octave-blink-matching-block t + "Control the blinking of matching Octave block keywords. +Non-nil means show matching begin of block when inserting a space, +newline or semicolon after an else or end keyword." + :type 'boolean + :group 'octave) + +(defcustom octave-block-offset 2 + "Extra indentation applied to statements in Octave block structures." + :type 'integer + :group 'octave) + +(defvar octave-block-comment-start + (concat (make-string 2 octave-comment-char) " ") + "String to insert to start a new Octave comment on an empty line.") + +(defcustom octave-continuation-offset 4 + "Extra indentation applied to Octave continuation lines." + :type 'integer + :group 'octave) + +(eval-and-compile + (defconst octave-continuation-marker-regexp "\\\\\\|\\.\\.\\.")) + +(defvar octave-continuation-regexp + (concat "[^#%\n]*\\(" octave-continuation-marker-regexp + "\\)\\s-*\\(\\s<.*\\)?$")) + +;; Char \ is considered a bad decision for continuing a line. +(defconst octave-continuation-string "..." + "Character string used for Octave continuation lines.") + +(defvar octave-mode-imenu-generic-expression + (list + ;; Functions + (list nil octave-function-header-regexp 3)) + "Imenu expression for Octave mode. See `imenu-generic-expression'.") + +(defcustom octave-mode-hook nil + "Hook to be run when Octave mode is started." + :type 'hook + :group 'octave) + +(defcustom octave-send-show-buffer t + "Non-nil means display `inferior-octave-buffer' after sending to it." + :type 'boolean + :group 'octave) + +(defcustom octave-send-line-auto-forward t + "Control auto-forward after sending to the inferior Octave process. +Non-nil means always go to the next Octave code line after sending." + :type 'boolean + :group 'octave) + +(defcustom octave-send-echo-input t + "Non-nil means echo input sent to the inferior Octave process." + :type 'boolean + :group 'octave) + + +;;; SMIE indentation + +(require 'smie) + +;; Use '__operators__' in Octave REPL to get a full list. +(defconst octave-operator-table + '((assoc ";" "\n") (assoc ",") ; The doc claims they have equal precedence!? + (right "=" "+=" "-=" "*=" "/=") + (assoc "&&") (assoc "||") ; The doc claims they have equal precedence!? + (assoc "&") (assoc "|") ; The doc claims they have equal precedence!? + (nonassoc "<" "<=" "==" ">=" ">" "!=" "~=") + (nonassoc ":") ;No idea what this is. + (assoc "+" "-") + (assoc "*" "/" "\\" ".\\" ".*" "./") + (nonassoc "'" ".'") + (nonassoc "++" "--" "!" "~") ;And unary "+" and "-". + (right "^" "**" ".^" ".**") + ;; It's not really an operator, but for indentation purposes it + ;; could be convenient to treat it as one. + (assoc "..."))) + +(defconst octave-smie-bnf-table + '((atom) + ;; We can't distinguish the first element in a sequence with + ;; precedence grammars, so we can't distinguish the condition + ;; if the `if' from the subsequent body, for example. + ;; This has to be done later in the indentation rules. + (exp (exp "\n" exp) + ;; We need to mention at least one of the operators in this part + ;; of the grammar: if the BNF and the operator table have + ;; no overlap, SMIE can't know how they relate. + (exp ";" exp) + ("try" exp "catch" exp "end_try_catch") + ("try" exp "catch" exp "end") + ("unwind_protect" exp + "unwind_protect_cleanup" exp "end_unwind_protect") + ("unwind_protect" exp "unwind_protect_cleanup" exp "end") + ("for" exp "endfor") + ("for" exp "end") + ("parfor" exp "endparfor") + ("parfor" exp "end") + ("do" exp "until" atom) + ("while" exp "endwhile") + ("while" exp "end") + ("if" exp "endif") + ("if" exp "else" exp "endif") + ("if" exp "elseif" exp "else" exp "endif") + ("if" exp "elseif" exp "elseif" exp "else" exp "endif") + ("if" exp "elseif" exp "elseif" exp "else" exp "end") + ("switch" exp "case" exp "endswitch") + ("switch" exp "case" exp "otherwise" exp "endswitch") + ("switch" exp "case" exp "case" exp "otherwise" exp "endswitch") + ("switch" exp "case" exp "case" exp "otherwise" exp "end") + ("function" exp "endfunction") + ("function" exp "end") + ("enumeration" exp "endenumeration") + ("enumeration" exp "end") + ("events" exp "endevents") + ("events" exp "end") + ("methods" exp "endmethods") + ("methods" exp "end") + ("properties" exp "endproperties") + ("properties" exp "end") + ("classdef" exp "endclassdef") + ("classdef" exp "end")) + ;; (fundesc (atom "=" atom)) + )) + +(defconst octave-smie-grammar + (smie-prec2->grammar + (smie-merge-prec2s + (smie-bnf->prec2 octave-smie-bnf-table + '((assoc "\n" ";"))) + + (smie-precs->prec2 octave-operator-table)))) + +;; Tokenizing needs to be refined so that ";;" is treated as two +;; tokens and also so as to recognize the \n separator (and +;; corresponding continuation lines). + +(defconst octave-operator-regexp + (regexp-opt (apply 'append (mapcar 'cdr octave-operator-table)))) + +(defun octave-smie-backward-token () + (let ((pos (point))) + (forward-comment (- (point))) + (cond + ((and (not (eq (char-before) ?\;)) ;Coalesce ";" and "\n". + (> pos (line-end-position)) + (if (looking-back octave-continuation-marker-regexp (- (point) 3)) + (progn + (goto-char (match-beginning 0)) + (forward-comment (- (point))) + nil) + t) + ;; Ignore it if it's within parentheses. + (let ((ppss (syntax-ppss))) + (not (and (nth 1 ppss) + (eq ?\( (char-after (nth 1 ppss))))))) + (skip-chars-forward " \t") + ;; Why bother distinguishing \n and ;? + ";") ;;"\n" + ((and (looking-back octave-operator-regexp (- (point) 3) 'greedy) + ;; Don't mistake a string quote for a transpose. + (not (looking-back "\\s\"" (1- (point))))) + (goto-char (match-beginning 0)) + (match-string-no-properties 0)) + (t + (smie-default-backward-token))))) + +(defun octave-smie-forward-token () + (skip-chars-forward " \t") + (when (looking-at (eval-when-compile + (concat "\\(" octave-continuation-marker-regexp + "\\)[ \t]*\\($\\|[%#]\\)"))) + (goto-char (match-end 1)) + (forward-comment 1)) + (cond + ((and (looking-at "[%#\n]") + (not (or (save-excursion (skip-chars-backward " \t") + ;; Only add implicit ; when needed. + (or (bolp) (eq (char-before) ?\;))) + ;; Ignore it if it's within parentheses. + (let ((ppss (syntax-ppss))) + (and (nth 1 ppss) + (eq ?\( (char-after (nth 1 ppss)))))))) + (if (eolp) (forward-char 1) (forward-comment 1)) + ;; Why bother distinguishing \n and ;? + ";") ;;"\n" + ((progn (forward-comment (point-max)) nil)) + ((looking-at ";[ \t]*\\($\\|[%#]\\)") + ;; Combine the ; with the subsequent \n. + (goto-char (match-beginning 1)) + (forward-comment 1) + ";") + ((and (looking-at octave-operator-regexp) + ;; Don't mistake a string quote for a transpose. + (not (looking-at "\\s\""))) + (goto-char (match-end 0)) + (match-string-no-properties 0)) + (t + (smie-default-forward-token)))) + +(defun octave-smie-rules (kind token) + (pcase (cons kind token) + ;; We could set smie-indent-basic instead, but that would have two + ;; disadvantages: + ;; - changes to octave-block-offset wouldn't take effect immediately. + ;; - edebug wouldn't show the use of this variable. + (`(:elem . basic) octave-block-offset) + ;; Since "case" is in the same BNF rules as switch..end, SMIE by default + ;; aligns it with "switch". + (`(:before . "case") (if (not (smie-rule-sibling-p)) octave-block-offset)) + (`(:after . ";") + (if (smie-rule-parent-p "classdef" "events" "enumeration" "function" "if" + "while" "else" "elseif" "for" "parfor" + "properties" "methods" "otherwise" "case" + "try" "catch" "unwind_protect" + "unwind_protect_cleanup") + (smie-rule-parent octave-block-offset) + ;; For (invalid) code between switch and case. + ;; (if (smie-parent-p "switch") 4) + nil)))) + +(defun octave-indent-comment () + "A function for `smie-indent-functions' (which see)." + (save-excursion + (back-to-indentation) + (cond + ((octave-in-string-or-comment-p) nil) + ((looking-at-p "\\(\\s<\\)\\1\\{2,\\}") + 0) + ;; Exclude %{, %} and %!. + ((and (looking-at-p "\\s<\\(?:[^{}!]\\|$\\)") + (not (looking-at-p "\\(\\s<\\)\\1"))) + (comment-choose-indent))))) + + +(defvar octave-font-lock-keywords + (list + ;; Fontify all builtin keywords. + (cons (concat "\\_<\\(" + (regexp-opt octave-reserved-words) + "\\)\\_>") + 'font-lock-keyword-face) + ;; Note: 'end' also serves as the last index in an indexing expression. + ;; Ref: http://www.mathworks.com/help/matlab/ref/end.html + (list (lambda (limit) + (while (re-search-forward "\\_<end\\_>" limit 'move) + (let ((beg (match-beginning 0)) + (end (match-end 0))) + (unless (octave-in-string-or-comment-p) + (condition-case nil + (progn + (goto-char beg) + (backward-up-list) + (when (memq (char-after) '(?\( ?\[ ?\{)) + (put-text-property beg end 'face nil)) + (goto-char end)) + (error (goto-char end)))))) + nil)) + ;; Fontify all operators. + (cons octave-operator-regexp 'font-lock-builtin-face) + ;; Fontify all function declarations. + (list octave-function-header-regexp + '(1 font-lock-keyword-face) + '(3 font-lock-function-name-face nil t))) + "Additional Octave expressions to highlight.") + +(defun octave-syntax-propertize-function (start end) + (goto-char start) + (octave-syntax-propertize-sqs end) + (funcall (syntax-propertize-rules + ("\\\\" (0 (when (eq (nth 3 (save-excursion + (syntax-ppss (match-beginning 0)))) + ?\") + (string-to-syntax "\\")))) + ;; Try to distinguish the string-quotes from the transpose-quotes. + ("\\(?:^\\|[[({,; ]\\)\\('\\)" + (1 (prog1 "\"'" (octave-syntax-propertize-sqs end))))) + (point) end)) + +(defun octave-syntax-propertize-sqs (end) + "Propertize the content/end of single-quote strings." + (when (eq (nth 3 (syntax-ppss)) ?\') + ;; A '..' string. + (when (re-search-forward + "\\(?:\\=\\|[^']\\)\\(?:''\\)*\\('\\)\\($\\|[^']\\)" end 'move) + (goto-char (match-beginning 2)) + (when (eq (char-before (match-beginning 1)) ?\\) + ;; Backslash cannot escape a single quote. + (put-text-property (1- (match-beginning 1)) (match-beginning 1) + 'syntax-table (string-to-syntax "."))) + (put-text-property (match-beginning 1) (match-end 1) + 'syntax-table (string-to-syntax "\"'"))))) + +(defvar electric-layout-rules) + +;;;###autoload +(define-derived-mode octave-mode prog-mode "Octave" + "Major mode for editing Octave code. + +Octave is a high-level language, primarily intended for numerical +computations. It provides a convenient command line interface +for solving linear and nonlinear problems numerically. Function +definitions can also be stored in files and used in batch mode." + :abbrev-table octave-abbrev-table + + (smie-setup octave-smie-grammar #'octave-smie-rules + :forward-token #'octave-smie-forward-token + :backward-token #'octave-smie-backward-token) + (setq-local smie-indent-basic 'octave-block-offset) + (add-hook 'smie-indent-functions #'octave-indent-comment nil t) + + (setq-local smie-blink-matching-triggers + (cons ?\; smie-blink-matching-triggers)) + (unless octave-blink-matching-block + (remove-hook 'post-self-insert-hook #'smie-blink-matching-open 'local)) + + (setq-local electric-indent-chars + (cons ?\; electric-indent-chars)) + ;; IIUC matlab-mode takes the opposite approach: it makes RET insert + ;; a ";" at those places where it's correct (i.e. outside of parens). + (setq-local electric-layout-rules '((?\; . after))) + + (setq-local comment-start octave-comment-start) + (setq-local comment-end "") + (setq-local comment-start-skip octave-comment-start-skip) + (setq-local comment-add 1) + + (setq-local parse-sexp-ignore-comments t) + (setq-local paragraph-start (concat "\\s-*$\\|" page-delimiter)) + (setq-local paragraph-separate paragraph-start) + (setq-local paragraph-ignore-fill-prefix t) + (setq-local fill-paragraph-function 'octave-fill-paragraph) + + (setq-local fill-nobreak-predicate + (lambda () (eq (octave-in-string-p) ?'))) + (add-function :around (local 'comment-line-break-function) + #'octave--indent-new-comment-line) + + (setq font-lock-defaults '(octave-font-lock-keywords)) + + (setq-local syntax-propertize-function #'octave-syntax-propertize-function) + + (setq-local imenu-generic-expression octave-mode-imenu-generic-expression) + (setq-local imenu-case-fold-search nil) + + (add-hook 'completion-at-point-functions 'octave-completion-at-point nil t) + (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) + + (easy-menu-add octave-mode-menu)) + + +(defcustom inferior-octave-program "octave" + "Program invoked by `inferior-octave'." + :type 'string + :group 'octave) + +(defcustom inferior-octave-buffer "*Inferior Octave*" + "Name of buffer for running an inferior Octave process." + :type 'string + :group 'octave) + +(defcustom inferior-octave-prompt + "\\(^octave\\(\\|.bin\\|.exe\\)\\(-[.0-9]+\\)?\\(:[0-9]+\\)?\\|^debug\\|^\\)>+ " + "Regexp to match prompts for the inferior Octave process." + :type 'regexp + :group 'octave) + +(defcustom inferior-octave-prompt-read-only comint-prompt-read-only + "If non-nil, the Octave prompt is read only. +See `comint-prompt-read-only' for details." + :type 'boolean + :group 'octave + :version "24.4") + +(defcustom inferior-octave-startup-file + (convert-standard-filename + (concat "~/.emacs-" (file-name-nondirectory inferior-octave-program))) + "Name of the inferior Octave startup file. +The contents of this file are sent to the inferior Octave process on +startup." + :type '(choice (const :tag "None" nil) file) + :group 'octave + :version "24.4") + +(defcustom inferior-octave-startup-args nil + "List of command line arguments for the inferior Octave process. +For example, for suppressing the startup message and using `traditional' +mode, set this to (\"-q\" \"--traditional\")." + :type '(repeat string) + :group 'octave) + +(defcustom inferior-octave-mode-hook nil + "Hook to be run when Inferior Octave mode is started." + :type 'hook + :group 'octave) + +(defvar inferior-octave-process nil) + +(defvar inferior-octave-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map comint-mode-map) + (define-key map "\M-." 'octave-find-definition) + (define-key map "\t" 'completion-at-point) + (define-key map "\C-hd" 'octave-help) + ;; Same as in `shell-mode'. + (define-key map "\M-?" 'comint-dynamic-list-filename-completions) + (define-key map "\C-c\C-l" 'inferior-octave-dynamic-list-input-ring) + (define-key map [menu-bar inout list-history] + '("List Input History" . inferior-octave-dynamic-list-input-ring)) + map) + "Keymap used in Inferior Octave mode.") + +(defvar inferior-octave-mode-syntax-table + (let ((table (make-syntax-table octave-mode-syntax-table))) + table) + "Syntax table in use in inferior-octave-mode buffers.") + +(defvar inferior-octave-font-lock-keywords + (list + (cons inferior-octave-prompt 'font-lock-type-face)) + ;; Could certainly do more font locking in inferior Octave ... + "Additional expressions to highlight in Inferior Octave mode.") + +(defvar inferior-octave-output-list nil) +(defvar inferior-octave-output-string nil) +(defvar inferior-octave-receive-in-progress nil) + +(define-obsolete-variable-alias 'inferior-octave-startup-hook + 'inferior-octave-mode-hook "24.4") + +(defvar inferior-octave-dynamic-complete-functions + '(inferior-octave-completion-at-point comint-filename-completion) + "List of functions called to perform completion for inferior Octave. +This variable is used to initialize `comint-dynamic-complete-functions' +in the Inferior Octave buffer.") + +(defvar info-lookup-mode) + +(define-derived-mode inferior-octave-mode comint-mode "Inferior Octave" + "Major mode for interacting with an inferior Octave process." + :abbrev-table octave-abbrev-table + (setq comint-prompt-regexp inferior-octave-prompt) + + (setq-local comment-start octave-comment-start) + (setq-local comment-end "") + (setq comment-column 32) + (setq-local comment-start-skip octave-comment-start-skip) + + (setq font-lock-defaults '(inferior-octave-font-lock-keywords nil nil)) + + (setq-local info-lookup-mode 'octave-mode) + (setq-local eldoc-documentation-function 'octave-eldoc-function) + + (setq comint-input-ring-file-name + (or (getenv "OCTAVE_HISTFILE") "~/.octave_hist") + comint-input-ring-size (or (getenv "OCTAVE_HISTSIZE") 1024)) + (setq-local comint-dynamic-complete-functions + inferior-octave-dynamic-complete-functions) + (setq-local comint-prompt-read-only inferior-octave-prompt-read-only) + (add-hook 'comint-input-filter-functions + 'inferior-octave-directory-tracker nil t) + ;; http://thread.gmane.org/gmane.comp.gnu.octave.general/48572 + (add-hook 'window-configuration-change-hook + 'inferior-octave-track-window-width-change nil t) + (comint-read-input-ring t)) + +;;;###autoload +(defun inferior-octave (&optional arg) + "Run an inferior Octave process, I/O via `inferior-octave-buffer'. +This buffer is put in Inferior Octave mode. See `inferior-octave-mode'. + +Unless ARG is non-nil, switches to this buffer. + +The elements of the list `inferior-octave-startup-args' are sent as +command line arguments to the inferior Octave process on startup. + +Additional commands to be executed on startup can be provided either in +the file specified by `inferior-octave-startup-file' or by the default +startup file, `~/.emacs-octave'." + (interactive "P") + (let ((buffer (get-buffer-create inferior-octave-buffer))) + (unless arg + (pop-to-buffer buffer)) + (unless (comint-check-proc buffer) + (with-current-buffer buffer + (inferior-octave-startup) + (inferior-octave-mode))) + buffer)) + +;;;###autoload +(defalias 'run-octave 'inferior-octave) + +(defun inferior-octave-startup () + "Start an inferior Octave process." + (let ((proc (comint-exec-1 + (substring inferior-octave-buffer 1 -1) + inferior-octave-buffer + inferior-octave-program + (append (list "-i" "--no-line-editing") + ;; --no-gui is introduced in Octave > 3.7 + (when (zerop (process-file inferior-octave-program + nil nil nil + "--no-gui" "--help")) + (list "--no-gui")) + inferior-octave-startup-args)))) + (set-process-filter proc 'inferior-octave-output-digest) + (setq inferior-octave-process proc + inferior-octave-output-list nil + inferior-octave-output-string nil + inferior-octave-receive-in-progress t) + + ;; This may look complicated ... However, we need to make sure that + ;; we additional startup code only AFTER Octave is ready (otherwise, + ;; output may be mixed up). Hence, we need to digest the Octave + ;; output to see when it issues a prompt. + (while inferior-octave-receive-in-progress + (or (process-live-p inferior-octave-process) + (error "Process `%s' died" inferior-octave-process)) + (accept-process-output inferior-octave-process)) + (goto-char (point-max)) + (set-marker (process-mark proc) (point)) + (insert-before-markers + (concat + (if (not (bobp)) " \n") + (if inferior-octave-output-list + (concat (mapconcat + 'identity inferior-octave-output-list "\n") + "\n")))) + + ;; An empty secondary prompt, as e.g. obtained by '--braindead', + ;; means trouble. + (inferior-octave-send-list-and-digest (list "PS2\n")) + (when (string-match "\\(PS2\\|ans\\) = *$" + (car inferior-octave-output-list)) + (inferior-octave-send-list-and-digest (list "PS2 (\"> \");\n"))) + + (inferior-octave-send-list-and-digest + (list "disp(getenv(\"OCTAVE_SRCDIR\"))\n")) + (process-put proc 'octave-srcdir + (unless (equal (car inferior-octave-output-list) "") + (car inferior-octave-output-list))) + + ;; O.K., now we are ready for the Inferior Octave startup commands. + (inferior-octave-send-list-and-digest + (list "more off;\n" + (unless (equal inferior-octave-output-string ">> ") + "PS1 (\"\\\\s> \");\n") + (when (and inferior-octave-startup-file + (file-exists-p inferior-octave-startup-file)) + (format "source (\"%s\");\n" inferior-octave-startup-file)))) + (when inferior-octave-output-list + (insert-before-markers + (mapconcat 'identity inferior-octave-output-list "\n"))) + + ;; And finally, everything is back to normal. + (set-process-filter proc 'comint-output-filter) + ;; Just in case, to be sure a cd in the startup file + ;; won't have detrimental effects. + (inferior-octave-resync-dirs) + ;; Generate a proper prompt, which is critical to + ;; `comint-history-isearch-backward-regexp'. Bug#14433. + (comint-send-string proc "\n"))) + +(defvar inferior-octave-completion-table + ;; + ;; Use cache to avoid repetitive computation of completions due to + ;; bug#11906 - http://debbugs.gnu.org/11906 - which may cause + ;; noticeable delay. CACHE: (CMD TIME VALUE). + (let ((cache)) + (completion-table-dynamic + (lambda (command) + (unless (and (equal (car cache) command) + (< (float-time) (+ 5 (cadr cache)))) + (inferior-octave-send-list-and-digest + (list (concat "completion_matches (\"" command "\");\n"))) + (setq cache (list command (float-time) + (delete-consecutive-dups + (sort inferior-octave-output-list 'string-lessp))))) + (car (cddr cache)))))) + +(defun inferior-octave-completion-at-point () + "Return the data to complete the Octave symbol at point." + ;; http://debbugs.gnu.org/14300 + (let* ((filecomp (string-match-p + "/" (or (comint--match-partial-filename) ""))) + (end (point)) + (start + (unless filecomp + (save-excursion + (skip-syntax-backward "w_" (comint-line-beginning-position)) + (point))))) + (when (and start (> end start)) + (list start end (completion-table-in-turn + inferior-octave-completion-table + 'comint-completion-file-name-table))))) + +(define-obsolete-function-alias 'inferior-octave-complete + 'completion-at-point "24.1") + +(defun inferior-octave-dynamic-list-input-ring () + "List the buffer's input history in a help buffer." + ;; We cannot use `comint-dynamic-list-input-ring', because it replaces + ;; "completion" by "history reference" ... + (interactive) + (if (or (not (ring-p comint-input-ring)) + (ring-empty-p comint-input-ring)) + (message "No history") + (let ((history nil) + (history-buffer " *Input History*") + (index (1- (ring-length comint-input-ring))) + (conf (current-window-configuration))) + ;; We have to build up a list ourselves from the ring vector. + (while (>= index 0) + (setq history (cons (ring-ref comint-input-ring index) history) + index (1- index))) + ;; Change "completion" to "history reference" + ;; to make the display accurate. + (with-output-to-temp-buffer history-buffer + (display-completion-list history) + (set-buffer history-buffer)) + (message "Hit space to flush") + (let ((ch (read-event))) + (if (eq ch ?\ ) + (set-window-configuration conf) + (setq unread-command-events (list ch))))))) + +(defun inferior-octave-output-digest (_proc string) + "Special output filter for the inferior Octave process. +Save all output between newlines into `inferior-octave-output-list', and +the rest to `inferior-octave-output-string'." + (setq string (concat inferior-octave-output-string string)) + (while (string-match "\n" string) + (setq inferior-octave-output-list + (append inferior-octave-output-list + (list (substring string 0 (match-beginning 0)))) + string (substring string (match-end 0)))) + (if (string-match inferior-octave-prompt string) + (setq inferior-octave-receive-in-progress nil)) + (setq inferior-octave-output-string string)) + +(defun inferior-octave-check-process () + (or (and inferior-octave-process + (process-live-p inferior-octave-process)) + (error (substitute-command-keys + "No inferior octave process running. Type \\[run-octave]")))) + +(defun inferior-octave-send-list-and-digest (list) + "Send LIST to the inferior Octave process and digest the output. +The elements of LIST have to be strings and are sent one by one. All +output is passed to the filter `inferior-octave-output-digest'." + (inferior-octave-check-process) + (let* ((proc inferior-octave-process) + (filter (process-filter proc)) + string) + (set-process-filter proc 'inferior-octave-output-digest) + (setq inferior-octave-output-list nil) + (unwind-protect + (while (setq string (car list)) + (setq inferior-octave-output-string nil + inferior-octave-receive-in-progress t) + (comint-send-string proc string) + (while inferior-octave-receive-in-progress + (accept-process-output proc)) + (setq list (cdr list))) + (set-process-filter proc filter)))) + +(defvar inferior-octave-directory-tracker-resync nil) +(make-variable-buffer-local 'inferior-octave-directory-tracker-resync) + +(defun inferior-octave-directory-tracker (string) + "Tracks `cd' commands issued to the inferior Octave process. +Use \\[inferior-octave-resync-dirs] to resync if Emacs gets confused." + (when inferior-octave-directory-tracker-resync + (setq inferior-octave-directory-tracker-resync nil) + (inferior-octave-resync-dirs)) + (cond + ((string-match "^[ \t]*cd[ \t;]*$" string) + (cd "~")) + ((string-match "^[ \t]*cd[ \t]+\\([^ \t\n;]*\\)[ \t\n;]*" string) + (condition-case err + (cd (match-string 1 string)) + (error (setq inferior-octave-directory-tracker-resync t) + (message "%s: `%s'" + (error-message-string err) + (match-string 1 string))))))) + +(defun inferior-octave-resync-dirs () + "Resync the buffer's idea of the current directory. +This command queries the inferior Octave process about its current +directory and makes this the current buffer's default directory." + (interactive) + (inferior-octave-send-list-and-digest '("disp (pwd ())\n")) + (cd (car inferior-octave-output-list))) + +(defcustom inferior-octave-minimal-columns 80 + "The minimal column width for the inferior Octave process." + :type 'integer + :group 'octave + :version "24.4") + +(defvar inferior-octave-last-column-width nil) + +(defun inferior-octave-track-window-width-change () + ;; http://thread.gmane.org/gmane.comp.gnu.octave.general/48572 + (let ((width (max inferior-octave-minimal-columns (window-width)))) + (unless (eq inferior-octave-last-column-width width) + (setq-local inferior-octave-last-column-width width) + (when (and inferior-octave-process + (process-live-p inferior-octave-process)) + (inferior-octave-send-list-and-digest + (list (format "putenv(\"COLUMNS\", \"%s\");\n" width))))))) + + +;;; Miscellaneous useful functions + +(defun octave-in-comment-p () + "Return non-nil if point is inside an Octave comment." + (nth 4 (syntax-ppss))) + +(defun octave-in-string-p () + "Return non-nil if point is inside an Octave string." + (nth 3 (syntax-ppss))) + +(defun octave-in-string-or-comment-p () + "Return non-nil if point is inside an Octave string or comment." + (nth 8 (syntax-ppss))) + +(defun octave-looking-at-kw (regexp) + "Like `looking-at', but sets `case-fold-search' nil." + (let ((case-fold-search nil)) + (looking-at regexp))) + +(defun octave-maybe-insert-continuation-string () + (if (or (octave-in-comment-p) + (save-excursion + (beginning-of-line) + (looking-at octave-continuation-regexp))) + nil + (delete-horizontal-space) + (insert (concat " " octave-continuation-string)))) + +(defun octave-completing-read () + (let ((def (or (thing-at-point 'symbol) + (save-excursion + (skip-syntax-backward "-(") + (thing-at-point 'symbol))))) + (completing-read + (format (if def "Function (default %s): " + "Function: ") def) + inferior-octave-completion-table + nil nil nil nil def))) + +(defun octave-goto-function-definition (fn) + "Go to the function definition of FN in current buffer." + (goto-char (point-min)) + (let ((search + (lambda (re sub) + (let (done) + (while (and (not done) (re-search-forward re nil t)) + (when (and (equal (match-string sub) fn) + (not (nth 8 (syntax-ppss)))) + (setq done t))) + (or done (goto-char (point-min))))))) + (pcase (file-name-extension (buffer-file-name)) + (`"cc" (funcall search + "\\_<DEFUN\\(?:_DLD\\)?\\s-*(\\s-*\\(\\(?:\\sw\\|\\s_\\)+\\)" 1)) + (t (funcall search octave-function-header-regexp 3))))) + +(defun octave-function-file-p () + "Return non-nil if the first token is \"function\". +The value is (START END NAME-START NAME-END) of the function." + (save-excursion + (goto-char (point-min)) + (when (equal (funcall smie-forward-token-function) "function") + (forward-word -1) + (let* ((start (point)) + (end (progn (forward-sexp 1) (point))) + (name (when (progn + (goto-char start) + (re-search-forward octave-function-header-regexp + end t)) + (list (match-beginning 3) (match-end 3))))) + (cons start (cons end name)))))) + +;; Like forward-comment but stop at non-comment blank +(defun octave-skip-comment-forward (limit) + (let ((ppss (syntax-ppss))) + (if (nth 4 ppss) + (goto-char (nth 8 ppss)) + (goto-char (or (comment-search-forward limit t) (point))))) + (while (and (< (point) limit) (looking-at-p "\\s<")) + (forward-comment 1))) + +;;; First non-copyright comment block +(defun octave-function-file-comment () + "Beginning and end positions of the function file comment." + (save-excursion + (goto-char (point-min)) + ;; Copyright block: octave/libinterp/parse-tree/lex.ll around line 1634 + (while (save-excursion + (when (comment-search-forward (point-max) t) + (when (eq (char-after) ?\{) ; case of block comment + (forward-char 1)) + (skip-syntax-forward "-") + (let ((case-fold-search t)) + (looking-at-p "\\(?:copyright\\|author\\)\\_>")))) + (octave-skip-comment-forward (point-max))) + (let ((beg (comment-search-forward (point-max) t))) + (when beg + (goto-char beg) + (octave-skip-comment-forward (point-max)) + (list beg (point)))))) + +(defun octave-sync-function-file-names () + "Ensure function name agree with function file name. +See Info node `(octave)Function Files'." + (interactive) + (when buffer-file-name + (pcase-let ((`(,start ,_end ,name-start ,name-end) + (octave-function-file-p))) + (when (and start name-start) + (let* ((func (buffer-substring name-start name-end)) + (file (file-name-sans-extension + (file-name-nondirectory buffer-file-name))) + (help-form (format "\ +a: Use function name `%s' +b: Use file name `%s' +q: Don't fix\n" func file)) + (c (unless (equal file func) + (save-window-excursion + (help-form-show) + (read-char-choice + "Which name to use? (a/b/q) " '(?a ?b ?q)))))) + (pcase c + (`?a (let ((newname (expand-file-name + (concat func (file-name-extension + buffer-file-name t))))) + (when (or (not (file-exists-p newname)) + (yes-or-no-p + (format "Target file %s exists; proceed? " newname))) + (when (file-exists-p buffer-file-name) + (rename-file buffer-file-name newname t)) + (set-visited-file-name newname)))) + (`?b (save-excursion + (goto-char name-start) + (delete-region name-start name-end) + (insert file))))))))) + +(defun octave-update-function-file-comment (beg end) + "Query replace function names in function file comment." + (interactive + (progn + (barf-if-buffer-read-only) + (if (use-region-p) + (list (region-beginning) (region-end)) + (or (octave-function-file-comment) + (error "No function file comment found"))))) + (save-excursion + (let* ((bounds (or (octave-function-file-p) + (error "Not in a function file buffer"))) + (func (if (cddr bounds) + (apply #'buffer-substring (cddr bounds)) + (error "Function name not found"))) + (old-func (progn + (goto-char beg) + (when (re-search-forward + "[=}]\\s-*\\(\\(?:\\sw\\|\\s_\\)+\\)\\_>" + (min (line-end-position 4) end) + t) + (match-string 1)))) + (old-func (read-string (format (if old-func + "Name to replace (default %s): " + "Name to replace: ") + old-func) + nil nil old-func))) + (if (and func old-func (not (equal func old-func))) + (perform-replace old-func func 'query + nil 'delimited nil nil beg end) + (message "Function names match"))))) + +(defface octave-function-comment-block + '((t (:inherit font-lock-doc-face))) + "Face used to highlight function comment block." + :group 'octave) + +(eval-when-compile (require 'texinfo)) + +(defun octave-font-lock-texinfo-comment () + (let ((kws + (eval-when-compile + (delq nil (mapcar + (lambda (kw) + (if (numberp (nth 1 kw)) + `(,(nth 0 kw) ,(nth 1 kw) ,(nth 2 kw) prepend) + (message "Ignoring Texinfo highlight: %S" kw))) + texinfo-font-lock-keywords))))) + (font-lock-add-keywords + nil + `((,(lambda (limit) + (while (and (< (point) limit) + (search-forward "-*- texinfo -*-" limit t) + (octave-in-comment-p)) + (let ((beg (nth 8 (syntax-ppss))) + (end (progn + (octave-skip-comment-forward (point-max)) + (point)))) + (put-text-property beg end 'font-lock-multiline t) + (font-lock-prepend-text-property + beg end 'face 'octave-function-comment-block) + (dolist (kw kws) + (goto-char beg) + (while (re-search-forward (car kw) end 'move) + (font-lock-apply-highlight (cdr kw)))))) + nil))) + 'append))) + + +;;; Indentation + +(defun octave-indent-new-comment-line (&optional soft) + ;; FIXME: C-M-j should probably be bound globally to a function like + ;; this one. + "Break Octave line at point, continuing comment if within one. +Insert `octave-continuation-string' before breaking the line +unless inside a list. Signal an error if within a single-quoted +string." + (interactive) + (funcall comment-line-break-function soft)) + +(defun octave--indent-new-comment-line (orig &rest args) + (cond + ((octave-in-comment-p) nil) + ((eq (octave-in-string-p) ?') + (error "Cannot split a single-quoted string")) + ((eq (octave-in-string-p) ?\") + (insert octave-continuation-string)) + (t + (delete-horizontal-space) + (unless (and (cadr (syntax-ppss)) + (eq (char-after (cadr (syntax-ppss))) ?\()) + (insert " " octave-continuation-string)))) + (apply orig args) + (indent-according-to-mode)) + +(define-obsolete-function-alias + 'octave-indent-defun 'prog-indent-sexp "24.4") + + +;;; Motion +(defun octave-next-code-line (&optional arg) + "Move ARG lines of Octave code forward (backward if ARG is negative). +Skips past all empty and comment lines. Default for ARG is 1. + +On success, return 0. Otherwise, go as far as possible and return -1." + (interactive "p") + (or arg (setq arg 1)) + (beginning-of-line) + (let ((n 0) + (inc (if (> arg 0) 1 -1))) + (while (and (/= arg 0) (= n 0)) + (setq n (forward-line inc)) + (while (and (= n 0) + (looking-at "\\s-*\\($\\|\\s<\\)")) + (setq n (forward-line inc))) + (setq arg (- arg inc))) + n)) + +(defun octave-previous-code-line (&optional arg) + "Move ARG lines of Octave code backward (forward if ARG is negative). +Skips past all empty and comment lines. Default for ARG is 1. + +On success, return 0. Otherwise, go as far as possible and return -1." + (interactive "p") + (or arg (setq arg 1)) + (octave-next-code-line (- arg))) + +(defun octave-beginning-of-line () + "Move point to beginning of current Octave line. +If on an empty or comment line, go to the beginning of that line. +Otherwise, move backward to the beginning of the first Octave code line +which is not inside a continuation statement, i.e., which does not +follow a code line ending with `...' or is inside an open +parenthesis list." + (interactive) + (beginning-of-line) + (unless (looking-at "\\s-*\\($\\|\\s<\\)") + (while (or (when (cadr (syntax-ppss)) + (goto-char (cadr (syntax-ppss))) + (beginning-of-line) + t) + (and (or (looking-at "\\s-*\\($\\|\\s<\\)") + (save-excursion + (if (zerop (octave-previous-code-line)) + (looking-at octave-continuation-regexp)))) + (zerop (forward-line -1))))))) + +(defun octave-end-of-line () + "Move point to end of current Octave line. +If on an empty or comment line, go to the end of that line. +Otherwise, move forward to the end of the first Octave code line which +does not end with `...' or is inside an open parenthesis list." + (interactive) + (end-of-line) + (unless (save-excursion + (beginning-of-line) + (looking-at "\\s-*\\($\\|\\s<\\)")) + (while (or (when (cadr (syntax-ppss)) + (condition-case nil + (progn + (up-list 1) + (end-of-line) + t) + (error nil))) + (and (save-excursion + (beginning-of-line) + (or (looking-at "\\s-*\\($\\|\\s<\\)") + (looking-at octave-continuation-regexp))) + (zerop (forward-line 1))))) + (end-of-line))) + +(defun octave-mark-block () + "Put point at the beginning of this Octave block, mark at the end. +The block marked is the one that contains point or follows point." + (interactive) + (if (and (looking-at "\\sw\\|\\s_") + (looking-back "\\sw\\|\\s_" (1- (point)))) + (skip-syntax-forward "w_")) + (unless (or (looking-at "\\s(") + (save-excursion + (let* ((token (funcall smie-forward-token-function)) + (level (assoc token smie-grammar))) + (and level (not (numberp (cadr level))))))) + (backward-up-list 1)) + (mark-sexp)) + +(defun octave-beginning-of-defun (&optional arg) + "Octave-specific `beginning-of-defun-function' (which see)." + (or arg (setq arg 1)) + ;; Move out of strings or comments. + (when (octave-in-string-or-comment-p) + (goto-char (octave-in-string-or-comment-p))) + (letrec ((orig (point)) + (toplevel (lambda (pos) + (condition-case nil + (progn + (backward-up-list 1) + (funcall toplevel (point))) + (scan-error pos))))) + (goto-char (funcall toplevel (point))) + (when (and (> arg 0) (/= orig (point))) + (setq arg (1- arg))) + (forward-sexp (- arg)) + (and (< arg 0) (forward-sexp -1)) + (/= orig (point)))) + +(defun octave-fill-paragraph (&optional _arg) + "Fill paragraph of Octave code, handling Octave comments." + ;; FIXME: difference with generic fill-paragraph: + ;; - code lines are only split, never joined. + ;; - \n that end comments are never removed. + ;; - insert continuation marker when splitting code lines. + (interactive "P") + (save-excursion + (let ((end (progn (forward-paragraph) (copy-marker (point) t))) + (beg (progn + (forward-paragraph -1) + (skip-chars-forward " \t\n") + (beginning-of-line) + (point))) + (cfc (current-fill-column)) + comment-prefix) + (goto-char beg) + (while (< (point) end) + (condition-case nil + (indent-according-to-mode) + (error nil)) + (move-to-column cfc) + ;; First check whether we need to combine non-empty comment lines + (if (and (< (current-column) cfc) + (octave-in-comment-p) + (not (save-excursion + (beginning-of-line) + (looking-at "^\\s-*\\s<+\\s-*$")))) + ;; This is a nonempty comment line which does not extend + ;; past the fill column. If it is followed by a nonempty + ;; comment line with the same comment prefix, try to + ;; combine them, and repeat this until either we reach the + ;; fill-column or there is nothing more to combine. + (progn + ;; Get the comment prefix + (save-excursion + (beginning-of-line) + (while (and (re-search-forward "\\s<+") + (not (octave-in-comment-p)))) + (setq comment-prefix (match-string 0))) + ;; And keep combining ... + (while (and (< (current-column) cfc) + (save-excursion + (forward-line 1) + (and (looking-at + (concat "^\\s-*" + comment-prefix + "\\S<")) + (not (looking-at + (concat "^\\s-*" + comment-prefix + "\\s-*$")))))) + (delete-char 1) + (re-search-forward comment-prefix) + (delete-region (match-beginning 0) (match-end 0)) + (fixup-whitespace) + (move-to-column cfc)))) + ;; We might also try to combine continued code lines> Perhaps + ;; some other time ... + (skip-chars-forward "^ \t\n") + (delete-horizontal-space) + (if (or (< (current-column) cfc) + (and (= (current-column) cfc) (eolp))) + (forward-line 1) + (if (not (eolp)) (insert " ")) + (or (funcall normal-auto-fill-function) + (forward-line 1)))) + t))) + +;;; Completions + +(defun octave-completion-at-point () + "Find the text to complete and the corresponding table." + (let* ((beg (save-excursion (skip-syntax-backward "w_") (point))) + (end (point))) + (if (< beg (point)) + ;; Extend region past point, if applicable. + (save-excursion (skip-syntax-forward "w_") + (setq end (point)))) + (when (> end beg) + (list beg end (or (and inferior-octave-process + (process-live-p inferior-octave-process) + inferior-octave-completion-table) + octave-reserved-words))))) + +(define-obsolete-function-alias 'octave-complete-symbol + 'completion-at-point "24.1") + +;;; Electric characters && friends +(define-skeleton octave-insert-defun + "Insert an Octave function skeleton. +Prompt for the function's name, arguments and return values (to be +entered without parens)." + (let* ((defname (file-name-sans-extension (buffer-name))) + (name (read-string (format "Function name (default %s): " defname) + nil nil defname)) + (args (read-string "Arguments: ")) + (vals (read-string "Return values: "))) + (format "%s%s (%s)" + (cond + ((string-equal vals "") vals) + ((string-match "[ ,]" vals) (concat "[" vals "] = ")) + (t (concat vals " = "))) + name + args)) + \n octave-block-comment-start "usage: " str \n + octave-block-comment-start '(delete-horizontal-space) \n + octave-block-comment-start '(delete-horizontal-space) \n + "function " > str \n + _ \n + "endfunction" > \n) + +;;; Communication with the inferior Octave process +(defun octave-kill-process () + "Kill inferior Octave process and its buffer." + (interactive) + (if inferior-octave-process + (progn + (process-send-string inferior-octave-process "quit;\n") + (accept-process-output inferior-octave-process))) + (if inferior-octave-buffer + (kill-buffer inferior-octave-buffer))) + +(defun octave-show-process-buffer () + "Make sure that `inferior-octave-buffer' is displayed." + (interactive) + (if (get-buffer inferior-octave-buffer) + (display-buffer inferior-octave-buffer) + (message "No buffer named %s" inferior-octave-buffer))) + +(defun octave-hide-process-buffer () + "Delete all windows that display `inferior-octave-buffer'." + (interactive) + (if (get-buffer inferior-octave-buffer) + (delete-windows-on inferior-octave-buffer) + (message "No buffer named %s" inferior-octave-buffer))) + +(defun octave-send-region (beg end) + "Send current region to the inferior Octave process." + (interactive "r") + (inferior-octave t) + (let ((proc inferior-octave-process) + (string (buffer-substring-no-properties beg end)) + line) + (with-current-buffer inferior-octave-buffer + (setq inferior-octave-output-list nil) + (while (not (string-equal string "")) + (if (string-match "\n" string) + (setq line (substring string 0 (match-beginning 0)) + string (substring string (match-end 0))) + (setq line string string "")) + (setq inferior-octave-receive-in-progress t) + (inferior-octave-send-list-and-digest (list (concat line "\n"))) + (while inferior-octave-receive-in-progress + (accept-process-output proc)) + (insert-before-markers + (mapconcat 'identity + (append + (if octave-send-echo-input (list line) (list "")) + inferior-octave-output-list + (list inferior-octave-output-string)) + "\n"))))) + (if octave-send-show-buffer + (display-buffer inferior-octave-buffer))) + +(defun octave-send-block () + "Send current Octave block to the inferior Octave process." + (interactive) + (save-excursion + (octave-mark-block) + (octave-send-region (point) (mark)))) + +(defun octave-send-defun () + "Send current Octave function to the inferior Octave process." + (interactive) + (save-excursion + (mark-defun) + (octave-send-region (point) (mark)))) + +(defun octave-send-line (&optional arg) + "Send current Octave code line to the inferior Octave process. +With positive prefix ARG, send that many lines. +If `octave-send-line-auto-forward' is non-nil, go to the next unsent +code line." + (interactive "P") + (or arg (setq arg 1)) + (if (> arg 0) + (let (beg end) + (beginning-of-line) + (setq beg (point)) + (octave-next-code-line (- arg 1)) + (end-of-line) + (setq end (point)) + (if octave-send-line-auto-forward + (octave-next-code-line 1)) + (octave-send-region beg end)))) + +(defun octave-eval-print-last-sexp () + "Evaluate Octave sexp before point and print value into current buffer." + (interactive) + (inferior-octave t) + (let ((standard-output (current-buffer)) + (print-escape-newlines nil) + (opoint (point))) + (terpri) + (prin1 + (save-excursion + (forward-sexp -1) + (inferior-octave-send-list-and-digest + (list (concat (buffer-substring-no-properties (point) opoint) + "\n"))) + (mapconcat 'identity inferior-octave-output-list "\n"))) + (terpri))) + + + +(defcustom octave-eldoc-message-style 'auto + "Octave eldoc message style: auto, oneline, multiline." + :type '(choice (const :tag "Automatic" auto) + (const :tag "One Line" oneline) + (const :tag "Multi Line" multiline)) + :group 'octave + :version "24.4") + +;; (FN SIGNATURE1 SIGNATURE2 ...) +(defvar octave-eldoc-cache nil) + +(defun octave-eldoc-function-signatures (fn) + (unless (equal fn (car octave-eldoc-cache)) + (inferior-octave-send-list-and-digest + (list (format "\ +if ismember(exist(\"%s\"), [2 3 5 103]) print_usage(\"%s\") endif\n" + fn fn))) + (let (result) + (dolist (line inferior-octave-output-list) + (when (string-match + "\\s-*\\(?:--[^:]+\\|usage\\):\\s-*\\(.*\\)$" + line) + (push (match-string 1 line) result))) + (setq octave-eldoc-cache + (cons (substring-no-properties fn) + (nreverse result))))) + (cdr octave-eldoc-cache)) + +(defun octave-eldoc-function () + "A function for `eldoc-documentation-function' (which see)." + (when (and inferior-octave-process + (process-live-p inferior-octave-process)) + (let* ((ppss (syntax-ppss)) + (paren-pos (cadr ppss)) + (fn (save-excursion + (if (and paren-pos + ;; PAREN-POS must be after the prompt + (>= paren-pos + (if (eq (get-buffer-process (current-buffer)) + inferior-octave-process) + (process-mark inferior-octave-process) + (point-min))) + (or (not (eq (get-buffer-process (current-buffer)) + inferior-octave-process)) + (< (process-mark inferior-octave-process) + paren-pos)) + (eq (char-after paren-pos) ?\()) + (goto-char paren-pos) + (setq paren-pos nil)) + (when (or (< (skip-syntax-backward "-") 0) paren-pos) + (thing-at-point 'symbol)))) + (sigs (and fn (octave-eldoc-function-signatures fn))) + (oneline (mapconcat 'identity sigs + (propertize " | " 'face 'warning))) + (multiline (mapconcat (lambda (s) (concat "-- " s)) sigs "\n"))) + ;; + ;; Return the value according to style. + (pcase octave-eldoc-message-style + (`auto (if (< (length oneline) (window-width (minibuffer-window))) + oneline + multiline)) + (`oneline oneline) + (`multiline multiline))))) + +(defcustom octave-help-buffer "*Octave Help*" + "Buffer name for `octave-help'." + :type 'string + :group 'octave + :version "24.4") + +(define-button-type 'octave-help-file + 'follow-link t + 'action #'help-button-action + 'help-function 'octave-find-definition) + +(define-button-type 'octave-help-function + 'follow-link t + 'action (lambda (b) + (octave-help + (buffer-substring (button-start b) (button-end b))))) + +(defvar octave-help-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\M-." 'octave-find-definition) + (define-key map "\C-hd" 'octave-help) + map)) + +(define-derived-mode octave-help-mode help-mode "OctHelp" + "Major mode for displaying Octave documentation." + :abbrev-table nil + :syntax-table octave-mode-syntax-table + (eval-and-compile (require 'help-mode)) + ;; Mostly stolen from `help-make-xrefs'. + (let ((inhibit-read-only t)) + (setq-local info-lookup-mode 'octave-mode) + ;; Delete extraneous newlines at the end of the docstring + (goto-char (point-max)) + (while (and (not (bobp)) (bolp)) + (delete-char -1)) + (insert "\n") + (when (or help-xref-stack help-xref-forward-stack) + (insert "\n")) + (when help-xref-stack + (help-insert-xref-button help-back-label 'help-back + (current-buffer))) + (when help-xref-forward-stack + (when help-xref-stack + (insert "\t")) + (help-insert-xref-button help-forward-label 'help-forward + (current-buffer))) + (when (or help-xref-stack help-xref-forward-stack) + (insert "\n")))) + +(defvar octave-help-mode-finish-hook nil + "Octave specific hook for `temp-buffer-show-hook'.") + +(defun octave-help-mode-finish () + (when (eq major-mode 'octave-help-mode) + (run-hooks 'octave-help-mode-finish-hook))) + +(add-hook 'temp-buffer-show-hook 'octave-help-mode-finish) + +(defun octave-help (fn) + "Display the documentation of FN." + (interactive (list (octave-completing-read))) + (inferior-octave-send-list-and-digest + (list (format "help \"%s\"\n" fn))) + (let ((lines inferior-octave-output-list) + (inhibit-read-only t)) + (when (string-match "error: \\(.*\\)$" (car lines)) + (error "%s" (match-string 1 (car lines)))) + (with-help-window octave-help-buffer + (princ (mapconcat 'identity lines "\n")) + (with-current-buffer octave-help-buffer + ;; Bound to t so that `help-buffer' returns current buffer for + ;; `help-setup-xref'. + (let ((help-xref-following t)) + (help-setup-xref (list 'octave-help fn) + (called-interactively-p 'interactive))) + ;; Note: can be turned off by suppress_verbose_help_message. + ;; + ;; Remove boring trailing text: Additional help for built-in functions + ;; and operators ... + (goto-char (point-max)) + (when (search-backward "\n\n\n" nil t) + (goto-char (match-beginning 0)) + (delete-region (point) (point-max))) + ;; File name highlight + (goto-char (point-min)) + (when (re-search-forward "from the file \\(.*\\)$" + (line-end-position) + t) + (let* ((file (match-string 1)) + (dir (file-name-directory + (directory-file-name (file-name-directory file))))) + (replace-match "" nil nil nil 1) + (insert "`") + ;; Include the parent directory which may be regarded as + ;; the category for the FN. + (help-insert-xref-button (file-relative-name file dir) + 'octave-help-file fn) + (insert "'"))) + ;; Make 'See also' clickable + (with-syntax-table octave-mode-syntax-table + (when (re-search-forward "^\\s-*See also:" nil t) + (let ((end (save-excursion (re-search-forward "^\\s-*$" nil t)))) + (while (re-search-forward "\\_<\\(?:\\sw\\|\\s_\\)+\\_>" end t) + (make-text-button (match-beginning 0) (match-end 0) + :type 'octave-help-function))))) + (octave-help-mode))))) + +(defcustom octave-source-directories nil + "A list of directories for Octave sources. +If the environment variable OCTAVE_SRCDIR is set, it is searched first." + :type '(repeat directory) + :group 'octave + :version "24.4") + +(defun octave-source-directories () + (let ((srcdir (or (and inferior-octave-process + (process-get inferior-octave-process 'octave-srcdir)) + (getenv "OCTAVE_SRCDIR")))) + (if srcdir + (cons srcdir octave-source-directories) + octave-source-directories))) + +(defvar octave-find-definition-filename-function + #'octave-find-definition-default-filename) + +(defun octave-find-definition-default-filename (name) + "Default value for `octave-find-definition-filename-function'." + (pcase (file-name-extension name) + (`"oct" + (octave-find-definition-default-filename + (concat "libinterp/dldfcn/" + (file-name-sans-extension (file-name-nondirectory name)) + ".cc"))) + (`"cc" + (let ((file (or (locate-file name (octave-source-directories)) + (locate-file (file-name-nondirectory name) + (octave-source-directories))))) + (or (and file (file-exists-p file)) + (error "File `%s' not found" name)) + file)) + (`"mex" + (if (yes-or-no-p (format "File `%s' may be binary; open? " + (file-name-nondirectory name))) + name + (user-error "Aborted"))) + (t name))) + +(defvar find-tag-marker-ring) + +(defun octave-find-definition (fn) + "Find the definition of FN. +Functions implemented in C++ can be found if +`octave-source-directories' is set correctly." + (interactive (list (octave-completing-read))) + (inferior-octave-send-list-and-digest + ;; help NAME is more verbose + (list (format "\ +if iskeyword(\"%s\") disp(\"`%s' is a keyword\") else which(\"%s\") endif\n" + fn fn fn))) + (let* ((line (car inferior-octave-output-list)) + (file (when (and line (string-match "from the file \\(.*\\)$" line)) + (match-string 1 line)))) + (if (not file) + (user-error "%s" (or line (format "`%s' not found" fn))) + (require 'etags) + (ring-insert find-tag-marker-ring (point-marker)) + (setq file (funcall octave-find-definition-filename-function file)) + (when file + (find-file file) + (octave-goto-function-definition fn))))) + + +(provide 'octave) +;;; octave.el ends here diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el index 5f78b770936..e608ea8af0e 100644 --- a/lisp/progmodes/opascal.el +++ b/lisp/progmodes/opascal.el @@ -110,29 +110,6 @@ end; end;" regardless of where in the line point is when the TAB command is used." :type 'boolean) -(define-obsolete-variable-alias - 'delphi-comment-face 'opascal-comment-face "24.4") -(defcustom opascal-comment-face 'font-lock-comment-face - "Face used to color OPascal comments." - :type 'face) - -(define-obsolete-variable-alias - 'delphi-string-face 'opascal-string-face "24.4") -(defcustom opascal-string-face 'font-lock-string-face - "Face used to color OPascal strings." - :type 'face) - -(define-obsolete-variable-alias - 'delphi-keyword-face 'opascal-keyword-face "24.4") -(defcustom opascal-keyword-face 'font-lock-keyword-face - "Face used to color OPascal keywords." - :type 'face) - -(define-obsolete-variable-alias 'delphi-other-face 'opascal-other-face "24.4") -(defcustom opascal-other-face nil - "Face used to color everything else." - :type '(choice (const :tag "None" nil) face)) - (defconst opascal-directives '(absolute abstract assembler automated cdecl default dispid dynamic export external far forward index inline message name near nodefault @@ -274,6 +251,21 @@ routine.") (defconst opascal-leading-spaces-re (concat "^" opascal-spaces-re)) (defconst opascal-word-chars "a-zA-Z0-9_") +(defvar opascal-mode-syntax-table + (let ((st (make-syntax-table))) + ;; Strings. + (modify-syntax-entry ?\" "\"" st) + (modify-syntax-entry ?\' "\"" st) + ;; Comments. + (modify-syntax-entry ?\{ "<" st) + (modify-syntax-entry ?\} ">" st) + (modify-syntax-entry ?\( "()1" st) + (modify-syntax-entry ?\) ")(4" st) + (modify-syntax-entry ?* ". 23b" st) + (modify-syntax-entry ?/ ". 12c" st) + (modify-syntax-entry ?\n "> c" st) + st)) + (defmacro opascal-save-excursion (&rest forms) ;; Executes the forms such that any movements have no effect, including ;; searches. @@ -283,13 +275,6 @@ routine.") (deactivate-mark nil)) (progn ,@forms))))) -(defmacro opascal-save-state (&rest forms) - ;; Executes the forms such that any buffer modifications do not have any side - ;; effects beyond the buffer's actual content changes. - `(let ((opascal--ignore-changes t)) - (with-silent-modifications - ,@forms))) - (defsubst opascal-is (element in-set) ;; If the element is in the set, the element cdr is returned, otherwise nil. (memq element in-set)) @@ -347,13 +332,6 @@ routine.") ;; Returns the column of the point p. (save-excursion (goto-char p) (current-column))) -(defun opascal-face-of (token-kind) - ;; Returns the face property appropriate for the token kind. - (cond ((opascal-is token-kind opascal-comments) opascal-comment-face) - ((opascal-is token-kind opascal-strings) opascal-string-face) - ((opascal-is token-kind opascal-keywords) opascal-keyword-face) - (opascal-other-face))) - (defvar opascal-progress-last-reported-point nil "The last point at which progress was reported.") @@ -361,8 +339,6 @@ routine.") "Number of chars to process before the next parsing progress report.") (defconst opascal-scanning-progress-step 2048 "Number of chars to process before the next scanning progress report.") -(defconst opascal-fontifying-progress-step opascal-scanning-progress-step - "Number of chars to process before the next fontification progress report.") (defun opascal-progress-start () ;; Initializes progress reporting. @@ -400,22 +376,30 @@ routine.") (goto-char curr-point) next)) -(defvar opascal--ignore-changes t - "Internal flag to control if the OPascal mode responds to buffer changes. -Defaults to t in case the `opascal-after-change' function is called on a -non-OPascal buffer. Set to nil in OPascal buffers. To override, just do: - (let ((opascal--ignore-changes t)) ...)") - -(defun opascal-set-text-properties (from to properties) - ;; Like `set-text-properties', except we do not consider this to be a buffer - ;; modification. - (opascal-save-state - (set-text-properties from to properties))) +(defconst opascal--literal-start-re (regexp-opt '("//" "{" "(*" "'" "\""))) (defun opascal-literal-kind (p) ;; Returns the literal kind the point p is in (or nil if not in a literal). - (if (and (<= (point-min) p) (<= p (point-max))) - (get-text-property p 'token))) + (when (and (<= (point-min) p) (<= p (point-max))) + (save-excursion + (let ((ppss (syntax-ppss p))) + ;; We want to return non-nil when right in front + ;; of a comment/string. + (if (null (nth 8 ppss)) + (when (looking-at opascal--literal-start-re) + (pcase (char-after) + (`?/ 'comment-single-line) + (`?\{ 'comment-multi-line-1) + (`?\( 'comment-multi-line-2) + (`?\' 'string) + (`?\" 'double-quoted-string))) + (if (nth 3 ppss) ;String. + (if (eq (nth 3 ppss) ?\") + 'double-quoted-string 'string) + (pcase (nth 7 ppss) + (`2 'comment-single-line) + (`1 'comment-multi-line-2) + (_ 'comment-multi-line-1)))))))) (defun opascal-literal-start-pattern (literal-kind) ;; Returns the start pattern of the literal kind. @@ -446,96 +430,27 @@ non-OPascal buffer. Set to nil in OPascal buffers. To override, just do: (string . "['\n]") (double-quoted-string . "[\"\n]"))))) -(defun opascal-is-literal-start (p) - ;; True if the point p is at the start point of a (completed) literal. - (let* ((kind (opascal-literal-kind p)) - (pattern (opascal-literal-start-pattern kind))) - (or (null kind) ; Non-literals are considered as start points. - (opascal-looking-at-string p pattern)))) - (defun opascal-is-literal-end (p) ;; True if the point p is at the end point of a (completed) literal. - (let* ((kind (opascal-literal-kind (1- p))) - (pattern (opascal-literal-end-pattern kind))) - (or (null kind) ; Non-literals are considered as end points. - - (and (opascal-looking-at-string (- p (length pattern)) pattern) - (or (not (opascal-is kind opascal-strings)) - ;; Special case: string delimiters are start/end ambiguous. - ;; We have an end only if there is some string content (at - ;; least a starting delimiter). - (not (opascal-is-literal-end (1- p))))) - - ;; Special case: strings cannot span lines. - (and (opascal-is kind opascal-strings) (eq ?\n (char-after (1- p))))))) - -(defun opascal-is-stable-literal (p) - ;; True if the point p marks a stable point. That is, a point outside of a - ;; literal region, inside of a literal region, or adjacent to completed - ;; literal regions. - (let ((at-start (opascal-is-literal-start p)) - (at-end (opascal-is-literal-end p))) - (or (>= p (point-max)) - (and at-start at-end) - (and (not at-start) (not at-end) - (eq (opascal-literal-kind (1- p)) (opascal-literal-kind p)))))) - -(defun opascal-complete-literal (literal-kind limit) - ;; Continues the search for a literal's true end point and returns the - ;; point past the end pattern (if found) or the limit (if not found). - (let ((pattern (opascal-literal-stop-pattern literal-kind))) - (if (not (stringp pattern)) - (error "Invalid literal kind %S" literal-kind) - ;; Search up to the limit. - (re-search-forward pattern limit 'goto-limit-on-fail) - (point)))) - -(defun opascal-literal-text-properties (kind) - ;; Creates a list of text properties for the literal kind. - (if (and (boundp 'font-lock-mode) - font-lock-mode) - (list 'token kind 'face (opascal-face-of kind) 'lazy-lock t) - (list 'token kind))) - -(defun opascal-parse-next-literal (limit) - ;; Searches for the next literal region (i.e. comment or string) and sets the - ;; the point to its end (or the limit, if not found). The literal region is - ;; marked as such with a text property, to speed up tokenizing during face - ;; coloring and indentation scanning. - (let ((search-start (point))) - (cond ((not (opascal-is-literal-end search-start)) - ;; We are completing an incomplete literal. - (let ((kind (opascal-literal-kind (1- search-start)))) - (opascal-complete-literal kind limit) - (opascal-set-text-properties - search-start (point) (opascal-literal-text-properties kind)))) - - ((re-search-forward - "\\(//\\)\\|\\({\\)\\|\\((\\*\\)\\|\\('\\)\\|\\(\"\\)" - limit 'goto-limit-on-fail) - ;; We found the start of a new literal. Find its end and mark it. - (let ((kind (cond ((match-beginning 1) 'comment-single-line) - ((match-beginning 2) 'comment-multi-line-1) - ((match-beginning 3) 'comment-multi-line-2) - ((match-beginning 4) 'string) - ((match-beginning 5) 'double-quoted-string))) - (start (match-beginning 0))) - (opascal-set-text-properties search-start start nil) - (opascal-complete-literal kind limit) - (opascal-set-text-properties - start (point) (opascal-literal-text-properties kind)))) - - ;; Nothing found. Mark it as a non-literal. - ((opascal-set-text-properties search-start limit nil))) - (opascal-step-progress (point) "Parsing" opascal-parsing-progress-step))) + (save-excursion + (and (null (nth 8 (syntax-ppss p))) + (nth 8 (syntax-ppss (1- p)))))) (defun opascal-literal-token-at (p) - ;; Returns the literal token surrounding the point p, or nil if none. - (let ((kind (opascal-literal-kind p))) - (when kind - (let ((start (previous-single-property-change (1+ p) 'token)) - (end (next-single-property-change p 'token))) - (opascal-token-of kind (or start (point-min)) (or end (point-max))))))) + "Return the literal token surrounding the point P, or nil if none." + (save-excursion + (let ((ppss (syntax-ppss p))) + (when (or (nth 8 ppss) (looking-at opascal--literal-start-re)) + (let* ((new-start (or (nth 8 ppss) p)) + (new-end (progn + (goto-char new-start) + (condition-case nil + (if (memq (char-after) '(?\' ?\")) + (forward-sexp 1) + (forward-comment 1)) + (scan-error (goto-char (point-max)))) + (point)))) + (opascal-token-of (opascal-literal-kind p) new-start new-end)))))) (defun opascal-point-token-at (p kind) ;; Returns the single character token at the point p. @@ -645,55 +560,6 @@ non-OPascal buffer. Set to nil in OPascal buffers. To override, just do: (opascal-is (opascal-token-kind next-token) '(space newline)))) next-token)) -(defun opascal-parse-region (from to) - ;; Parses the literal tokens in the region. The point is set to "to". - (save-restriction - (widen) - (goto-char from) - (while (< (point) to) - (opascal-parse-next-literal to)))) - -(defun opascal-parse-region-until-stable (from to) - ;; Parses at least the literal tokens in the region. After that, parsing - ;; continues as long as obsolete literal regions are encountered. The point - ;; is set to the encountered stable point. - (save-restriction - (widen) - (opascal-parse-region from to) - (while (not (opascal-is-stable-literal (point))) - (opascal-parse-next-literal (point-max))))) - -(defun opascal-fontify-region (from to &optional verbose) - ;; Colors the text in the region according to OPascal rules. - (opascal-save-excursion - (opascal-save-state - (let ((p from) - (opascal-verbose verbose) - (token nil)) - (opascal-progress-start) - (while (< p to) - ;; Color the token and move past it. - (setq token (opascal-token-at p)) - (add-text-properties - (opascal-token-start token) (opascal-token-end token) - (list 'face (opascal-face-of (opascal-token-kind token)) 'lazy-lock t)) - (setq p (opascal-token-end token)) - (opascal-step-progress p "Fontifying" opascal-fontifying-progress-step)) - (opascal-progress-done))))) - -(defun opascal-after-change (change-start change-end _old-length) - ;; Called when the buffer has changed. Reparses the changed region. - (unless opascal--ignore-changes - (let ((opascal--ignore-changes t)) ; Prevent recursive calls. - (opascal-save-excursion - (opascal-progress-start) - ;; Reparse at least from the token previous to the change to the end of - ;; line after the change. - (opascal-parse-region-until-stable - (opascal-token-start (opascal-token-at (1- change-start))) - (progn (goto-char change-end) (end-of-line) (point))) - (opascal-progress-done))))) - (defun opascal-group-start (from-token) ;; Returns the token that denotes the start of the ()/[] group. (let ((token (opascal-previous-token from-token)) @@ -1561,41 +1427,6 @@ If before the indent, the point is moved to the indent." (interactive "r") (opascal-debug-log "String: %S" (buffer-substring from to))) -(defun opascal-debug-show-is-stable () - (interactive) - (opascal-debug-log "stable: %S prev: %S next: %S" - (opascal-is-stable-literal (point)) - (opascal-literal-kind (1- (point))) - (opascal-literal-kind (point)))) - -(defun opascal-debug-unparse-buffer () - (interactive) - (opascal-set-text-properties (point-min) (point-max) nil)) - -(defun opascal-debug-parse-region (from to) - (interactive "r") - (let ((opascal-verbose t)) - (opascal-save-excursion - (opascal-progress-start) - (opascal-parse-region from to) - (opascal-progress-done "Parsing done")))) - -(defun opascal-debug-parse-window () - (interactive) - (opascal-debug-parse-region (window-start) (window-end))) - -(defun opascal-debug-parse-buffer () - (interactive) - (opascal-debug-parse-region (point-min) (point-max))) - -(defun opascal-debug-fontify-window () - (interactive) - (opascal-fontify-region (window-start) (window-end) t)) - -(defun opascal-debug-fontify-buffer () - (interactive) - (opascal-fontify-region (point-min) (point-max) t)) - (defun opascal-debug-tokenize-region (from to) (interactive) (opascal-save-excursion @@ -1747,6 +1578,7 @@ An error is raised if not in a comment." (error "Not in a comment") (let* ((start-comment (opascal-comment-block-start comment)) (end-comment (opascal-comment-block-end comment)) + ;; FIXME: Don't abuse global variables like `comment-end/start'. (comment-start (opascal-token-start start-comment)) (comment-end (opascal-token-end end-comment)) (content-start (opascal-comment-content-start start-comment)) @@ -1814,12 +1646,7 @@ An error is raised if not in a comment." ;; Restore our position (goto-char marked-point) - (set-marker marked-point nil) - - ;; React to the entire fill change as a whole. - (opascal-progress-start) - (opascal-parse-region comment-start comment-end) - (opascal-progress-done))))))) + (set-marker marked-point nil))))))) (defun opascal-new-comment-line () "If in a // comment, do a newline, indented such that one is still in the @@ -1848,16 +1675,37 @@ comment block. If not in a // comment, just does a normal newline." (goto-char end) token))) +(defconst opascal-font-lock-keywords + `(("\\_<\\(function\\|pro\\(cedure\\|gram\\)\\)[ \t]+\\([[:alpha:]][[:alnum:]_]*\\)" + (1 font-lock-keyword-face) (3 font-lock-function-name-face)) + ,(concat "\\_<" (regexp-opt (mapcar #'symbol-name opascal-keywords)) + "\\_>"))) + (defconst opascal-font-lock-defaults - '(nil ; We have our own fontify routine, so keywords don't apply. - t ; Syntactic fontification doesn't apply. + '(opascal-font-lock-keywords + nil ; Syntactic fontification does apply. nil ; Don't care about case since we don't use regexps to find tokens. nil ; Syntax alists don't apply. - nil ; Syntax begin movement doesn't apply - (font-lock-fontify-region-function . opascal-fontify-region) - (font-lock-verbose . opascal-fontifying-progress-step)) + nil ; Syntax begin movement doesn't apply. + ) "OPascal mode font-lock defaults. Syntactic fontification is ignored.") +(defconst opascal--syntax-propertize + (syntax-propertize-rules + ;; The syntax-table settings are too coarse and end up treating /* and (/ + ;; as comment starters. Fix it here by removing the "2" from the syntax + ;; of the second char of such sequences. + ("/\\(\\*\\)" (1 ". 3b")) + ("(\\(\\/\\)" (1 (prog1 ". 1c" (forward-char -1) nil))) + ;; Pascal uses '' and "" rather than \' and \" to escape quotes. + ("''\\|\"\"" (0 (if (save-excursion + (nth 3 (syntax-ppss (match-beginning 0)))) + (string-to-syntax ".") + ;; In case of 3 or more quotes in a row, only advance + ;; one quote at a time. + (forward-char -1) + nil))))) + (defvar opascal-debug-mode-map (let ((kmap (make-sparse-keymap))) (dolist (binding '(("n" opascal-debug-goto-next-token) @@ -1866,14 +1714,7 @@ comment block. If not in a // comment, just does a normal newline." ("T" opascal-debug-tokenize-buffer) ("W" opascal-debug-tokenize-window) ("g" opascal-debug-goto-point) - ("s" opascal-debug-show-current-string) - ("a" opascal-debug-parse-buffer) - ("w" opascal-debug-parse-window) - ("f" opascal-debug-fontify-window) - ("F" opascal-debug-fontify-buffer) - ("r" opascal-debug-parse-region) - ("c" opascal-debug-unparse-buffer) - ("x" opascal-debug-show-is-stable))) + ("s" opascal-debug-show-current-string))) (define-key kmap (car binding) (cadr binding))) kmap) "Keystrokes for OPascal mode debug commands.") @@ -1923,14 +1764,8 @@ Customization: Coloring: - `opascal-comment-face' (default font-lock-comment-face) - Face used to color OPascal comments. - `opascal-string-face' (default font-lock-string-face) - Face used to color OPascal strings. `opascal-keyword-face' (default font-lock-keyword-face) Face used to color OPascal keywords. - `opascal-other-face' (default nil) - Face used to color everything else. Turning on OPascal mode calls the value of the variable `opascal-mode-hook' with no args, if that value is non-nil." @@ -1940,21 +1775,13 @@ with no args, if that value is non-nil." (setq-local comment-indent-function #'opascal-indent-line) (setq-local case-fold-search t) (setq-local opascal-progress-last-reported-point nil) - (setq-local opascal--ignore-changes nil) (setq-local font-lock-defaults opascal-font-lock-defaults) (setq-local tab-always-indent opascal-tab-always-indents) + (setq-local syntax-propertize-function opascal--syntax-propertize) - ;; FIXME: Use syntax-propertize-function to tokenize, maybe? - - ;; We need to keep track of changes to the buffer to determine if we need - ;; to retokenize changed text. - (add-hook 'after-change-functions #'opascal-after-change nil t) - - (opascal-save-excursion - (let ((opascal-verbose t)) - (opascal-progress-start) - (opascal-parse-region (point-min) (point-max)) - (opascal-progress-done)))) + (setq-local comment-start "// ") + (setq-local comment-start-skip "\\(?://\\|(\\*\\|{\\)[ \t]*") + (setq-local comment-end-skip "[ \t]*\\(?:\n\\|\\*)\\|}\\)")) (provide 'opascal) ;;; opascal.el ends here diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index 829ecda5150..ffc8200644a 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el @@ -158,31 +158,44 @@ -(defconst pascal-font-lock-keywords (purecopy - (list - '("^[ \t]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ \t]*\\([a-z]\\)" +(defconst pascal-font-lock-keywords + `(("\\_<\\(function\\|pro\\(cedure\\|gram\\)\\)[ \t]+\\([[:alpha:]][[:alnum:]_]*\\)" + (1 font-lock-keyword-face) + (3 font-lock-function-name-face)) + ;; ("type" "const" "real" "integer" "char" "boolean" "var" + ;; "record" "array" "file") + (,(concat "\\<\\(array\\|boolean\\|c\\(har\\|onst\\)\\|file\\|" + "integer\\|re\\(al\\|cord\\)\\|type\\|var\\)\\>") + font-lock-type-face) + ("\\<\\(label\\|external\\|forward\\)\\>" . font-lock-constant-face) + ("\\<\\([0-9]+\\)[ \t]*:" 1 font-lock-function-name-face) + ;; ("of" "to" "for" "if" "then" "else" "case" "while" + ;; "do" "until" "and" "or" "not" "in" "with" "repeat" "begin" "end") + ,(concat "\\<\\(" + "and\\|begin\\|case\\|do\\|e\\(lse\\|nd\\)\\|for\\|i[fn]\\|" + "not\\|o[fr]\\|repeat\\|t\\(hen\\|o\\)\\|until\\|w\\(hile\\|ith\\)" + "\\)\\>") + ("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?" 1 font-lock-keyword-face) - '("^[ \t]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ \t]*\\([a-z][a-z0-9_]*\\)" - 3 font-lock-function-name-face t) -; ("type" "const" "real" "integer" "char" "boolean" "var" -; "record" "array" "file") - (cons (concat "\\<\\(array\\|boolean\\|c\\(har\\|onst\\)\\|file\\|" - "integer\\|re\\(al\\|cord\\)\\|type\\|var\\)\\>") - 'font-lock-type-face) - '("\\<\\(label\\|external\\|forward\\)\\>" . font-lock-constant-face) - '("\\<\\([0-9]+\\)[ \t]*:" 1 font-lock-function-name-face) -; ("of" "to" "for" "if" "then" "else" "case" "while" -; "do" "until" "and" "or" "not" "in" "with" "repeat" "begin" "end") - (concat "\\<\\(" - "and\\|begin\\|case\\|do\\|e\\(lse\\|nd\\)\\|for\\|i[fn]\\|" - "not\\|o[fr]\\|repeat\\|t\\(hen\\|o\\)\\|until\\|w\\(hile\\|ith\\)" - "\\)\\>") - '("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?" - 1 font-lock-keyword-face) - '("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?" - 2 font-lock-keyword-face t))) + ("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?" + 2 font-lock-keyword-face t)) "Additional expressions to highlight in Pascal mode.") -(put 'pascal-mode 'font-lock-defaults '(pascal-font-lock-keywords nil t)) + +(defconst pascal--syntax-propertize + (syntax-propertize-rules + ;; The syntax-table settings are too coarse and end up treating /* and (/ + ;; as comment starters. Fix it here by removing the "2" from the syntax + ;; of the second char of such sequences. + ("/\\(\\*\\)" (1 ". 3b")) + ("(\\(\\/\\)" (1 (prog1 ". 1c" (forward-char -1) nil))) + ;; Pascal uses '' and "" rather than \' and \" to escape quotes. + ("''\\|\"\"" (0 (if (save-excursion + (nth 3 (syntax-ppss (match-beginning 0)))) + (string-to-syntax ".") + ;; In case of 3 or more quotes in a row, only advance + ;; one quote at a time. + (forward-char -1) + nil))))) (defcustom pascal-indent-level 3 "Indentation of Pascal statements with respect to containing block." @@ -346,23 +359,22 @@ See also the user variables `pascal-type-keywords', `pascal-start-keywords' and Turning on Pascal mode calls the value of the variable pascal-mode-hook with no args, if that value is non-nil." - (set (make-local-variable 'local-abbrev-table) pascal-mode-abbrev-table) - (set (make-local-variable 'indent-line-function) 'pascal-indent-line) - (set (make-local-variable 'comment-indent-function) 'pascal-indent-comment) - (set (make-local-variable 'parse-sexp-ignore-comments) nil) - (set (make-local-variable 'blink-matching-paren-dont-ignore-comments) t) - (set (make-local-variable 'case-fold-search) t) - (set (make-local-variable 'comment-start) "{") - (set (make-local-variable 'comment-start-skip) "(\\*+ *\\|{ *") - (set (make-local-variable 'comment-end) "}") + (setq-local local-abbrev-table pascal-mode-abbrev-table) + (setq-local indent-line-function 'pascal-indent-line) + (setq-local comment-indent-function 'pascal-indent-comment) + (setq-local parse-sexp-ignore-comments nil) + (setq-local blink-matching-paren-dont-ignore-comments t) + (setq-local case-fold-search t) + (setq-local comment-start "{") + (setq-local comment-start-skip "(\\*+ *\\|{ *") + (setq-local comment-end "}") (add-hook 'completion-at-point-functions 'pascal-completions-at-point nil t) ;; Font lock support - (set (make-local-variable 'font-lock-defaults) - '(pascal-font-lock-keywords nil t)) + (setq-local font-lock-defaults '(pascal-font-lock-keywords nil t)) + (setq-local syntax-propertize-function pascal--syntax-propertize) ;; Imenu support - (set (make-local-variable 'imenu-generic-expression) - pascal-imenu-generic-expression) - (set (make-local-variable 'imenu-case-fold-search) t) + (setq-local imenu-generic-expression pascal-imenu-generic-expression) + (setq-local imenu-case-fold-search t) ;; Pascal-mode's own hide/show support. (add-to-invisibility-spec '(pascal . t))) diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index bd58a7300ec..01ac8584e19 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -148,10 +148,10 @@ (defvar perl-imenu-generic-expression '(;; Functions - (nil "^[ \t]*sub\\s-+\\([-A-Za-z0-9+_:]+\\)" 1) + (nil "^[ \t]*sub\\s-+\\([-[:alnum:]+_:]+\\)" 1) ;;Variables - ("Variables" "^\\(?:my\\|our\\)\\s-+\\([$@%][-A-Za-z0-9+_:]+\\)\\s-*=" 1) - ("Packages" "^[ \t]*package\\s-+\\([-A-Za-z0-9+_:]+\\);" 1) + ("Variables" "^\\(?:my\\|our\\)\\s-+\\([$@%][-[:alnum:]+_:]+\\)\\s-*=" 1) + ("Packages" "^[ \t]*package\\s-+\\([-[:alnum:]+_:]+\\);" 1) ("Doc sections" "^=head[0-9][ \t]+\\(.*\\)" 1)) "Imenu generic expression for Perl mode. See `imenu-generic-expression'.") @@ -160,6 +160,7 @@ (defcustom perl-prettify-symbols t "If non-nil, some symbols will be displayed using Unicode chars." + :version "24.4" :type 'boolean) (defconst perl--prettify-symbols-alist @@ -275,7 +276,6 @@ Regexp match data 0 points to the chars." (let ((case-fold-search nil)) (goto-char start) (perl-syntax-propertize-special-constructs end) - ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)") (funcall (syntax-propertize-rules ;; Turn POD into b-style comments. Place the cut rule first since it's @@ -287,7 +287,7 @@ Regexp match data 0 points to the chars." ;; check that it occurs inside a '..' string. ("\\(\\$\\)[{']" (1 ". p")) ;; Handle funny names like $DB'stop. - ("\\$ ?{?^?[_a-zA-Z][_a-zA-Z0-9]*\\('\\)[_a-zA-Z]" (1 "_")) + ("\\$ ?{?^?[_[:alpha:]][_[:alnum:]]*\\('\\)[_[:alpha:]]" (1 "_")) ;; format statements ("^[ \t]*format.*=[ \t]*\\(\n\\)" (1 (prog1 "\"" (perl-syntax-propertize-special-constructs end)))) @@ -345,7 +345,29 @@ Regexp match data 0 points to the chars." perl-quote-like-pairs) (string-to-syntax "|") (string-to-syntax "\""))) - (perl-syntax-propertize-special-constructs end)))))) + (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)) + (name (match-string 1))) + (goto-char (match-end 1)) + (if (save-excursion (nth 8 (syntax-ppss (match-beginning 0)))) + ;; Leave the property of the newline unchanged. + st + (cons (car (string-to-syntax "< c")) + ;; Remember the names of heredocs found on this line. + (cons (pcase (aref name 0) + (`?\\ (substring name 1)) + (_ (substring name 1 -1))) + (cdr st))))))) + ;; We don't call perl-syntax-propertize-special-constructs directly + ;; from the << rule, because there might be other elements (between + ;; the << and the \n) that need to be propertized. + ("\\(?:$\\)\\s<" + (0 (ignore (perl-syntax-propertize-special-constructs end)))) + ) (point) end))) (defvar perl-empty-syntax-table @@ -370,6 +392,22 @@ Regexp match data 0 points to the chars." (let ((state (syntax-ppss)) char) (cond + ((eq 2 (nth 7 state)) + ;; A Here document. + (let ((names (cdr (get-text-property (nth 8 state) 'syntax-table)))) + (when (cdr names) + (setq names (reverse names)) + ;; Multiple heredocs on a single line, we have to search from the + ;; beginning, since we don't know which names might be + ;; before point. + (goto-char (nth 8 state))) + (while (and names + (re-search-forward + (concat "^" (regexp-quote (pop names)) "\n") + limit 'move)) + (unless names + (put-text-property (1- (point)) (point) 'syntax-table + (string-to-syntax "> c")))))) ((or (null (setq char (nth 3 state))) (and (characterp char) (eq (char-syntax (nth 3 state)) ?\"))) ;; Normal text, or comment, or docstring, or normal string. diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 85e4172c8fe..63bd9258d69 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -278,16 +278,16 @@ ;;; Code: +(require 'comint) + (eval-when-compile (require 'font-lock) ;; We need imenu everywhere because of the predicate index! (require 'imenu) ;) - (require 'info) (require 'shell) ) -(require 'comint) (require 'easymenu) (require 'align) @@ -772,6 +772,8 @@ Relevant only when `prolog-imenu-flag' is non-nil." :version "24.1" :group 'prolog-other :type 'boolean) +(make-obsolete-variable 'prolog-underscore-wordchar-flag + 'superword-mode "24.4") (defcustom prolog-use-sicstus-sd nil "If non-nil, use the source level debugger of SICStus 3#7 and later." @@ -785,6 +787,7 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24." :version "24.1" :group 'prolog-other :type 'boolean) +(make-obsolete-variable 'prolog-char-quote-workaround nil "24.1") ;;------------------------------------------------------------------- @@ -802,10 +805,7 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24." ;; - In atoms \x<hex> sometimes needs a terminating \ (ISO-style) ;; and sometimes not. (let ((table (make-syntax-table))) - (if prolog-underscore-wordchar-flag - (modify-syntax-entry ?_ "w" table) - (modify-syntax-entry ?_ "_" table)) - + (modify-syntax-entry ?_ (if prolog-underscore-wordchar-flag "w" "_") table) (modify-syntax-entry ?+ "." table) (modify-syntax-entry ?- "." table) (modify-syntax-entry ?= "." table) @@ -815,7 +815,8 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24." (modify-syntax-entry ?\' "\"" table) ;; Any better way to handle the 0'<char> construct?!? - (when prolog-char-quote-workaround + (when (and prolog-char-quote-workaround + (not (fboundp 'syntax-propertize-rules))) (modify-syntax-entry ?0 "\\" table)) (modify-syntax-entry ?% "<" table) @@ -1770,7 +1771,8 @@ This function must be called from the source code buffer." real-file)) (with-current-buffer buffer (goto-char (point-max)) - (set-process-filter process 'prolog-consult-compile-filter) + (add-function :override (process-filter process) + #'prolog-consult-compile-filter) (process-send-string "prolog" command-string) ;; (prolog-build-prolog-command compilep file real-file first-line)) (while (and prolog-process-flag @@ -1781,7 +1783,8 @@ This function must be called from the source code buffer." (insert (if compilep "\nCompilation finished.\n" "\nConsulted.\n")) - (set-process-filter process old-filter)))) + (remove-function (process-filter process) + #'prolog-consult-compile-filter)))) (defvar compilation-error-list) @@ -3027,11 +3030,14 @@ The rest of the elements are undefined." (error "Sorry, no help method defined for this Prolog system.")))) )) + +(autoload 'Info-goto-node "info" nil t) +(declare-function Info-follow-nearest-node "info" (&optional FORK)) + (defun prolog-help-info (predicate) (let ((buffer (current-buffer)) oldp (str (concat "^\\* " (regexp-quote predicate) " */"))) - (require 'info) (pop-to-buffer nil) (Info-goto-node prolog-info-predicate-index) (if (not (re-search-forward str nil t)) @@ -3120,7 +3126,6 @@ Only for internal use by `prolog-find-documentation'") (defun prolog-goto-predicate-info (predicate) "Go to the info page for PREDICATE, which is a PredSpec." (interactive) - (require 'info) (string-match "\\(.*\\)/\\([0-9]+\\).*$" predicate) (let ((buffer (current-buffer)) (name (match-string 1 predicate)) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index f0f67d01845..ccb2dcba42e 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -157,7 +157,7 @@ ;; Skeletons: 6 skeletons are provided for simple inserting of class, ;; def, for, if, try and while. These skeletons are integrated with -;; dabbrev. If you have `dabbrev-mode' activated and +;; 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 @@ -177,12 +177,14 @@ ;; might guessed you should run `python-shell-send-buffer' from time ;; to time to get better results too. -;; Imenu: This mode supports Imenu in its most basic form, letting it -;; build the necessary alist via `imenu-default-create-index-function' -;; by having set `imenu-extract-index-name-function' to -;; `python-info-current-defun' and -;; `imenu-prev-index-position-function' to -;; `python-imenu-prev-index-position'. +;; Imenu: There are two index building functions to be used as +;; `imenu-create-index-function': `python-imenu-create-index' (the +;; default one, builds the alist in form of a tree) and +;; `python-imenu-create-flat-index'. See also +;; `python-imenu-format-item-label-function', +;; `python-imenu-format-parent-item-label-function', +;; `python-imenu-format-parent-item-jump-label-function' variables for +;; changing the way labels are formatted in the tree version. ;; If you used python-mode.el you probably will miss auto-indentation ;; when inserting newlines. To achieve the same behavior you have @@ -368,22 +370,24 @@ This variant of `rx' supports common python named REGEXPS." ;;; Font-lock and syntax +(eval-when-compile + (defun python-syntax--context-compiler-macro (form type &optional syntax-ppss) + (pcase type + (`'comment + `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) + (and (nth 4 ppss) (nth 8 ppss)))) + (`'string + `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) + (and (nth 3 ppss) (nth 8 ppss)))) + (`'paren + `(nth 1 (or ,syntax-ppss (syntax-ppss)))) + (_ form)))) + (defun python-syntax-context (type &optional syntax-ppss) "Return non-nil if point is on TYPE using SYNTAX-PPSS. TYPE can be `comment', `string' or `paren'. It returns the start character address of the specified TYPE." - (declare (compiler-macro - (lambda (form) - (pcase type - (`'comment - `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) - (and (nth 4 ppss) (nth 8 ppss)))) - (`'string - `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) - (and (nth 3 ppss) (nth 8 ppss)))) - (`'paren - `(nth 1 (or ,syntax-ppss (syntax-ppss)))) - (_ form))))) + (declare (compiler-macro python-syntax--context-compiler-macro)) (let ((ppss (or syntax-ppss (syntax-ppss)))) (pcase type (`comment (and (nth 4 ppss) (nth 8 ppss))) @@ -638,6 +642,13 @@ It makes underscores and dots word constituent chars.") These make `python-indent-calculate-indentation' subtract the value of `python-indent-offset'.") +(defvar python-indent-block-enders + '("break" "continue" "pass" "raise" "return") + "List of words that mark the end of a block. +These make `python-indent-calculate-indentation' subtract the +value of `python-indent-offset' when `python-indent-context' is +AFTER-LINE.") + (defun python-indent-guess-indent-offset () "Guess and set `python-indent-offset' for the current buffer." (interactive) @@ -763,9 +774,13 @@ START is the buffer position where the sexp starts." (save-excursion (goto-char context-start) (current-indentation)) - (if (progn - (back-to-indentation) - (looking-at (regexp-opt python-indent-dedenters))) + (if (or (save-excursion + (back-to-indentation) + (looking-at (regexp-opt python-indent-dedenters))) + (save-excursion + (python-util-forward-comment -1) + (python-nav-beginning-of-statement) + (member (current-word) python-indent-block-enders))) python-indent-offset 0))) ;; When inside of a string, do nothing. just use the current @@ -1180,6 +1195,70 @@ Returns nil if point is not in a def or class." ;; Ensure point moves forward. (and (> beg-pos (point)) (goto-char beg-pos))))) +(defun python-nav--syntactically (fn poscompfn &optional contextfn) + "Move point using FN avoiding places with specific context. +FN must take no arguments. POSCOMPFN is a two arguments function +used to compare current and previous point after it is moved +using FN, this is normally a less-than or greater-than +comparison. Optional argument CONTEXTFN defaults to +`python-syntax-context-type' and is used for checking current +point context, it must return a non-nil value if this point must +be skipped." + (let ((contextfn (or contextfn 'python-syntax-context-type)) + (start-pos (point-marker)) + (prev-pos)) + (catch 'found + (while t + (let* ((newpos + (and (funcall fn) (point-marker))) + (context (funcall contextfn))) + (cond ((and (not context) newpos + (or (and (not prev-pos) newpos) + (and prev-pos newpos + (funcall poscompfn newpos prev-pos)))) + (throw 'found (point-marker))) + ((and newpos context) + (setq prev-pos (point))) + (t (when (not newpos) (goto-char start-pos)) + (throw 'found nil)))))))) + +(defun python-nav--forward-defun (arg) + "Internal implementation of python-nav-{backward,forward}-defun. +Uses ARG to define which function to call, and how many times +repeat it." + (let ((found)) + (while (and (> arg 0) + (setq found + (python-nav--syntactically + (lambda () + (re-search-forward + python-nav-beginning-of-defun-regexp nil t)) + '>))) + (setq arg (1- arg))) + (while (and (< arg 0) + (setq found + (python-nav--syntactically + (lambda () + (re-search-backward + python-nav-beginning-of-defun-regexp nil t)) + '<))) + (setq arg (1+ arg))) + found)) + +(defun python-nav-backward-defun (&optional arg) + "Navigate to closer defun backward ARG times. +Unlikely `python-nav-beginning-of-defun' this doesn't care about +nested definitions." + (interactive "^p") + (python-nav--forward-defun (- (or arg 1)))) + +(defun python-nav-forward-defun (&optional arg) + "Navigate to closer defun forward ARG times. +Unlikely `python-nav-beginning-of-defun' this doesn't care about +nested definitions." + (interactive "^p") + (python-nav--forward-defun (or arg 1))) + (defun python-nav-beginning-of-statement () "Move to start of current statement." (interactive "^") @@ -1603,7 +1682,7 @@ This variable, when set to a string, makes the values stored in `python-shell-process-environment' and `python-shell-exec-path' to be modified properly so shells are started with the specified virtualenv." - :type 'string + :type '(choice (const nil) string) :group 'python :safe 'stringp) @@ -2644,8 +2723,8 @@ the if condition." (defvar python-skeleton-available '() "Internal list of available skeletons.") -(define-abbrev-table 'python-mode-abbrev-table () - "Abbrev table for Python mode." +(define-abbrev-table 'python-mode-skeleton-abbrev-table () + "Abbrev table for Python mode skeletons." :case-fixed t ;; Allow / inside abbrevs. :regexp "\\(?:^\\|[^/]\\)\\<\\([[:word:]/]+\\)\\W*" @@ -2658,13 +2737,13 @@ the if condition." (defmacro python-skeleton-define (name doc &rest skel) "Define a `python-mode' skeleton using NAME DOC and SKEL. The skeleton will be bound to python-skeleton-NAME and will -be added to `python-mode-abbrev-table'." +be added to `python-mode-skeleton-abbrev-table'." (declare (indent 2)) (let* ((name (symbol-name name)) (function-name (intern (concat "python-skeleton-" name)))) `(progn - (define-abbrev python-mode-abbrev-table ,name "" ',function-name - :system t) + (define-abbrev python-mode-skeleton-abbrev-table + ,name "" ',function-name :system t) (setq python-skeleton-available (cons ',function-name python-skeleton-available)) (define-skeleton ,function-name @@ -2672,6 +2751,10 @@ be added to `python-mode-abbrev-table'." (format "Insert %s statement." name)) ,@skel)))) +(define-abbrev-table 'python-mode-abbrev-table () + "Abbrev table for Python mode." + :parents (list python-mode-skeleton-abbrev-table)) + (defmacro python-define-auxiliary-skeleton (name doc &optional &rest skel) "Define a `python-mode' auxiliary skeleton using NAME DOC and SKEL. The skeleton will be bound to python-skeleton-NAME." @@ -2928,15 +3011,193 @@ Interactively, prompt for symbol." ;;; Imenu -(defun python-imenu-prev-index-position () - "Python mode's `imenu-prev-index-position-function'." - (let ((found)) - (while (and (setq found - (re-search-backward python-nav-beginning-of-defun-regexp nil t)) - (not (python-info-looking-at-beginning-of-defun)))) - (and found - (python-info-looking-at-beginning-of-defun) - (python-info-current-defun)))) +(defvar python-imenu-format-item-label-function + 'python-imenu-format-item-label + "Imenu function used to format an item label. +It must be a function with two arguments: TYPE and NAME.") + +(defvar python-imenu-format-parent-item-label-function + 'python-imenu-format-parent-item-label + "Imenu function used to format a parent item label. +It must be a function with two arguments: TYPE and NAME.") + +(defvar python-imenu-format-parent-item-jump-label-function + 'python-imenu-format-parent-item-jump-label + "Imenu function used to format a parent jump item label. +It must be a function with two arguments: TYPE and NAME.") + +(defun python-imenu-format-item-label (type name) + "Return imenu label for single node using TYPE and NAME." + (format "%s (%s)" name type)) + +(defun python-imenu-format-parent-item-label (type name) + "Return imenu label for parent node using TYPE and NAME." + (format "%s..." (python-imenu-format-item-label type name))) + +(defun python-imenu-format-parent-item-jump-label (type name) + "Return imenu label for parent node jump using TYPE and NAME." + (if (string= type "class") + "*class definition*" + "*function definition*")) + +(defun python-imenu--put-parent (type name pos num-children tree &optional root) + "Add the parent with TYPE, NAME, POS and NUM-CHILDREN to TREE. +Optional Argument ROOT must be non-nil when the node being +processed is the root of the TREE." + (let ((label + (funcall python-imenu-format-item-label-function type name)) + (jump-label + (funcall python-imenu-format-parent-item-jump-label-function type name))) + (if root + ;; This is the root, everything is a children. + (cons label (cons (cons jump-label pos) tree)) + ;; This is node a which may contain some children. + (cons + (cons label (cons (cons jump-label pos) + ;; Append all the children + (python-util-popn tree num-children))) + ;; All previous non-children nodes. + (nthcdr num-children tree))))) + +(defun python-imenu--build-tree (&optional min-indent prev-indent num-children tree) + "Recursively build the tree of nested definitions of a node. +Arguments MIN-INDENT PREV-INDENT NUM-CHILDREN and TREE are +internal and should not be passed explicitly unless you know what +you are doing." + (setq num-children (or num-children 0) + min-indent (or min-indent 0)) + (let* ((pos (python-nav-backward-defun)) + (type) + (name (when (and pos (looking-at python-nav-beginning-of-defun-regexp)) + (let ((split (split-string (match-string-no-properties 0)))) + (setq type (car split)) + (cadr split)))) + (label (when name + (funcall python-imenu-format-item-label-function type name))) + (indent (current-indentation))) + (cond ((not pos) + ;; No defun found, nothing to add. + tree) + ((equal indent 0) + (if (> num-children 0) + ;; Append it as the parent of everything collected to + ;; this point. + (python-imenu--put-parent type name pos num-children tree t) + ;; There are no children, this is a lonely defun. + (cons label pos))) + ((equal min-indent indent) + ;; Stop collecting nodes after moving to a position with + ;; indentation equaling min-indent. This is specially + ;; useful for navigating nested definitions recursively. + tree) + (t + (python-imenu--build-tree + min-indent + indent + ;; Add another children, either when this is the + ;; first call or when indentation is + ;; less-or-equal than previous. And do not + ;; discard the number of children, because the + ;; way code is scanned, all children are + ;; collected until a root node yet to be found + ;; appears. + (if (or (not prev-indent) + (and + (> indent min-indent) + (<= indent prev-indent))) + (1+ num-children) + num-children) + (cond ((not prev-indent) + ;; First call to the function: append this + ;; defun to the index. + (list (cons label pos))) + ((= indent prev-indent) + ;; Add another defun with the same depth + ;; as the previous. + (cons (cons label pos) tree)) + ((and (< indent prev-indent) + (< 0 num-children)) + ;; There are children to be appended and + ;; the previous defun had more + ;; indentation, the current one must be a + ;; parent. + (python-imenu--put-parent type name pos num-children tree)) + ((> indent prev-indent) + ;; There are children defuns deeper than + ;; current depth. Fear not, we already + ;; know how to treat them. + (cons + (prog1 + (python-imenu--build-tree + prev-indent indent 1 (list (cons label pos))) + ;; Adjustment: after scanning backwards + ;; for all deeper children, we need to + ;; continue our scan for a parent from + ;; the current defun we are looking at. + (python-nav-forward-defun)) + tree)))))))) + +(defun python-imenu-create-index () + "Return tree Imenu alist for the current python buffer. +Change `python-imenu-format-item-label-function', +`python-imenu-format-parent-item-label-function', +`python-imenu-format-parent-item-jump-label-function' to +customize how labels are formatted." + (goto-char (point-max)) + (let ((index) + (tree)) + (while (setq tree (python-imenu--build-tree)) + (setq index (cons tree index))) + index)) + +(defun python-imenu-create-flat-index (&optional alist prefix) + "Return flat outline of the current python buffer for Imenu. +Optional Argument ALIST is the tree to be flattened, when nil +`python-imenu-build-index' is used with +`python-imenu-format-parent-item-jump-label-function' +`python-imenu-format-parent-item-label-function' +`python-imenu-format-item-label-function' set to (lambda (type +name) name). Optional Argument PREFIX is used in recursive calls +and should not be passed explicitly. + +Converts this: + + \((\"Foo\" . 103) + (\"Bar\" . 138) + (\"decorator\" + (\"decorator\" . 173) + (\"wrap\" + (\"wrap\" . 353) + (\"wrapped_f\" . 393)))) + +To this: + + \((\"Foo\" . 103) + (\"Bar\" . 138) + (\"decorator\" . 173) + (\"decorator.wrap\" . 353) + (\"decorator.wrapped_f\" . 393))" + ;; Inspired by imenu--flatten-index-alist removed in revno 21853. + (apply + 'nconc + (mapcar + (lambda (item) + (let ((name (if prefix + (concat prefix "." (car item)) + (car item))) + (pos (cdr item))) + (cond ((or (numberp pos) (markerp pos)) + (list (cons name pos))) + ((listp pos) + (cons + (cons name (cdar pos)) + (python-imenu-create-flat-index (cddr item) name)))))) + (or alist + (let* ((fn (lambda (type name) name)) + (python-imenu-format-item-label-function fn) + (python-imenu-format-parent-item-label-function fn) + (python-imenu-format-parent-item-jump-label-function fn)) + (python-imenu-create-index)))))) ;;; Misc helpers @@ -3257,6 +3518,22 @@ Optional argument DIRECTION defines the direction to move to." (goto-char comment-start)) (forward-comment factor))) +(defun python-util-popn (lst n) + "Return LST first N elements. +N should be an integer, when it's a natural negative number its +opposite is used. When N is bigger than the length of LST, the +list is returned as is." + (let* ((n (min (abs n))) + (len (length lst)) + (acc)) + (if (> n len) + lst + (while (< 0 n) + (setq acc (cons (car lst) acc) + lst (cdr lst) + n (1- n))) + (reverse acc)))) + ;;;###autoload (define-derived-mode python-mode prog-mode "Python" @@ -3302,11 +3579,8 @@ if that value is non-nil." (add-hook 'post-self-insert-hook 'python-indent-post-self-insert-function nil 'local) - (set (make-local-variable 'imenu-extract-index-name-function) - #'python-info-current-defun) - - (set (make-local-variable 'imenu-prev-index-position-function) - #'python-imenu-prev-index-position) + (set (make-local-variable 'imenu-create-index-function) + #'python-imenu-create-index) (set (make-local-variable 'add-log-current-defun-function) #'python-info-current-defun) diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 6e471d1aa2a..fa4efe49b7b 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -113,7 +113,7 @@ "Regexp to match the beginning of a heredoc.") (defconst ruby-expression-expansion-re - "[^\\]\\(\\\\\\\\\\)*\\(#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)\\)")) + "\\(?:[^\\]\\|\\=\\)\\(\\\\\\\\\\)*\\(#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)\\)")) (defun ruby-here-doc-end-match () "Return a regexp to find the end of a heredoc. @@ -148,13 +148,16 @@ This should only be called after matching against `ruby-here-doc-beg-re'." (define-abbrev-table 'ruby-mode-abbrev-table () "Abbrev table in use in Ruby mode buffers.") +(defvar ruby-use-smie nil) + (defvar ruby-mode-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "M-C-b") 'ruby-backward-sexp) - (define-key map (kbd "M-C-f") 'ruby-forward-sexp) + (unless ruby-use-smie + (define-key map (kbd "M-C-b") 'ruby-backward-sexp) + (define-key map (kbd "M-C-f") 'ruby-forward-sexp) + (define-key map (kbd "M-C-q") 'ruby-indent-exp)) (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 "M-C-q") 'ruby-indent-exp) (define-key map (kbd "C-c {") 'ruby-toggle-block) map) "Keymap used in Ruby mode.") @@ -236,6 +239,111 @@ Also ignores spaces after parenthesis when 'space." (put 'ruby-comment-column 'safe-local-variable 'integerp) (put 'ruby-deep-arglist 'safe-local-variable 'booleanp) +;;; SMIE support + +(require 'smie) + +(defconst ruby-smie-grammar + ;; FIXME: Add support for Cucumber. + (smie-prec2->grammar + (smie-bnf->prec2 + '((id) + (insts (inst) (insts ";" insts)) + (inst (exp) (inst "iuwu-mod" exp)) + (exp (exp1) (exp "," exp)) + (exp1 (exp2) (exp2 "?" exp1 ":" exp1)) + (exp2 ("def" insts "end") + ("begin" insts-rescue-insts "end") + ("do" insts "end") + ("class" insts "end") ("module" insts "end") + ("for" for-body "end") + ("[" expseq "]") + ("{" hashvals "}") + ("while" insts "end") + ("until" insts "end") + ("unless" insts "end") + ("if" if-body "end") + ("case" cases "end")) + (for-body (for-head ";" insts)) + (for-head (id "in" exp)) + (cases (exp "then" insts) ;; FIXME: Ruby also allows (exp ":" insts). + (cases "when" cases) (insts "else" insts)) + (expseq (exp) );;(expseq "," expseq) + (hashvals (id "=>" exp1) (hashvals "," hashvals)) + (insts-rescue-insts (insts) + (insts-rescue-insts "rescue" insts-rescue-insts) + (insts-rescue-insts "ensure" insts-rescue-insts)) + (itheni (insts) (exp "then" insts)) + (ielsei (itheni) (itheni "else" insts)) + (if-body (ielsei) (if-body "elsif" if-body))) + '((nonassoc "in") (assoc ";") (assoc ",")) + '((assoc "when")) + '((assoc "elsif")) + '((assoc "rescue" "ensure")) + '((assoc ","))))) + +(defun ruby-smie--bosp () + (save-excursion (skip-chars-backward " \t") + (or (bolp) (eq (char-before) ?\;)))) + +(defun ruby-smie--implicit-semi-p () + (save-excursion + (skip-chars-backward " \t") + (not (or (bolp) + (memq (char-before) '(?\; ?- ?+ ?* ?/ ?:)) + (and (memq (char-before) '(?\? ?=)) + (not (memq (char-syntax (char-before (1- (point)))) + '(?w ?_)))))))) + +(defun ruby-smie--forward-token () + (skip-chars-forward " \t") + (if (and (looking-at "[\n#]") + ;; Only add implicit ; when needed. + (ruby-smie--implicit-semi-p)) + (progn + (if (eolp) (forward-char 1) (forward-comment 1)) + ";") + (forward-comment (point-max)) + (let ((tok (smie-default-forward-token))) + (cond + ((member tok '("unless" "if" "while" "until")) + (if (save-excursion (forward-word -1) (ruby-smie--bosp)) + tok "iuwu-mod")) + (t tok))))) + +(defun ruby-smie--backward-token () + (let ((pos (point))) + (forward-comment (- (point))) + (if (and (> pos (line-end-position)) + (ruby-smie--implicit-semi-p)) + (progn (skip-chars-forward " \t") + ";") + (let ((tok (smie-default-backward-token))) + (cond + ((member tok '("unless" "if" "while" "until")) + (if (ruby-smie--bosp) + tok "iuwu-mod")) + (t tok)))))) + +(defun ruby-smie-rules (kind token) + (pcase (cons kind token) + (`(:elem . basic) ruby-indent-level) + (`(:after . ";") + (if (smie-rule-parent-p "def" "begin" "do" "class" "module" "for" + "[" "{" "while" "until" "unless" + "if" "then" "elsif" "else" "when" + "rescue" "ensure") + (smie-rule-parent ruby-indent-level) + ;; For (invalid) code between switch and case. + ;; (if (smie-parent-p "switch") 4) + 0)) + (`(:before . ,(or `"else" `"then" `"elsif")) 0) + (`(:before . ,(or `"when")) + (if (not (smie-rule-sibling-p)) 0)) ;; ruby-indent-level + ;; Hack attack: Since newlines are separators, don't try to align args that + ;; appear on a separate line. + (`(:list-intro . ";") t))) + (defun ruby-imenu-create-index-in-block (prefix beg end) "Create an imenu index of methods inside a block." (let ((index-alist '()) (case-fold-search nil) @@ -290,7 +398,11 @@ Also ignores spaces after parenthesis when 'space." (set-syntax-table ruby-mode-syntax-table) (setq local-abbrev-table ruby-mode-abbrev-table) (setq indent-tabs-mode ruby-indent-tabs-mode) - (set (make-local-variable 'indent-line-function) 'ruby-indent-line) + (if ruby-use-smie + (smie-setup ruby-smie-grammar #'ruby-smie-rules + :forward-token #'ruby-smie--forward-token + :backward-token #'ruby-smie--backward-token) + (set (make-local-variable 'indent-line-function) 'ruby-indent-line)) (set (make-local-variable 'require-final-newline) t) (set (make-local-variable 'comment-start) "# ") (set (make-local-variable 'comment-end) "") @@ -847,22 +959,24 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'." indent)))) (defun ruby-beginning-of-defun (&optional arg) - "Move backward to the beginning of the current top-level defun. + "Move backward to the beginning of the current defun. With ARG, move backward multiple defuns. Negative ARG means move forward." (interactive "p") - (and (re-search-backward (concat "^\\s *" ruby-defun-beg-re "\\_>") - nil t (or arg 1)) - (beginning-of-line))) - -(defun ruby-end-of-defun (&optional arg) - "Move forward to the end of the current top-level defun. -With ARG, move forward multiple defuns. Negative ARG means -move backward." + (let (case-fold-search) + (and (re-search-backward (concat "^\\s *" ruby-defun-beg-re "\\_>") + nil t (or arg 1)) + (beginning-of-line)))) + +(defun ruby-end-of-defun () + "Move point to the end of the current defun. +The defun begins at or after the point. This function is called +by `end-of-defun'." (interactive "p") (ruby-forward-sexp) - (when (looking-back (concat "^\\s *" ruby-block-end-re)) - (forward-line 1))) + (let (case-fold-search) + (when (looking-back (concat "^\\s *" ruby-block-end-re)) + (forward-line 1)))) (defun ruby-beginning-of-indent () "Backtrack to a line which can be used as a reference for @@ -881,6 +995,7 @@ current block, a sibling block, or an outer block. Do that (abs N) times." (depth (or (nth 2 (ruby-parse-region (line-beginning-position) (line-end-position))) 0)) + case-fold-search down done) (when (< (* depth signum) 0) ;; Moving end -> end or beginning -> beginning. @@ -1232,6 +1347,9 @@ If the result is do-end block, it will always be multiline." (declare-function ruby-syntax-propertize-heredoc "ruby-mode" (limit)) (declare-function ruby-syntax-enclosing-percent-literal "ruby-mode" (limit)) (declare-function ruby-syntax-propertize-percent-literal "ruby-mode" (limit)) +;; Unusual code layout confuses the byte-compiler. +(declare-function ruby-syntax-propertize-expansion "ruby-mode" ()) +(declare-function ruby-syntax-expansion-allowed-p "ruby-mode" (parse-state)) (if (eval-when-compile (fboundp #'syntax-propertize-rules)) ;; New code that works independently from font-lock. @@ -1245,54 +1363,70 @@ If the result is do-end block, it will always be multiline." '("gsub" "gsub!" "sub" "sub!" "scan" "split" "split!" "index" "match" "assert_match" "Given" "Then" "When") "Methods that can take regexp as the first argument. -It will be properly highlighted even when the call omits parens.")) +It will be properly highlighted even when the call omits parens.") + + (defvar ruby-syntax-before-regexp-re + (concat + ;; Special tokens that can't be followed by a division operator. + "\\(^\\|[[=(,~?:;<>]" + ;; Control flow keywords and operators following bol or whitespace. + "\\|\\(?:^\\|\\s \\)" + (regexp-opt '("if" "elsif" "unless" "while" "until" "when" "and" + "or" "not" "&&" "||")) + ;; Method name from the list. + "\\|\\_<" + (regexp-opt ruby-syntax-methods-before-regexp) + "\\)\\s *") + "Regexp to match text that can be followed by a regular expression.")) (defun ruby-syntax-propertize-function (start end) "Syntactic keywords for Ruby mode. See `syntax-propertize-function'." - (goto-char start) - (ruby-syntax-propertize-heredoc end) - (ruby-syntax-enclosing-percent-literal end) - (funcall - (syntax-propertize-rules - ;; $' $" $` .... are variables. - ;; ?' ?" ?` are ascii codes. - ("\\([?$]\\)[#\"'`]" - (1 (unless (save-excursion - ;; Not within a string. - (nth 3 (syntax-ppss (match-beginning 0)))) - (string-to-syntax "\\")))) - ;; Regexps: regexps are distinguished from division because - ;; of the keyword, symbol, or method name before them. - ((concat - ;; Special tokens that can't be followed by a division operator. - "\\(^\\|[[=(,~?:;<>]" - ;; Control flow keywords and operators following bol or whitespace. - "\\|\\(?:^\\|\\s \\)" - (regexp-opt '("if" "elsif" "unless" "while" "until" "when" "and" - "or" "not" "&&" "||")) - ;; Method name from the list. - "\\|\\_<" - (regexp-opt ruby-syntax-methods-before-regexp) - "\\)\\s *" - ;; The regular expression itself. - "\\(/\\)[^/\n\\\\]*\\(?:\\\\.[^/\n\\\\]*\\)*\\(/\\)") - (3 (unless (nth 3 (syntax-ppss (match-beginning 2))) - (put-text-property (match-beginning 2) (match-end 2) - 'syntax-table (string-to-syntax "\"/")) - (string-to-syntax "\"/")))) - ("^=en\\(d\\)\\_>" (1 "!")) - ("^\\(=\\)begin\\_>" (1 "!")) - ;; Handle here documents. - ((concat ruby-here-doc-beg-re ".*\\(\n\\)") - (7 (unless (ruby-singleton-class-p (match-beginning 0)) - (put-text-property (match-beginning 7) (match-end 7) - 'syntax-table (string-to-syntax "\"")) - (ruby-syntax-propertize-heredoc end)))) - ;; Handle percent literals: %w(), %q{}, etc. - ((concat "\\(?:^\\|[[ \t\n<+(,=]\\)" ruby-percent-literal-beg-re) - (1 (prog1 "|" (ruby-syntax-propertize-percent-literal end))))) - (point) end) - (ruby-syntax-propertize-expansions start end)) + (let (case-fold-search) + (goto-char start) + (remove-text-properties start end '(ruby-expansion-match-data)) + (ruby-syntax-propertize-heredoc end) + (ruby-syntax-enclosing-percent-literal end) + (funcall + (syntax-propertize-rules + ;; $' $" $` .... are variables. + ;; ?' ?" ?` are ascii codes. + ("\\([?$]\\)[#\"'`]" + (1 (unless (save-excursion + ;; Not within a string. + (nth 3 (syntax-ppss (match-beginning 0)))) + (string-to-syntax "\\")))) + ;; Regular expressions. Start with matching unescaped slash. + ("\\(?:\\=\\|[^\\]\\)\\(?:\\\\\\\\\\)*\\(/\\)" + (1 (let ((state (save-excursion (syntax-ppss (match-beginning 1))))) + (when (or + ;; Beginning of a regexp. + (and (null (nth 8 state)) + (save-excursion + (forward-char -1) + (looking-back ruby-syntax-before-regexp-re + (point-at-bol)))) + ;; End of regexp. We don't match the whole + ;; regexp at once because it can have + ;; string interpolation inside, or span + ;; several lines. + (eq ?/ (nth 3 state))) + (string-to-syntax "\"/"))))) + ;; Expression expansions in strings. We're handling them + ;; here, so that the regexp rule never matches inside them. + (ruby-expression-expansion-re + (0 (ignore (ruby-syntax-propertize-expansion)))) + ("^=en\\(d\\)\\_>" (1 "!")) + ("^\\(=\\)begin\\_>" (1 "!")) + ;; Handle here documents. + ((concat ruby-here-doc-beg-re ".*\\(\n\\)") + (7 (unless (ruby-singleton-class-p (match-beginning 0)) + (put-text-property (match-beginning 7) (match-end 7) + 'syntax-table (string-to-syntax "\"")) + (ruby-syntax-propertize-heredoc end)))) + ;; Handle percent literals: %w(), %q{}, etc. + ((concat "\\(?:^\\|[[ \t\n<+(,=]\\)" ruby-percent-literal-beg-re) + (1 (prog1 "|" (ruby-syntax-propertize-percent-literal end))))) + (point) end))) (defun ruby-syntax-propertize-heredoc (limit) (let ((ppss (syntax-ppss)) @@ -1305,7 +1439,7 @@ It will be properly highlighted even when the call omits parens.")) (line-end-position) t) (unless (ruby-singleton-class-p (match-beginning 0)) (push (concat (ruby-here-doc-end-match) "\n") res)))) - (let ((start (point))) + (save-excursion ;; With multiple openers on the same line, we don't know in which ;; part `start' is, so we have to go back to the beginning. (when (cdr res) @@ -1315,9 +1449,9 @@ It will be properly highlighted even when the call omits parens.")) (if (null res) (put-text-property (1- (point)) (point) 'syntax-table (string-to-syntax "\"")))) - ;; Make extra sure we don't move back, lest we could fall into an - ;; inf-loop. - (if (< (point) start) (goto-char start)))))) + ;; End up at bol following the heredoc openers. + ;; Propertize expression expansions from this point forward. + )))) (defun ruby-syntax-enclosing-percent-literal (limit) (let ((state (syntax-ppss)) @@ -1338,44 +1472,59 @@ It will be properly highlighted even when the call omits parens.")) (cl (or (cdr (aref (syntax-table) op)) (cdr (assoc op '((?< . ?>)))))) parse-sexp-lookup-properties) - (condition-case nil - (progn - (if cl ; Paired delimiters. - ;; Delimiter pairs of the same kind can be nested - ;; inside the literal, as long as they are balanced. - ;; Create syntax table that ignores other characters. - (with-syntax-table (make-char-table 'syntax-table nil) - (modify-syntax-entry op (concat "(" (char-to-string cl))) - (modify-syntax-entry cl (concat ")" ops)) - (modify-syntax-entry ?\\ "\\") - (save-restriction - (narrow-to-region (point) limit) - (forward-list))) ; skip to the paired character - ;; Single character delimiter. - (re-search-forward (concat "[^\\]\\(?:\\\\\\\\\\)*" - (regexp-quote ops)) limit nil)) - ;; Found the closing delimiter. - (put-text-property (1- (point)) (point) 'syntax-table - (string-to-syntax "|"))) - ;; Unclosed literal, leave the following text unpropertized. - ((scan-error search-failed) (goto-char limit)))))) + (save-excursion + (condition-case nil + (progn + (if cl ; Paired delimiters. + ;; Delimiter pairs of the same kind can be nested + ;; inside the literal, as long as they are balanced. + ;; Create syntax table that ignores other characters. + (with-syntax-table (make-char-table 'syntax-table nil) + (modify-syntax-entry op (concat "(" (char-to-string cl))) + (modify-syntax-entry cl (concat ")" ops)) + (modify-syntax-entry ?\\ "\\") + (save-restriction + (narrow-to-region (point) limit) + (forward-list))) ; skip to the paired character + ;; Single character delimiter. + (re-search-forward (concat "[^\\]\\(?:\\\\\\\\\\)*" + (regexp-quote ops)) limit nil)) + ;; Found the closing delimiter. + (put-text-property (1- (point)) (point) 'syntax-table + (string-to-syntax "|"))) + ;; Unclosed literal, do nothing. + ((scan-error search-failed))))))) + + (defun ruby-syntax-propertize-expansion () + ;; Save the match data to a text property, for font-locking later. + ;; Set the syntax of all double quotes and backticks to punctuation. + (let* ((beg (match-beginning 2)) + (end (match-end 2)) + (state (and beg (save-excursion (syntax-ppss beg))))) + (when (ruby-syntax-expansion-allowed-p state) + (put-text-property beg (1+ beg) 'ruby-expansion-match-data + (match-data)) + (goto-char beg) + (while (re-search-forward "[\"`]" end 'move) + (put-text-property (match-beginning 0) (match-end 0) + 'syntax-table (string-to-syntax ".")))))) + + (defun ruby-syntax-expansion-allowed-p (parse-state) + "Return non-nil if expression expansion is allowed." + (let ((term (nth 3 parse-state))) + (cond + ((memq term '(?\" ?` ?\n ?/))) + ((eq term t) + (save-match-data + (save-excursion + (goto-char (nth 8 parse-state)) + (looking-at "%\\(?:[QWrx]\\|\\W\\)"))))))) (defun ruby-syntax-propertize-expansions (start end) - (remove-text-properties start end '(ruby-expansion-match-data)) - (goto-char start) - ;; Find all expression expansions and - ;; - save the match data to a text property, for font-locking later, - ;; - set the syntax of all double quotes and backticks to punctuation. - (while (re-search-forward ruby-expression-expansion-re end 'move) - (let ((beg (match-beginning 2)) - (end (match-end 2))) - (when (and beg (save-excursion (nth 3 (syntax-ppss beg)))) - (put-text-property beg (1+ beg) 'ruby-expansion-match-data - (match-data)) - (goto-char beg) - (while (re-search-forward "[\"`]" end 'move) - (put-text-property (match-beginning 0) (match-end 0) - 'syntax-table (string-to-syntax "."))))))) + (save-excursion + (goto-char start) + (while (re-search-forward ruby-expression-expansion-re end 'move) + (ruby-syntax-propertize-expansion)))) ) ;; For Emacsen where syntax-propertize-rules is not (yet) available, diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 8f1954402e5..07e9bb85c4e 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -335,11 +335,11 @@ shell it really is." . ((nil ;; function FOO ;; function FOO() - "^\\s-*function\\s-+\\\([[:alpha:]_][[:alnum:]_]+\\)\\s-*\\(?:()\\)?" + "^\\s-*function\\s-+\\\([[:alpha:]_][[:alnum:]_]*\\)\\s-*\\(?:()\\)?" 1) ;; FOO() (nil - "^\\s-*\\([[:alpha:]_][[:alnum:]_]+\\)\\s-*()" + "^\\s-*\\([[:alpha:]_][[:alnum:]_]*\\)\\s-*()" 1) ))) "Alist of regular expressions for recognizing shell function definitions. @@ -353,6 +353,28 @@ See `sh-feature' and `imenu-generic-expression'." :group 'sh-script :version "20.4") +(defun sh-current-defun-name () + "Find the name of function or variable at point. +For use in `add-log-current-defun-function'." + (save-excursion + (end-of-line) + (when (re-search-backward + (concat "\\(?:" + ;; function FOO + ;; function FOO() + "^\\s-*function\\s-+\\\([[:alpha:]_][[:alnum:]_]*\\)\\s-*\\(?:()\\)?" + "\\)\\|\\(?:" + ;; FOO() + "^\\s-*\\([[:alpha:]_][[:alnum:]_]*\\)\\s-*()" + "\\)\\|\\(?:" + ;; FOO= + "^\\([[:alpha:]_][[:alnum:]_]*\\)=" + "\\)") + nil t) + (or (match-string-no-properties 1) + (match-string-no-properties 2) + (match-string-no-properties 3))))) + (defvar sh-shell-variables nil "Alist of shell variable names that should be included in completion. These are used for completion in addition to all the variables named @@ -1533,6 +1555,7 @@ with your script for an edit-interpret-debug cycle." (setq-local skeleton-newline-indent-rigidly t) (setq-local defun-prompt-regexp (concat "^\\(function[ \t]\\|[[:alnum:]]+[ \t]+()[ \t]+\\)")) + (setq-local add-log-current-defun-function #'sh-current-defun-name) ;; Parse or insert magic number for exec, and set all variables depending ;; on the shell thus determined. (sh-set-shell diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 3cf6757d5ec..940afc3d5f4 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -285,36 +285,49 @@ file. Since that is a plaintext file, this could be dangerous." (define-widget 'sql-login-params 'lazy "Widget definition of the login parameters list" - ;; FIXME: does not implement :default property for the user, - ;; database and server options. Anybody have some guidance on how to - ;; do this. :tag "Login Parameters" - :type '(repeat (choice - (const user) - (const password) - (choice :tag "server" - (const server) - (list :tag "file" - (const :format "" server) - (const :format "" :file) - regexp) - (list :tag "completion" - (const :format "" server) + :type '(set :tag "Login Parameters" + (choice :tag "user" + :value user + (const user) + (list :tag "Specify a default" + (const user) + (list :tag "Default" + :inline t (const :default) string))) + (const password) + (choice :tag "server" + :value server + (const server) + (list :tag "Specify a default" + (const server) + (list :tag "Default" + :inline t (const :default) string)) + (list :tag "file" + (const :format "" server) + (const :format "" :file) + regexp) + (list :tag "completion" + (const :format "" server) + (const :format "" :completion) + (restricted-sexp + :match-alternatives (listp stringp)))) + (choice :tag "database" + :value database + (const database) + (list :tag "Specify a default" + (const database) + (list :tag "Default" + :inline t (const :default) string)) + (list :tag "file" + (const :format "" database) + (const :format "" :file) + regexp) + (list :tag "completion" + (const :format "" database) (const :format "" :completion) (restricted-sexp :match-alternatives (listp stringp)))) - (choice :tag "database" - (const database) - (list :tag "file" - (const :format "" database) - (const :format "" :file) - regexp) - (list :tag "completion" - (const :format "" database) - (const :format "" :completion) - (restricted-sexp - :match-alternatives (listp stringp)))) - (const port)))) + (const port))) ;; SQL Product support diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el index 80e632c6ef6..a75bdff27bd 100644 --- a/lisp/progmodes/subword.el +++ b/lisp/progmodes/subword.el @@ -26,7 +26,8 @@ ;; This package provides `subword' oriented commands and a minor mode ;; (`subword-mode') that substitutes the common word handling -;; functions with them. +;; functions with them. It also provides the `superword-mode' minor +;; mode that treats symbols as words, the opposite of `subword-mode'. ;; In spite of GNU Coding Standards, it is popular to name a symbol by ;; mixing uppercase and lowercase letters, e.g. "GtkWidget", @@ -43,12 +44,13 @@ ;; The subword oriented commands defined in this package recognize ;; subwords in a nomenclature to move between them and to edit them as -;; words. +;; 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 +;; Key Word oriented command Subword oriented command (also superword) ;; ============================================================ ;; M-f `forward-word' `subword-forward' ;; M-b `backward-word' `subword-backward' @@ -67,8 +69,13 @@ ;; To make the mode turn on automatically, put the following code in ;; your .emacs: ;; -;; (add-hook 'c-mode-common-hook -;; (lambda () (subword-mode 1))) +;; (add-hook 'c-mode-common-hook 'subword-mode) +;; + +;; To make the mode turn `superword-mode' on automatically for +;; only some modes, put the following code in your .emacs: +;; +;; (add-hook 'c-mode-common-hook 'superword-mode) ;; ;; Acknowledgment: @@ -98,7 +105,8 @@ (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)) + 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)))))) @@ -133,21 +141,21 @@ subwords in a nomenclature to move between subwords and to edit them as words. \\{subword-mode-map}" - nil - nil - subword-mode-map) + :lighter " ," + (when subword-mode (superword-mode -1))) (define-obsolete-function-alias 'c-subword-mode 'subword-mode "23.2") ;;;###autoload (define-global-minor-mode global-subword-mode subword-mode - (lambda () (subword-mode 1))) + (lambda () (subword-mode 1)) + :group 'convenience) (defun subword-forward (&optional arg) "Do the same as `forward-word' but on subwords. See the command `subword-mode' for a description of subwords. Optional argument ARG is the same as for `forward-word'." - (interactive "p") + (interactive "^p") (unless arg (setq arg 1)) (cond ((< 0 arg) @@ -165,9 +173,23 @@ Optional argument ARG is the same as for `forward-word'." "Do the same as `backward-word' but on subwords. See the command `subword-mode' for a description of subwords. Optional argument ARG is the same as for `backward-word'." - (interactive "p") + (interactive "^p") (subword-forward (- (or arg 1)))) +(defun subword-right (&optional arg) + "Do the same as `right-word' but on subwords." + (interactive "^p") + (if (eq (current-bidi-paragraph-direction) 'left-to-right) + (subword-forward arg) + (subword-backward arg))) + +(defun subword-left (&optional arg) + "Do the same as `left-word' but on subwords." + (interactive "^p") + (if (eq (current-bidi-paragraph-direction) 'left-to-right) + (subword-backward arg) + (subword-forward arg))) + (defun subword-mark (arg) "Do the same as `mark-word' but on subwords. See the command `subword-mode' for a description of subwords. @@ -254,41 +276,74 @@ Optional argument ARG is the same as for `capitalize-word'." (unless advance (goto-char start)))) + + +(defvar superword-mode-map subword-mode-map + "Keymap used in `superword-mode' minor mode.") + +;;;###autoload +(define-minor-mode superword-mode + "Toggle superword movement and editing (Superword mode). +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-map}" + :lighter " ²" + (when superword-mode (subword-mode -1))) + +;;;###autoload +(define-global-minor-mode global-superword-mode superword-mode + (lambda () (superword-mode 1)) + :group 'convenience) ;; ;; Internal functions ;; (defun subword-forward-internal () - (if (and - (save-excursion - (let ((case-fold-search nil)) - (re-search-forward subword-forward-regexp nil t))) - (> (match-end 0) (point))) - (goto-char - (cond - ((< 1 (- (match-end 2) (match-beginning 2))) - (1- (match-end 2))) - (t - (match-end 0)))) - (forward-word 1))) - + (if superword-mode + (forward-symbol 1) + (if (and + (save-excursion + (let ((case-fold-search nil)) + (re-search-forward subword-forward-regexp nil t))) + (> (match-end 0) (point))) + (goto-char + (cond + ((< 1 (- (match-end 2) (match-beginning 2))) + (1- (match-end 2))) + (t + (match-end 0)))) + (forward-word 1)))) (defun subword-backward-internal () - (if (save-excursion - (let ((case-fold-search nil)) - (re-search-backward subword-backward-regexp nil t))) - (goto-char - (cond - ((and (match-end 3) - (< 1 (- (match-end 3) (match-beginning 3))) - (not (eq (point) (match-end 3)))) - (1- (match-end 3))) - (t - (1+ (match-beginning 0))))) - (backward-word 1))) + (if superword-mode + (forward-symbol -1) + (if (save-excursion + (let ((case-fold-search nil)) + (re-search-backward subword-backward-regexp nil t))) + (goto-char + (cond + ((and (match-end 3) + (< 1 (- (match-end 3) (match-beginning 3))) + (not (eq (point) (match-end 3)))) + (1- (match-end 3))) + (t + (1+ (match-beginning 0))))) + (backward-word 1)))) + (provide 'subword) +(provide 'superword) ;;; subword.el ends here diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index 9169a433015..3e91aeba9a1 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -266,7 +266,7 @@ quoted for Tcl." ;; Maybe someone has a better set? (let ((map (make-sparse-keymap))) ;; Will inherit from `comint-mode-map' thanks to define-derived-mode. - (define-key map "\t" 'comint-dynamic-complete) + (define-key map "\t" 'completion-at-point) (define-key map "\M-?" 'comint-dynamic-list-filename-completions) (define-key map "\177" 'backward-delete-char-untabify) (define-key map "\M-\C-x" 'tcl-eval-defun) diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el index 7b59faca261..443472192be 100644 --- a/lisp/progmodes/vera-mode.el +++ b/lisp/progmodes/vera-mode.el @@ -101,6 +101,8 @@ select and move operations. All parts of an identifier separated by underscore are treated as single words otherwise." :type 'boolean :group 'vera) +(make-obsolete-variable 'vera-underscore-is-part-of-word + 'superword-mode "24.4") (defcustom vera-intelligent-tab t "Non-nil means `TAB' does indentation, word completion and tab insertion. @@ -1353,6 +1355,11 @@ If `vera-intelligent-tab' is nil, always indent line." (defvar vera-expand-upper-case nil) (eval-when-compile (require 'hippie-exp)) +(declare-function he-init-string "hippie-exp" (beg end)) +(declare-function he-dabbrev-beg "hippie-exp" ()) +(declare-function he-string-member "hippie-exp" (str lst &optional trans-case)) +(declare-function he-reset-string "hippie-exp" ()) +(declare-function he-substitute-string "hippie-exp" (str &optional trans-case)) (defun vera-try-expand-abbrev (old) "Try expanding abbreviations from `vera-abbrev-list'." diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 5571a905f85..ed911fcbba2 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -123,9 +123,9 @@ ;;; Code: ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version (substring "$$Revision: 820 $$" 12 -3) +(defconst verilog-mode-version (substring "$$Revision: 840 $$" 12 -3) "Version of this Verilog mode.") -(defconst verilog-mode-release-date (substring "$$Date: 2012-09-17 20:43:10 -0400 (Mon, 17 Sep 2012) $$" 8 -3) +(defconst verilog-mode-release-date (substring "$$Date: 2013-01-03 05:29:05 -0800 (Thu, 03 Jan 2013) $$" 8 -3) "Release date of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -501,7 +501,7 @@ entry \"Fontify Buffer\"). XEmacs: turn off and on font locking." "Type of statements to lineup across multiple lines. If 'all' is selected, then all line ups described below are done. -If 'declaration', then just declarations are lined up with any +If 'declarations', then just declarations are lined up with any preceding declarations, taking into account widths and the like, so or example the code: reg [31:0] a; @@ -964,7 +964,7 @@ See also `verilog-library-flags', `verilog-library-directories'." This is used for AUTORESET and AUTOTIEOFF. For proper behavior, you will probably also need `verilog-auto-reset-widths' set." :group 'verilog-mode-auto - :type 'string) + :type '(choice (const nil) regexp)) (put 'verilog-active-low-regexp 'safe-local-variable 'stringp) (defcustom verilog-auto-sense-include-inputs nil @@ -1129,37 +1129,37 @@ won't merge conflict." (defcustom verilog-auto-inst-interfaced-ports nil "Non-nil means include interfaced ports in AUTOINST expansions." + :version "24.3" ;; rev773, default change rev815 :group 'verilog-mode-auto - :type 'boolean - :version "24.3") + :type 'boolean) (put 'verilog-auto-inst-interfaced-ports 'safe-local-variable 'verilog-booleanp) (defcustom verilog-auto-input-ignore-regexp nil "If set, when creating AUTOINPUT list, ignore signals matching this regexp. See the \\[verilog-faq] for examples on using this." :group 'verilog-mode-auto - :type 'string) + :type '(choice (const nil) regexp)) (put 'verilog-auto-input-ignore-regexp 'safe-local-variable 'stringp) (defcustom verilog-auto-inout-ignore-regexp nil "If set, when creating AUTOINOUT list, ignore signals matching this regexp. See the \\[verilog-faq] for examples on using this." :group 'verilog-mode-auto - :type 'string) + :type '(choice (const nil) regexp)) (put 'verilog-auto-inout-ignore-regexp 'safe-local-variable 'stringp) (defcustom verilog-auto-output-ignore-regexp nil "If set, when creating AUTOOUTPUT list, ignore signals matching this regexp. See the \\[verilog-faq] for examples on using this." :group 'verilog-mode-auto - :type 'string) + :type '(choice (const nil) regexp)) (put 'verilog-auto-output-ignore-regexp 'safe-local-variable 'stringp) (defcustom verilog-auto-template-warn-unused nil "Non-nil means report warning if an AUTO_TEMPLATE line is not used. This feature is not supported before Emacs 21.1 or XEmacs 21.4." + :version "24.3" ;;rev787 :group 'verilog-mode-auto - :version "24.3" :type 'boolean) (put 'verilog-auto-template-warn-unused 'safe-local-variable 'verilog-booleanp) @@ -1176,21 +1176,21 @@ assignment, else the data type for variable creation." "If set, when creating AUTOTIEOFF list, ignore signals matching this regexp. See the \\[verilog-faq] for examples on using this." :group 'verilog-mode-auto - :type 'string) + :type '(choice (const nil) regexp)) (put 'verilog-auto-tieoff-ignore-regexp 'safe-local-variable 'stringp) (defcustom verilog-auto-unused-ignore-regexp nil "If set, when creating AUTOUNUSED list, ignore signals matching this regexp. See the \\[verilog-faq] for examples on using this." :group 'verilog-mode-auto - :type 'string) + :type '(choice (const nil) regexp)) (put 'verilog-auto-unused-ignore-regexp 'safe-local-variable 'stringp) (defcustom verilog-typedef-regexp nil "If non-nil, regular expression that matches Verilog-2001 typedef names. For example, \"_t$\" matches typedefs named with _t, as in the C language." :group 'verilog-mode-auto - :type 'string) + :type '(choice (const nil) regexp)) (put 'verilog-typedef-regexp 'safe-local-variable 'stringp) (defcustom verilog-mode-hook 'verilog-set-compile-command @@ -1230,14 +1230,14 @@ For example, \"_t$\" matches typedefs named with _t, as in the C language." (defcustom verilog-before-save-font-hook nil "Hook run before `verilog-save-font-mods' removes highlighting." + :version "24.3" ;;rev735 :group 'verilog-mode-auto - :version "24.3" :type 'hook) (defcustom verilog-after-save-font-hook nil "Hook run after `verilog-save-font-mods' restores highlighting." + :version "24.3" ;;rev735 :group 'verilog-mode-auto - :version "24.3" :type 'hook) (defvar verilog-imenu-generic-expression @@ -2784,6 +2784,8 @@ find the errors." (modify-syntax-entry ?> "." table) (modify-syntax-entry ?& "." table) (modify-syntax-entry ?| "." table) + ;; FIXME: This goes against Emacs conventions. Use "_" syntax instead and + ;; then use regexps with things like "\\_<...\\_>". (modify-syntax-entry ?` "w" table) (modify-syntax-entry ?_ "w" table) (modify-syntax-entry ?\' "." table) @@ -7771,9 +7773,12 @@ Tieoff value uses `verilog-active-low-regexp' and ;; Else presume verilog-auto-reset-widths is true (t (let* ((width (verilog-sig-width sig))) - (if (string-match "^[0-9]+$" width) - (concat width (if (verilog-sig-signed sig) "'sh0" "'h0")) - (concat "{" width "{1'b0}}"))))))) + (cond ((not width) + "`0/*NOWIDTH*/") + ((string-match "^[0-9]+$" width) + (concat width (if (verilog-sig-signed sig) "'sh0" "'h0"))) + (t + (concat "{" width "{1'b0}}")))))))) ;; ;; Dumping @@ -7954,6 +7959,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." vec expect-signal keywd newsig rvalue enum io signed typedefed multidim modport varstack tmp) + ;;(if dbg (setq dbg (concat dbg (format "\n\nverilog-read-decls START PT %s END %s\n" (point) end-mod-point)))) (save-excursion (verilog-beg-of-defun-quick) (setq sigs-const (verilog-read-auto-constants (point) end-mod-point)) @@ -8008,7 +8014,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." (setq paren (1- paren)) (forward-char 1) (when (< paren sig-paren) - (setq expect-signal nil))) ; ) that ends variables inside v2k arg list + (setq expect-signal nil rvalue nil))) ; ) that ends variables inside v2k arg list ((looking-at "\\s-*\\(\\[[^]]+\\]\\)") (goto-char (match-end 0)) (cond (newsig ; Memory, not just width. Patch last signal added's memory (nth 3) @@ -12456,12 +12462,20 @@ used on the right hand side of assignments. By default, AUTORESET will include the width of the signal in the autos, SystemVerilog designs may want to change this. To control -this behavior, see `verilog-auto-reset-widths'. +this behavior, see `verilog-auto-reset-widths'. In some cases +AUTORESET must use a '0 assignment and it will print NOWIDTH; use +`verilog-auto-reset-widths' unbased to prevent this. AUTORESET ties signals to deasserted, which is presumed to be zero. Signals that match `verilog-active-low-regexp' will be deasserted by tying them to a one. +AUTORESET may try to reset arrays or structures that cannot be +reset by a simple assignment, resulting in compile errors. This +is a feature to be taken as a hint that you need to reset these +signals manually (or put them into a \"`ifdef NEVER signal<=`0; +`endif\" so Verilog-Mode ignores them.) + An example: always @(posedge clk or negedge reset_l) begin diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index e3b421efbe1..0050a94513a 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.33.28" +(defconst vhdl-version "3.34.2" "VHDL Mode version number.") -(defconst vhdl-time-stamp "2010-09-22" +(defconst vhdl-time-stamp "2012-11-21" "VHDL Mode time stamp for last update.") ;; This file is part of GNU Emacs. @@ -72,8 +72,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Emacs Versions -;; supported: GNU Emacs 20.X/21.X/22.X,23.X, XEmacs 20.X/21.X -;; tested on: GNU Emacs 20.4/21.3/22.1,23.X, XEmacs 21.1 (marginally) +;; this updated version was only tested on: GNU Emacs 20.4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Installation @@ -84,7 +83,7 @@ ;; or into an arbitrary directory that is added to the load path by the ;; following line in your Emacs start-up file `.emacs': -;; (setq load-path (cons (expand-file-name "<directory-name>") load-path)) +;; (push (expand-file-name "<directory-name>") load-path) ;; If you already have the compiled `vhdl-mode.elc' file, put it in the same ;; directory. Otherwise, byte-compile the source file: @@ -96,7 +95,7 @@ ;; (not required in Emacs 20 and higher): ;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t) -;; (setq auto-mode-alist (cons '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist)) +;; (push '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist) ;; More detailed installation instructions are included in the official ;; VHDL Mode distribution. @@ -130,6 +129,7 @@ ;; Emacs 21+ handling (defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep 'xemacs))) "Non-nil if GNU Emacs 21, 22, ... is used.") +;; Emacs 22+ handling (defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not (featurep 'xemacs))) "Non-nil if GNU Emacs 22, ... is used.") @@ -210,22 +210,25 @@ Overrides local variable `indent-tabs-mode'." (defcustom vhdl-compiler-alist '( + ;; 60: docal <= false; + ;; ^^^^^ + ;; [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]+\\):" 0 1 0) ("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_0078: "Unknown identifier "Addr_Bits"." "<filename>" 40 30 - ("Aldec" "vcom" "-93 -work \\1" "make" "-f \\1" + ;; 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" - (".+?[ \t]+\\(?:ERROR\\)[^:]+:.+?\\(?:.+\"\\(.+?\\)\"[ \t]+\\([0-9]+\\)\\)" 1 2 0) ("" 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]+ (\\(.+\\),\\([0-9]+\\)):" 1 2 0) ("" 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 @@ -233,21 +236,27 @@ 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+ (\\(.+\\),\\([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" "ghdl" "-i --workdir=\\1 --ieee=synopsys -fexplicit " "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "ghdl" - ("ghdl_p: \\*E,\\w+ (\\(.+\\),\\([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) + 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]+\\):" 0 1 2) + ("E L\\([0-9]+\\)/C\\([0-9]+\\):" nil 1 2) ("^analyze +\\(.+ +\\)*\\(.+\\)$" 2) nil) ;; ModelSim, Model Technology: vcom test.vhd @@ -257,29 +266,39 @@ 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]+\]\\)? \\(.+\\)(\\([0-9]+\\)):" 3 4 0) ("" 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 0) ("" 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 + ;; Error: VHDL error at dvi2sdi.vhd(473): object k2_alto_out_lvl is used + ;; Error: Verilog HDL syntax error at otsuif_v1_top.vhd(147) near text + ;; Error: VHDL syntax error at otsuif_v1_top.vhd(147): clk_ is an illegal + ;; Error: VHDL Use Clause error at otsuif_v1_top.vhd(455): design library + ;; 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) + 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\\)[^:]*: \\(.+\\)(\\([0-9]+\\)):" 2 3 0) ("" 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 0) ("" 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)) @@ -287,39 +306,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+: \\(.+\\): (line \\([0-9]+\\)): " 2 3 0) ("" 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 \\(.+\\) Line \\([0-9]+\\):" 1 2 0) ("" 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]+ \\(.+\\)(\\([0-9]+\\)):" 1 2 0) ("" 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]+ \\(.+\\)(\\([0-9]+\\)):" 1 2 0) ("" 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]:\"\\(.+\\)\":\\([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]+\\) \\*\\*\\*" 0 1 0) + ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil) ("^ *Compiling \"\\(.+\\)\" " 1) nil) ;; VeriBest: vc vhdl test.vhd @@ -329,21 +348,21 @@ Overrides local variable `indent-tabs-mode'." ;; [Error] Name BITA is unknown ("VeriBest" "vc" "vhdl" "make" "-f \\1" nil "mkdir \\1" "./" "work/" "Makefile" "veribest" - ("^ +\\([0-9]+\\): +[^ ]" 0 1 0) ("" 0) + ("^ +\\([0-9]+\\): +[^ ]" nil 1 nil) ("" 0) nil) ;; Viewlogic: analyze -libfile vsslib.ini -src test.vhd ;; Compiling "test.vhd" line 1... ;; **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]+\\) \\*\\*\\*" 0 1 0) + ("\\*\\*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]+ - \"\\(.+\\)\" Line \\([0-9]+\\)\." 1 2 0) ("" 0) + ("^ERROR:HDLParsers:[0-9]+ - \"\\([^ \\t\\n]+\\)\" Line \\([0-9]+\\)\." 1 2 nil) ("" 0) nil) ) "List of available VHDL compilers and their properties. @@ -429,9 +448,13 @@ NOTE: Activate new error and file message regexps and reflect the new setting (string :tag "ID string ") (list :tag "Error message" :indent 4 (regexp :tag "Regexp ") - (integer :tag "File subexp index") + (choice :tag "File subexp " + (integer :tag "Index") + (const :tag "No file name" nil)) (integer :tag "Line subexp index") - (integer :tag "Column subexp idx")) + (choice :tag "Column subexp " + (integer :tag "Index") + (const :tag "No column number" nil))) (list :tag "File message" :indent 4 (regexp :tag "Regexp ") (integer :tag "File subexp index")) @@ -450,6 +473,7 @@ NOTE: Activate new error and file message regexps and reflect the new setting (const :tag "Downcase" downcase)))))) :set (lambda (variable value) (vhdl-custom-set variable value 'vhdl-update-mode-menu)) + :version "24.4" :group 'vhdl-compile) (defcustom vhdl-compiler "GHDL" @@ -457,7 +481,7 @@ NOTE: Activate new error and file message regexps and reflect the new setting Select a compiler name from the ones defined in option `vhdl-compiler-alist'." :type (let ((alist vhdl-compiler-alist) list) (while alist - (setq list (cons (list 'const (caar alist)) list)) + (push (list 'const (caar alist)) list) (setq alist (cdr alist))) (append '(choice) (nreverse list))) :group 'vhdl-compile) @@ -602,7 +626,7 @@ NOTE: Reflect the new setting in the choice list of option `vhdl-project' (list :tag "Compiler" :indent 6 ,(let ((alist vhdl-compiler-alist) list) (while alist - (setq list (cons (list 'const (caar alist)) list)) + (push (list 'const (caar alist)) list) (setq alist (cdr alist))) (append '(choice :tag "Compiler name") (nreverse list))) @@ -637,7 +661,7 @@ headers and the source files/directories to be scanned in the hierarchy browser. The current project can also be changed temporarily in the menu." :type (let ((alist vhdl-project-alist) list) (while alist - (setq list (cons (list 'const (caar alist)) list)) + (push (list 'const (caar alist)) list) (setq alist (cdr alist))) (append '(choice (const :tag "None" nil) (const :tag "--")) (nreverse list))) @@ -1268,6 +1292,18 @@ The comments and empty lines between groups of ports are pasted: (const :tag "Always" always)) :group 'vhdl-port) +(defcustom vhdl-actual-generic-name '(".*" . "\\&") + (concat + "Specifies how actual generic names are obtained from formal generic names. +In a component instantiation, an actual generic name can be +obtained by modifying the formal generic name (e.g. attaching or stripping +off a substring)." + vhdl-name-doc-string) + :type '(cons (regexp :tag "From regexp") + (string :tag "To string ")) + :group 'vhdl-port + :version "24.4") + (defcustom vhdl-actual-port-name '(".*" . "\\&") (concat "Specifies how actual port names are obtained from formal port names. @@ -1469,21 +1505,21 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry (defvar end-comment-column) -(defgroup vhdl-align nil - "Customizations for alignment." +(defgroup vhdl-beautify nil + "Customizations for beautification." :group 'vhdl) (defcustom vhdl-auto-align t "Non-nil means align some templates automatically after generation." :type 'boolean - :group 'vhdl-align) + :group 'vhdl-beautify) (defcustom vhdl-align-groups t "Non-nil means align groups of code lines separately. A group of code lines is a region of consecutive lines between two lines that match the regexp in option `vhdl-align-group-separate'." :type 'boolean - :group 'vhdl-align) + :group 'vhdl-beautify) (defcustom vhdl-align-group-separate "^\\s-*$" "Regexp for matching a line that separates groups of lines for alignment. @@ -1491,7 +1527,7 @@ Examples: \"^\\s-*$\": matches an empty line \"^\\s-*\\(--.*\\)?$\": matches an empty line or a comment-only line" :type 'regexp - :group 'vhdl-align) + :group 'vhdl-beautify) (defcustom vhdl-align-same-indent t "Non-nil means align blocks with same indent separately. @@ -1500,7 +1536,18 @@ blocks of same indent which are aligned separately (except for argument/port lists). This gives nicer alignment in most cases. Option `vhdl-align-groups' still applies within these blocks." :type 'boolean - :group 'vhdl-align) + :group 'vhdl-beautify) + +(defcustom vhdl-beautify-options '(t t t t t) + "List of options for beautifying code. Allows to disable individual +features of code beautification." + :type '(list (boolean :tag "Whitespace cleanup ") + (boolean :tag "Single statement per line") + (boolean :tag "Indentation ") + (boolean :tag "Alignment ") + (boolean :tag "Case fixing ")) + :group 'vhdl-beautify + :version "24.4") (defgroup vhdl-highlight nil @@ -1846,7 +1893,7 @@ useful in large files where syntax-based indentation gets very slow." :group 'vhdl-misc) (defcustom vhdl-indent-comment-like-next-code-line t - "*Non-nil means comment lines are indented like the following code line. + "Non-nil means comment lines are indented like the following code line. Otherwise, comment lines are indented like the preceding code line. Indenting comment lines like the following code line gives nicer indentation when comments precede the code that they refer to." @@ -1872,14 +1919,11 @@ NOTE: Activate the new setting by restarting Emacs." "Non-nil means consider the underscore character `_' as part of word. An identifier containing underscores is then treated as a single word in select and move operations. All parts of an identifier separated by underscore -are treated as single words otherwise. - -NOTE: Activate the new setting in a VHDL buffer by using the menu entry - \"Activate Options\"." +are treated as single words otherwise." :type 'boolean - :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-mode-syntax-table-init)) :group 'vhdl-misc) +(make-obsolete-variable 'vhdl-underscore-is-part-of-word + 'superword-mode "24.4") (defgroup vhdl-related nil @@ -2070,7 +2114,7 @@ your style, only those that are different from the default.") (lambda (var) (cons var (symbol-value var)))) varlist)))) - (setq vhdl-style-alist (cons default vhdl-style-alist)))) + (push default vhdl-style-alist))) (defvar vhdl-mode-hook nil "Hook called by `vhdl-mode'.") @@ -2087,10 +2131,11 @@ your style, only those that are different from the default.") (require 'hippie-exp) ;; optional (minimize warning messages during compile) +(unless (featurep 'xemacs) (eval-when-compile (require 'font-lock) (require 'ps-print) - (require 'speedbar)) + (require 'speedbar))) ; for speedbar-with-writable ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -2190,6 +2235,17 @@ Ignore byte-compiler warnings you might see." (unless (fboundp 'member-ignore-case) (defalias 'member-ignore-case 'member)) +;; `last-input-char' obsolete in Emacs 24, `last-input-event' different +;; behavior in XEmacs +(defvar vhdl-last-input-event) +(if (featurep 'xemacs) + (defvaralias 'vhdl-last-input-event 'last-input-char) + (defvaralias 'vhdl-last-input-event 'last-input-event)) + +;; `help-print-return-message' changed to `print-help-return-message' in Emacs +;;;(unless (fboundp 'help-print-return-message) +;;; (defalias 'help-print-return-message 'print-help-return-message)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Compatibility with older VHDL Mode versions @@ -2210,7 +2266,7 @@ Ignore byte-compiler warnings you might see." (vhdl-warning (apply 'format args) t) (unless vhdl-warnings (vhdl-run-when-idle .1 nil 'vhdl-print-warnings)) - (setq vhdl-warnings (cons (apply 'format args) vhdl-warnings)))) + (push (apply 'format args) vhdl-warnings))) (defun vhdl-warning (string &optional nobeep) "Print out warning STRING and beep." @@ -2244,7 +2300,7 @@ Ignore byte-compiler warnings you might see." (let ((old-alist vhdl-model-alist) new-alist) (while old-alist - (setq new-alist (cons (append (car old-alist) '("")) new-alist)) + (push (append (car old-alist) '("")) new-alist) (setq old-alist (cdr old-alist))) (setq vhdl-model-alist (nreverse new-alist))) (customize-save-variable 'vhdl-model-alist vhdl-model-alist)) @@ -2254,7 +2310,7 @@ Ignore byte-compiler warnings you might see." (let ((old-alist vhdl-project-alist) new-alist) (while old-alist - (setq new-alist (cons (append (car old-alist) '("")) new-alist)) + (push (append (car old-alist) '("")) new-alist) (setq old-alist (cdr old-alist))) (setq vhdl-project-alist (nreverse new-alist))) (customize-save-variable 'vhdl-project-alist vhdl-project-alist)) @@ -2342,7 +2398,6 @@ Ignore byte-compiler warnings you might see." (unless (get 'speedbar-indentation-width 'saved-value) (setq speedbar-indentation-width 2))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Help functions / inline substitutions / macros ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -2433,6 +2488,7 @@ old environment. Used for consistent searching." (progn (set-buffer (create-file-buffer ,file-name)) (setq file-opened t) (vhdl-insert-file-contents ,file-name) + ;; FIXME: This modifies a global syntax-table! (modify-syntax-entry ?\- ". 12" (syntax-table)) (modify-syntax-entry ?\n ">" (syntax-table)) (modify-syntax-entry ?\^M ">" (syntax-table)) @@ -2489,7 +2545,7 @@ conversion." (defun vhdl-delete (elt list) "Delete by side effect the first occurrence of ELT as a member of LIST." - (setq list (cons nil list)) + (push nil list) (let ((list1 list)) (while (and (cdr list1) (not (equal elt (cadr list1)))) (setq list1 (cdr list1))) @@ -2497,6 +2553,9 @@ conversion." (setcdr list1 (cddr list1)))) (cdr list)) +(declare-function speedbar-refresh "speedbar" (&optional arg)) +(declare-function speedbar-do-function-pointer "speedbar" ()) + (defun vhdl-speedbar-refresh (&optional key) "Refresh directory or project with name KEY." (when (and (boundp 'speedbar-frame) @@ -2537,6 +2596,11 @@ 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'." @@ -2547,19 +2611,19 @@ elements > `vhdl-menu-max-size'." (menuno 1) (i 0)) (while remain - (setq sublist (cons (car remain) sublist)) + (push (car remain) sublist) (setq remain (cdr remain)) (setq i (+ i 1)) (if (= i vhdl-menu-max-size) (progn - (setq result (cons (cons (format "%s %s" title menuno) - (nreverse sublist)) result)) + (push (cons (format "%s %s" title menuno) + (nreverse sublist)) result) (setq i 0) (setq menuno (+ menuno 1)) (setq sublist '())))) (and sublist - (setq result (cons (cons (format "%s %s" title menuno) - (nreverse sublist)) result))) + (push (cons (format "%s %s" title menuno) + (nreverse sublist)) result)) (nreverse result)) list)) @@ -2723,11 +2787,6 @@ STRING are replaced by `-' and substrings are converted to lower case." (define-key vhdl-mode-map "\M-\C-h" 'vhdl-mark-defun)) (define-key vhdl-mode-map "\M-\C-q" 'vhdl-indent-sexp) (define-key vhdl-mode-map "\M-^" 'vhdl-delete-indentation) - ;; backspace/delete key bindings - (define-key vhdl-mode-map [backspace] 'backward-delete-char-untabify) - (unless (boundp 'delete-key-deletes-forward) ; XEmacs variable - (define-key vhdl-mode-map [delete] 'delete-char) - (define-key vhdl-mode-map [(meta delete)] 'kill-word)) ;; mode specific key bindings (define-key vhdl-mode-map "\C-c\C-m\C-e" 'vhdl-electric-mode) (define-key vhdl-mode-map "\C-c\C-m\C-s" 'vhdl-stutter-mode) @@ -2794,6 +2853,8 @@ STRING are replaced by `-' and substrings are converted to lower case." (define-key vhdl-mode-map "\C-c\C-l\C-o" 'vhdl-line-open) (define-key vhdl-mode-map "\C-c\C-l\C-g" 'goto-line) (define-key vhdl-mode-map "\C-c\C-l\C-c" 'vhdl-comment-uncomment-line) + (define-key vhdl-mode-map "\C-c\C-x\C-s" 'vhdl-fix-statement-region) + (define-key vhdl-mode-map "\C-c\C-x\M-s" 'vhdl-fix-statement-buffer) (define-key vhdl-mode-map "\C-c\C-x\C-p" 'vhdl-fix-clause) (define-key vhdl-mode-map "\C-c\C-x\M-c" 'vhdl-fix-case-region) (define-key vhdl-mode-map "\C-c\C-x\C-c" 'vhdl-fix-case-buffer) @@ -2864,56 +2925,51 @@ STRING are replaced by `-' and substrings are converted to lower case." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Syntax table -(defvar vhdl-mode-syntax-table nil +(defvar vhdl-mode-syntax-table + (let ((st (make-syntax-table))) + ;; define punctuation + (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) + ;; define string + (modify-syntax-entry ?\" "\"" st) + ;; define underscore + (modify-syntax-entry ?\_ (if vhdl-underscore-is-part-of-word "w" "_") st) + ;; a single hyphen is punctuation, but a double hyphen starts a comment + (modify-syntax-entry ?\- ". 12" st) + ;; and \n and \^M end a comment + (modify-syntax-entry ?\n ">" st) + (modify-syntax-entry ?\^M ">" st) + ;; define parentheses to match + (modify-syntax-entry ?\( "()" st) + (modify-syntax-entry ?\) ")(" st) + (modify-syntax-entry ?\[ "(]" st) + (modify-syntax-entry ?\] ")[" st) + (modify-syntax-entry ?\{ "(}" st) + (modify-syntax-entry ?\} "){" st) + st) "Syntax table used in `vhdl-mode' buffers.") -(defvar vhdl-mode-ext-syntax-table nil +(defvar vhdl-mode-ext-syntax-table + ;; Extended syntax table including '_' (for simpler search regexps). + (let ((st (copy-syntax-table vhdl-mode-syntax-table))) + (modify-syntax-entry ?_ "w" st) + st) "Syntax table extended by `_' used in `vhdl-mode' buffers.") -(defun vhdl-mode-syntax-table-init () - "Initialize `vhdl-mode-syntax-table'." - (setq vhdl-mode-syntax-table (make-syntax-table)) - ;; define punctuation - (modify-syntax-entry ?\# "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\$ "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\% "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\& "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\' "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\* "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\+ "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\. "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\/ "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\: "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\; "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\< "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\= "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\> "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\\ "." vhdl-mode-syntax-table) - (modify-syntax-entry ?\| "." vhdl-mode-syntax-table) - ;; define string - (modify-syntax-entry ?\" "\"" vhdl-mode-syntax-table) - ;; define underscore - (when vhdl-underscore-is-part-of-word - (modify-syntax-entry ?\_ "w" vhdl-mode-syntax-table)) - ;; a single hyphen is punctuation, but a double hyphen starts a comment - (modify-syntax-entry ?\- ". 12" vhdl-mode-syntax-table) - ;; and \n and \^M end a comment - (modify-syntax-entry ?\n ">" vhdl-mode-syntax-table) - (modify-syntax-entry ?\^M ">" vhdl-mode-syntax-table) - ;; define parentheses to match - (modify-syntax-entry ?\( "()" vhdl-mode-syntax-table) - (modify-syntax-entry ?\) ")(" vhdl-mode-syntax-table) - (modify-syntax-entry ?\[ "(]" vhdl-mode-syntax-table) - (modify-syntax-entry ?\] ")[" vhdl-mode-syntax-table) - (modify-syntax-entry ?\{ "(}" vhdl-mode-syntax-table) - (modify-syntax-entry ?\} "){" vhdl-mode-syntax-table) - ;; extended syntax table including '_' (for simpler search regexps) - (setq vhdl-mode-ext-syntax-table (copy-syntax-table vhdl-mode-syntax-table)) - (modify-syntax-entry ?_ "w" vhdl-mode-ext-syntax-table)) - -;; initialize syntax table for VHDL Mode -(vhdl-mode-syntax-table-init) - (defvar vhdl-syntactic-context nil "Buffer local variable containing syntactic analysis list.") (make-variable-buffer-local 'vhdl-syntactic-context) @@ -3506,6 +3562,9 @@ STRING are replaced by `-' and substrings are converted to lower case." ["Whitespace Region" vhdl-fixup-whitespace-region (mark)] ["Whitespace Buffer" vhdl-fixup-whitespace-buffer t] "--" + ["Statement Region" vhdl-fix-statement-region (mark)] + ["Statement Buffer" vhdl-fix-statement-buffer t] + "--" ["Trailing Spaces Buffer" vhdl-remove-trailing-spaces t]) ("Update" ["Sensitivity List" vhdl-update-sensitivity-list-process t] @@ -3814,6 +3873,7 @@ STRING are replaced by `-' and substrings are converted to lower case." ["Always" (customize-set-variable 'vhdl-include-group-comments 'always) :style radio :selected (eq 'always vhdl-include-group-comments)]) + ["Actual Generic Name..." (customize-option 'vhdl-actual-generic-name) t] ["Actual Port Name..." (customize-option 'vhdl-actual-port-name) t] ["Instance Name..." (customize-option 'vhdl-instance-name) t] ("Testbench" @@ -3910,7 +3970,7 @@ STRING are replaced by `-' and substrings are converted to lower case." ["End Comment Column..." (customize-option 'vhdl-end-comment-column) t] "--" ["Customize Group..." (customize-group 'vhdl-comment) t]) - ("Align" + ("Beautify" ["Auto Align Templates" (customize-set-variable 'vhdl-auto-align (not vhdl-auto-align)) :style toggle :selected vhdl-auto-align] @@ -3918,13 +3978,14 @@ STRING are replaced by `-' and substrings are converted to lower case." (customize-set-variable 'vhdl-align-groups (not vhdl-align-groups)) :style toggle :selected vhdl-align-groups] ["Group Separation String..." - (customize-set-variable 'vhdl-align-group-separate) t] + (customize-option 'vhdl-align-group-separate) t] ["Align Lines with Same Indent" (customize-set-variable 'vhdl-align-same-indent (not vhdl-align-same-indent)) :style toggle :selected vhdl-align-same-indent] + ["Beautify Options..." (customize-option 'vhdl-beautify-options) t] "--" - ["Customize Group..." (customize-group 'vhdl-align) t]) + ["Customize Group..." (customize-group 'vhdl-beautify) t]) ("Highlight" ["Highlighting On/Off..." (customize-option @@ -4188,14 +4249,13 @@ The directory of the current source file is scanned." (setq found nil) (while file-list (setq found t) - (setq menu-list (cons (vector (car file-list) - (list 'find-file (car file-list)) t) - menu-list)) + (push (vector (car file-list) (list 'find-file (car file-list)) t) + menu-list) (setq file-list (cdr file-list))) (setq menu-list (vhdl-menu-split menu-list "Sources")) - (when found (setq menu-list (cons "--" menu-list))) - (setq menu-list (cons ["*Rescan*" vhdl-add-source-files-menu t] menu-list)) - (setq menu-list (cons "Sources" menu-list)) + (when found (push "--" menu-list)) + (push ["*Rescan*" vhdl-add-source-files-menu t] menu-list) + (push "Sources" menu-list) ;; Create menu (easy-menu-add menu-list) (easy-menu-define vhdl-sources-menu newmap @@ -4579,7 +4639,7 @@ Usage: option `vhdl-index-menu' to non-nil) or made accessible as a mouse menu (e.g. add \"(global-set-key '[S-down-mouse-3] 'imenu)\" to your start-up file) for browsing the file contents (is not populated if buffer is - larger than `font-lock-maximum-size'). Also, a source file menu can be + larger than 256000). Also, a source file menu can be added (set option `vhdl-source-file-menu' to non-nil) for browsing the current directory for VHDL source files. @@ -4706,7 +4766,7 @@ Usage: automatically recognized as VHDL source files. To add an extension \".xxx\", add the following line to your Emacs start-up file (`.emacs'): - \(setq auto-mode-alist (cons '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist)) + \(push '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist) HINTS: @@ -7277,7 +7337,7 @@ indentation change." (beginning-of-line 2) (setq syntax (vhdl-get-syntactic-context))))) (when is-comment - (setq syntax (cons (cons 'comment nil) syntax))) + (push (cons 'comment nil) syntax)) (apply '+ (mapcar 'vhdl-get-offset syntax))) ;; indent like previous nonblank line (save-excursion (beginning-of-line) @@ -7388,7 +7448,7 @@ ENDPOS is encountered." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Alignment, whitespace fixup, beautifying +;;; Alignment, beautifying ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst vhdl-align-alist @@ -7604,7 +7664,8 @@ the token in MATCH." (when vhdl-progress-interval (setq vhdl-progress-info (vector (count-lines (point-min) beg) (count-lines (point-min) end) 0)))) - (vhdl-fixup-whitespace-region beg end t) + (when (nth 0 vhdl-beautify-options) + (vhdl-fixup-whitespace-region beg end t)) (goto-char beg) (if (not vhdl-align-groups) ;; align entire region @@ -7728,14 +7789,14 @@ the token in MATCH." ;; search for comment start positions and lengths (while (< (point) end) (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>")) - (looking-at "^\\(.*[^ \t\n\r\f-]+\\)\\s-*\\(--.*\\)$") + (looking-at "^\\(.*?[^ \t\n\r\f-]+\\)\\s-*\\(--.*\\)$") (not (save-excursion (goto-char (match-beginning 2)) (vhdl-in-literal)))) (setq start (+ (- (match-end 1) (match-beginning 1)) spacing)) (setq length (- (match-end 2) (match-beginning 2))) (setq start-max (max start start-max)) (setq length-max (max length length-max)) - (setq comment-list (cons (cons start length) comment-list))) + (push (cons start length) comment-list)) (beginning-of-line 2)) (setq comment-list (sort comment-list (function (lambda (a b) (> (car a) (car b)))))) @@ -7746,14 +7807,14 @@ the token in MATCH." (unless (or (= (caar comment-list) (car start-list)) (<= (+ (car start-list) (cdar comment-list)) end-comment-column)) - (setq start-list (cons (caar comment-list) start-list))) + (push (caar comment-list) start-list)) (setq comment-list (cdr comment-list))) ;; align lines as nicely as possible (goto-char beg) (while (< (point) end) (setq cur-start nil) (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>")) - (or (and (looking-at "^\\(.*[^ \t\n\r\f-]+\\)\\(\\s-*\\)\\(--.*\\)$") + (or (and (looking-at "^\\(.*?[^ \t\n\r\f-]+\\)\\(\\s-*\\)\\(--.*\\)$") (not (save-excursion (goto-char (match-beginning 3)) (vhdl-in-literal)))) @@ -7879,7 +7940,7 @@ end of line, do nothing in comments and strings." (replace-match "\\2"))) ;; surround operator symbols by one space (goto-char beg) - (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\([^/:<>=]\\)\\(:\\|\\??=\\|\\??<<\\|\\??>>\\|\\??<\\|\\??>\\|:=\\|\\??<=\\|\\??>=\\|=>\\|\\??/=\\|\\?\\?\\)\\([^=>]\\|$\\)\\)" end t) + (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\([^/:<>=\n]\\)\\(:\\|\\??=\\|\\??<<\\|\\??>>\\|\\??<\\|\\??>\\|:=\\|\\??<=\\|\\??>=\\|=>\\|\\??/=\\|\\?\\?\\)\\([^=>\n]\\|$\\)\\)" end t) (if (or (match-string 1) (<= (match-beginning 0) ; not if at boi (save-excursion (back-to-indentation) (point)))) @@ -7913,6 +7974,154 @@ end of line, do nothing in comments." (vhdl-fixup-whitespace-region (point-min) (point-max))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Case fixing + +(defun vhdl-fix-case-region-1 (beg end upper-case word-regexp &optional count) + "Convert all words matching WORD-REGEXP in region to lower or upper case, +depending on parameter UPPER-CASE." + (let ((case-replace nil) + (last-update 0)) + (vhdl-prepare-search-2 + (save-excursion + (goto-char end) + (setq end (point-marker)) + (goto-char beg) + (while (re-search-forward word-regexp end t) + (or (vhdl-in-literal) + (if upper-case + (upcase-word -1) + (downcase-word -1))) + (when (and count vhdl-progress-interval (not noninteractive) + (< vhdl-progress-interval + (- (nth 1 (current-time)) last-update))) + (message "Fixing case... (%2d%s)" + (+ (* count 20) (/ (* 20 (- (point) beg)) (- end beg))) + "%") + (setq last-update (nth 1 (current-time))))) + (goto-char end))))) + +(defun vhdl-fix-case-region (beg end &optional arg) + "Convert all VHDL words in region to lower or upper case, depending on +options vhdl-upper-case-{keywords,types,attributes,enum-values}." + (interactive "r\nP") + (vhdl-fix-case-region-1 + beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0) + (vhdl-fix-case-region-1 + beg end vhdl-upper-case-types vhdl-types-regexp 1) + (vhdl-fix-case-region-1 + beg end vhdl-upper-case-attributes (concat "'" vhdl-attributes-regexp) 2) + (vhdl-fix-case-region-1 + beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp 3) + (vhdl-fix-case-region-1 + beg end vhdl-upper-case-constants vhdl-constants-regexp 4) + (when vhdl-progress-interval (message "Fixing case...done"))) + +(defun vhdl-fix-case-buffer () + "Convert all VHDL words in buffer to lower or upper case, depending on +options vhdl-upper-case-{keywords,types,attributes,enum-values}." + (interactive) + (vhdl-fix-case-region (point-min) (point-max))) + +(defun vhdl-fix-case-word (&optional arg) + "Convert word after cursor to upper case if necessary." + (interactive "p") + (save-excursion + (when arg (backward-word 1)) + (vhdl-prepare-search-1 + (when (and vhdl-upper-case-keywords + (looking-at vhdl-keywords-regexp)) + (upcase-word 1)) + (when (and vhdl-upper-case-types + (looking-at vhdl-types-regexp)) + (upcase-word 1)) + (when (and vhdl-upper-case-attributes + (looking-at vhdl-attributes-regexp)) + (upcase-word 1)) + (when (and vhdl-upper-case-enum-values + (looking-at vhdl-enum-values-regexp)) + (upcase-word 1)) + (when (and vhdl-upper-case-constants + (looking-at vhdl-constants-regexp)) + (upcase-word 1))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Fix statements +;; - force each statement to be on a separate line except when on same line +;; with 'end' keyword + +(defun vhdl-fix-statement-region (beg end &optional arg) + "Force statements in region on separate line except when on same line +with 'end' keyword (necessary for correct indentation). +Currently supported keywords: 'begin', 'if'." + (interactive "r\nP") + (vhdl-prepare-search-2 + (let (point) + (save-excursion + (goto-char end) + (setq end (point-marker)) + (goto-char beg) + ;; `begin' keyword + (while (re-search-forward + "^\\s-*[^ \t\n].*?\\(\\<begin\\>\\)\\(.*\\<end\\>\\)?" end t) + (goto-char (match-end 0)) + (setq point (point-marker)) + (when (and (match-string 1) + (or (not (match-string 2)) + (save-excursion (goto-char (match-end 2)) + (vhdl-in-literal))) + (not (save-excursion (goto-char (match-beginning 1)) + (vhdl-in-literal)))) + (goto-char (match-beginning 1)) + (insert "\n") + (indent-according-to-mode)) + (goto-char point)) + (goto-char beg) + ;; `for', `if' keywords + (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 + (when (and (not (save-excursion (goto-char (match-beginning 1)) + (vhdl-in-literal))) + (save-excursion + (beginning-of-line 1) + (save-match-data + (and (re-search-forward "^\\s-*\\([^ \t\n].*\\)" + (match-beginning 1) t) + (not (string-match + "\\(\\<end\\>\\|\\<wait\\>\\|\\w+\\s-*:\\)\\s-*$" + (match-string 1))))))) + (goto-char (match-beginning 1)) + (insert "\n") + (indent-according-to-mode)) + (goto-char point)))))) + +(defun vhdl-fix-statement-buffer () + "Force statements in buffer on separate line except when on same line +with 'end' keyword (necessary for correct indentation)." + (interactive) + (vhdl-fix-statement-region (point-min) (point-max))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Trailing spaces + +(defun vhdl-remove-trailing-spaces-region (beg end &optional arg) + "Remove trailing spaces in region." + (interactive "r\nP") + (save-excursion + (goto-char end) + (setq end (point-marker)) + (goto-char beg) + (while (re-search-forward "[ \t]+$" end t) + (unless (vhdl-in-literal) + (replace-match "" nil nil))))) + +(defun vhdl-remove-trailing-spaces () + "Remove trailing spaces in buffer." + (interactive) + (vhdl-remove-trailing-spaces-region (point-min) (point-max))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Beautify (defun vhdl-beautify-region (beg end) @@ -7922,10 +8131,17 @@ case fixing to a region. Calls functions `vhdl-indent-buffer', `vhdl-fix-case-buffer'." (interactive "r") (setq end (save-excursion (goto-char end) (point-marker))) - (vhdl-indent-region beg end) + (save-excursion ; remove DOS EOL characters in UNIX file + (goto-char beg) + (while (search-forward "
" nil t) + (replace-match "" nil t))) + (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)) - (vhdl-align-region beg end)) - (vhdl-fix-case-region beg end)) + (when (nth 3 vhdl-beautify-options) (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))) (defun vhdl-beautify-buffer () "Beautify buffer by applying indentation, whitespace fixup, alignment, and @@ -8021,7 +8237,8 @@ buffer." (while (re-search-forward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?process\\>" nil t) (goto-char (match-beginning 0)) (condition-case nil (vhdl-update-sensitivity-list) (error ""))) - (message "Updating sensitivity lists...done")))) + (message "Updating sensitivity lists...done"))) + (when noninteractive (save-buffer))) (defun vhdl-update-sensitivity-list () "Update sensitivity list." @@ -8047,57 +8264,57 @@ buffer." (scan-regions-list '(;; right-hand side of signal/variable assignment ;; (special case: "<=" is relational operator in a condition) - ((re-search-forward "[<:]=" proc-end t) - (re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" proc-end t)) + ((vhdl-re-search-forward "[<:]=" proc-end t) + (vhdl-re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" proc-end t)) ;; if condition - ((re-search-forward "^\\s-*if\\>" proc-end t) - (re-search-forward "\\<then\\>" proc-end t)) + ((vhdl-re-search-forward "^\\s-*if\\>" proc-end t) + (vhdl-re-search-forward "\\<then\\>" proc-end t)) ;; elsif condition - ((re-search-forward "\\<elsif\\>" proc-end t) - (re-search-forward "\\<then\\>" proc-end t)) + ((vhdl-re-search-forward "\\<elsif\\>" proc-end t) + (vhdl-re-search-forward "\\<then\\>" proc-end t)) ;; while loop condition - ((re-search-forward "^\\s-*while\\>" proc-end t) - (re-search-forward "\\<loop\\>" proc-end t)) + ((vhdl-re-search-forward "^\\s-*while\\>" proc-end t) + (vhdl-re-search-forward "\\<loop\\>" proc-end t)) ;; exit/next condition - ((re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" proc-end t) - (re-search-forward ";" proc-end t)) + ((vhdl-re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" proc-end t) + (vhdl-re-search-forward ";" proc-end t)) ;; assert condition - ((re-search-forward "\\<assert\\>" proc-end t) - (re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" proc-end t)) + ((vhdl-re-search-forward "\\<assert\\>" proc-end t) + (vhdl-re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" proc-end t)) ;; case expression - ((re-search-forward "^\\s-*case\\>" proc-end t) - (re-search-forward "\\<is\\>" proc-end t)) + ((vhdl-re-search-forward "^\\s-*case\\>" proc-end t) + (vhdl-re-search-forward "\\<is\\>" proc-end t)) ;; parameter list of procedure call, array index ((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t) (1- (point))) (progn (backward-char) (forward-sexp) (while (looking-at "(") (forward-sexp)) (point))))) - name field read-list sens-list signal-list + name field read-list sens-list signal-list tmp-list sens-beg sens-end beg end margin) ;; scan for signals in old sensitivity list (goto-char proc-beg) - (re-search-forward "\\<process\\>" proc-mid t) + (vhdl-re-search-forward "\\<process\\>" proc-mid t) (if (not (looking-at "[ \t\n\r\f]*(")) (setq sens-beg (point)) - (setq sens-beg (re-search-forward "\\([ \t\n\r\f]*\\)([ \t\n\r\f]*" nil t)) + (setq sens-beg (vhdl-re-search-forward "\\([ \t\n\r\f]*\\)([ \t\n\r\f]*" nil t)) (goto-char (match-end 1)) (forward-sexp) (setq sens-end (1- (point))) (goto-char sens-beg) - (while (and (re-search-forward "\\(\\w+\\)" sens-end t) + (while (and (vhdl-re-search-forward "\\(\\w+\\)" sens-end t) (setq sens-list (cons (downcase (match-string 0)) sens-list)) - (re-search-forward "\\s-*,\\s-*" sens-end t)))) + (vhdl-re-search-forward "\\s-*,\\s-*" sens-end t)))) (setq signal-list (append visible-list sens-list)) ;; search for sequential parts (goto-char proc-mid) (while (setq beg (re-search-forward "^\\s-*\\(els\\)?if\\>" proc-end t)) - (setq end (re-search-forward "\\<then\\>" proc-end t)) - (when (re-search-backward "\\('event\\|\\<\\(falling\\|rising\\)_edge\\)\\>" beg t) + (setq end (vhdl-re-search-forward "\\<then\\>" proc-end t)) + (when (vhdl-re-search-backward "\\('event\\|\\<\\(falling\\|rising\\)_edge\\)\\>" beg t) (goto-char end) (backward-word 1) (vhdl-forward-sexp) - (setq seq-region-list (cons (cons end (point)) seq-region-list)) + (push (cons end (point)) seq-region-list) (beginning-of-line))) ;; scan for signals read in process (while scan-regions-list @@ -8114,15 +8331,35 @@ buffer." (and tmp-list (< (point) (cdar tmp-list)))))) (while (vhdl-re-search-forward "[^'\".]\\<\\([a-zA-Z]\\w*\\)\\(\\(\\.\\w+\\|[ \t\n\r\f]*([^)]*)\\)*\\)[ \t\n\r\f]*\\('\\(\\w+\\)\\|\\(=>\\)\\)?" end t) (setq name (match-string 1)) + ;; get array index range (when vhdl-array-index-record-field-in-sensitivity-list - (setq field (match-string 2))) + (setq field (match-string 2)) + ;; not use if it includes a variable name + (save-match-data + (setq tmp-list visible-list) + (while (and field tmp-list) + (when (string-match + (concat "\\<" (car tmp-list) "\\>") field) + (setq field nil)) + (setq tmp-list (cdr tmp-list))))) (when (and (not (match-string 6)) ; not when formal parameter (not (and (match-string 5) ; not event attribute (not (member (downcase (match-string 5)) '("event" "last_event" "transaction"))))) (member (downcase name) signal-list)) - (unless (member-ignore-case (concat name field) read-list) - (setq read-list (cons (concat name field) read-list)))) + ;; not add if name or name+field already exists + (unless + (or (member-ignore-case name read-list) + (member-ignore-case (concat name field) read-list)) + (push (concat name field) read-list)) + (setq tmp-list read-list) + ;; remove existing name+field if name is added + (save-match-data + (while tmp-list + (when (string-match (concat "^" name field "[(.]") + (car tmp-list)) + (setq read-list (delete (car tmp-list) read-list))) + (setq tmp-list (cdr tmp-list))))) (goto-char (match-end 1))))) (setq scan-regions-list (cdr scan-regions-list))) ;; update sensitivity list @@ -8178,7 +8415,7 @@ buffer." (while (< (point) end) (when (looking-at "signal[ \t\n\r\f]+") (goto-char (match-end 0))) - (while (looking-at "\\(\\w+\\)[ \t\n\r\f,]+") + (while (looking-at "\\([a-zA-Z]\\w*\\)[ \t\n\r\f,]+") (setq signal-list (cons (downcase (match-string 1)) signal-list)) (goto-char (match-end 0)) @@ -8197,12 +8434,12 @@ buffer." (when (= 0 (nth 0 (parse-partial-sexp beg (point)))) (if (match-string 2) ;; scan signal name - (while (looking-at "[ \t\n\r\f,]+\\(\\w+\\)") + (while (looking-at "[ \t\n\r\f,]+\\([a-zA-Z]\\w*\\)") (setq signal-list (cons (downcase (match-string 1)) signal-list)) (goto-char (match-end 0))) ;; scan alias name, check is alias of (declared) signal - (when (and (looking-at "[ \t\n\r\f]+\\(\\w+\\)[^;]*\\<is[ \t\n\r\f]+\\(\\w+\\)") + (when (and (looking-at "[ \t\n\r\f]+\\([a-zA-Z]\\w*\\)[^;]*\\<is[ \t\n\r\f]+\\([a-zA-Z]\\w*\\)") (member (downcase (match-string 2)) signal-list)) (setq signal-list (cons (downcase (match-string 1)) signal-list)) @@ -8290,19 +8527,6 @@ buffer." (goto-char end) (insert ")"))))))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Miscellaneous - -(defun vhdl-remove-trailing-spaces () - "Remove trailing spaces in the whole buffer." - (interactive) - (save-match-data - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "[ \t]+$" (point-max) t) - (unless (vhdl-in-literal) - (replace-match "" nil nil)))))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Electrification @@ -8334,14 +8558,14 @@ project is defined." With a prefix argument ARG, enable the mode if ARG is positive, and disable it otherwise. If called from Lisp, enable it if ARG is omitted or nil." - :global t) + :global t :group 'vhdl-mode) (define-minor-mode vhdl-stutter-mode "Toggle VHDL stuttering mode. With a prefix argument ARG, enable the mode if ARG is positive, and disable it otherwise. If called from Lisp, enable it if ARG is omitted or nil." - :global t) + :global t :group 'vhdl-mode) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Stuttering @@ -8398,7 +8622,7 @@ is omitted or nil." (defun vhdl-electric-quote (count) "'' --> \"" (interactive "p") (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (if (= (preceding-char) last-input-event) + (if (= (preceding-char) vhdl-last-input-event) (progn (delete-char -1) (insert-char ?\" 1)) (insert-char ?\' 1)) (self-insert-command count))) @@ -8406,7 +8630,7 @@ is omitted or nil." (defun vhdl-electric-semicolon (count) "';;' --> ' : ', ': ;' --> ' := '" (interactive "p") (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (cond ((= (preceding-char) last-input-event) + (cond ((= (preceding-char) vhdl-last-input-event) (progn (delete-char -1) (unless (eq (preceding-char) ? ) (insert " ")) (insert ": ") @@ -8420,7 +8644,7 @@ is omitted or nil." (defun vhdl-electric-comma (count) "',,' --> ' <= '" (interactive "p") (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (cond ((= (preceding-char) last-input-event) + (cond ((= (preceding-char) vhdl-last-input-event) (progn (delete-char -1) (unless (eq (preceding-char) ? ) (insert " ")) (insert "<= "))) @@ -8430,7 +8654,7 @@ is omitted or nil." (defun vhdl-electric-period (count) "'..' --> ' => '" (interactive "p") (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (cond ((= (preceding-char) last-input-event) + (cond ((= (preceding-char) vhdl-last-input-event) (progn (delete-char -1) (unless (eq (preceding-char) ? ) (insert " ")) (insert "=> "))) @@ -8440,7 +8664,7 @@ is omitted or nil." (defun vhdl-electric-equal (count) "'==' --> ' == '" (interactive "p") (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (cond ((= (preceding-char) last-input-event) + (cond ((= (preceding-char) vhdl-last-input-event) (progn (delete-char -1) (unless (eq (preceding-char) ? ) (insert " ")) (insert "== "))) @@ -8711,12 +8935,13 @@ since these are almost equivalent)." "[COMPONENT | ENTITY | CONFIGURATION]" " " t)) (setq unit (upcase (or unit ""))) (cond ((equal unit "ENTITY") - (vhdl-template-field "library name" "." nil nil nil nil + (let ((begin (point))) + (vhdl-template-field "library name" "." t begin (point) nil (vhdl-work-library)) (vhdl-template-field "entity name" "(") (if (vhdl-template-field "[architecture name]" nil t) (insert ")") - (delete-char -1))) + (delete-char -1)))) ((equal unit "CONFIGURATION") (vhdl-template-field "library name" "." nil nil nil nil (vhdl-work-library)) @@ -9852,7 +10077,7 @@ otherwise." (let ((definition (upcase (or (vhdl-template-field - "[scalar type | ARRAY | RECORD | ACCESS | FILE]" nil t) + "[scalar type | ARRAY | RECORD | ACCESS | FILE | ENUM]" nil t) "")))) (cond ((equal definition "") (delete-char -4) @@ -9870,6 +10095,11 @@ otherwise." ((equal definition "FILE") (vhdl-insert-keyword " OF ") (vhdl-template-field "type" ";")) + ((equal definition "ENUM") + (kill-word -1) + (insert "(") + (setq end-pos (point-marker)) + (insert ");")) (t (insert ";"))) (when mid-pos (setq end-pos (point-marker)) @@ -10916,7 +11146,7 @@ but not if inside a comment or quote." (backward-word 1) (vhdl-case-word 1) (delete-char 1)) - (let ((invoke-char last-command-event) + (let ((invoke-char vhdl-last-input-event) (abbrev-mode -1) (vhdl-template-invoked-by-hook t)) (let ((caught (catch 'abort @@ -11640,7 +11870,8 @@ reflected in a subsequent paste operation." ;; paste formal and actual generic (insert (car (nth 0 generic)) " => " (if no-constants - (car (nth 0 generic)) + (vhdl-replace-string vhdl-actual-generic-name + (car (nth 0 generic))) (or (nth 2 generic) ""))) (setq generic-list (cdr generic-list)) (insert (if generic-list "," ")")) @@ -11783,7 +12014,7 @@ reflected in a subsequent paste operation." ;; paste generic constants (setq name (nth 0 generic)) (when name - (insert (car name)) + (insert (vhdl-replace-string vhdl-actual-generic-name (car name))) ;; paste type (insert " : " (nth 1 generic)) ;; paste initialization @@ -11809,7 +12040,7 @@ reflected in a subsequent paste operation." (message "Pasting port as signals...") (unless no-indent (indent-according-to-mode)) (let ((margin (current-indentation)) - start port names + start port names type generic-list port-name constant-name pos (port-list (nth 2 vhdl-port-list))) (when port-list (setq start (point)) @@ -11829,7 +12060,21 @@ reflected in a subsequent paste operation." (setq names (cdr names)) (when names (insert ", "))) ;; paste type - (insert " : " (nth 3 port)) + (setq type (nth 3 port)) + (setq generic-list (nth 1 vhdl-port-list)) + (vhdl-prepare-search-1 + (setq pos 0) + ;; replace formal by actual generics + (while generic-list + (setq port-name (car (nth 0 (car generic-list)))) + (while (string-match (concat "\\<" port-name "\\>") type pos) + (setq constant-name + (save-match-data (vhdl-replace-string + vhdl-actual-generic-name port-name))) + (setq type (replace-match constant-name t nil type)) + (setq pos (match-end 0))) + (setq generic-list (cdr generic-list)))) + (insert " : " type) ;; paste initialization (inputs only) (when (and initialize (nth 2 port) (equal "IN" (upcase (nth 2 port)))) (insert " := " @@ -12418,77 +12663,6 @@ expressions (e.g. for index ranges of types and signals)." try-expand-list-all-buffers))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Case fixing - -(defun vhdl-fix-case-region-1 (beg end upper-case word-regexp &optional count) - "Convert all words matching WORD-REGEXP in region to lower or upper case, -depending on parameter UPPER-CASE." - (let ((case-replace nil) - (last-update 0)) - (vhdl-prepare-search-2 - (save-excursion - (goto-char end) - (setq end (point-marker)) - (goto-char beg) - (while (re-search-forward word-regexp end t) - (or (vhdl-in-literal) - (if upper-case - (upcase-word -1) - (downcase-word -1))) - (when (and count vhdl-progress-interval (not noninteractive) - (< vhdl-progress-interval - (- (nth 1 (current-time)) last-update))) - (message "Fixing case... (%2d%s)" - (+ (* count 20) (/ (* 20 (- (point) beg)) (- end beg))) - "%") - (setq last-update (nth 1 (current-time))))) - (goto-char end))))) - -(defun vhdl-fix-case-region (beg end &optional arg) - "Convert all VHDL words in region to lower or upper case, depending on -options vhdl-upper-case-{keywords,types,attributes,enum-values}." - (interactive "r\nP") - (vhdl-fix-case-region-1 - beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0) - (vhdl-fix-case-region-1 - beg end vhdl-upper-case-types vhdl-types-regexp 1) - (vhdl-fix-case-region-1 - beg end vhdl-upper-case-attributes (concat "'" vhdl-attributes-regexp) 2) - (vhdl-fix-case-region-1 - beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp 3) - (vhdl-fix-case-region-1 - beg end vhdl-upper-case-constants vhdl-constants-regexp 4) - (when vhdl-progress-interval (message "Fixing case...done"))) - -(defun vhdl-fix-case-buffer () - "Convert all VHDL words in buffer to lower or upper case, depending on -options vhdl-upper-case-{keywords,types,attributes,enum-values}." - (interactive) - (vhdl-fix-case-region (point-min) (point-max))) - -(defun vhdl-fix-case-word (&optional arg) - "Convert word after cursor to upper case if necessary." - (interactive "p") - (save-excursion - (when arg (backward-word 1)) - (vhdl-prepare-search-1 - (when (and vhdl-upper-case-keywords - (looking-at vhdl-keywords-regexp)) - (upcase-word 1)) - (when (and vhdl-upper-case-types - (looking-at vhdl-types-regexp)) - (upcase-word 1)) - (when (and vhdl-upper-case-attributes - (looking-at vhdl-attributes-regexp)) - (upcase-word 1)) - (when (and vhdl-upper-case-enum-values - (looking-at vhdl-enum-values-regexp)) - (upcase-word 1)) - (when (and vhdl-upper-case-constants - (looking-at vhdl-constants-regexp)) - (upcase-word 1))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Line handling functions (defun vhdl-current-line () @@ -12642,7 +12816,7 @@ it works within comments too." ;; print results (message "\n\ File statistics: \"%s\"\n\ ----------------------\n\ +-----------------------\n\ # statements : %5d\n\ # code lines : %5d\n\ # empty lines : %5d\n\ @@ -13493,9 +13667,9 @@ hierarchy otherwise.") (while (and (re-search-backward "^[ \t]*\\(end\\|use\\)\\>" nil t) (equal "USE" (upcase (match-string 1)))) (when (looking-at "^[ \t]*use[ \t\n\r\f]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+") - (setq lib-alist (cons (cons (match-string-no-properties 1) + (push (cons (match-string-no-properties 1) (vhdl-match-string-downcase 2)) - lib-alist)))))) + lib-alist))))) lib-alist)) (defun vhdl-scan-directory-contents (name &optional project update num-string @@ -13541,7 +13715,7 @@ hierarchy otherwise.") file-tmp-list) (while file-list (unless (string-match file-exclude-regexp (car file-list)) - (setq file-tmp-list (cons (car file-list) file-tmp-list))) + (push (car file-list) file-tmp-list)) (setq file-list (cdr file-list))) (setq file-list (nreverse file-tmp-list)))) ;; do for all files @@ -13576,7 +13750,7 @@ hierarchy otherwise.") "Entity declared twice (used 1.): \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" ent-name (nth 1 ent-entry) (nth 2 ent-entry) file-name (vhdl-current-line)) - (setq ent-list (cons ent-key ent-list)) + (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) @@ -13628,7 +13802,7 @@ hierarchy otherwise.") "Configuration declared twice (used 1.): \"%s\" of \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" conf-name ent-name (nth 1 conf-entry) (nth 2 conf-entry) file-name conf-line) - (setq conf-list (cons conf-key conf-list)) + (push conf-key conf-list) ;; scan for subconfigurations and subentities (while (re-search-forward "^[ \t]*for[ \t\n\r\f]+\\(\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]+" end-of-unit t) (setq inst-comp-key (vhdl-match-string-downcase 3) @@ -13691,8 +13865,8 @@ hierarchy otherwise.") (setq func-alist (nreverse func-alist)) (setq comp-alist (nreverse comp-alist)) (if is-body - (setq pack-body-list (cons pack-key pack-body-list)) - (setq pack-list (cons pack-key pack-list))) + (push pack-key pack-body-list) + (push pack-key pack-list)) (aput 'pack-alist pack-key (if is-body @@ -13946,7 +14120,7 @@ of PROJECT." (let ((case-fold-search nil)) (while dir-list (unless (string-match file-exclude-regexp (car dir-list)) - (setq dir-list-tmp (cons (car dir-list) dir-list-tmp))) + (push (car dir-list) dir-list-tmp)) (setq dir-list (cdr dir-list))) (setq dir-list (nreverse dir-list-tmp)))) (message "Collecting source files...done") @@ -14338,12 +14512,19 @@ if required." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Add hierarchy browser functionality to speedbar -(defvar vhdl-speedbar-key-map nil +(defvar vhdl-speedbar-mode-map nil "Keymap used when in the VHDL hierarchy browser mode.") (defvar vhdl-speedbar-menu-items nil "Additional menu-items to add to speedbar frame.") +(declare-function speedbar-add-supported-extension "speedbar" (extension)) +(declare-function speedbar-add-mode-functions-list "speedbar" (new-list)) +(declare-function speedbar-make-specialized-keymap "speedbar" ()) +(declare-function speedbar-change-initial-expansion-list "speedbar" + (new-default)) +(declare-function speedbar-add-expansion-list "speedbar" (new-list)) + (defun vhdl-speedbar-initialize () "Initialize speedbar." ;; general settings @@ -14366,24 +14547,24 @@ if required." (speedbar-item-info . vhdl-speedbar-item-info) (speedbar-line-directory . vhdl-speedbar-line-project))) ;; keymap - (unless vhdl-speedbar-key-map - (setq vhdl-speedbar-key-map (speedbar-make-specialized-keymap)) - (define-key vhdl-speedbar-key-map "e" 'speedbar-edit-line) - (define-key vhdl-speedbar-key-map "\C-m" 'speedbar-edit-line) - (define-key vhdl-speedbar-key-map "+" 'speedbar-expand-line) - (define-key vhdl-speedbar-key-map "=" 'speedbar-expand-line) - (define-key vhdl-speedbar-key-map "-" 'vhdl-speedbar-contract-level) - (define-key vhdl-speedbar-key-map "_" 'vhdl-speedbar-contract-all) - (define-key vhdl-speedbar-key-map "C" 'vhdl-speedbar-port-copy) - (define-key vhdl-speedbar-key-map "P" 'vhdl-speedbar-place-component) - (define-key vhdl-speedbar-key-map "F" 'vhdl-speedbar-configuration) - (define-key vhdl-speedbar-key-map "A" 'vhdl-speedbar-select-mra) - (define-key vhdl-speedbar-key-map "K" 'vhdl-speedbar-make-design) - (define-key vhdl-speedbar-key-map "R" 'vhdl-speedbar-rescan-hierarchy) - (define-key vhdl-speedbar-key-map "S" 'vhdl-save-caches) + (unless vhdl-speedbar-mode-map + (setq vhdl-speedbar-mode-map (speedbar-make-specialized-keymap)) + (define-key vhdl-speedbar-mode-map "e" 'speedbar-edit-line) + (define-key vhdl-speedbar-mode-map "\C-m" 'speedbar-edit-line) + (define-key vhdl-speedbar-mode-map "+" 'speedbar-expand-line) + (define-key vhdl-speedbar-mode-map "=" 'speedbar-expand-line) + (define-key vhdl-speedbar-mode-map "-" 'vhdl-speedbar-contract-level) + (define-key vhdl-speedbar-mode-map "_" 'vhdl-speedbar-contract-all) + (define-key vhdl-speedbar-mode-map "C" 'vhdl-speedbar-port-copy) + (define-key vhdl-speedbar-mode-map "P" 'vhdl-speedbar-place-component) + (define-key vhdl-speedbar-mode-map "F" 'vhdl-speedbar-configuration) + (define-key vhdl-speedbar-mode-map "A" 'vhdl-speedbar-select-mra) + (define-key vhdl-speedbar-mode-map "K" 'vhdl-speedbar-make-design) + (define-key vhdl-speedbar-mode-map "R" 'vhdl-speedbar-rescan-hierarchy) + (define-key vhdl-speedbar-mode-map "S" 'vhdl-save-caches) (let ((key 0)) (while (<= key 9) - (define-key vhdl-speedbar-key-map (int-to-string key) + (define-key vhdl-speedbar-mode-map (int-to-string key) `(lambda () (interactive) (vhdl-speedbar-set-depth ,key))) (setq key (1+ key))))) (define-key speedbar-mode-map "h" @@ -14436,10 +14617,10 @@ if required." ["Save Caches" vhdl-save-caches vhdl-updated-project-list]))) ;; hook-ups (speedbar-add-expansion-list - '("vhdl directory" vhdl-speedbar-menu-items vhdl-speedbar-key-map + '("vhdl directory" vhdl-speedbar-menu-items vhdl-speedbar-mode-map vhdl-speedbar-display-directory)) (speedbar-add-expansion-list - '("vhdl project" vhdl-speedbar-menu-items vhdl-speedbar-key-map + '("vhdl project" vhdl-speedbar-menu-items vhdl-speedbar-mode-map vhdl-speedbar-display-projects)) (setq speedbar-stealthy-function-list (append @@ -14473,11 +14654,15 @@ if required." "Name of last selected project.") ;; macros must be defined in the file they are used (copied from `speedbar.el') -(defmacro speedbar-with-writable (&rest forms) - "Allow the buffer to be writable and evaluate FORMS." - (list 'let '((inhibit-read-only t)) - (cons 'progn forms))) -(put 'speedbar-with-writable 'lisp-indent-function 0) +;;; (defmacro speedbar-with-writable (&rest forms) +;;; "Allow the buffer to be writable and evaluate FORMS." +;;; (list 'let '((inhibit-read-only t)) +;;; (cons 'progn forms))) +;;; (put 'speedbar-with-writable 'lisp-indent-function 0) + +(declare-function speedbar-extension-list-to-regex "speedbar" (extlist)) +(declare-function speedbar-directory-buttons "speedbar" (directory _index)) +(declare-function speedbar-file-lists "speedbar" (directory)) (defun vhdl-speedbar-display-directory (directory depth &optional rescan) "Display directory and hierarchy information in speedbar." @@ -14513,6 +14698,9 @@ if required." (error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly")))) (setq speedbar-full-text-cache nil)) ; prevent caching +(declare-function speedbar-make-tag-line "speedbar" + (type char func data tag tfunc tdata tface depth)) + (defun vhdl-speedbar-insert-projects () "Insert all projects in speedbar." (vhdl-speedbar-make-title-line "Projects:") @@ -14616,6 +14804,8 @@ otherwise use cached data." depth) (setq pack-alist (cdr pack-alist)))))) +(declare-function speedbar-line-directory "speedbar" (&optional depth)) + (defun vhdl-speedbar-rescan-hierarchy () "Rescan hierarchy for the directory or project under the cursor." (interactive) @@ -14637,6 +14827,8 @@ otherwise use cached data." (abbreviate-file-name (match-string 1 path))))) (vhdl-speedbar-refresh key))) +(declare-function speedbar-goto-this-file "speedbar" (file)) + (defun vhdl-speedbar-expand-dirs (directory) "Expand subdirectories in DIRECTORY according to `speedbar-shown-directories'." @@ -14686,6 +14878,8 @@ otherwise use cached data." (setq unit-alist (cdr unit-alist)))))) (vhdl-speedbar-update-current-unit nil t)) +(declare-function speedbar-center-buffer-smartly "speedbar" ()) + (defun vhdl-speedbar-contract-level () "Contract current level in current directory/project." (interactive) @@ -14726,21 +14920,24 @@ otherwise use cached data." (setq arch-alist (nth 4 (car ent-alist))) (setq subunit-alist nil) (while arch-alist - (setq subunit-alist (cons (caar arch-alist) subunit-alist)) + (push (caar arch-alist) subunit-alist) (setq arch-alist (cdr arch-alist))) - (setq unit-alist (cons (list (caar ent-alist) subunit-alist) unit-alist)) + (push (list (caar ent-alist) subunit-alist) unit-alist) (setq ent-alist (cdr ent-alist))) (while conf-alist - (setq unit-alist (cons (list (caar conf-alist)) unit-alist)) + (push (list (caar conf-alist)) unit-alist) (setq conf-alist (cdr conf-alist))) (while pack-alist - (setq unit-alist (cons (list (caar pack-alist)) unit-alist)) + (push (list (caar pack-alist)) unit-alist) (setq pack-alist (cdr pack-alist))) (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)))) +(declare-function speedbar-change-expand-button-char "speedbar" (char)) +(declare-function speedbar-delete-subblock "speedbar" (indent)) + (defun vhdl-speedbar-expand-project (text token indent) "Expand/contract the project under the cursor." (cond @@ -15069,6 +15266,8 @@ otherwise use cached data." (setq vhdl-speedbar-last-selected-project vhdl-project))) t) +(declare-function speedbar-position-cursor-on-line "speedbar" ()) + (defun vhdl-speedbar-update-current-unit (&optional no-position always) "Highlight all design units that are contained in the current file. NO-POSITION non-nil means do not re-position cursor." @@ -15158,6 +15357,9 @@ NO-POSITION non-nil means do not re-position cursor." (setq unit-list (cdr unit-list))) pos) +(declare-function speedbar-make-button "speedbar" + (start end face mouse function &optional token)) + (defun vhdl-speedbar-make-inst-line (inst-name inst-file-marker ent-name ent-file-marker arch-name arch-file-marker @@ -15344,6 +15546,8 @@ NO-POSITION non-nil means do not re-position cursor." 'speedbar-directory-face level) (setq dirs (cdr dirs))))) +(declare-function speedbar-reset-scanners "speedbar" ()) + (defun vhdl-speedbar-dired (text token indent) "Speedbar click handler for directory expand button in hierarchy mode." (cond ((string-match "+" text) ; we have to expand this dir @@ -15374,7 +15578,7 @@ NO-POSITION non-nil means do not re-position cursor." (concat (speedbar-line-directory indent) token)))) (while oldl (if (not (string-match (concat "^" (regexp-quote td)) (car oldl))) - (setq newl (cons (car oldl) newl))) + (push (car oldl) newl)) (setq oldl (cdr oldl))) (setq speedbar-shown-directories (nreverse newl))) (speedbar-change-expand-button-char ?+) @@ -15383,6 +15587,8 @@ NO-POSITION non-nil means do not re-position cursor." (when (equal (selected-frame) speedbar-frame) (speedbar-center-buffer-smartly))) +(declare-function speedbar-files-item-info "speedbar" ()) + (defun vhdl-speedbar-item-info () "Derive and display information about this line item." (save-excursion @@ -15431,6 +15637,8 @@ NO-POSITION non-nil means do not re-position cursor." (vhdl-default-directory))))) (t (message ""))))) +(declare-function speedbar-line-text "speedbar" (&optional p)) + (defun vhdl-speedbar-line-text () "Calls `speedbar-line-text' and removes text properties." (let ((string (speedbar-line-text))) @@ -15481,7 +15689,7 @@ NO-POSITION non-nil means do not re-position cursor." (setq dir (car path-list)) (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)" dir) (if (file-directory-p (match-string 2 dir)) - (setq path-list-1 (cons dir path-list-1)) + (push dir path-list-1) (vhdl-warning-when-idle "No such directory: \"%s\"" (match-string 2 dir))) (setq path-list (cdr path-list))) ;; resolve path wildcards @@ -15503,13 +15711,13 @@ NO-POSITION non-nil means do not re-position cursor." dir-list) (while all-list (when (file-directory-p (car all-list)) - (setq dir-list (cons (car all-list) dir-list))) + (push (car all-list) dir-list)) (setq all-list (cdr all-list))) dir-list)) (cdr path-list-1)))) (string-match "\\(-r \\)?\\(.*\\)[/\\].*" dir) (when (file-directory-p (match-string 2 dir)) - (setq path-list-2 (cons dir path-list-2))) + (push dir path-list-2)) (setq path-list-1 (cdr path-list-1)))) (nreverse path-list-2))) @@ -15525,6 +15733,11 @@ NO-POSITION non-nil means do not re-position cursor." (goto-char dest) nil))) +(declare-function speedbar-find-file-in-frame "speedbar" (file)) +(declare-function speedbar-set-timer "speedbar" (timeout)) +;; speedbar loads dframe at runtime. +(declare-function dframe-maybee-jump-to-attached-frame "dframe" ()) + (defun vhdl-speedbar-find-file (text token indent) "When user clicks on TEXT, load file with name and position in TOKEN. Jump to the design unit if `vhdl-speedbar-jump-to-unit' is t or if the file @@ -15534,12 +15747,11 @@ 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) - (goto-char (point-min)) - (forward-line (1- (cdr token))) + (vhdl-goto-line (cdr token)) (recenter)) (vhdl-speedbar-update-current-unit t t) (speedbar-set-timer dframe-update-speed) - (speedbar-maybee-jump-to-attached-frame)))) + (dframe-maybee-jump-to-attached-frame)))) (defun vhdl-speedbar-port-copy () "Copy the port of the entity/component or subprogram under the cursor." @@ -15553,8 +15765,7 @@ is already shown in a buffer." (let ((token (get-text-property (match-beginning 3) 'speedbar-token))) (vhdl-visit-file (car token) t - (progn (goto-char (point-min)) - (forward-line (1- (cdr token))) + (progn (vhdl-goto-line (cdr token)) (end-of-line) (if is-entity (vhdl-port-copy) @@ -15600,6 +15811,8 @@ is already shown in a buffer." (setcar (cddr (cddr ent-entry)) arch-key) ; (nth 4 ent-entry) (speedbar-refresh)))) +(declare-function speedbar-line-file "speedbar" (&optional p)) + (defun vhdl-speedbar-make-design () "Make (compile) design unit or directory/project under the cursor." (interactive) @@ -16007,7 +16220,7 @@ component instantiation." (or (aget generic-alist (match-string 2) t) (error "ERROR: Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) (cdar generic-alist)))) - (setq constant-alist (cons constant-entry constant-alist)) + (push constant-entry constant-alist) (setq constant-name (downcase constant-name)) (if (or (member constant-name single-list) (member constant-name multi-list)) @@ -16027,7 +16240,7 @@ component instantiation." (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-alist (cons signal-entry signal-alist)) + (push signal-entry signal-alist) (setq signal-name (downcase signal-name)) (if (equal (upcase (nth 2 signal-entry)) "IN") ;; input signal @@ -16061,8 +16274,8 @@ component instantiation." (unless (match-string 1) (setq port-alist (cdr port-alist))) (vhdl-forward-syntactic-ws)) - (setq inst-alist (cons (list inst-name (nreverse constant-alist) - (nreverse signal-alist)) inst-alist))) + (push (list inst-name (nreverse constant-alist) + (nreverse signal-alist)) inst-alist)) ;; prepare signal insertion (vhdl-goto-marker arch-decl-pos) (forward-line 1) @@ -16129,6 +16342,7 @@ component instantiation." (while constant-alist (setq constant-name (downcase (caar constant-alist)) constant-entry (car constant-alist)) + (unless (string-match "^[0-9]+" constant-name) (cond ((member constant-name written-list) nil) ((member constant-name multi-list) @@ -16145,7 +16359,7 @@ component instantiation." (setq generic-end-pos (vhdl-compose-insert-generic constant-entry)) (setq generic-inst-pos (point-marker)) - (add-to-list 'written-list constant-name))) + (add-to-list 'written-list constant-name)))) (setq constant-alist (cdr constant-alist))) (when (/= constant-temp-pos generic-inst-pos) (vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos)) @@ -16305,8 +16519,7 @@ current project/directory." ;; insert component declarations (while ent-alist (vhdl-visit-file (nth 2 (car ent-alist)) nil - (progn (goto-char (point-min)) - (forward-line (1- (nth 3 (car ent-alist)))) + (progn (vhdl-goto-line (nth 3 (car ent-alist))) (end-of-line) (vhdl-port-copy))) (goto-char component-pos) @@ -16562,12 +16775,12 @@ no project is defined." (setq sublist (nth 11 (car commands-alist))) (unless (or (equal "" (car sublist)) (assoc (car sublist) regexp-alist)) - (setq regexp-alist (cons (list (nth 0 sublist) - (if (= 0 (nth 1 sublist)) - (if (featurep 'xemacs) 9 nil) + (push (list (nth 0 sublist) + (if (and (featurep 'xemacs) (not (nth 1 sublist))) + 9 (nth 1 sublist)) (nth 2 sublist) (nth 3 sublist)) - regexp-alist))) + regexp-alist)) (setq commands-alist (cdr commands-alist))) (setq compilation-error-regexp-alist (append compilation-error-regexp-alist (nreverse regexp-alist)))) @@ -16580,7 +16793,7 @@ no project is defined." (setq sublist (nth 12 (car commands-alist))) (unless (or (equal "" (car sublist)) (assoc (car sublist) regexp-alist)) - (setq regexp-alist (cons sublist regexp-alist))) + (push sublist regexp-alist)) (setq commands-alist (cdr commands-alist))) (setq compilation-file-regexp-alist (append compilation-file-regexp-alist (nreverse regexp-alist)))))) @@ -16709,6 +16922,42 @@ specified by a target." (compile (concat (if (equal command "") "make" command) " " options " " vhdl-make-target)))) +;; Emacs 22+ setup +(defvar vhdl-error-regexp-emacs-alist + ;; Get regexps from `vhdl-compiler-alist' + (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)))) + (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+.") + +;; Add error regexps using compilation-mode-hook. +(defun vhdl-error-regexp-add-emacs () + "Set up Emacs compile for VHDL." + (interactive) + (when (and (boundp 'compilation-error-regexp-alist-alist) + (not (assoc 'vhdl-modelsim compilation-error-regexp-alist-alist))) + (mapcar + (lambda (item) + (push (car item) compilation-error-regexp-alist) + (push item compilation-error-regexp-alist-alist)) + vhdl-error-regexp-emacs-alist))) + +(when vhdl-emacs-22 + (add-hook 'compilation-mode-hook 'vhdl-error-regexp-add-emacs)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Makefile generation @@ -16731,7 +16980,7 @@ specified by a target." (let (pack-list) (while lib-alist (when (equal (downcase (caar lib-alist)) (downcase work-library)) - (setq pack-list (cons (cdar lib-alist) pack-list))) + (push (cdar lib-alist) pack-list)) (setq lib-alist (cdr lib-alist))) pack-list)) @@ -16783,8 +17032,10 @@ specified by a target." (setq ent-entry (car ent-alist) ent-key (nth 0 ent-entry)) (when (nth 2 ent-entry) - (setq ent-file-name (file-relative-name - (nth 2 ent-entry) compile-directory) + (setq ent-file-name (if vhdl-compile-absolute-path + (nth 2 ent-entry) + (file-relative-name (nth 2 ent-entry) + compile-directory)) arch-alist (nth 4 ent-entry) lib-alist (nth 6 ent-entry) rule (aget rule-alist ent-file-name) @@ -16794,9 +17045,9 @@ specified by a target." subcomp-list nil) (setq tmp-key (vhdl-replace-string ent-regexp (funcall adjust-case ent-key))) - (setq unit-list (cons (cons ent-key tmp-key) unit-list)) + (push (cons ent-key tmp-key) unit-list) ;; rule target for this entity - (setq target-list (cons ent-key target-list)) + (push ent-key target-list) ;; rule dependencies for all used packages (setq pack-list (vhdl-get-packages lib-alist work-library)) (setq depend-list (append depend-list pack-list)) @@ -16808,8 +17059,10 @@ specified by a target." (setq arch-entry (car arch-alist) arch-key (nth 0 arch-entry) ent-arch-key (concat ent-key "-" arch-key) - arch-file-name (file-relative-name (nth 2 arch-entry) - compile-directory) + arch-file-name (if vhdl-compile-absolute-path + (nth 2 arch-entry) + (file-relative-name (nth 2 arch-entry) + compile-directory)) inst-alist (nth 4 arch-entry) lib-alist (nth 5 arch-entry) rule (aget rule-alist arch-file-name) @@ -16820,11 +17073,11 @@ specified by a target." (funcall adjust-case (concat arch-key " " ent-key)))) (setq unit-list (cons (cons ent-arch-key tmp-key) unit-list)) - (setq second-list (cons ent-arch-key second-list)) + (push ent-arch-key second-list) ;; rule target for this architecture - (setq target-list (cons ent-arch-key target-list)) + (push ent-arch-key target-list) ;; rule dependency for corresponding entity - (setq depend-list (cons ent-key depend-list)) + (push ent-key depend-list) ;; rule dependencies for contained component instantiations (while inst-alist (setq inst-entry (car inst-alist)) @@ -16842,9 +17095,8 @@ specified by a target." ;; add rule (aput 'rule-alist arch-file-name (list target-list depend-list)) (setq arch-alist (cdr arch-alist))) - (setq prim-list (cons (list ent-key second-list - (append subcomp-list all-pack-list)) - prim-list))) + (push (list ent-key second-list (append subcomp-list all-pack-list)) + prim-list)) (setq ent-alist (cdr ent-alist))) (setq ent-alist tmp-list) ;; rules for all configurations @@ -16852,8 +17104,10 @@ specified by a target." (while conf-alist (setq conf-entry (car conf-alist) conf-key (nth 0 conf-entry) - conf-file-name (file-relative-name - (nth 2 conf-entry) compile-directory) + conf-file-name (if vhdl-compile-absolute-path + (nth 2 conf-entry) + (file-relative-name (nth 2 conf-entry) + compile-directory)) ent-key (nth 4 conf-entry) arch-key (nth 5 conf-entry) inst-alist (nth 6 conf-entry) @@ -16864,9 +17118,9 @@ specified by a target." subcomp-list (list ent-key)) (setq tmp-key (vhdl-replace-string conf-regexp (funcall adjust-case conf-key))) - (setq unit-list (cons (cons conf-key tmp-key) unit-list)) + (push (cons conf-key tmp-key) unit-list) ;; rule target for this configuration - (setq target-list (cons conf-key target-list)) + (push conf-key target-list) ;; rule dependency for corresponding entity and architecture (setq depend-list (cons ent-key (cons (concat ent-key "-" arch-key) depend-list))) @@ -16884,16 +17138,14 @@ specified by a target." (setq depend-list (cons inst-ent-key depend-list) subcomp-list (cons inst-ent-key subcomp-list))) ; (when comp-arch-key -; (setq depend-list (cons (concat comp-ent-key "-" comp-arch-key) -; depend-list))) +; (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)) - (setq prim-list (cons (list conf-key nil (append subcomp-list pack-list)) - prim-list)) + (push (list conf-key nil (append subcomp-list pack-list)) prim-list) (setq conf-alist (cdr conf-alist))) (setq conf-alist tmp-list) ;; rules for all packages @@ -16903,16 +17155,18 @@ specified by a target." pack-key (nth 0 pack-entry) pack-body-key nil) (when (nth 2 pack-entry) - (setq pack-file-name (file-relative-name (nth 2 pack-entry) - compile-directory) + (setq pack-file-name (if vhdl-compile-absolute-path + (nth 2 pack-entry) + (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) target-list (nth 0 rule) depend-list (nth 1 rule)) (setq tmp-key (vhdl-replace-string pack-regexp (funcall adjust-case pack-key))) - (setq unit-list (cons (cons pack-key tmp-key) unit-list)) + (push (cons pack-key tmp-key) unit-list) ;; rule target for this package - (setq target-list (cons pack-key target-list)) + (push pack-key target-list) ;; rule dependencies for all used packages (setq pack-list (vhdl-get-packages lib-alist work-library)) (setq depend-list (append depend-list pack-list)) @@ -16922,8 +17176,10 @@ specified by a target." ;; rules for this package's body (when (nth 7 pack-entry) (setq pack-body-key (concat pack-key "-body") - pack-body-file-name (file-relative-name (nth 7 pack-entry) - compile-directory) + pack-body-file-name (if vhdl-compile-absolute-path + (nth 7 pack-entry) + (file-relative-name (nth 7 pack-entry) + compile-directory)) rule (aget rule-alist pack-body-file-name) target-list (nth 0 rule) depend-list (nth 1 rule)) @@ -16932,9 +17188,9 @@ specified by a target." (setq unit-list (cons (cons pack-body-key tmp-key) unit-list)) ;; rule target for this package's body - (setq target-list (cons pack-body-key target-list)) + (push pack-body-key target-list) ;; rule dependency for corresponding package declaration - (setq depend-list (cons pack-key depend-list)) + (push pack-key depend-list) ;; rule dependencies for all used packages (setq pack-list (vhdl-get-packages lib-body-alist work-library)) (setq depend-list (append depend-list pack-list)) @@ -17057,16 +17313,16 @@ specified by a target." (unless (equal unit-key unit-name) (insert " \\\n" unit-name)) (insert " :" - " \\\n\t\t" (nth 2 vhdl-makefile-default-targets) - " \\\n\t\t$(UNIT-" work-library "-" unit-key ")") - (while second-list - (insert " \\\n\t\t$(UNIT-" work-library "-" (car second-list) ")") - (setq second-list (cdr second-list))) + " \\\n\t\t" (nth 2 vhdl-makefile-default-targets)) (while subcomp-list (when (and (assoc (car subcomp-list) unit-list) (not (equal unit-key (car subcomp-list)))) (insert " \\\n\t\t" (car subcomp-list))) (setq subcomp-list (cdr subcomp-list))) + (insert " \\\n\t\t$(UNIT-" work-library "-" unit-key ")") + (while second-list + (insert " \\\n\t\t$(UNIT-" work-library "-" (car second-list) ")") + (setq second-list (cdr second-list))) (insert "\n") (setq prim-list (cdr prim-list))) ;; insert rule for each library unit file @@ -17205,6 +17461,7 @@ specified by a target." 'vhdl-include-direction-comments 'vhdl-include-type-comments 'vhdl-include-group-comments + 'vhdl-actual-generic-name 'vhdl-actual-port-name 'vhdl-instance-name 'vhdl-testbench-entity-name @@ -17287,13 +17544,21 @@ specified by a target." (defconst vhdl-doc-release-notes nil "\ -Release Notes for VHDL Mode 3.33 +Release Notes for VHDL Mode 3.34 ================================ - - New Features - - User Options +- Added support for GNU Emacs 22/23/24: + - Compilation error parsing fixed for new `compile.el' package. + +- Port translation: Derive actual generic name from formal generic name. + +- New user options: + `vhdl-actual-generic-name': Specify how actual generic names are obtained. +Release Notes for VHDL Mode 3.33 +================================ + New Features ------------ diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index edfe368479c..c8044f407fc 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -343,6 +343,10 @@ If no function name is found, return nil." ;;; Integration with other packages +(defvar ediff-window-A) +(defvar ediff-window-B) +(defvar ediff-window-C) + (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'." diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el index 2ad44b4b1c8..37c3cd37a6c 100644 --- a/lisp/progmodes/xscheme.el +++ b/lisp/progmodes/xscheme.el @@ -35,7 +35,6 @@ ;;;; Internal Variables (defvar xscheme-previous-mode) -(defvar xscheme-previous-process-state) (defvar xscheme-last-input-end) (defvar xscheme-process-command-line nil @@ -388,8 +387,6 @@ with no args, if that value is non-nil. (if (not preserve) (let ((previous-mode major-mode)) (kill-all-local-variables) - (make-local-variable 'xscheme-process-name) - (make-local-variable 'xscheme-previous-process-state) (make-local-variable 'xscheme-runlight-string) (make-local-variable 'xscheme-runlight) (set (make-local-variable 'xscheme-previous-mode) previous-mode) @@ -397,35 +394,29 @@ with no args, if that value is non-nil. (set (make-local-variable 'xscheme-buffer-name) (buffer-name buffer)) (set (make-local-variable 'xscheme-last-input-end) (make-marker)) (let ((process (get-buffer-process buffer))) - (if process - (progn - (setq xscheme-process-name (process-name process)) - (setq xscheme-previous-process-state - (cons (process-filter process) - (process-sentinel process))) - (xscheme-process-filter-initialize t) - (xscheme-mode-line-initialize xscheme-buffer-name) - (set-process-sentinel process 'xscheme-process-sentinel) - (set-process-filter process 'xscheme-process-filter)) - (setq xscheme-previous-process-state (cons nil nil))))))) + (when process + (setq-local xscheme-process-name (process-name process)) + ;; FIXME: Use add-function! + (xscheme-process-filter-initialize t) + (xscheme-mode-line-initialize xscheme-buffer-name) + (add-function :override (process-sentinel process) + #'xscheme-process-sentinel) + (add-function :override (process-filter process) + #'xscheme-process-filter)))))) (scheme-interaction-mode-initialize) (scheme-mode-variables) (run-mode-hooks 'scheme-mode-hook 'scheme-interaction-mode-hook)) (defun exit-scheme-interaction-mode () - "Take buffer out of scheme interaction mode" + "Take buffer out of scheme interaction mode." (interactive) (if (not (derived-mode-p 'scheme-interaction-mode)) (error "Buffer not in scheme interaction mode")) - (let ((previous-state xscheme-previous-process-state)) - (funcall xscheme-previous-mode) - (let ((process (get-buffer-process (current-buffer)))) - (if process - (progn - (if (eq (process-filter process) 'xscheme-process-filter) - (set-process-filter process (car previous-state))) - (if (eq (process-sentinel process) 'xscheme-process-sentinel) - (set-process-sentinel process (cdr previous-state)))))))) + (funcall xscheme-previous-mode) + (let ((process (get-buffer-process (current-buffer)))) + (when process + (remove-function (process-sentinel process) #'xscheme-process-sentinel) + (remove-function (process-filter process) #'xscheme-process-filter)))) (defvar scheme-interaction-mode-commands-alist nil) (defvar scheme-interaction-mode-map nil) diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el index 4da5d1db244..059261ac0ac 100644 --- a/lisp/ps-mule.el +++ b/lisp/ps-mule.el @@ -188,7 +188,32 @@ See also the variable `ps-font-info-database'.") (defcustom ps-mule-font-info-database-default ps-mule-font-info-database-latin "The default setting to use when `ps-multibyte-buffer' is nil." - :type '(symbol :tag "Multi-Byte Buffer Database Font Default") + :type '(alist :key-type symbol :tag "Charset" + :value-type + (list (list + (choice :tag "Font type" + (const normal) + (const bold) + (const italic) + (const bold-italic)) + (choice :tag "Font source" + (const builtin) + (const bdf) + (const vflib) + (const nil)) + ;; My guess as to what the doc is trying to say... + (choice :tag "Font name" + (const nil) + string + (repeat :tag "List" string)) + (choice :tag "Encoding" + (const nil) + coding-system + function) + (choice :tag "Bytes" + (const nil) + (const 1) + (const 2))))) :group 'ps-print-font) (defconst ps-mule-font-info-database-ps diff --git a/lisp/ps-print.el b/lisp/ps-print.el index f7c03c2de85..b5961064cb4 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -3017,7 +3017,6 @@ Any other value is ignored and black color will be used. This variable is used only when `ps-print-color-p' (which see) is neither nil nor black-white." :type '(choice :menu-tag "Default Foreground Gray/Color" - :tag "Default Foreground Gray/Color" (const :tag "Session Foreground" t) (const :tag "Frame Foreground" frame-parameter) (number :tag "Gray Scale" :value 0.0) @@ -3025,7 +3024,8 @@ nor black-white." (list :tag "RGB Color" :value (0.0 0.0 0.0) (number :tag "Red") (number :tag "Green") - (number :tag "Blue"))) + (number :tag "Blue")) + (other :tag "Default Foreground Gray/Color" nil)) :version "20" :group 'ps-print-color) @@ -3063,7 +3063,6 @@ nor black-white. See also `ps-use-face-background'." :type '(choice :menu-tag "Default Background Gray/Color" - :tag "Default Background Gray/Color" (const :tag "Session Background" t) (const :tag "Frame Background" frame-parameter) (number :tag "Gray Scale" :value 1.0) @@ -3071,7 +3070,8 @@ See also `ps-use-face-background'." (list :tag "RGB Color" :value (1.0 1.0 1.0) (number :tag "Red") (number :tag "Green") - (number :tag "Blue"))) + (number :tag "Blue")) + (other :tag "Default Background Gray/Color" nil)) :version "20" :group 'ps-print-color) @@ -6658,7 +6658,7 @@ If FACE is not a valid face name, use default face." ;; But autoload them here to make the separation invisible. ;;;### (autoloads (ps-mule-end-job ps-mule-begin-job ps-mule-initialize -;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "1f436e4d78c7dc983a503dac18298515") +;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "b39f881d3a029049994ef6aa3de93c89") ;;; Generated autoloads from ps-mule.el (defvar ps-multibyte-buffer nil "\ diff --git a/lisp/recentf.el b/lisp/recentf.el index a4e4359999f..01a68d9dddd 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -72,6 +72,7 @@ See the command `recentf-save-list'." (defcustom recentf-save-file (locate-user-emacs-file "recentf" ".recentf") "File to save the recent list into." :group 'recentf + :version "24.4" :type 'file :initialize 'custom-initialize-default :set (lambda (symbol value) diff --git a/lisp/register.el b/lisp/register.el index ae2f7cf3e2a..4876c614642 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -31,10 +31,6 @@ (eval-when-compile (require 'cl-lib)) -(declare-function semantic-insert-foreign-tag "semantic/tag" (foreign-tag)) -(declare-function semantic-tag-buffer "semantic/tag" (tag)) -(declare-function semantic-tag-start "semantic/tag" (tag)) - ;;; Code: (cl-defstruct @@ -174,11 +170,6 @@ delete any existing frames that the frame configuration doesn't mention. (error "Register access aborted")) (find-file (nth 1 val)) (goto-char (nth 2 val))) - ((and (fboundp 'semantic-foreign-tag-p) - semantic-mode - (semantic-foreign-tag-p val)) - (switch-to-buffer (semantic-tag-buffer val)) - (goto-char (semantic-tag-start val))) (t (error "Register doesn't contain a buffer position or configuration"))))) @@ -349,10 +340,6 @@ Interactively, second arg is non-nil if prefix arg is supplied." (princ val (current-buffer))) ((and (markerp val) (marker-position val)) (princ (marker-position val) (current-buffer))) - ((and (fboundp 'semantic-foreign-tag-p) - semantic-mode - (semantic-foreign-tag-p val)) - (semantic-insert-foreign-tag val)) (t (error "Register does not contain text")))) (if (not arg) (exchange-point-and-mark))) diff --git a/lisp/replace.el b/lisp/replace.el index 17eea19edd8..af05bd11fb2 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -250,6 +250,10 @@ letters. \(Transferring the case pattern means that if the old text matched is all caps, or capitalized, then its replacement is upcased or capitalized.) +Ignore read-only matches if `query-replace-skip-read-only' is non-nil, +ignore hidden matches if `search-invisible' is nil, and ignore more +matches using a non-nil `isearch-filter-predicates'. + If `replace-lax-whitespace' is non-nil, a space or spaces in the string to be replaced will match a sequence of whitespace chars defined by the regexp in `search-whitespace-regexp'. @@ -300,6 +304,10 @@ pattern of the old text to the new text, if `case-replace' and all caps, or capitalized, then its replacement is upcased or capitalized.) +Ignore read-only matches if `query-replace-skip-read-only' is non-nil, +ignore hidden matches if `search-invisible' is nil, and ignore more +matches using a non-nil `isearch-filter-predicates'. + If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp to be replaced will match a sequence of whitespace chars defined by the regexp in `search-whitespace-regexp'. @@ -380,6 +388,10 @@ that reads REGEXP. Preserves case in each replacement if `case-replace' and `case-fold-search' are non-nil and REGEXP has no uppercase letters. +Ignore read-only matches if `query-replace-skip-read-only' is non-nil, +ignore hidden matches if `search-invisible' is nil, and ignore more +matches using a non-nil `isearch-filter-predicates'. + If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp to be replaced will match a sequence of whitespace chars defined by the regexp in `search-whitespace-regexp'. @@ -470,6 +482,10 @@ are non-nil and FROM-STRING has no uppercase letters. \(Preserving case means that if the string matched is all caps, or capitalized, then its replacement is upcased or capitalized.) +Ignore read-only matches if `query-replace-skip-read-only' is non-nil, +ignore hidden matches if `search-invisible' is nil, and ignore more +matches using a non-nil `isearch-filter-predicates'. + If `replace-lax-whitespace' is non-nil, a space or spaces in the string to be replaced will match a sequence of whitespace chars defined by the regexp in `search-whitespace-regexp'. @@ -512,6 +528,10 @@ and TO-STRING is also null.)" Preserve case in each match if `case-replace' and `case-fold-search' are non-nil and REGEXP has no uppercase letters. +Ignore read-only matches if `query-replace-skip-read-only' is non-nil, +ignore hidden matches if `search-invisible' is nil, and ignore more +matches using a non-nil `isearch-filter-predicates'. + If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp to be replaced will match a sequence of whitespace chars defined by the regexp in `search-whitespace-regexp'. @@ -1125,6 +1145,14 @@ If the value is nil, don't highlight the buffer names specially." :type 'face :group 'matching) +(defcustom list-matching-lines-prefix-face 'shadow + "Face used by \\[list-matching-lines] to show the prefix column. +If the face doesn't differ from the default face, +don't highlight the prefix with line numbers specially." + :type 'face + :group 'matching + :version "24.4") + (defcustom occur-excluded-properties '(read-only invisible intangible field mouse-face help-echo local-map keymap yank-handler follow-link) @@ -1334,7 +1362,9 @@ See also `multi-occur'." (isearch-no-upper-case-p regexp t) case-fold-search) list-matching-lines-buffer-name-face - nil list-matching-lines-face + (if (face-differs-from-default-p list-matching-lines-prefix-face) + list-matching-lines-prefix-face) + list-matching-lines-face (not (eq occur-excluded-properties t)))))) (let* ((bufcount (length active-bufs)) (diff (- (length bufs) bufcount))) @@ -1359,16 +1389,18 @@ See also `multi-occur'." (defun occur-engine (regexp buffers out-buf nlines case-fold title-face prefix-face match-face keep-props) (with-current-buffer out-buf - (let ((globalcount 0) + (let ((global-lines 0) ;; total count of matching lines + (global-matches 0) ;; total count of matches (coding nil) (case-fold-search case-fold)) ;; Map over all the buffers (dolist (buf buffers) (when (buffer-live-p buf) - (let ((matches 0) ;; count of matched lines - (lines 1) ;; line count - (prev-after-lines nil) ;; context lines of prev match - (prev-lines nil) ;; line number of prev match endpt + (let ((lines 0) ;; count of matching lines + (matches 0) ;; count of matches + (curr-line 1) ;; line count + (prev-line nil) ;; line number of prev match endpt + (prev-after-lines nil) ;; context lines of prev match (matchbeg 0) (origpt nil) (begpt nil) @@ -1389,7 +1421,7 @@ See also `multi-occur'." (while (not (eobp)) (setq origpt (point)) (when (setq endpt (re-search-forward regexp nil t)) - (setq matches (1+ matches)) ;; increment match count + (setq lines (1+ lines)) ;; increment matching lines count (setq matchbeg (match-beginning 0)) ;; Get beginning of first match line and end of the last. (save-excursion @@ -1398,7 +1430,7 @@ See also `multi-occur'." (goto-char endpt) (setq endpt (line-end-position))) ;; Sum line numbers up to the first match line. - (setq lines (+ lines (count-lines origpt begpt))) + (setq curr-line (+ curr-line (count-lines origpt begpt))) (setq marker (make-marker)) (set-marker marker matchbeg) (setq curstring (occur-engine-line begpt endpt keep-props)) @@ -1407,6 +1439,7 @@ See also `multi-occur'." (start 0)) (while (and (< start len) (string-match regexp curstring start)) + (setq matches (1+ matches)) (add-text-properties (match-beginning 0) (match-end 0) (append @@ -1420,10 +1453,10 @@ See also `multi-occur'." ;; Generate the string to insert for this match (let* ((match-prefix ;; Using 7 digits aligns tabs properly. - (apply #'propertize (format "%7d:" lines) + (apply #'propertize (format "%7d:" curr-line) (append (when prefix-face - `(font-lock-face prefix-face)) + `(font-lock-face ,prefix-face)) `(occur-prefix t mouse-face (highlight) ;; Allow insertion of text at ;; the end of the prefix (for @@ -1447,7 +1480,9 @@ See also `multi-occur'." ;; of multi-line matches. (replace-regexp-in-string "\n" - "\n :" + (if prefix-face + (propertize "\n :" 'font-lock-face prefix-face) + "\n :") match-str) ;; Add marker at eol, but no mouse props. (propertize "\n" 'occur-target marker))) @@ -1458,7 +1493,8 @@ See also `multi-occur'." ;; The complex multi-line display style. (setq ret (occur-context-lines out-line nlines keep-props begpt endpt - lines prev-lines prev-after-lines)) + curr-line prev-line prev-after-lines + prefix-face)) ;; Set first elem of the returned list to `data', ;; and the second elem to `prev-after-lines'. (setq prev-after-lines (nth 1 ret)) @@ -1470,28 +1506,34 @@ See also `multi-occur'." (if endpt (progn ;; Sum line numbers between first and last match lines. - (setq lines (+ lines (count-lines begpt endpt) - ;; Add 1 for empty last match line since - ;; count-lines returns 1 line less. - (if (and (bolp) (eolp)) 1 0))) + (setq curr-line (+ curr-line (count-lines begpt endpt) + ;; Add 1 for empty last match line since + ;; count-lines returns 1 line less. + (if (and (bolp) (eolp)) 1 0))) ;; On to the next match... (forward-line 1)) (goto-char (point-max))) - (setq prev-lines (1- lines))) + (setq prev-line (1- curr-line))) ;; Flush remaining context after-lines. (when prev-after-lines (with-current-buffer out-buf (insert (apply #'concat (occur-engine-add-prefix - prev-after-lines))))))) - (when (not (zerop matches)) ;; is the count zero? - (setq globalcount (+ globalcount matches)) + prev-after-lines prefix-face))))))) + (when (not (zerop lines)) ;; is the count zero? + (setq global-lines (+ global-lines lines) + global-matches (+ global-matches matches)) (with-current-buffer out-buf (goto-char headerpt) (let ((beg (point)) end) (insert (propertize - (format "%d match%s%s in buffer: %s\n" + (format "%d match%s%s%s in buffer: %s\n" matches (if (= matches 1) "" "es") + ;; Don't display the same number of lines + ;; and matches in case of 1 match per line. + (if (= lines matches) + "" (format " in %d line%s" + lines (if (= lines 1) "" "s"))) ;; Don't display regexp for multi-buffer. (if (> (length buffers) 1) "" (format " for \"%s\"" @@ -1506,12 +1548,17 @@ See also `multi-occur'." `(occur-title ,buf)))) (goto-char (point-min))))))) ;; Display total match count and regexp for multi-buffer. - (when (and (not (zerop globalcount)) (> (length buffers) 1)) + (when (and (not (zerop global-lines)) (> (length buffers) 1)) (goto-char (point-min)) (let ((beg (point)) end) - (insert (format "%d match%s total for \"%s\":\n" - globalcount (if (= globalcount 1) "" "es") + (insert (format "%d match%s%s total for \"%s\":\n" + global-matches (if (= global-matches 1) "" "es") + ;; Don't display the same number of lines + ;; and matches in case of 1 match per line. + (if (= global-lines global-matches) + "" (format " in %d line%s" + global-lines (if (= global-lines 1) "" "s"))) (query-replace-descr regexp))) (setq end (point)) (add-text-properties beg end (when title-face @@ -1523,7 +1570,7 @@ See also `multi-occur'." ;; buffer. (set-buffer-file-coding-system coding)) ;; Return the number of matches - globalcount))) + global-matches))) (defun occur-engine-line (beg end &optional keep-props) (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode) @@ -1537,10 +1584,13 @@ See also `multi-occur'." str) (buffer-substring-no-properties beg end))) -(defun occur-engine-add-prefix (lines) +(defun occur-engine-add-prefix (lines &optional prefix-face) (mapcar #'(lambda (line) - (concat " :" line "\n")) + (concat (if prefix-face + (propertize " :" 'font-lock-face prefix-face) + " :") + line "\n")) lines)) (defun occur-accumulate-lines (count &optional keep-props pt) @@ -1563,13 +1613,14 @@ See also `multi-occur'." ;; Generate context display for occur. ;; OUT-LINE is the line where the match is. ;; NLINES and KEEP-PROPS are args to occur-engine. -;; LINES is line count of the current match, -;; PREV-LINES is line count of the previous match, +;; CURR-LINE is line count of the current match, +;; PREV-LINE is line count of the previous match, ;; PREV-AFTER-LINES is a list of after-context lines of the previous match. ;; Generate a list of lines, add prefixes to all but OUT-LINE, ;; then concatenate them all together. (defun occur-context-lines (out-line nlines keep-props begpt endpt - lines prev-lines prev-after-lines) + curr-line prev-line prev-after-lines + &optional prefix-face) ;; Find after- and before-context lines of the current match. (let ((before-lines (nreverse (cdr (occur-accumulate-lines @@ -1584,22 +1635,22 @@ See also `multi-occur'." (when prev-after-lines ;; Don't overlap prev after-lines with current before-lines. - (if (>= (+ prev-lines (length prev-after-lines)) - (- lines (length before-lines))) + (if (>= (+ prev-line (length prev-after-lines)) + (- curr-line (length before-lines))) (setq prev-after-lines (butlast prev-after-lines (- (length prev-after-lines) - (- lines prev-lines (length before-lines) 1)))) + (- curr-line prev-line (length before-lines) 1)))) ;; Separate non-overlapping context lines with a dashed line. (setq separator "-------\n"))) - (when prev-lines + (when prev-line ;; Don't overlap current before-lines with previous match line. - (if (<= (- lines (length before-lines)) - prev-lines) + (if (<= (- curr-line (length before-lines)) + prev-line) (setq before-lines (nthcdr (- (length before-lines) - (- lines prev-lines 1)) + (- curr-line prev-line 1)) before-lines)) ;; Separate non-overlapping before-context lines. (unless (> nlines 0) @@ -1609,10 +1660,13 @@ See also `multi-occur'." ;; Return a list where the first element is the output line. (apply #'concat (append - (and prev-after-lines - (occur-engine-add-prefix prev-after-lines)) - (and separator (list separator)) - (occur-engine-add-prefix before-lines) + (if prev-after-lines + (occur-engine-add-prefix prev-after-lines prefix-face)) + (if separator + (list (if prefix-face + (propertize separator 'font-lock-face prefix-face) + separator))) + (occur-engine-add-prefix before-lines prefix-face) (list out-line))) ;; And the second element is the list of context after-lines. (if (> nlines 0) after-lines)))) @@ -1818,6 +1872,68 @@ It is used by `query-replace-regexp', `replace-regexp', It is called with three arguments, as if it were `re-search-forward'.") +(defun replace-search (search-string limit regexp-flag delimited-flag + case-fold-search) + "Search for the next occurence of SEARCH-STRING to replace." + ;; Let-bind global isearch-* variables to values used + ;; to search the next replacement. These let-bindings + ;; should be effective both at the time of calling + ;; `isearch-search-fun-default' and also at the + ;; time of funcalling `search-function'. + ;; These isearch-* bindings can't be placed higher + ;; outside of this function because then another I-search + ;; used after `recursive-edit' might override them. + (let* ((isearch-regexp regexp-flag) + (isearch-word delimited-flag) + (isearch-lax-whitespace + replace-lax-whitespace) + (isearch-regexp-lax-whitespace + replace-regexp-lax-whitespace) + (isearch-case-fold-search case-fold-search) + (isearch-adjusted nil) + (isearch-nonincremental t) ; don't use lax word mode + (isearch-forward t) + (search-function + (or (if regexp-flag + replace-re-search-function + replace-search-function) + (isearch-search-fun-default)))) + (funcall search-function search-string limit t))) + +(defvar replace-overlay nil) + +(defun replace-highlight (match-beg match-end range-beg range-end + search-string regexp-flag delimited-flag + case-fold-search) + (if query-replace-highlight + (if replace-overlay + (move-overlay replace-overlay match-beg match-end (current-buffer)) + (setq replace-overlay (make-overlay match-beg match-end)) + (overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays + (overlay-put replace-overlay 'face 'query-replace))) + (if query-replace-lazy-highlight + (let ((isearch-string search-string) + (isearch-regexp regexp-flag) + (isearch-word delimited-flag) + (isearch-lax-whitespace + replace-lax-whitespace) + (isearch-regexp-lax-whitespace + replace-regexp-lax-whitespace) + (isearch-case-fold-search case-fold-search) + (isearch-forward t) + (isearch-other-end match-beg) + (isearch-error nil)) + (isearch-lazy-highlight-new-loop range-beg range-end)))) + +(defun replace-dehighlight () + (when replace-overlay + (delete-overlay replace-overlay)) + (when query-replace-lazy-highlight + (lazy-highlight-cleanup lazy-highlight-cleanup) + (setq isearch-lazy-highlight-last-string nil)) + ;; Close overlays opened by `isearch-range-invisible' in `perform-replace'. + (isearch-clean-overlays)) + (defun perform-replace (from-string replacements query-flag regexp-flag delimited-flag &optional repeat-count map start end) @@ -1852,6 +1968,9 @@ make, or the user didn't cancel the call." (keep-going t) (stack nil) (replace-count 0) + (skip-read-only-count 0) + (skip-filtered-count 0) + (skip-invisible-count 0) (nonempty-match nil) (multi-buffer nil) (recenter-last-op nil) ; Start cycling order with initial position. @@ -1905,62 +2024,40 @@ make, or the user didn't cancel the call." ;; Loop finding occurrences that perhaps should be replaced. (while (and keep-going (not (or (eobp) (and limit (>= (point) limit)))) - ;; Let-bind global isearch-* variables to values used - ;; to search the next replacement. These let-bindings - ;; should be effective both at the time of calling - ;; `isearch-search-fun-default' and also at the - ;; time of funcalling `search-function'. - ;; These isearch-* bindings can't be placed higher - ;; outside of this loop because then another I-search - ;; used after `recursive-edit' might override them. - (let* ((isearch-regexp regexp-flag) - (isearch-word delimited-flag) - (isearch-lax-whitespace - replace-lax-whitespace) - (isearch-regexp-lax-whitespace - replace-regexp-lax-whitespace) - (isearch-case-fold-search case-fold-search) - (isearch-adjusted nil) - (isearch-nonincremental t) ; don't use lax word mode - (isearch-forward t) - (search-function - (or (if regexp-flag - replace-re-search-function - replace-search-function) - (isearch-search-fun-default)))) - ;; Use the next match if it is already known; - ;; otherwise, search for a match after moving forward - ;; one char if progress is required. - (setq real-match-data - (cond ((consp match-again) - (goto-char (nth 1 match-again)) - (replace-match-data - t real-match-data match-again)) - ;; MATCH-AGAIN non-nil means accept an - ;; adjacent match. - (match-again - (and - (funcall search-function search-string - limit t) - ;; For speed, use only integers and - ;; reuse the list used last time. - (replace-match-data t real-match-data))) - ((and (< (1+ (point)) (point-max)) - (or (null limit) - (< (1+ (point)) limit))) - ;; If not accepting adjacent matches, - ;; move one char to the right before - ;; searching again. Undo the motion - ;; if the search fails. - (let ((opoint (point))) - (forward-char 1) - (if (funcall - search-function search-string - limit t) - (replace-match-data - t real-match-data) - (goto-char opoint) - nil))))))) + ;; Use the next match if it is already known; + ;; otherwise, search for a match after moving forward + ;; one char if progress is required. + (setq real-match-data + (cond ((consp match-again) + (goto-char (nth 1 match-again)) + (replace-match-data + t real-match-data match-again)) + ;; MATCH-AGAIN non-nil means accept an + ;; adjacent match. + (match-again + (and + (replace-search search-string limit + regexp-flag delimited-flag + case-fold-search) + ;; For speed, use only integers and + ;; reuse the list used last time. + (replace-match-data t real-match-data))) + ((and (< (1+ (point)) (point-max)) + (or (null limit) + (< (1+ (point)) limit))) + ;; If not accepting adjacent matches, + ;; move one char to the right before + ;; searching again. Undo the motion + ;; if the search fails. + (let ((opoint (point))) + (forward-char 1) + (if (replace-search search-string limit + regexp-flag delimited-flag + case-fold-search) + (replace-match-data + t real-match-data) + (goto-char opoint) + nil)))))) ;; Record whether the match is nonempty, to avoid an infinite loop ;; repeatedly matching the same empty string. @@ -1982,12 +2079,27 @@ make, or the user didn't cancel the call." (and (/= (nth 0 match) (nth 1 match)) match)))))) - ;; Optionally ignore matches that have a read-only property. - (unless (and query-replace-skip-read-only - (text-property-not-all - (nth 0 real-match-data) (nth 1 real-match-data) - 'read-only nil)) - + (cond + ;; Optionally ignore matches that have a read-only property. + ((not (or (not query-replace-skip-read-only) + (not (text-property-not-all + (nth 0 real-match-data) (nth 1 real-match-data) + 'read-only nil)))) + (setq skip-read-only-count (1+ skip-read-only-count))) + ;; Optionally filter out matches. + ((not (run-hook-with-args-until-failure + 'isearch-filter-predicates + (nth 0 real-match-data) (nth 1 real-match-data))) + (setq skip-filtered-count (1+ skip-filtered-count))) + ;; Optionally ignore invisible matches. + ((not (or (eq search-invisible t) + ;; Don't open overlays for automatic replacements. + (and (not query-flag) search-invisible) + ;; Open hidden overlays for interactive replacements. + (not (isearch-range-invisible + (nth 0 real-match-data) (nth 1 real-match-data))))) + (setq skip-invisible-count (1+ skip-invisible-count))) + (t ;; Calculate the replacement string, if necessary. (when replacements (set-match-data real-match-data) @@ -2192,45 +2304,31 @@ make, or the user didn't cancel the call." (match-end 0) (current-buffer)) (match-data t))) - stack))))) + stack)))))) (replace-dehighlight)) (or unread-command-events - (message "Replaced %d occurrence%s" + (message "Replaced %d occurrence%s%s" replace-count - (if (= replace-count 1) "" "s"))) + (if (= replace-count 1) "" "s") + (if (> (+ skip-read-only-count + skip-filtered-count + skip-invisible-count) 0) + (format " (skipped %s)" + (mapconcat + 'identity + (delq nil (list + (if (> skip-read-only-count 0) + (format "%s read-only" + skip-read-only-count)) + (if (> skip-invisible-count 0) + (format "%s invisible" + skip-invisible-count)) + (if (> skip-filtered-count 0) + (format "%s filtered out" + skip-filtered-count)))) + ", ")) + ""))) (or (and keep-going stack) multi-buffer))) -(defvar replace-overlay nil) - -(defun replace-highlight (match-beg match-end range-beg range-end - search-string regexp-flag delimited-flag - case-fold-search) - (if query-replace-highlight - (if replace-overlay - (move-overlay replace-overlay match-beg match-end (current-buffer)) - (setq replace-overlay (make-overlay match-beg match-end)) - (overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays - (overlay-put replace-overlay 'face 'query-replace))) - (if query-replace-lazy-highlight - (let ((isearch-string search-string) - (isearch-regexp regexp-flag) - (isearch-word delimited-flag) - (isearch-lax-whitespace - replace-lax-whitespace) - (isearch-regexp-lax-whitespace - replace-regexp-lax-whitespace) - (isearch-case-fold-search case-fold-search) - (isearch-forward t) - (isearch-other-end match-beg) - (isearch-error nil)) - (isearch-lazy-highlight-new-loop range-beg range-end)))) - -(defun replace-dehighlight () - (when replace-overlay - (delete-overlay replace-overlay)) - (when query-replace-lazy-highlight - (lazy-highlight-cleanup lazy-highlight-cleanup) - (setq isearch-lazy-highlight-last-string nil))) - ;;; replace.el ends here diff --git a/lisp/shell.el b/lisp/shell.el index d09d7aee43f..51a0ffc4fe8 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -111,9 +111,10 @@ "Directory support in shell mode." :group 'shell) -(defgroup shell-faces nil - "Faces in shell buffers." - :group 'shell) +;; Unused. +;;; (defgroup shell-faces nil +;;; "Faces in shell buffers." +;;; :group 'shell) ;;;###autoload (defcustom shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe") diff --git a/lisp/simple.el b/lisp/simple.el index 3ef700a6058..18a360faa61 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -380,12 +380,18 @@ Other major modes are defined by comparison with this one." map) "Keymap used for programming modes.") -(defun prog-indent-sexp () - "Indent the expression after point." - (interactive) - (let ((start (point)) - (end (save-excursion (forward-sexp 1) (point)))) - (indent-region start end nil))) +(defun prog-indent-sexp (&optional defun) + "Indent the expression after point. +When interactively called with prefix, indent the enclosing defun +instead." + (interactive "P") + (save-excursion + (when defun + (end-of-line) + (beginning-of-defun)) + (let ((start (point)) + (end (progn (forward-sexp 1) (point)))) + (indent-region start end nil)))) (define-derived-mode prog-mode fundamental-mode "Prog" "Major mode for editing programming language source code." @@ -1236,13 +1242,33 @@ in *Help* buffer. See also the command `describe-char'." bidi-fixer encoding-msg pos total percent col hscroll)))))) ;; Initialize read-expression-map. It is defined at C level. -(let ((m (make-sparse-keymap))) - (define-key m "\M-\t" 'lisp-complete-symbol) - ;; Might as well bind TAB to completion, since inserting a TAB char is much - ;; too rarely useful. - (define-key m "\t" 'lisp-complete-symbol) - (set-keymap-parent m minibuffer-local-map) - (setq read-expression-map m)) +(defvar read-expression-map + (let ((m (make-sparse-keymap))) + (define-key m "\M-\t" 'completion-at-point) + ;; Might as well bind TAB to completion, since inserting a TAB char is + ;; much too rarely useful. + (define-key m "\t" 'completion-at-point) + (set-keymap-parent m minibuffer-local-map) + m)) + +(defun read-minibuffer (prompt &optional initial-contents) + "Return a Lisp object read using the minibuffer, unevaluated. +Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS +is a string to insert in the minibuffer before reading. +\(INITIAL-CONTENTS can also be a cons of a string and an integer. +Such arguments are used as in `read-from-minibuffer'.)" + ;; Used for interactive spec `x'. + (read-from-minibuffer prompt initial-contents minibuffer-local-map + t minibuffer-history)) + +(defun eval-minibuffer (prompt &optional initial-contents) + "Return value of Lisp expression read using the minibuffer. +Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS +is a string to insert in the minibuffer before reading. +\(INITIAL-CONTENTS can also be a cons of a string and an integer. +Such arguments are used as in `read-from-minibuffer'.)" + ;; Used for interactive spec `X'. + (eval (read--expression prompt initial-contents))) (defvar minibuffer-completing-symbol nil "Non-nil means completing a Lisp symbol in the minibuffer.") @@ -1291,6 +1317,20 @@ display the result of expression evaluation." (format " (#o%o, #x%x, %s)" value value char-string) (format " (#o%o, #x%x)" value value))))) +(defvar eval-expression-minibuffer-setup-hook nil + "Hook run by `eval-expression' when entering the minibuffer.") + +(defun read--expression (prompt &optional initial-contents) + (let ((minibuffer-completing-symbol t)) + (minibuffer-with-setup-hook + (lambda () + (add-hook 'completion-at-point-functions + #'lisp-completion-at-point nil t) + (run-hooks 'eval-expression-minibuffer-setup-hook)) + (read-from-minibuffer prompt initial-contents + read-expression-map t + 'read-expression-history)))) + ;; We define this, rather than making `eval' interactive, ;; for the sake of completion of names like eval-region, eval-buffer. (defun eval-expression (exp &optional insert-value) @@ -1307,10 +1347,7 @@ and `eval-expression-print-level'. If `eval-expression-debug-on-error' is non-nil, which is the default, this command arranges for all errors to enter the debugger." (interactive - (list (let ((minibuffer-completing-symbol t)) - (read-from-minibuffer "Eval: " - nil read-expression-map t - 'read-expression-history)) + (list (read--expression "Eval: ") current-prefix-arg)) (if (null eval-expression-debug-on-error) @@ -2841,7 +2878,7 @@ Command Output*' is deleted. Optional fourth arg OUTPUT-BUFFER specifies where to put the command's output. If the value is a buffer or buffer name, put -the output there. Any other value, including nil, means to +the output there. Any other value, excluding nil, means to insert the output in the current buffer. In either case, the output is inserted after point (leaving mark after it). @@ -2890,7 +2927,7 @@ interactively, this is t." (goto-char start) (and replace (push-mark (point) 'nomsg)) (setq exit-status - (call-process-region start end shell-file-name t + (call-process-region start end shell-file-name replace (if error-file (list t error-file) t) @@ -3286,46 +3323,33 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]." (defvar filter-buffer-substring-functions nil - "This variable is a wrapper hook around `filter-buffer-substring'. -Each member of the hook should be a function accepting four arguments: -\(FUN BEG END DELETE), where FUN is itself a function of three arguments + "This variable is a wrapper hook around `filter-buffer-substring'.") +(make-obsolete-variable 'filter-buffer-substring-functions + 'filter-buffer-substring-function "24.4") + +(defvar filter-buffer-substring-function #'buffer-substring--filter + "Function to perform the filtering in `filter-buffer-substring'. +The function is called with 3 arguments: \(BEG END DELETE). The arguments BEG, END, and DELETE are the same as those of `filter-buffer-substring' in each case. - -The first hook function to be called receives a FUN equivalent -to the default operation of `filter-buffer-substring', -i.e. one that returns the buffer-substring between BEG and -END (processed by any `buffer-substring-filters'). Normally, -the hook function will call FUN and then do its own processing -of the result. The next hook function receives a FUN equivalent -to the previous hook function, calls it, and does its own -processing, and so on. The overall result is that of all hook -functions acting in sequence. - -Any hook may choose not to call FUN though, in which case it -effectively replaces the default behavior with whatever it chooses. -Of course, a later hook function may do the same thing.") +It should return the buffer substring between BEG and END, after filtering.") (defvar buffer-substring-filters nil "List of filter functions for `filter-buffer-substring'. Each function must accept a single argument, a string, and return a string. The buffer substring is passed to the first function in the list, and the return value of each function is passed to -the next. The final result (if `buffer-substring-filters' is -nil, this is the unfiltered buffer-substring) is passed to the -first function on `filter-buffer-substring-functions'. - +the next. As a special convention, point is set to the start of the buffer text being operated on (i.e., the first argument of `filter-buffer-substring') before these functions are called.") (make-obsolete-variable 'buffer-substring-filters - 'filter-buffer-substring-functions "24.1") + 'filter-buffer-substring-function "24.1") (defun filter-buffer-substring (beg end &optional delete) "Return the buffer substring between BEG and END, after filtering. -The wrapper hook `filter-buffer-substring-functions' performs -the actual filtering. The obsolete variable `buffer-substring-filters' -is also consulted. If both of these are nil, no filtering is done. +The hook `filter-buffer-substring-function' performs the actual filtering. +By default, no filtering is done. If DELETE is non-nil, the text between BEG and END is deleted from the buffer. @@ -3333,9 +3357,12 @@ from the buffer. This function should be used instead of `buffer-substring', `buffer-substring-no-properties', or `delete-and-extract-region' when you want to allow filtering to take place. For example, -major or minor modes can use `filter-buffer-substring-functions' to +major or minor modes can use `filter-buffer-substring-function' to extract characters that are special to a buffer, and should not be copied into other buffers." + (funcall filter-buffer-substring-function beg end delete)) + +(defun buffer-substring--filter (beg end &optional delete) (with-wrapper-hook filter-buffer-substring-functions (beg end delete) (cond ((or delete buffer-substring-filters) @@ -4182,7 +4209,7 @@ a mistake; see the documentation of `set-mark'." (marker-position (mark-marker)) (signal 'mark-inactive nil))) -(defsubst deactivate-mark (&optional force) +(defun deactivate-mark (&optional force) "Deactivate the mark. If Transient Mark mode is disabled, this function normally does nothing; but if FORCE is non-nil, it deactivates the mark anyway. @@ -4840,13 +4867,25 @@ lines." (frame-char-width)) hscroll)))))) (if target-hscroll (set-window-hscroll (selected-window) target-hscroll)) - (or (and (= (vertical-motion - (cons (or goal-column - (if (consp temporary-goal-column) - (car temporary-goal-column) - temporary-goal-column)) - arg)) - arg) + ;; vertical-motion can move more than it was asked to if it moves + ;; across display strings with newlines. We don't want to ring + ;; the bell and announce beginning/end of buffer in that case. + (or (and (or (and (>= arg 0) + (>= (vertical-motion + (cons (or goal-column + (if (consp temporary-goal-column) + (car temporary-goal-column) + temporary-goal-column)) + arg)) + arg)) + (and (< arg 0) + (<= (vertical-motion + (cons (or goal-column + (if (consp temporary-goal-column) + (car temporary-goal-column) + temporary-goal-column)) + arg)) + arg))) (or (>= arg 0) (/= (point) opoint) ;; If the goal column lies on a display string, @@ -6623,7 +6662,9 @@ the default method of inserting the completion in BUFFER.") (defun choose-completion-string (choice &optional buffer base-position insert-function) "Switch to BUFFER and insert the completion choice CHOICE. -BASE-POSITION, says where to insert the completion." +BASE-POSITION says where to insert the completion. +INSERT-FUNCTION says how to insert the completion and falls +back on `completion-list-insert-choice-function' when nil." ;; If BUFFER is the minibuffer, exit the minibuffer ;; unless it is reading a file name and CHOICE is a directory, @@ -6717,15 +6758,21 @@ Called from `temp-buffer-show-hook'." (defun completion-setup-function () (let* ((mainbuf (current-buffer)) (base-dir - ;; When reading a file name in the minibuffer, - ;; try and find the right default-directory to set in the - ;; completion list buffer. - ;; FIXME: Why do we do that, actually? --Stef + ;; FIXME: This is a bad hack. We try to set the default-directory + ;; in the *Completions* buffer so that the relative file names + ;; displayed there can be treated as valid file names, independently + ;; from the completion context. But this suffers from many problems: + ;; - It's not clear when the completions are file names. With some + ;; completion tables (e.g. bzr revision specs), the listed + ;; completions can mix file names and other things. + ;; - It doesn't pay attention to possible quoting. + ;; - With fancy completion styles, the code below will not always + ;; find the right base directory. (if minibuffer-completing-file-name (file-name-as-directory (expand-file-name - (substring (minibuffer-completion-contents) - 0 (or completion-base-size 0))))))) + (buffer-substring (minibuffer-prompt-end) + (- (point) (or completion-base-size 0)))))))) (with-current-buffer standard-output (let ((base-size completion-base-size) ;Read before killing localvars. (base-position completion-base-position) diff --git a/lisp/sort.el b/lisp/sort.el index 56e97061d13..9493768f6a0 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -568,7 +568,8 @@ From a program takes two point or marker arguments, BEG and END." (insert (car ll))))) ;;;###autoload -(defun delete-duplicate-lines (beg end &optional reverse adjacent interactive) +(defun delete-duplicate-lines (beg end &optional reverse adjacent keep-blanks + interactive) "Delete duplicate lines in the region between BEG and END. If REVERSE is nil, search and delete duplicates forward keeping the first @@ -582,6 +583,9 @@ delete repeated lines only if they are adjacent. It works like the utility this is more efficient in performance and memory usage than when ADJACENT is nil that uses additional memory to remember previous lines. +If KEEP-BLANKS is non-nil (when called interactively with three C-u prefixes), +duplicate blank lines are preserved. + When called from Lisp and INTERACTIVE is omitted or nil, return the number of deleted duplicate lines, do not print it; if INTERACTIVE is t, the function behaves in all respects as if it had been called interactively." @@ -591,6 +595,7 @@ function behaves in all respects as if it had been called interactively." (list (region-beginning) (region-end) (equal current-prefix-arg '(4)) (equal current-prefix-arg '(16)) + (equal current-prefix-arg '(64)) t))) (let ((lines (unless adjacent (make-hash-table :weakness 'key :test 'equal))) line prev-line @@ -605,14 +610,16 @@ function behaves in all respects as if it had been called interactively." (and (< (point) end) (not (eobp)))) (setq line (buffer-substring-no-properties (line-beginning-position) (line-end-position))) - (if (if adjacent (equal line prev-line) (gethash line lines)) - (progn - (delete-region (progn (forward-line 0) (point)) - (progn (forward-line 1) (point))) - (if reverse (forward-line -1)) - (setq count (1+ count))) - (if adjacent (setq prev-line line) (puthash line t lines)) - (forward-line (if reverse -1 1))))) + (if (and keep-blanks (string= "" line)) + (forward-line 1) + (if (if adjacent (equal line prev-line) (gethash line lines)) + (progn + (delete-region (progn (forward-line 0) (point)) + (progn (forward-line 1) (point))) + (if reverse (forward-line -1)) + (setq count (1+ count))) + (if adjacent (setq prev-line line) (puthash line t lines)) + (forward-line (if reverse -1 1)))))) (set-marker beg nil) (set-marker end nil) (when interactive diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 70bf5f41518..9daa77b740f 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -73,7 +73,7 @@ this version is not backward compatible to 0.14 or earlier.") ;; `speedbar-insert-generic-list'. If you use ;; `speedbar-insert-generic-list', also read the doc for ;; `speedbar-tag-hierarchy-method' in case you wish to override it. -;; The macro `speedbar-with-attached-buffer' brings you back to the +;; The macro `dframe-with-attached-buffer' brings you back to the ;; buffer speedbar is displaying for. ;; ;; For those functions that make buttons, the "function" should be a @@ -1137,10 +1137,7 @@ in the selected file. dframe-mouse-position-function #'speedbar-position-cursor-on-line)) speedbar-buffer) -(defmacro speedbar-message (fmt &rest args) - "Like `message', but for use in the speedbar frame. -Argument FMT is the format string, and ARGS are the arguments for message." - `(dframe-message ,fmt ,@args)) +(define-obsolete-function-alias 'speedbar-message 'dframe-message "24.4") (defsubst speedbar-y-or-n-p (prompt &optional deleting) "Like `y-or-n-p', but for use in the speedbar frame. @@ -1157,8 +1154,10 @@ return true without a query." (dframe-select-attached-frame (speedbar-current-frame))) ;; Backwards compatibility -(defalias 'speedbar-with-attached-buffer 'dframe-with-attached-buffer) -(defalias 'speedbar-maybee-jump-to-attached-frame 'dframe-maybee-jump-to-attached-frame) +(define-obsolete-function-alias 'speedbar-with-attached-buffer + 'dframe-with-attached-buffer "24.4") ; macro +(define-obsolete-function-alias 'speedbar-maybee-jump-to-attached-frame + 'dframe-maybee-jump-to-attached-frame "24.4") (defun speedbar-set-mode-line-format () "Set the format of the mode line based on the current speedbar environment. @@ -1285,7 +1284,7 @@ and the existence of packages." (if (eq major-mode 'speedbar-mode) ;; XEmacs may let us get in here in other mode buffers. (speedbar-item-info))) - (error (speedbar-message nil))))))) + (error (dframe-message nil))))))) (defun speedbar-show-info-under-mouse () "Call the info function for the line under the mouse." @@ -1417,13 +1416,13 @@ Argument ARG represents to force a refresh past any caches that may exist." (delq (assoc d speedbar-directory-contents-alist) speedbar-directory-contents-alist))) (if (<= 1 speedbar-verbosity-level) - (speedbar-message "Refreshing speedbar...")) + (dframe-message "Refreshing speedbar...")) (speedbar-update-contents) (speedbar-stealthy-updates) ;; Reset the timer in case it got really hosed for some reason... (speedbar-set-timer dframe-update-speed) (if (<= 1 speedbar-verbosity-level) - (speedbar-message "Refreshing speedbar...done")))) + (dframe-message "Refreshing speedbar...done")))) (defun speedbar-item-load () "Load the item under the cursor or mouse if it is a Lisp file." @@ -1467,7 +1466,7 @@ File style information is displayed with `speedbar-item-info'." ;; Skip items in "folder" type text characters. (if (looking-at "\\s-*[[<({].[]>)}] ") (goto-char (match-end 0))) ;; Get the text - (speedbar-message "Text: %s" (buffer-substring-no-properties + (dframe-message "Text: %s" (buffer-substring-no-properties (point) (line-end-position))))) (defun speedbar-item-info () @@ -1485,7 +1484,7 @@ Return nil if not applicable. If FILENAME, then use that instead of reading it from the speedbar buffer." (let* ((item (or filename (speedbar-line-file))) (attr (if item (file-attributes item) nil))) - (if (and item attr) (speedbar-message "%s %-6d %s" (nth 8 attr) + (if (and item attr) (dframe-message "%s %-6d %s" (nth 8 attr) (nth 7 attr) item) nil))) @@ -1506,14 +1505,14 @@ Return nil if not applicable." (when (and (semantic-tag-overlay attr) (semantic-tag-buffer attr)) (set-buffer (semantic-tag-buffer attr))) - (speedbar-message + (dframe-message (funcall semantic-sb-info-format-tag-function attr) ))) (looking-at "\\([0-9]+\\):") (setq item (file-name-nondirectory (speedbar-line-directory))) - (speedbar-message "Tag: %s in %s" tag item))) + (dframe-message "Tag: %s in %s" tag item))) (if (re-search-forward "{[+-]} \\([^\n]+\\)$" (line-end-position) t) - (speedbar-message "Group of tags \"%s\"" (match-string 1)) + (dframe-message "Group of tags \"%s\"" (match-string 1)) (if (re-search-forward " [+-]?[()|@] \\([^\n]+\\)$" nil t) (let* ((detailtext (match-string 1)) (detail (or (speedbar-line-token) detailtext)) @@ -1532,18 +1531,18 @@ Return nil if not applicable." (if (featurep 'semantic) (with-no-warnings (if (semantic-tag-p detail) - (speedbar-message + (dframe-message (funcall semantic-sb-info-format-tag-function detail parent)) (if parent - (speedbar-message "Detail: %s of tag %s" detail + (dframe-message "Detail: %s of tag %s" detail (if (semantic-tag-p parent) (semantic-format-tag-name parent nil t) parent)) - (speedbar-message "Detail: %s" detail)))) + (dframe-message "Detail: %s" detail)))) ;; Not using `semantic': (if parent - (speedbar-message "Detail: %s of tag %s" detail parent) - (speedbar-message "Detail: %s" detail)))) + (dframe-message "Detail: %s of tag %s" detail parent) + (dframe-message "Detail: %s" detail)))) nil))))) (defun speedbar-files-item-info () @@ -1641,7 +1640,7 @@ Files can be renamed to new names or moved to new directories." (if (file-directory-p f) (delete-directory f t t) (delete-file f t)) - (speedbar-message "Okie dokie.") + (dframe-message "Okie dokie.") (let ((p (point))) (speedbar-refresh) (goto-char p)) @@ -1706,9 +1705,9 @@ variable `speedbar-obj-alist'." (defmacro speedbar-with-writable (&rest forms) "Allow the buffer to be writable and evaluate FORMS." - (list 'let '((inhibit-read-only t)) - (cons 'progn forms))) -(put 'speedbar-with-writable 'lisp-indent-function 0) + (declare (indent 0)) + `(let ((inhibit-read-only t)) + ,@forms)) (defun speedbar-insert-button (text face mouse function &optional token prevline) @@ -2437,7 +2436,7 @@ name will have the function FIND-FUN and not token." (car (car lst)) ;button name nil nil 'speedbar-tag-face (1+ level))) - (t (speedbar-message "speedbar-insert-generic-list: malformed list!") + (t (dframe-message "speedbar-insert-generic-list: malformed list!") )) (setq lst (cdr lst))))) @@ -2492,14 +2491,14 @@ name will have the function FIND-FUN and not token." (expand-file-name default-directory)))) nil (if (<= 1 speedbar-verbosity-level) - (speedbar-message "Updating speedbar to: %s..." + (dframe-message "Updating speedbar to: %s..." default-directory)) (speedbar-update-directory-contents) (if (<= 1 speedbar-verbosity-level) (progn - (speedbar-message "Updating speedbar to: %s...done" + (dframe-message "Updating speedbar to: %s...done" default-directory) - (speedbar-message nil)))) + (dframe-message nil)))) ;; Else, we can do a short cut. No text cache. (let ((cbd (expand-file-name default-directory))) (set-buffer speedbar-buffer) @@ -2662,16 +2661,16 @@ Also resets scanner functions." ;;(eq (get major-mode 'mode-class 'special))) (progn (if (<= 2 speedbar-verbosity-level) - (speedbar-message + (dframe-message "Updating speedbar to special mode: %s..." major-mode)) (speedbar-update-special-contents) (if (<= 2 speedbar-verbosity-level) (progn - (speedbar-message + (dframe-message "Updating speedbar to special mode: %s...done" major-mode) - (speedbar-message nil)))) + (dframe-message nil)))) ;; Update all the contents if directories change! (unless (and (or (member major-mode speedbar-ignored-modes) @@ -2704,7 +2703,7 @@ interrupted by the user." (while (and l (funcall (car l))) ;;(sit-for 0) (setq l (cdr l)))) - ;;(speedbar-message "Exit with %S" (car l)) + ;;(dframe-message "Exit with %S" (car l)) )))) (defun speedbar-reset-scanners () @@ -2944,7 +2943,7 @@ the file being checked." (point)))) (fulln (concat f fn))) (if (<= 2 speedbar-verbosity-level) - (speedbar-message "Speedbar vc check...%s" fulln)) + (dframe-message "Speedbar vc check...%s" fulln)) (and (file-writable-p fulln) (speedbar-this-file-in-vc f fn)))) @@ -3016,7 +3015,7 @@ the file being checked." (point)))) (fulln (concat f fn))) (if (<= 2 speedbar-verbosity-level) - (speedbar-message "Speedbar obj check...%s" fulln)) + (dframe-message "Speedbar obj check...%s" fulln)) (let ((oa speedbar-obj-alist)) (while (and oa (not (string-match (car (car oa)) fulln))) (setq oa (cdr oa))) @@ -3076,7 +3075,7 @@ a function if appropriate." (buffer-substring-no-properties (match-beginning 0) (match-end 0)) "0"))))) - ;;(speedbar-message "%S:%S:%S:%s" fn tok txt dent) + ;;(dframe-message "%S:%S:%S:%s" fn tok txt dent) (and fn (funcall fn txt tok dent))) (speedbar-position-cursor-on-line)) @@ -3697,14 +3696,14 @@ Each symbol will be associated with its line position in FILE." (if (get-buffer "*etags tmp*") (kill-buffer "*etags tmp*")) ;kill to clean it up (if (<= 1 speedbar-verbosity-level) - (speedbar-message "Fetching etags...")) + (dframe-message "Fetching etags...")) (set-buffer (get-buffer-create "*etags tmp*")) (apply 'call-process speedbar-fetch-etags-command nil (current-buffer) nil (append speedbar-fetch-etags-arguments (list file))) (goto-char (point-min)) (if (<= 1 speedbar-verbosity-level) - (speedbar-message "Fetching etags...")) + (dframe-message "Fetching etags...")) (let ((expr (let ((exprlst speedbar-fetch-etags-parse-list) (ans nil)) @@ -3721,7 +3720,7 @@ Each symbol will be associated with its line position in FILE." (setq tnl (speedbar-extract-one-symbol expr))) (if tnl (setq newlist (cons tnl newlist))) (forward-line 1))) - (speedbar-message + (dframe-message "Sorry, no support for a file of that extension")))) ) (if speedbar-sort-tags @@ -3908,7 +3907,7 @@ Argument BUFFER is the buffer being tested." (let* ((item (speedbar-line-text)) (buffer (if item (get-buffer item) nil))) (and buffer - (speedbar-message "%s%s %S %d %s" + (dframe-message "%s%s %S %d %s" (if (buffer-modified-p buffer) "* " "") item (with-current-buffer buffer major-mode) diff --git a/lisp/startup.el b/lisp/startup.el index db84a5b11b2..b7b4c156f02 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1856,11 +1856,8 @@ To quit a partially entered command, type Control-g.\n") (insert "\n" (emacs-version) "\n" emacs-copyright)) -;; No mouse menus, so give help using kbd commands. (defun normal-no-mouse-startup-screen () - - ;; If keys have their default meanings, - ;; use precomputed string to save lots of time. + "Show a splash screen suitable for displays without mouse support." (let* ((c-h-accessible ;; If normal-erase-is-backspace is used on a tty, there's ;; no way to invoke C-h and you have to use F1 instead. @@ -1938,47 +1935,24 @@ If you have no Meta key, you may instead type ESC followed by the character.)") 'follow-link t) (insert "\n") (insert "\n" (emacs-version) "\n" emacs-copyright "\n") - - (if (and (eq (key-binding "\C-h\C-c") 'describe-copying) - (eq (key-binding "\C-h\C-d") 'describe-distribution) - (eq (key-binding "\C-h\C-w") 'describe-no-warranty)) - (progn - (insert - " -GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for ") - (insert-button "full details" - 'action (lambda (_button) (describe-no-warranty)) - 'follow-link t) - (insert ". -Emacs is Free Software--Free as in Freedom--so you can redistribute copies -of Emacs and modify it; type C-h C-c to see ") - (insert-button "the conditions" - 'action (lambda (_button) (describe-copying)) - 'follow-link t) - (insert ". -Type C-h C-d for information on ") - (insert-button "getting the latest version" - 'action (lambda (_button) (describe-distribution)) - 'follow-link t) - (insert ".")) - (insert (substitute-command-keys - " + (insert (substitute-command-keys + " GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for ")) - (insert-button "full details" - 'action (lambda (_button) (describe-no-warranty)) - 'follow-link t) - (insert (substitute-command-keys ". + (insert-button "full details" + 'action (lambda (_button) (describe-no-warranty)) + 'follow-link t) + (insert (substitute-command-keys ". Emacs is Free Software--Free as in Freedom--so you can redistribute copies of Emacs and modify it; type \\[describe-copying] to see ")) - (insert-button "the conditions" - 'action (lambda (_button) (describe-copying)) - 'follow-link t) - (insert (substitute-command-keys". + (insert-button "the conditions" + 'action (lambda (_button) (describe-copying)) + 'follow-link t) + (insert (substitute-command-keys". Type \\[describe-distribution] for information on ")) - (insert-button "getting the latest version" - 'action (lambda (_button) (describe-distribution)) - 'follow-link t) - (insert "."))) + (insert-button "getting the latest version" + 'action (lambda (_button) (describe-distribution)) + 'follow-link t) + (insert ".")) (defun normal-about-screen () (insert "\n" (emacs-version) "\n" emacs-copyright "\n\n") @@ -2027,14 +2001,11 @@ Type \\[describe-distribution] for information on ")) (insert "\tBuying printed manuals from the FSF\n")) (defun startup-echo-area-message () - (cond ((daemonp) - "Starting Emacs daemon.") - ((eq (key-binding "\C-h\C-a") 'about-emacs) - "For information about GNU Emacs and the GNU system, type C-h C-a.") - (t - (substitute-command-keys - "For information about GNU Emacs and the GNU system, type \ -\\[about-emacs].")))) + (if (daemonp) + "Starting Emacs daemon." + (substitute-command-keys + "For information about GNU Emacs and the GNU system, type \ +\\[about-emacs]."))) (defun display-startup-echo-area-message () (let ((resize-mini-windows t)) diff --git a/lisp/subr.el b/lisp/subr.el index f5bab44643b..f8fbe98b141 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -376,6 +376,23 @@ one is kept." (setq tail (cdr tail)))) list) +;; See http://lists.gnu.org/archive/html/emacs-devel/2013-05/msg00204.html +(defun delete-consecutive-dups (list &optional circular) + "Destructively remove `equal' consecutive duplicates from LIST. +First and last elements are considered consecutive if CIRCULAR is +non-nil." + (let ((tail list) last) + (while (consp tail) + (if (equal (car tail) (cadr tail)) + (setcdr tail (cddr tail)) + (setq last (car tail) + tail (cdr tail)))) + (if (and circular + (cdr list) + (equal last (car list))) + (nbutlast list) + list))) + (defun number-sequence (from &optional to inc) "Return a sequence of numbers from FROM to TO (both inclusive) as a list. INC is the increment used between numbers in the sequence and defaults to 1. @@ -1044,14 +1061,17 @@ and `event-end' functions." (nth 1 position)))) (and (symbolp area) area))) -(defsubst posn-point (position) +(defun posn-point (position) "Return the buffer location in POSITION. POSITION should be a list of the form returned by the `event-start' -and `event-end' functions." +and `event-end' functions. +Returns nil if POSITION does not correspond to any buffer location (e.g. +a click on a scroll bar)." (or (nth 5 position) - (if (consp (nth 1 position)) - (car (nth 1 position)) - (nth 1 position)))) + (let ((pt (nth 1 position))) + (or (car-safe pt) + ;; Apparently this can also be `vertical-scroll-bar' (bug#13979). + (if (integerp pt) pt))))) (defun posn-set-point (position) "Move point to POSITION. @@ -1124,12 +1144,14 @@ POSITION should be a list of the form returned by the `event-start' and `event-end' functions." (nth 3 position)) -(defsubst posn-string (position) +(defun posn-string (position) "Return the string object of POSITION. Value is a cons (STRING . STRING-POS), or nil if not a string. POSITION should be a list of the form returned by the `event-start' and `event-end' functions." - (nth 4 position)) + (let ((x (nth 4 position))) + ;; Apparently this can also be `handle' or `below-handle' (bug#13979). + (when (consp x) x))) (defsubst posn-image (position) "Return the image object of POSITION. @@ -1409,7 +1431,9 @@ Of course, a subsequent hook function may do the same thing. Each hook function definition is used to construct the FUN passed to the next hook function, if any. The last (or \"outermost\") FUN is then called once." - (declare (indent 2) (debug (form sexp body))) + (declare (indent 2) (debug (form sexp body)) + (obsolete "use a <foo>-function variable modified by add-function." + "24.4")) ;; We need those two gensyms because CL's lexical scoping is not available ;; for function arguments :-( (let ((funs (make-symbol "funs")) @@ -2193,11 +2217,11 @@ by doing (clear-string STRING)." ;; And of course, don't keep the sensitive data around. (erase-buffer)))))))) -;; This should be used by `call-interactively' for `n' specs. (defun read-number (prompt &optional default) "Read a numeric value in the minibuffer, prompting with PROMPT. DEFAULT specifies a default value to return if the user just types RET. -The value of DEFAULT is inserted into PROMPT." +The value of DEFAULT is inserted into PROMPT. +This function is used by the `interactive' code letter `n'." (let ((n nil) (default1 (if (consp default) (car default) default))) (when default1 @@ -2218,7 +2242,7 @@ The value of DEFAULT is inserted into PROMPT." (condition-case nil (setq n (cond ((zerop (length str)) default1) - ((stringp str) (string-to-number str)))) + ((stringp str) (read str)))) (error nil))) (unless (numberp n) (message "Please enter a number.") @@ -2636,6 +2660,13 @@ Various programs in Emacs store information in this directory. Note that this should end with a directory separator. See also `locate-user-emacs-file'.") +(custom-declare-variable-early 'user-emacs-directory-warning t + "Non-nil means warn if cannot access `user-emacs-directory'. +Set this to nil at your own risk..." + :type 'boolean + :group 'initialization + :version "24.4") + (defun locate-user-emacs-file (new-name &optional old-name) "Return an absolute per-user Emacs-specific file name. If NEW-NAME exists in `user-emacs-directory', return it. @@ -2651,17 +2682,33 @@ directory if it does not exist." (file-readable-p at-home)) at-home ;; Make sure `user-emacs-directory' exists, - ;; unless we're in batch mode or dumping Emacs + ;; unless we're in batch mode or dumping Emacs. (or noninteractive purify-flag - (file-accessible-directory-p - (directory-file-name user-emacs-directory)) - (let ((umask (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes ?\700) - (make-directory user-emacs-directory)) - (set-default-file-modes umask)))) + (let (errtype) + (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)))) + (when (and errtype + user-emacs-directory-warning + (not (get 'user-emacs-directory-warning 'this-session))) + ;; Only warn once per Emacs session. + (put 'user-emacs-directory-warning 'this-session t) + (display-warning 'initialization + (format "\ +Unable to %s `user-emacs-directory' (%s). +Any data that would normally be written there may be lost! +If you never want to see this message again, +customize the variable `user-emacs-directory-warning'." + errtype user-emacs-directory))))) bestname)))) ;;;; Misc. useful functions. @@ -2670,8 +2717,9 @@ directory if it does not exist." "Return non-nil if the current buffer is narrowed." (/= (- (point-max) (point-min)) (buffer-size))) -(defun find-tag-default () - "Determine default tag to search for, based on text at point. +(defun find-tag-default-bounds () + "Determine the boundaries of the default tag, based on text at point. +Return a cons cell with the beginning and end of the found tag. If there is no plausible default, return nil." (let (from to bound) (when (or (progn @@ -2695,7 +2743,14 @@ If there is no plausible default, return nil." (< (setq from (point)) bound) (skip-syntax-forward "w_") (setq to (point))))) - (buffer-substring-no-properties from to)))) + (cons from to)))) + +(defun find-tag-default () + "Determine default tag to search for, based on text at point. +If there is no plausible default, return nil." + (let ((bounds (find-tag-default-bounds))) + (when bounds + (buffer-substring-no-properties (car bounds) (cdr bounds))))) (defun find-tag-default-as-regexp () "Return regexp that matches the default tag at point. @@ -2708,7 +2763,7 @@ symbol at point exactly." (get major-mode 'find-tag-default-function) 'find-tag-default)) (tag (funcall tagf))) - (cond ((not tag)) + (cond ((null tag) nil) ((eq tagf 'find-tag-default) (format "\\_<%s\\_>" (regexp-quote tag))) (t (regexp-quote tag))))) @@ -3834,6 +3889,58 @@ node `(elisp)Syntax Table Internals' for a list of codes. If SYNTAX is nil, return nil." (and syntax (logand (car syntax) 65535))) +;; Utility motion commands + +;; Whitespace + +(defun forward-whitespace (arg) + "Move point to the end of the next sequence of whitespace chars. +Each such sequence may be a single newline, or a sequence of +consecutive space and/or tab characters. +With prefix argument ARG, do it ARG times if positive, or move +backwards ARG times if negative." + (interactive "^p") + (if (natnump arg) + (re-search-forward "[ \t]+\\|\n" nil 'move arg) + (while (< arg 0) + (if (re-search-backward "[ \t]+\\|\n" nil 'move) + (or (eq (char-after (match-beginning 0)) ?\n) + (skip-chars-backward " \t"))) + (setq arg (1+ arg))))) + +;; Symbols + +(defun forward-symbol (arg) + "Move point to the next position that is the end of a symbol. +A symbol is any sequence of characters that are in either the +word constituent or symbol constituent syntax class. +With prefix argument ARG, do it ARG times if positive, or move +backwards ARG times if negative." + (interactive "^p") + (if (natnump arg) + (re-search-forward "\\(\\sw\\|\\s_\\)+" nil 'move arg) + (while (< arg 0) + (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil 'move) + (skip-syntax-backward "w_")) + (setq arg (1+ arg))))) + +;; Syntax blocks + +(defun forward-same-syntax (&optional arg) + "Move point past all characters with the same syntax class. +With prefix argument ARG, do it ARG times if positive, or move +backwards ARG times if negative." + (interactive "^p") + (or arg (setq arg 1)) + (while (< arg 0) + (skip-syntax-backward + (char-to-string (char-syntax (char-before)))) + (setq arg (1+ arg))) + (while (> arg 0) + (skip-syntax-forward (char-to-string (char-syntax (char-after)))) + (setq arg (1- arg)))) + + ;;;; Text clones (defun text-clone-maintain (ol1 after beg end &optional _len) @@ -4333,32 +4440,16 @@ convenience wrapper around `make-progress-reporter' and friends. ;;;; Support for watching filesystem events. -(defun inotify-event-p (event) - "Check if EVENT is an inotify event." - (and (listp event) - (>= (length event) 3) - (eq (car event) 'file-inotify))) - -;;;###autoload -(defun inotify-handle-event (event) - "Handle inotify file system monitoring event. -If EVENT is an inotify filewatch event, call its callback. -Otherwise, signal a `filewatch-error'." - (interactive "e") - (unless (inotify-event-p event) - (signal 'filewatch-error (cons "Not a valid inotify event" event))) - (funcall (nth 2 event) (nth 1 event))) - -(defun w32notify-handle-event (event) - "Handle MS-Windows file system monitoring event. -If EVENT is an MS-Windows filewatch event, call its callback. +(defun file-notify-handle-event (event) + "Handle file system monitoring event. +If EVENT is a filewatch event, call its callback. Otherwise, signal a `filewatch-error'." (interactive "e") - (if (and (eq (car event) 'file-w32notify) - (= (length event) 3)) + (if (and (eq (car event) 'file-notify) + (>= (length event) 3)) (funcall (nth 2 event) (nth 1 event)) (signal 'filewatch-error - (cons "Not a valid MS-Windows file-notify event" event)))) + (cons "Not a valid file-notify event" event)))) ;;;; Comparing version strings. @@ -4624,4 +4715,20 @@ This is the simplest safe way to invoke `condition-wait'." (prin1-to-string (make-hash-table))))) (provide 'hashtable-print-readable)) +;; This is used in lisp/Makefile.in and in leim/Makefile.in to +;; generate file names for autoloads, custom-deps, and finder-data. +(defun unmsys--file-name (file) + "Produce the canonical file name for FILE from its MSYS form. + +On systems other than MS-Windows, just returns FILE. +On MS-Windows, converts /d/foo/bar form of file names +passed by MSYS Make into d:/foo/bar that Emacs can grok. + +This function is called from lisp/Makefile and leim/Makefile." + (when (and (eq system-type 'windows-nt) + (string-match "\\`/[a-zA-Z]/" file)) + (setq file (concat (substring file 1 2) ":" (substring file 2)))) + file) + + ;;; subr.el ends here diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 6e85925a69c..109107e857f 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -133,8 +133,10 @@ This information is useful, but it takes screen space away from file names." :group 'tar) (defvar tar-parse-info nil) -(defvar tar-superior-buffer nil) -(defvar tar-superior-descriptor nil) +(defvar tar-superior-buffer nil + "Buffer containing the tar archive from which a member was extracted.") +(defvar tar-superior-descriptor nil + "Tar descriptor for a member extracted from an archive.") (defvar tar-file-name-coding-system nil) (put 'tar-superior-buffer 'permanent-local t) diff --git a/lisp/term.el b/lisp/term.el index b37e71280da..1c67057d3a7 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -953,7 +953,7 @@ is buffer-local." (when term-escape-char ;; Undo previous term-set-escape-char. (define-key term-raw-map term-escape-char 'term-send-raw)) - (setq term-escape-char (vector key)) + (setq term-escape-char (if (vectorp key) key (vector key))) (define-key term-raw-map term-escape-char term-raw-escape-map) ;; FIXME: If we later call term-set-escape-char again with another key, ;; we should undo this binding. diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index b8baaa077ce..0298ad81a34 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -558,6 +558,11 @@ unless the current buffer is a scratch buffer." (other-frame -1)) ;; If no position specified, make new frame offset by 25 from current. +;; You'd think this was a window manager's job, but apparently without +;; this, new frames open exactly on top of old ones (?). +;; http://lists.gnu.org/archive/html/emacs-devel/2010-10/msg00988.html +;; Note that AFAICS it is not documented that functions on +;; before-make-frame-hook can access PARAMETERS. (defvar parameters) ; dynamically bound in make-frame (add-hook 'before-make-frame-hook (lambda () @@ -895,7 +900,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;; Do the actual Nextstep Windows setup here; the above code just ;; defines functions and variables that we use now. -(defun ns-initialize-window-system () +(defun ns-initialize-window-system (&optional _display) "Initialize Emacs for Nextstep (Cocoa / GNUstep) windowing." (cl-assert (not ns-initialized)) diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el index cf67aca8343..ab776ea6257 100644 --- a/lisp/term/pc-win.el +++ b/lisp/term/pc-win.el @@ -403,7 +403,7 @@ Errors out because it is not supposed to be called, ever." (error "terminal-init-internal called for window-system `%s'" (window-system))) -(defun msdos-initialize-window-system () +(defun msdos-initialize-window-system (&optional display) "Initialization function for the `pc' \"window system\"." (or (eq (window-system) 'pc) (error diff --git a/lisp/term/vt100.el b/lisp/term/vt100.el index 782924086df..2453f479eda 100644 --- a/lisp/term/vt100.el +++ b/lisp/term/vt100.el @@ -46,6 +46,7 @@ With a prefix argument ARG, switch to 132-column mode if ARG is positive, and 80-column mode otherwise. If called from Lisp, switch to 132-column mode if ARG is omitted or nil." :global t :init-value (= (frame-width) 132) + :group 'terminals (send-string-to-terminal (if vt100-wide-mode "\e[?3h" "\e[?3l")) (set-frame-width terminal-frame (if vt100-wide-mode 132 80))) diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index cbd08e68a39..acadb0fad43 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -246,7 +246,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (declare-function x-parse-geometry "frame.c" (string)) (defvar x-command-line-resources) -(defun w32-initialize-window-system () +(defun w32-initialize-window-system (&optional _display) "Initialize Emacs for W32 GUI frames." (cl-assert (not w32-initialized)) diff --git a/lisp/term/w32console.el b/lisp/term/w32console.el index 1a896eec4d6..95964840c10 100644 --- a/lisp/term/w32console.el +++ b/lisp/term/w32console.el @@ -47,6 +47,8 @@ (declare-function x-setup-function-keys "term/common-win" (frame)) (declare-function get-screen-color "w32console.c" ()) +(declare-function w32-get-console-codepage "w32proc.c" ()) +(declare-function w32-get-console-output-codepage "w32proc.c" ()) (defun terminal-init-w32console () "Terminal initialization function for w32 console." diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 63ef2b402b0..822df0e37e5 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -427,7 +427,9 @@ as returned by `x-server-vendor'." (#x3fe . ?,D~(B) ;; Kana: Fixme: needs conversion to Japanese charset -- seems ;; to require jisx0213, for which the Unicode translation - ;; isn't clear. + ;; isn't clear. Using Emacs to convert this to Unicode and back changes + ;; this from "(J~(B" (i.e., bytes "ESC ( J ~ ESC ( B") to "$(G"#(B" (i.e., bytes + ;; "ESC $ ( G " # ESC ( B"). (#x47e . ?(J~(B) (#x4a1 . ?$A!#(B) (#x4a2 . ?\$A!8(B) @@ -1127,6 +1129,9 @@ as returned by `x-server-vendor'." (#x20a8 . ?$,1tH(B) (#x20aa . ?$,1tJ(B) (#x20ab . ?$,1tK(B) + ;; Kana: Fixme: needs checking. Using Emacs to convert this to Unicode + ;; and back changes this from ",b$(B" (i.e., bytes "ESC , b $ ESC ( B") to + ;; ",F$(B" (i.e., bytes "ESC , F $ ESC ( B"). (#x20ac . ?,b$(B))) (puthash (car pair) (cdr pair) x-keysym-table)) @@ -1338,7 +1343,7 @@ Request data types in the order specified by `x-select-request-type'." (defvar x-display-name) (defvar x-command-line-resources) -(defun x-initialize-window-system () +(defun x-initialize-window-system (&optional display) "Initialize Emacs for X frames and open the first connection to an X server." (cl-assert (not x-initialized)) @@ -1352,7 +1357,7 @@ Request data types in the order specified by `x-select-request-type'." (while (setq i (string-match "[.*]" x-resource-name)) (aset x-resource-name i ?-)))) - (x-open-connection (or x-display-name + (x-open-connection (or display (setq x-display-name (or (getenv "DISPLAY" (selected-frame)) (getenv "DISPLAY")))) x-command-line-resources diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index dcf32e5c595..05a129225ee 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -27,7 +27,7 @@ (defgroup xterm nil "XTerm support." :version "24.1" - :group 'environment) + :group 'terminals) (defcustom xterm-extra-capabilities 'check "Whether Xterm supports some additional, more modern, features. @@ -752,4 +752,6 @@ versions of xterm." (set-terminal-parameter nil 'background-mode 'dark) t)) +(provide 'xterm) + ;;; xterm.el ends here diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el index 2bd7283676e..0d9c8eb7c64 100644 --- a/lisp/textmodes/artist.el +++ b/lisp/textmodes/artist.el @@ -1449,6 +1449,8 @@ Keymap summary (message ""))) (artist-mode-line-show-curr-operation artist-key-is-drawing)) +(declare-function picture-mode-exit "picture" (&optional nostrip)) + (defun artist-mode-exit () "Exit Artist mode. This will call the hook `artist-mode-hook'." (if (and artist-picture-compatibility (eq major-mode 'picture-mode)) diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index aa20b739946..01a126eb381 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -3020,11 +3020,14 @@ Parsing initializes `bibtex-reference-keys' and `bibtex-strings'." Visit the BibTeX files defined by `bibtex-files' and return a list of corresponding buffers. Initialize in these buffers `bibtex-reference-keys' if not yet set. -List of BibTeX buffers includes current buffer if CURRENT is non-nil. +List of BibTeX buffers includes current buffer if CURRENT is non-nil +and the current buffer visits a file using `bibtex-mode'. If FORCE is non-nil, (re)initialize `bibtex-reference-keys' even if already set. If SELECT is non-nil interactively select a BibTeX buffer. -When called interactively, FORCE is t, CURRENT is t if current buffer uses -`bibtex-mode', and SELECT is t if current buffer does not use `bibtex-mode'," + +When called interactively, FORCE is t, CURRENT is t if current buffer +visits a file using `bibtex-mode', and SELECT is t if current buffer +does not use `bibtex-mode'," (interactive (list (eq major-mode 'bibtex-mode) t (not (eq major-mode 'bibtex-mode)))) (let ((file-path (split-string (or bibtex-file-path default-directory) ":+")) @@ -3062,10 +3065,12 @@ When called interactively, FORCE is t, CURRENT is t if current buffer uses (if (file-readable-p file) (push (find-file-noselect file) buffer-list))) ;; Include current buffer iff we want it. - ;; Exclude current buffer if it doesn't use `bibtex-mode'. - ;; Thus calling `bibtex-initialize' gives meaningful results for - ;; any current buffer. - (unless (and current (eq major-mode 'bibtex-mode)) (setq current nil)) + ;; Exclude current buffer if it does not visit a file using `bibtex-mode'. + ;; This way we exclude BibTeX buffers such as `bibtex-search-buffer' + ;; that are not visiting a BibTeX file. Also, calling `bibtex-initialize' + ;; gives meaningful results for any current buffer. + (unless (and current (eq major-mode 'bibtex-mode) buffer-file-name) + (setq current nil)) (cond ((and current (not (memq (current-buffer) buffer-list))) (push (current-buffer) buffer-list)) ((and (not current) (memq (current-buffer) buffer-list)) @@ -5163,6 +5168,9 @@ Return the URL or nil if none can be generated." (if (stringp (car scheme)) (setq fmt (pop scheme))) (dolist (step scheme) + ;; In the first STEP, if the field contains multiple + ;; matches, we want the match the closest to point. + ;; (if (eq step (car scheme)) (setq text (cdr (assoc-string (car step) fields-alist t))) (if (string-match (nth 1 step) text) (push (cond ((functionp (nth 2 step)) @@ -5233,19 +5241,22 @@ where FILE is the BibTeX file of ENTRY." (if (string= "" field) ;; Unrestricted search. (while (re-search-forward regexp nil t) - (let ((beg (bibtex-beginning-of-entry)) - (end (bibtex-end-of-entry)) - key) - (if (and (<= beg (match-beginning 0)) - (<= (match-end 0) end) - (save-excursion - (goto-char beg) - (and (looking-at bibtex-entry-head) - (setq key (bibtex-key-in-head)))) - (not (assoc key entries))) - (push (list key file - (buffer-substring-no-properties beg end)) - entries)))) + (save-excursion + (let ((mbeg (match-beginning 0)) + (mend (match-end 0)) + (beg (bibtex-beginning-of-entry)) + (end (bibtex-end-of-entry)) + key) + (if (and (<= beg mbeg) + (<= mend end) + (progn + (goto-char beg) + (looking-at bibtex-entry-head)) + (setq key (bibtex-key-in-head)) + (not (assoc key entries))) + (push (list key file + (buffer-substring-no-properties beg end)) + entries))))) ;; The following is slow. But it works reliably even in more ;; complicated cases with BibTeX string constants and crossrefed ;; entries. If you prefer speed over reliability, perform an diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 6ab3e3d3f16..81f17c897eb 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -738,7 +738,7 @@ before the current command." (let ((ispell-otherchars (ispell-get-otherchars))) (cond ((not (and (numberp flyspell-pre-point) - (buffer-live-p flyspell-pre-buffer))) + (eq flyspell-pre-buffer (current-buffer)))) nil) ((and (eq flyspell-pre-pre-point flyspell-pre-point) (eq flyspell-pre-pre-buffer flyspell-pre-buffer)) @@ -956,11 +956,10 @@ Mostly we check word delimiters." ;; Prevent anything we do from affecting the mark. deactivate-mark) (if (flyspell-check-pre-word-p) - (with-current-buffer flyspell-pre-buffer + (save-excursion '(flyspell-debug-signal-pre-word-checked) - (save-excursion - (goto-char flyspell-pre-point) - (flyspell-word)))) + (goto-char flyspell-pre-point) + (flyspell-word))) (if (flyspell-check-word-p) (progn '(flyspell-debug-signal-word-checked) @@ -974,16 +973,14 @@ Mostly we check word delimiters." ;; FLYSPELL-CHECK-PRE-WORD-P (setq flyspell-pre-pre-buffer (current-buffer)) (setq flyspell-pre-pre-point (point))) - (progn - (setq flyspell-pre-pre-buffer nil) - (setq flyspell-pre-pre-point nil) - ;; when a word is not checked because of a delayed command - ;; we do not disable the ispell cache. - (if (and (symbolp this-command) + (setq flyspell-pre-pre-buffer nil) + (setq flyspell-pre-pre-point nil) + ;; when a word is not checked because of a delayed command + ;; we do not disable the ispell cache. + (when (and (symbolp this-command) (get this-command 'flyspell-delayed)) - (progn - (setq flyspell-word-cache-end -1) - (setq flyspell-word-cache-result '_))))) + (setq flyspell-word-cache-end -1) + (setq flyspell-word-cache-result '_))) (while (and (not (input-pending-p)) (consp flyspell-changes)) (let ((start (car (car flyspell-changes))) (stop (cdr (car flyspell-changes)))) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 467ac004420..94b184d09a1 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1383,7 +1383,8 @@ aspell is used along with Emacs).") ;; Unless default dict, re-add "-d" option with the mapped value (if dict-name (if dict-equiv - (nconc ispell-args (list "-d" dict-equiv)) + (setq ispell-args + (nconc ispell-args (list "-d" dict-equiv))) (message "ispell-set-spellchecker-params: Missing hunspell equiv for \"%s\". Skipping." dict-name) @@ -2328,10 +2329,14 @@ Global `ispell-quit' set to start location to continue spell session." ((= char ?i) ; accept and insert word into pers dict (ispell-send-string (concat "*" word "\n")) (setq ispell-pdict-modified-p '(t)) ; dictionary modified! + (and (fboundp 'flyspell-unhighlight-at) + (flyspell-unhighlight-at start)) nil) ((or (= char ?a) (= char ?A)) ; accept word without insert (ispell-send-string (concat "@" word "\n")) (add-to-list 'ispell-buffer-session-localwords word) + (and (fboundp 'flyspell-unhighlight-at) + (flyspell-unhighlight-at start)) (or ispell-buffer-local-name ; session localwords might conflict (setq ispell-buffer-local-name (buffer-name))) (if (null ispell-pdict-modified-p) @@ -4331,8 +4336,13 @@ Both should not be used to define a buffer-local dictionary." (if (fboundp 'comment-padright) ;; Try and use the proper comment marker, ;; e.g. ";;" rather than ";". - (comment-padright comment-start - (comment-add nil)) + (progn + ;; XEmacs: comment-normalize-vars + ;; (newcomment.el) only in >= 21.5 + (and (fboundp 'comment-normalize-vars) + (comment-normalize-vars)) + (comment-padright comment-start + (comment-add nil))) comment-start) " ") "") diff --git a/lisp/textmodes/refill.el b/lisp/textmodes/refill.el index f6a2c7eca05..ebbc6ee0afb 100644 --- a/lisp/textmodes/refill.el +++ b/lisp/textmodes/refill.el @@ -83,9 +83,10 @@ ;;; Code: -(defgroup refill nil - "Refilling paragraphs on changes." - :group 'fill) +;; Unused. +;;; (defgroup refill nil +;;; "Refilling paragraphs on changes." +;;; :group 'fill) (defvar refill-ignorable-overlay nil "Portion of the most recently filled paragraph not needing filling. @@ -222,7 +223,8 @@ characters only cause refilling if they would cause auto-filling. For true \"word wrap\" behavior, use `visual-line-mode' instead." - :group 'refill + ;; Not global, so no effect. +;;; :group 'refill :lighter " Refill" :keymap '(("\177" . backward-delete-char-untabify)) ;; Remove old state if necessary diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index 079101b56ee..ca29709de2e 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -514,12 +514,6 @@ ;; remove extra whitespace (while (string-match "[\n\t\r]\\|[ \t][ \t]+" field) (setq field (replace-match " " nil t field))) - ;; remove leading garbage - (if (string-match (if raw "^[ \t]+" "^[ \t{]+") field) - (setq field (replace-match "" nil t field))) - ;; remove trailing garbage - (if (string-match (if raw "[ \t]+$" "[ \t}]+$") field) - (setq field (replace-match "" nil t field))) (push (cons key field) alist)))) alist)) diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el index a86b10e21cc..3a64aad6a06 100644 --- a/lisp/textmodes/reftex-parse.el +++ b/lisp/textmodes/reftex-parse.el @@ -234,8 +234,19 @@ of master file." ((match-end 1) ;; It is a label - (push (reftex-label-info (reftex-match-string 1) file bound) - docstruct)) + (when (or (null reftex-label-ignored-macros-and-environments) + ;; \label{} defs should always be honored, + ;; just no keyval style [label=foo] defs. + (string-equal "\label{" (substring (reftex-match-string 0) 0 7)) + (if (and (fboundp 'TeX-current-macro) + (fboundp 'LaTeX-current-environment)) + (not (or (member (save-match-data (TeX-current-macro)) + reftex-label-ignored-macros-and-environments) + (member (save-match-data (LaTeX-current-environment)) + reftex-label-ignored-macros-and-environments))) + t)) + (push (reftex-label-info (reftex-match-string 1) file bound) + docstruct))) ((match-end 3) ;; It is a section @@ -349,9 +360,9 @@ of master file." ; "\\(\\`\\|[\n\r]\\)[^%]*\\\\\\(" "\\(^\\)[^%\n\r]*\\\\\\(" (mapconcat 'identity reftex-bibliography-commands "\\|") - "\\){[ \t]*\\([^}]+\\)") nil t) + "\\)\\(\\[.+?\\]\\)?{[ \t]*\\([^}]+\\)") nil t) (setq files - (split-string (reftex-match-string 3) + (split-string (reftex-match-string 4) "[ \t\n\r]*,[ \t\n\r]*"))))) (when files (setq files diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index 2a5c9c55866..ce23a48dec6 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el @@ -863,6 +863,48 @@ DOWNCASE t: Downcase words before using them." (string :tag "")) (option (boolean :tag "Downcase words ")))) +(defcustom reftex-label-regexps + '(;; Normal \\label{foo} labels + "\\\\label{\\(?1:[^}]*\\)}" + ;; keyvals [..., label = {foo}, ...] forms used by ctable, + ;; listings, minted, ... + "\\[[^]]*\\<label[[:space:]]*=[[:space:]]*{?\\(?1:[^],}]+\\)}?") + "List of regexps matching \\label definitions. +The default value matches usual \\label{...} definitions and +keyval style [..., label = {...}, ...] label definitions. It is +assumed that the regexp group 1 matches the label text, so you +have to define it using \\(?1:...\\) when adding new regexps. + +When changed from Lisp, make sure to call +`reftex-compile-variables' afterwards to make the change +effective." + :set (lambda (symbol value) + (set symbol value) + (when (fboundp 'reftex-compile-variables) + (reftex-compile-variables))) + :group 'reftex-defining-label-environments + :type '(repeat (regexp :tag "Regular Expression"))) + +(defcustom reftex-label-ignored-macros-and-environments nil + "List of macros and environments to be ignored when searching for labels. +The purpose is to ignore environments and macros that use keyval +style label=foo arguments, but the label has a different meaning +than a \\label{foo}. Standard \\label{...} definitions are never +ignored. + +E.g., TikZ defines several macros/environments where [label=foo] +defines the label to be printed at some node or edge, but it's +not a label used for referencing. + +Note that this feature is only supported if you are using AUCTeX +and the functions `TeX-current-macro' and +`LaTeX-current-environment' are bound. Also note that this +feature might slow down the reftex parsing process for large TeX +files." + :version "24.4" + :group 'reftex-defining-label-environments + :type '(repeat string)) + (defcustom reftex-label-illegal-re "[^-a-zA-Z0-9_+=:;,.]" "Regexp matching characters not valid in labels." :group 'reftex-making-and-inserting-labels @@ -890,7 +932,7 @@ The function will be called with two arguments, the LABEL and the DEFAULT FORMAT, which usually is `\\label{%s}'. The function should return the string to insert into the buffer." :group 'reftex-making-and-inserting-labels - :type 'function) + :type '(choice (const nil) function)) ;; Label referencing @@ -958,7 +1000,9 @@ This is used to string together whole reference sets, like ("Fancyref" "fancyref" (("\\fref" ?f) ("\\Fref" ?F))) ("Hyperref" "hyperref" - (("\\autoref" ?a) ("\\autopageref" ?u)))) + (("\\autoref" ?a) ("\\autopageref" ?u))) + ("Cleveref" "cleveref" + (("\\cref" ?c) ("\\Cref" ?C) ("\\cpageref" ?d) ("\\Cpageref" ?D)))) "Alist of reference styles. Each element is a list of the style name, the name of the LaTeX package associated with the style or t for any package, and an @@ -1070,7 +1114,7 @@ buffer." :group 'reftex) (defcustom reftex-bibliography-commands - '("bibliography" "nobibliography" "setupbibtex\\[.*?database=") + '("bibliography" "nobibliography" "setupbibtex\\[.*?database=" "addbibresource") "LaTeX commands which specify the BibTeX databases to use with the document." :group 'reftex-citation-support :type '(repeat string)) diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index d5bb0170cd9..7fed4d0d021 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -547,7 +547,7 @@ will deactivate it." (when (member style list) (setq reftex-tables-dirty t changed t) - (delete style list))) + (setq list (delete style list)))) (t (if (member style list) (delete style list) @@ -1081,13 +1081,7 @@ This enforces rescanning the buffer on next use." (wbol "\\(^\\)[ \t]*") ; Need to keep the empty group because ; match numbers are hard coded (label-re (concat "\\(?:" - ;; Normal \label{...} - "\\\\label{\\([^}]*\\)}" - "\\|" - ;; keyvals [..., label = {foo}, ...] - ;; forms used by ctable, listings, - ;; minted, ... - "\\[[^]]*label[[:space:]]*=[[:space:]]*{?\\(?1:[^],}]+\\)}?" + (mapconcat 'identity reftex-label-regexps "\\|") "\\)")) (include-re (concat wbol "\\\\\\(" diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el index 16b99627400..5782f25e48d 100644 --- a/lisp/textmodes/remember.el +++ b/lisp/textmodes/remember.el @@ -216,10 +216,11 @@ All functions are run in the remember buffer." Each function is called with the current buffer narrowed to what the user wants remembered. If any function returns non-nil, the data is assumed to have been -recorded somewhere by that function. " +recorded somewhere by that function." :type 'hook :options '(remember-store-in-mailbox remember-append-to-file + remember-store-in-files remember-diary-extract-entries org-remember-handler) :group 'remember) @@ -429,6 +430,30 @@ If you want to remember a region, supply a universal prefix to (run-hook-with-args-until-success 'remember-handler-functions)) (remember-destroy)))) +(defcustom remember-data-directory "~/remember" + "The directory in which to store remember data as files." + :type 'directory + :version "24.4" + :group 'remember) + +(defcustom remember-directory-file-name-format "%Y-%m-%d_%T-%z" + "Format string for the file name in which to store unprocessed data." + :type 'string + :version "24.4" + :group 'remember) + +(defun remember-store-in-files () + "Store remember data in a file in `remember-data-directory'. +The file is named after `remember-directory-file-name-format' fed through +`format-time-string'." + (let ((name (format-time-string + remember-directory-file-name-format (current-time))) + (text (buffer-string))) + (with-temp-buffer + (insert text) + (write-file (convert-standard-filename + (format "%s/%s" remember-data-directory name)))))) + ;;;###autoload (defun remember-clipboard () "Remember the contents of the current clipboard. @@ -456,7 +481,7 @@ Most useful for remembering things from other applications." (defcustom remember-diary-file nil "File for extracted diary entries. If this is nil, then `diary-file' will be used instead." - :type 'file + :type '(choice (const :tag "diary-file" nil) file) :group 'remember) (defun remember-diary-convert-entry (entry) diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index b3503c6c982..01981175e1d 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -3932,7 +3932,7 @@ string)) to be used for converting the document." (choice :tag "Command options" (const :tag "No options" nil) (string :tag "Options")))) - :group 'rst + :group 'rst-compile :package-version "1.2.0") (rst-testcover-defcustom) diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 259cd772b12..b7ecdb513f5 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -128,20 +128,27 @@ positions of the thing found." (error nil))))) ;;;###autoload -(defun thing-at-point (thing) +(defun thing-at-point (thing &optional no-properties) "Return the THING at point. THING should be a symbol specifying a type of syntactic entity. Possibilities include `symbol', `list', `sexp', `defun', `filename', `url', `email', `word', `sentence', `whitespace', `line', `number', and `page'. +When the optional argument NO-PROPERTIES is non-nil, +strip text properties from the return value. + See the file `thingatpt.el' for documentation on how to define a symbol as a valid THING." - (if (get thing 'thing-at-point) - (funcall (get thing 'thing-at-point)) - (let ((bounds (bounds-of-thing-at-point thing))) - (if bounds - (buffer-substring (car bounds) (cdr bounds)))))) + (let ((text + (if (get thing 'thing-at-point) + (funcall (get thing 'thing-at-point)) + (let ((bounds (bounds-of-thing-at-point thing))) + (when bounds + (buffer-substring (car bounds) (cdr bounds))))))) + (when (and text no-properties) + (set-text-properties 0 (length text) nil text)) + text)) ;; Go to beginning/end @@ -529,60 +536,11 @@ with angle brackets.") (buffer-substring-no-properties (car boundary-pair) (cdr boundary-pair)))))) -;; Whitespace - -(defun forward-whitespace (arg) - "Move point to the end of the next sequence of whitespace chars. -Each such sequence may be a single newline, or a sequence of -consecutive space and/or tab characters. -With prefix argument ARG, do it ARG times if positive, or move -backwards ARG times if negative." - (interactive "p") - (if (natnump arg) - (re-search-forward "[ \t]+\\|\n" nil 'move arg) - (while (< arg 0) - (if (re-search-backward "[ \t]+\\|\n" nil 'move) - (or (eq (char-after (match-beginning 0)) ?\n) - (skip-chars-backward " \t"))) - (setq arg (1+ arg))))) - ;; Buffer (put 'buffer 'end-op (lambda () (goto-char (point-max)))) (put 'buffer 'beginning-op (lambda () (goto-char (point-min)))) -;; Symbols - -(defun forward-symbol (arg) - "Move point to the next position that is the end of a symbol. -A symbol is any sequence of characters that are in either the -word constituent or symbol constituent syntax class. -With prefix argument ARG, do it ARG times if positive, or move -backwards ARG times if negative." - (interactive "p") - (if (natnump arg) - (re-search-forward "\\(\\sw\\|\\s_\\)+" nil 'move arg) - (while (< arg 0) - (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil 'move) - (skip-syntax-backward "w_")) - (setq arg (1+ arg))))) - -;; Syntax blocks - -(defun forward-same-syntax (&optional arg) - "Move point past all characters with the same syntax class. -With prefix argument ARG, do it ARG times if positive, or move -backwards ARG times if negative." - (interactive "p") - (or arg (setq arg 1)) - (while (< arg 0) - (skip-syntax-backward - (char-to-string (char-syntax (char-before)))) - (setq arg (1+ arg))) - (while (> arg 0) - (skip-syntax-forward (char-to-string (char-syntax (char-after)))) - (setq arg (1- arg)))) - ;; Aliases (defun word-at-point () diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 261e34b440e..657951d7b75 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -151,7 +151,7 @@ This variable is obsolete; instead of setting it to t, disable :group 'tooltip) (make-obsolete-variable 'tooltip-use-echo-area - "disable Tooltip mode instead" "24.1") + "disable Tooltip mode instead" "24.1" 'set) ;;; Variables that are not customizable. diff --git a/lisp/type-break.el b/lisp/type-break.el index 3ddf2e2d20a..b4e4be31955 100644 --- a/lisp/type-break.el +++ b/lisp/type-break.el @@ -95,7 +95,7 @@ When this variable is non-nil, its value is considered to be a \"good\" length (in seconds) for a break initiated by the command `type-break', overriding `type-break-good-rest-interval'. This provides querying of break interruptions when `type-break-good-rest-interval' is nil." - :type 'integer + :type '(choice (const nil) integer) :group 'type-break) (defcustom type-break-keystroke-threshold @@ -418,7 +418,7 @@ Variables controlling the display of messages in the mode line include: `global-mode-string' `type-break-mode-line-break-message' `type-break-mode-line-warning'" - :global t) + :global t :group 'type-break) (define-minor-mode type-break-query-mode "Toggle typing break queries. @@ -428,7 +428,7 @@ enable them if ARG is omitted or nil. The user may also enable or disable this mode simply by setting the variable of the same name." - :global t) + :global t :group 'type-break) ;;; session file functions diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index f8f24de6b68..49adec69de7 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,23 @@ +2013-05-23 Glenn Morris <rgm@gnu.org> + + * url.el (mm-dissect-buffer, mm-display-part): Declare. + +2013-05-22 Glenn Morris <rgm@gnu.org> + + * url-handlers.el (mm-save-part-to-file, mm-destroy-parts) + (mm-decode-string, mail-content-type-get): Declare. + +2013-05-21 Glenn Morris <rgm@gnu.org> + + * url-dav.el (url-http): Require it. + (url-http-head-file-attributes): Don't autoload it. + + * url-proxy.el (url-http): Autoload it. + +2013-05-15 Glenn Morris <rgm@gnu.org> + + * url-news.el (url-news): Remove empty custom group. + 2013-02-16 Glenn Morris <rgm@gnu.org> * url-http.el (url-http-wait-for-headers-change-function): diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el index 6e4191ae7b5..a31206a2f6f 100644 --- a/lisp/url/url-dav.el +++ b/lisp/url/url-dav.el @@ -32,10 +32,12 @@ (require 'xml) (require 'url-util) (require 'url-handlers) +(require 'url-http) (defvar url-dav-supported-protocols '(1 2) "List of supported DAV versions.") +;; Dynamically bound. (defvar url-http-content-type) (defvar url-http-response-status) (defvar url-http-end-of-headers) @@ -621,8 +623,6 @@ Returns t if the lock was successfully released." (url-debug 'dav "Unrecognized DAV:locktype (%S)" (car lock))))) modes)) -(autoload 'url-http-head-file-attributes "url-http") - (defun url-dav-file-attributes (url &optional id-format) (let ((properties (cdar (url-dav-get-properties url)))) (if (and properties diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index 67d72bcfb61..ae807d6eab9 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -28,16 +28,20 @@ ;; (require 'url-util) (eval-when-compile (require 'mm-decode)) ;; (require 'mailcap) -;; The following functions in the byte compiler's warnings are known not -;; to cause any real problem for the following reasons: -;; - mm-save-part-to-file, mm-destroy-parts: always used -;; after mm-dissect-buffer and defined in the same file. ;; The following are autoloaded instead of `require'd to avoid eagerly ;; loading all of URL when turning on url-handler-mode in the .emacs. (autoload 'url-expand-file-name "url-expand" "Convert url to a fully specified url, and canonicalize it.") (autoload 'mm-dissect-buffer "mm-decode" "Dissect the current buffer and return a list of MIME handles.") (autoload 'url-scheme-get-property "url-methods" "Get property of a URL SCHEME.") +;; Always used after mm-dissect-buffer and defined in the same file. +(declare-function mm-save-part-to-file "mm-decode" (handle file)) +(declare-function mm-destroy-parts "mm-decode" (handles)) +;; mm-decode loads mm-bodies. +(declare-function mm-decode-string "mm-bodies" (string charset)) +;; mm-decode loads mail-parse. +(declare-function mail-content-type-get "mail-parse" (ct attribute)) + ;; Implementation status ;; --------------------- ;; Function Status diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el index 391974d79f8..d4532626183 100644 --- a/lisp/url/url-news.el +++ b/lisp/url/url-news.el @@ -28,9 +28,10 @@ (autoload 'url-warn "url") (autoload 'gnus-group-read-ephemeral-group "gnus-group") -(defgroup url-news nil - "News related options." - :group 'url) +;; Unused. +;;; (defgroup url-news nil +;;; "News related options." +;;; :group 'url) (defun url-news-open-host (host port user pass) (if (fboundp 'nnheader-init-server-buffer) diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el index e858545e121..44587e93bc6 100644 --- a/lisp/url/url-proxy.el +++ b/lisp/url/url-proxy.el @@ -63,6 +63,8 @@ (url-warn 'url (format "Unknown proxy directive: %s" proxy) 'critical) nil)))) +(autoload 'url-http "url-http") + (defun url-proxy (url callback &optional cbargs) ;; Retrieve URL from a proxy. ;; Expects `url-using-proxy' to be bound to the specific proxy to use." @@ -73,7 +75,7 @@ (url-http url callback cbargs)) (t (error "Don't know how to use proxy `%s'" url-using-proxy)))) - + (provide 'url-proxy) ;;; url-proxy.el ends here diff --git a/lisp/url/url.el b/lisp/url/url.el index a1f0415d5fd..43e52ef25cf 100644 --- a/lisp/url/url.el +++ b/lisp/url/url.el @@ -290,6 +290,12 @@ no further processing). URL is either a string or a parsed URL." (get-buffer-process asynch-buffer))))))) asynch-buffer))) +;; url-mm-callback called from url-mm, which requires mm-decode. +(declare-function mm-dissect-buffer "mm-decode" + (&optional no-strict-mime loose-mime from)) +(declare-function mm-display-part "mm-decode" + (handle &optional no-default force)) + (defun url-mm-callback (&rest ignored) (let ((handle (mm-dissect-buffer t))) (url-mark-buffer-as-dead (current-buffer)) diff --git a/lisp/vc/compare-w.el b/lisp/vc/compare-w.el index fa451ccbe20..ae4fcc99a25 100644 --- a/lisp/vc/compare-w.el +++ b/lisp/vc/compare-w.el @@ -35,7 +35,7 @@ :prefix "compare-" :group 'tools) -(defcustom compare-windows-whitespace "\\(\\s-\\|\n\\)+" +(defcustom compare-windows-whitespace "\\(\\s-\\|\n\\|\240\\)+" "Regexp or function that defines whitespace sequences for `compare-windows'. That command optionally ignores changes in whitespace. @@ -49,6 +49,7 @@ any text before that point. If the function returns the same value for both windows, then the whitespace is considered to match, and is skipped." + :version "24.4" ; added \240 :type '(choice regexp function) :group 'compare-windows) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index d9224b29c2e..e945d6ef160 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -124,7 +124,6 @@ when editing big diffs)." ("A" . diff-ediff-patch) ("r" . diff-restrict-view) ("R" . diff-reverse-direction) - ("/" . diff-undo) ([remap undo] . diff-undo)) "Basic keymap for `diff-mode', bound to various prefix keys." :inherit special-mode-map) diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el index b4d986fb036..3e64250d1a7 100644 --- a/lisp/vc/ediff-diff.el +++ b/lisp/vc/ediff-diff.el @@ -27,10 +27,8 @@ (provide 'ediff-diff) -(eval-when-compile - (require 'ediff-util)) - (require 'ediff-init) +(require 'ediff-util) (defgroup ediff-diff nil "Diff related utilities." diff --git a/lisp/vc/ediff-merg.el b/lisp/vc/ediff-merg.el index dea872bd142..a1f4d4f5d78 100644 --- a/lisp/vc/ediff-merg.el +++ b/lisp/vc/ediff-merg.el @@ -32,11 +32,8 @@ (defvar ediff-merge-window-share) (defvar ediff-window-config-saved) -(eval-when-compile - (require 'ediff-util)) -;; end pacifier - (require 'ediff-init) +(require 'ediff-util) (defcustom ediff-quit-merge-hook 'ediff-maybe-save-and-delete-merge "Hooks to run before quitting a merge job. diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el index 3e3bc6c9663..58e10819a30 100644 --- a/lisp/vc/ediff-mult.el +++ b/lisp/vc/ediff-mult.el @@ -110,14 +110,11 @@ :prefix "ediff-" :group 'ediff) - -;; compiler pacifier -(eval-when-compile - (require 'ediff-ptch) - (require 'ediff)) -;; end pacifier - (require 'ediff-init) +(require 'ediff-diff) +(require 'ediff-wind) +(require 'ediff-util) + ;; meta-buffer (ediff-defvar-local ediff-meta-buffer nil "") @@ -1795,6 +1792,14 @@ all marked sessions must be active." )) (error "The patch buffer wasn't found")))) +(declare-function ediff-directories-internal "ediff" + (dir1 dir2 dir3 regexp action jobname + &optional startup-hooks merge-autostore-dir)) + +(declare-function ediff-directory-revisions-internal "ediff" + (dir1 regexp action jobname + &optional startup-hooks merge-autostore-dir)) + ;; This function executes in meta buffer. It knows where event happened. (defun ediff-filegroup-action () @@ -2360,6 +2365,8 @@ If this is a session registry buffer then just bury it." (setq point (point-min))) point)))) +(autoload 'ediff-patch-file-internal "ediff-ptch") + ;; this is the action invoked when the user selects a patch from the meta ;; buffer. (defun ediff-patch-file-form-meta (file &optional startup-hooks) diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el index 64f4ee4a6ac..e22b31ed048 100644 --- a/lisp/vc/ediff-ptch.el +++ b/lisp/vc/ediff-ptch.el @@ -33,12 +33,8 @@ :prefix "ediff-" :group 'ediff) -;; compiler pacifier -(eval-when-compile - (require 'ediff)) -;; end pacifier - (require 'ediff-init) +(require 'ediff-util) (defcustom ediff-patch-program "patch" "Name of the program that applies patches. @@ -472,6 +468,8 @@ are two possible targets for this patch. However, these files do not exist." (set-window-buffer ediff-window-B ediff-patch-diagnostics)) (t (display-buffer ediff-patch-diagnostics 'not-this-window)))) +(defvar ediff-use-last-dir) + ;; prompt for file, get the buffer (defun ediff-prompt-for-patch-file () (let ((dir (cond (ediff-use-last-dir ediff-last-dir-patch) @@ -642,6 +640,11 @@ optional argument, then use it." ;;; (eq code 0) ;;; (not (eq code 2)))) +(autoload 'ediff-find-file "ediff") +(declare-function ediff-buffers-internal "ediff" + (buf-a buf-b buf-c startup-hooks job-name + &optional merge-buffer-file)) + (defun ediff-patch-file-internal (patch-buf source-filename &optional startup-hooks) (setq source-filename (expand-file-name source-filename)) diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index 81146c0c931..ec227f44e8f 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -42,9 +42,6 @@ (eval-and-compile (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) -(eval-when-compile - (require 'ediff)) - ;; end pacifier @@ -3477,6 +3474,9 @@ Without an argument, it saves customized diff argument, if available (if (window-live-p ediff-control-window) (select-window ediff-control-window))) +(declare-function ediff-regions-internal "ediff" + (buffer-a beg-a end-a buffer-b beg-b end-b + startup-hooks job-name word-mode setup-parameters)) (defun ediff-inferior-compare-regions () "Compare regions in an active Ediff session. diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el index 81109906262..124bdbd26df 100644 --- a/lisp/vc/ediff-wind.el +++ b/lisp/vc/ediff-wind.el @@ -42,17 +42,16 @@ (eval-and-compile (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) -(eval-when-compile - (require 'ediff-util) - (require 'ediff-help)) +(require 'ediff-init) +(require 'ediff-help) ;; end pacifier -(require 'ediff-init) ;; be careful with ediff-tbar -(if (featurep 'xemacs) - (require 'ediff-tbar) - (defun ediff-compute-toolbar-width () 0)) +(eval-and-compile + (if (featurep 'xemacs) + (require 'ediff-tbar) + (defun ediff-compute-toolbar-width () 0))) (defgroup ediff-window nil "Ediff window manipulation." @@ -358,6 +357,8 @@ into icons, regardless of the window manager." (ediff-setup-windows-plain-compare buffer-A buffer-B buffer-C control-buffer))) +(autoload 'ediff-setup-control-buffer "ediff-util") + (defun ediff-setup-windows-plain-merge (buf-A buf-B buf-C control-buffer) ;; skip dedicated and unsplittable frames (ediff-destroy-control-frame control-buffer) @@ -908,6 +909,8 @@ into icons, regardless of the window manager." (not (ediff-frame-has-dedicated-windows (window-frame wind))) ))) +(declare-function ediff-make-bottom-toolbar "ediff-util" (&optional frame)) + ;; Prepare or refresh control frame (defun ediff-setup-control-frame (ctl-buffer designated-minibuffer-frame) (let ((window-min-height 1) diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el index aba23b06535..7a8f399a6ce 100644 --- a/lisp/vc/ediff.el +++ b/lisp/vc/ediff.el @@ -116,11 +116,7 @@ (eval-and-compile (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - -(eval-when-compile - (require 'dired) - (require 'ediff-util) - (require 'ediff-ptch)) +(require 'ediff-util) ;; end pacifier (require 'ediff-init) @@ -154,6 +150,11 @@ (ediff-with-current-buffer ediff-buffer-A (setq buffer-read-only t))) +(declare-function dired-get-filename "dired" + (&optional localp no-error-if-not-filep)) +(declare-function dired-get-marked-files "dired" + (&optional localp arg filter distinguish-one-marked)) + ;; Return a plausible default for ediff's first file: ;; In dired, return the file number FILENO (or 0) in the list ;; (all-selected-files, filename under the cursor), where directories are @@ -1345,6 +1346,12 @@ buffer." rev1 rev2 ancestor-rev startup-hooks merge-buffer-file))) ;;; Apply patch +(defvar ediff-last-dir-patch) +(defvar ediff-patch-default-directory) +(declare-function ediff-get-patch-buffer "ediff-ptch" + (&optional arg patch-buf)) +(declare-function ediff-dispatch-file-patching-job "ediff-ptch" + (patch-buf filename &optional startup-hooks)) ;;;###autoload (defun ediff-patch-file (&optional arg patch-buf) @@ -1373,6 +1380,9 @@ buffer. If odd -- assume it is in a file." source-dir nil nil (ediff-get-default-file-name))) (ediff-dispatch-file-patching-job patch-buf source-file))) +(declare-function ediff-patch-buffer-internal "ediff-ptch" + (patch-buf buf-to-patch-name &optional startup-hooks)) + ;;;###autoload (defun ediff-patch-buffer (&optional arg patch-buf) "Run Ediff by patching the buffer specified at prompt. @@ -1464,9 +1474,9 @@ Uses `vc.el' or `rcs.el' depending on `ediff-version-control-package'." "Return string describing the version of Ediff. When called interactively, displays the version." (interactive) - ;; called-interactively-p - not in XEmacs - ;; (if (called-interactively-p 'interactive) - (if (interactive-p) + (if (if (featurep 'xemacs) + (interactive-p) + (called-interactively-p 'interactive)) (message "%s" (ediff-version)) (format "Ediff %s of %s" ediff-version ediff-date))) diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index b74ff77bc41..b633b7be403 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -317,7 +317,9 @@ Otherwise, don't move point." result) (save-excursion (when pos (goto-char pos)) - (forward-line 1) + (forward-line 0) + ;; Treat "---" separator lines as part of the following revision. + (forward-line (if (looking-at "-\\{20,\\}$") 2 1)) (while looping (setq pos (re-search-backward log-view-message-re nil 'move) looping (and pos (log-view-inside-comment-p (point))))) diff --git a/lisp/vc/vc-arch.el b/lisp/vc/vc-arch.el index 52609457ebc..f94e19271ee 100644 --- a/lisp/vc/vc-arch.el +++ b/lisp/vc/vc-arch.el @@ -311,6 +311,9 @@ Only the value `maybe' can be trusted :-(." 'up-to-date 'edited))))))))) +;; -dir-status 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) "Run 'tla inventory' for DIR and pass results to CALLBACK. CALLBACK expects (ENTRIES &optional MORE-TO-COME); see @@ -432,6 +435,8 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see (message "There are unresolved conflicts in %s" (file-name-nondirectory rej)))))) +(autoload 'vc-switches "vc") + (defun vc-arch-checkin (files rev comment) (if rev (error "Committing to a specific revision is unsupported")) ;; FIXME: This implementation probably only works for singleton filesets diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index d0912cb719c..5e76d8464a5 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -47,8 +47,7 @@ (eval-when-compile (require 'cl-lib) - (require 'vc) ;; for vc-exec-after - (require 'vc-dir)) + (require 'vc-dir)) ; vc-dir-at-event ;; Clear up the cache to force vc-call to check again and discover ;; new functions when we reload this file. @@ -320,6 +319,12 @@ in the repository root directory of FILE." ("^Using saved parent location: \\(.+\\)" 1 nil nil 0)) "Value of `compilation-error-regexp-alist' in *vc-bzr* buffers.") +;; Follows vc-bzr-(async-)command, which uses vc-do-(async-)command +;; from vc-dispatcher. +(declare-function vc-exec-after "vc-dispatcher" (code)) +;; Follows vc-exec-after. +(declare-function vc-set-async-update "vc-dispatcher" (process-buffer)) + (defun vc-bzr-pull (prompt) "Pull changes into the current Bzr branch. Normally, this runs \"bzr pull\". However, if the branch is a @@ -653,7 +658,7 @@ REV non-nil gets an error." (defun vc-bzr-revert (file &optional contents-done) (unless contents-done - (with-temp-buffer (vc-bzr-command "revert" t 0 file)))) + (with-temp-buffer (vc-bzr-command "revert" t 0 file "--no-backup")))) (defvar log-view-message-re) (defvar log-view-file-re) @@ -693,8 +698,13 @@ REV non-nil gets an error." (2 'change-log-email)) ("^ *timestamp: \\(.*\\)" (1 'change-log-date-face))))))) +(autoload 'vc-setup-buffer "vc-dispatcher") + (defun vc-bzr-print-log (files buffer &optional shortlog start-revision limit) - "Get bzr change log for FILES into specified BUFFER." + "Print commit log associated with FILES into specified BUFFER. +If SHORTLOG is non-nil, use --line format. +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." ;; `vc-do-command' creates the buffer, but we need it before running ;; the command. (vc-setup-buffer buffer) @@ -707,8 +717,33 @@ REV non-nil gets an error." (apply 'vc-bzr-command "log" buffer 'async files (append (when shortlog '("--line")) - (when start-revision (list (format "-r..%s" start-revision))) + ;; The extra complications here when start-revision and limit + ;; are set are due to bzr log's --forward argument, which + ;; could be enabled via an alias in bazaar.conf. + ;; Svn, for example, does not have this problem, because + ;; it doesn't have --forward. Instead, you can use + ;; svn --log -r HEAD:0 or -r 0:HEAD as you prefer. + ;; Bzr, however, insists in -r X..Y that X come before Y. + (if start-revision + (list (format + (if (and limit (= limit 1)) + ;; This means we don't have to use --no-aliases. + ;; Is -c any different to -r in this case? + "-r%s" + "-r..%s") start-revision))) (when limit (list "-l" (format "%s" limit))) + ;; There is no sensible way to combine --limit and --forward, + ;; and it breaks the meaning of START-REVISION as the + ;; _newest_ revision. See bug#14168. + ;; Eg bzr log --forward -r ..100 --limit 50 prints + ;; revisions 1-50 rather than 50-100. There + ;; seems no way in general to get bzr to print revisions + ;; 50-100 in --forward order in that case. + ;; FIXME There may be other alias stuff we want to keep. + ;; Is there a way to just suppress --forward? + ;; As of 2013/4 the only caller uses limit = 1, so it does + ;; not matter much. + (and start-revision limit (> limit 1) '("--no-aliases")) (if (stringp vc-bzr-log-switches) (list vc-bzr-log-switches) vc-bzr-log-switches))))) @@ -750,6 +785,8 @@ REV non-nil gets an error." (goto-char (point-min))) found))) +(autoload 'vc-switches "vc") + (defun vc-bzr-diff (files &optional rev1 rev2 buffer) "VC bzr backend for diff." (let* ((switches (vc-switches 'bzr 'diff)) @@ -870,6 +907,8 @@ stream. Standard error output is discarded." (:conc-name vc-bzr-extra-fileinfo->)) extra-name) ;; original name for rename targets, new name for +(declare-function vc-default-dir-printer "vc-dir" (backend fileentry)) + (defun vc-bzr-dir-printer (info) "Pretty-printer for the vc-dir-fileinfo structure." (let ((extra (vc-dir-fileinfo->extra info))) @@ -1082,6 +1121,10 @@ stream. Standard error output is discarded." 'help-echo shelve-help-echo 'face 'font-lock-variable-name-face)))))) +;; Follows vc-bzr-command, which uses vc-do-command from vc-dispatcher. +(declare-function vc-resynch-buffer "vc-dispatcher" + (file &optional keep noquery reset-vc-info)) + (defun vc-bzr-shelve (name) "Create a shelve." (interactive "sShelf name: ") @@ -1141,6 +1184,9 @@ stream. Standard error output is discarded." (match-string 1) (error "Cannot find shelf at point")))) +;; vc-bzr-shelve-delete-at-point must be called from a vc-dir buffer. +(declare-function vc-dir-refresh "vc-dir" ()) + (defun vc-bzr-shelve-delete-at-point () (interactive) (let ((shelve (vc-bzr-shelve-get-at-point (point)))) diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index 407e691439b..eee896056c6 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -280,6 +280,8 @@ committed and support display of sticky tags." ;;; State-changing functions ;;; +(autoload 'vc-switches "vc") + (defun vc-cvs-register (files &optional _rev comment) "Register FILES into the CVS version-control system. COMMENT can be used to provide an initial description of FILES. @@ -415,6 +417,8 @@ REV is the revision to check out." (defun vc-cvs-delete-file (file) (vc-cvs-command nil 0 file "remove" "-f")) +(autoload 'vc-default-revert "vc") + (defun vc-cvs-revert (file &optional contents-done) "Revert FILE to the working revision on which it was based." (vc-default-revert 'CVS file contents-done) @@ -501,9 +505,12 @@ Will fail unless you have administrative privileges on the repo." ;;; (declare-function vc-rcs-print-log-cleanup "vc-rcs" ()) +;; Follows vc-cvs-command, which uses vc-do-command from vc-dispatcher. +(declare-function vc-exec-after "vc-dispatcher" (code)) (defun vc-cvs-print-log (files buffer &optional _shortlog _start-revision limit) - "Get change logs associated with FILES." + "Print commit log associated with FILES into specified BUFFER. +Remaining arguments are ignored." (require 'vc-rcs) ;; It's just the catenation of the individual logs. (vc-cvs-command @@ -518,6 +525,9 @@ Will fail unless you have administrative privileges on the repo." "Get comment history of a file." (vc-call-backend 'RCS 'comment-history file)) +(autoload 'vc-version-backup-file "vc") +(declare-function vc-coding-system-for-diff "vc" (file)) + (defun vc-cvs-diff (files &optional oldvers newvers buffer) "Get a difference report using CVS between two revisions of FILE." (let* (process-file-side-effects @@ -562,14 +572,13 @@ Will fail unless you have administrative privileges on the repo." (defconst vc-cvs-annotate-first-line-re "^[0-9]") -(defun vc-cvs-annotate-process-filter (process string) +(defun vc-cvs-annotate-process-filter (filter process string) (setq string (concat (process-get process 'output) string)) (if (not (string-match vc-cvs-annotate-first-line-re string)) ;; Still waiting for the first real line. (process-put process 'output string) - (let ((vc-filter (process-get process 'vc-filter))) - (set-process-filter process vc-filter) - (funcall vc-filter process (substring string (match-beginning 0)))))) + (remove-function (process-filter process) #'vc-cvs-annotate-process-filter) + (funcall filter process (substring string (match-beginning 0))))) (defun vc-cvs-annotate-command (file buffer &optional revision) "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER. @@ -583,9 +592,8 @@ Optional arg REVISION is a revision to annotate from." (let ((proc (get-buffer-process buffer))) (if proc ;; If running asynchronously, use a process filter. - (progn - (process-put proc 'vc-filter (process-filter proc)) - (set-process-filter proc 'vc-cvs-annotate-process-filter)) + (add-function :around (process-filter proc) + #'vc-cvs-annotate-process-filter) (with-current-buffer buffer (goto-char (point-min)) (re-search-forward vc-cvs-annotate-first-line-re) @@ -666,6 +674,10 @@ workspace is immediately moved to that new branch)." (vc-cvs-command nil 0 dir "tag" "-c" (if branchp "-b") name) (when branchp (vc-cvs-command nil 0 dir "update" "-r" name))) +;; Follows vc-cvs-command, which uses vc-do-command from vc-dispatcher. +(declare-function vc-resynch-buffer "vc-dispatcher" + (file &optional keep noquery reset-vc-info)) + (defun vc-cvs-retrieve-tag (dir name update) "Retrieve a tag at and below DIR. NAME is the name of the tag; if it is empty, do a `cvs update'. diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index d10e3934680..80f78496a43 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -930,8 +930,6 @@ If it is a file, return the corresponding cons for the file itself." (defvar use-vc-backend) ;; dynamically bound -;; Autoload cookie needed by desktop.el. -;;;###autoload (define-derived-mode vc-dir-mode special-mode "VC dir" "Major mode for VC directory buffers. Marking/Unmarking key bindings and actions: @@ -1301,6 +1299,8 @@ These are the commands available for use in the file status buffer: "Auxiliary information to be saved in desktop file." (cons (desktop-file-name default-directory dirname) vc-dir-backend)) +(defvar desktop-missing-file-warning) + (defun vc-dir-restore-desktop-buffer (_filename _buffername misc-data) "Restore a `vc-dir' buffer specified in a desktop file." (let ((dir (car misc-data)) diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index b03619e03d9..309cf50404c 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -1,4 +1,4 @@ -;;; vc-dispatcher.el -- generic command-dispatcher facility. +;;; vc-dispatcher.el -- generic command-dispatcher facility. -*- lexical-binding: t -*- ;; Copyright (C) 2008-2013 Free Software Foundation, Inc. @@ -182,32 +182,29 @@ Another is that undo information is not kept." (defvar vc-sentinel-movepoint) ;Dynamically scoped. -(defun vc-process-sentinel (p s) - (let ((previous (process-get p 'vc-previous-sentinel)) - (buf (process-buffer p))) +(defun vc--process-sentinel (p code) + (let ((buf (process-buffer p))) ;; Impatient users sometime kill "slow" buffers; check liveness ;; to avoid "error in process sentinel: Selecting deleted buffer". (when (buffer-live-p buf) - (when previous (funcall previous p s)) (with-current-buffer buf (setq mode-line-process (let ((status (process-status p))) ;; Leave mode-line uncluttered, normally. (unless (eq 'exit status) (format " (%s)" status)))) - (let (vc-sentinel-movepoint) + (let (vc-sentinel-movepoint + (m (process-mark p))) ;; Normally, we want async code such as sentinels to not move point. (save-excursion - (goto-char (process-mark p)) - (let ((cmds (process-get p 'vc-sentinel-commands))) - (process-put p 'vc-sentinel-commands nil) - (dolist (cmd cmds) + (goto-char m) ;; Each sentinel may move point and the next one should be run ;; at that new point. We could get the same result by having ;; each sentinel read&set process-mark, but since `cmd' needs ;; to work both for async and sync processes, this would be ;; difficult to achieve. - (vc-exec-after cmd)))) + (vc-exec-after code) + (move-marker m (point))) ;; But sometimes the sentinels really want to move point. (when vc-sentinel-movepoint (let ((win (get-buffer-window (current-buffer) 0))) @@ -226,7 +223,9 @@ Another is that undo information is not kept." (defun vc-exec-after (code) "Eval CODE when the current buffer's process is done. If the current buffer has no process, just evaluate CODE. -Else, add CODE to the process' sentinel." +Else, add CODE to the process' sentinel. +CODE can be either a function of no arguments, or an expression +to evaluate." (let ((proc (get-buffer-process (current-buffer)))) (cond ;; If there's no background process, just execute the code. @@ -237,20 +236,14 @@ Else, add CODE to the process' sentinel." ((or (null proc) (eq (process-status proc) 'exit)) ;; Make sure we've read the process's output before going further. (when proc (accept-process-output proc)) - (eval code)) + (if (functionp code) (funcall code) (eval code))) ;; If a process is running, add CODE to the sentinel ((eq (process-status proc) 'run) (vc-set-mode-line-busy-indicator) - (let ((previous (process-sentinel proc))) - (unless (eq previous 'vc-process-sentinel) - (process-put proc 'vc-previous-sentinel previous)) - (set-process-sentinel proc 'vc-process-sentinel)) - (process-put proc 'vc-sentinel-commands - ;; We keep the code fragments in the order given - ;; so that vc-diff-finish's message shows up in - ;; the presence of non-nil vc-command-messages. - (append (process-get proc 'vc-sentinel-commands) - (list code)))) + (letrec ((fun (lambda (p _msg) + (remove-function (process-sentinel p) fun) + (vc--process-sentinel p code)))) + (add-function :after (process-sentinel proc) fun))) (t (error "Unexpected process state")))) nil) @@ -329,7 +322,9 @@ case, and the process object in the asynchronous case." command squeezed)))) (when vc-command-messages (message "Running %s in background..." full-command)) - ;;(set-process-sentinel proc (lambda (p msg) (delete-process p))) + ;; Get rid of the default message insertion, in case we don't + ;; set a sentinel explicitly. + (set-process-sentinel proc #'ignore) (set-process-filter proc 'vc-process-filter) (setq status proc) (when vc-command-messages @@ -386,6 +381,8 @@ Display the buffer in some window, but don't select it." (set-window-start window new-window-start)) buffer)) +(defvar compilation-error-regexp-alist) + (defun vc-compilation-mode (backend) "Setup `compilation-mode' after with the appropriate `compilation-error-regexp-alist'." (let* ((error-regexp-alist @@ -477,7 +474,7 @@ Used by `vc-restore-buffer-context' to later restore the context." (vc-position-context (mark-marker)))) ;; Make the right thing happen in transient-mark-mode. (mark-active nil)) - (list point-context mark-context nil))) + (list point-context mark-context))) (defun vc-restore-buffer-context (context) "Restore point/mark, and reparse any affected compilation buffers. @@ -516,6 +513,8 @@ ARG and NO-CONFIRM are passed on to `revert-buffer'." (make-variable-buffer-local 'vc-mode-line-hook) (put 'vc-mode-line-hook 'permanent-local t) +(defvar view-old-buffer-read-only) + (defun vc-resynch-window (file &optional keep noquery reset-vc-info) "If FILE is in the current buffer, either revert or unvisit it. The choice between revert (to see expanded keywords) and unvisit diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 17de931628b..af5be361047 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -234,30 +234,30 @@ matching the resulting Git log output, and KEYWORDS is a list of (vc-git--state-code diff-letter))) (if (vc-git--empty-db-p) 'added 'up-to-date)))) -(defun vc-git-working-revision (_file) +(defun vc-git-working-revision (file) "Git-specific version of `vc-working-revision'." (let* (process-file-side-effects - (str (with-output-to-string - (with-current-buffer standard-output - (vc-git--out-ok "symbolic-ref" "HEAD"))))) - (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str) - (match-string 2 str) - str))) + (str (vc-git--run-command-string nil "symbolic-ref" "HEAD"))) + (vc-file-setprop file 'vc-git-detached (null str)) + (if str + (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str) + (match-string 2 str) + 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* ((branch (vc-working-revision file)) + (let* ((rev (vc-working-revision file)) + (detached (vc-file-getprop file 'vc-git-detached)) (def-ml (vc-default-mode-line-string 'Git file)) (help-echo (get-text-property 0 'help-echo def-ml))) - (if (zerop (length branch)) - (propertize - (concat def-ml "!") - 'help-echo (concat help-echo "\nNo current branch (detached HEAD)")) - (propertize def-ml - 'help-echo (concat help-echo "\nCurrent branch: " branch))))) + (propertize (if detached + (substring def-ml 0 (- 7 (length rev))) + def-ml) + 'help-echo (concat help-echo "\nCurrent revision: " rev)))) (cl-defstruct (vc-git-extra-fileinfo (:copier nil) @@ -443,6 +443,12 @@ or an empty string if none." (when next-stage (vc-git-dir-status-goto-stage next-stage files update-function)))) +;; Follows vc-git-command (or vc-do-async-command), which uses vc-do-command +;; from vc-dispatcher. +(declare-function vc-exec-after "vc-dispatcher" (code)) +;; Follows vc-exec-after. +(declare-function vc-set-async-update "vc-dispatcher" (process-buffer)) + (defun vc-git-dir-status-goto-stage (stage files update-function) (erase-buffer) (pcase stage @@ -731,10 +737,14 @@ This prompts for a branch to merge from." ;;; HISTORY FUNCTIONS +(autoload 'vc-setup-buffer "vc-dispatcher") + (defun vc-git-print-log (files buffer &optional shortlog start-revision limit) - "Get change log associated with FILES. -Note that using SHORTLOG requires at least Git version 1.5.6, -for the --graph option." + "Print commit log associated with FILES into specified BUFFER. +If SHORTLOG is non-nil, use a short format based on `vc-git-root-log-format'. +\(This requires at least Git version 1.5.6, for the --graph option.) +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." (let ((coding-system-for-read vc-git-commits-coding-system)) ;; `vc-do-command' creates the buffer, but we need it before running ;; the command. @@ -855,6 +865,8 @@ or BRANCH^ (where \"^\" can be repeated)." (indent-region (point-min) (point-max) 2) (buffer-string)))) +(autoload 'vc-switches "vc") + (defun vc-git-diff (files &optional rev1 rev2 buffer) "Get a difference report using Git between two revisions of FILES." (let (process-file-side-effects) @@ -941,10 +953,13 @@ or BRANCH^ (where \"^\" can be repeated)." (point) (1- (point-max))))))) (or (vc-git-symbolic-commit prev-rev) prev-rev)) - (with-temp-buffer - (and - (vc-git--out-ok "rev-parse" (concat rev "^")) - (buffer-substring-no-properties (point-min) (+ (point-min) 40)))))) + (vc-git--rev-parse (concat rev "^")))) + +(defun vc-git--rev-parse (rev) + (with-temp-buffer + (and + (vc-git--out-ok "rev-parse" rev) + (buffer-substring-no-properties (point-min) (+ (point-min) 40))))) (defun vc-git-next-revision (file rev) "Git-specific version of `vc-next-revision'." @@ -1005,6 +1020,12 @@ or BRANCH^ (where \"^\" can be repeated)." (or (vc-file-getprop file 'git-root) (vc-file-setprop file 'git-root (vc-find-root file ".git")))) +;; grep-compute-defaults autoloads grep. +(declare-function grep-read-regexp "grep" ()) +(declare-function grep-read-files "grep" (regexp)) +(declare-function grep-expand-template "grep" + (template &optional regexp files dir excl)) + ;; Derived from `lgrep'. (defun vc-git-grep (regexp &optional files dir) "Run git grep, searching for REGEXP in FILES in directory DIR. @@ -1060,6 +1081,10 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (if (eq next-error-last-buffer (current-buffer)) (setq default-directory dir)))))) +;; Everywhere but here, follows vc-git-command, which uses vc-do-command +;; from vc-dispatcher. +(autoload 'vc-resynch-buffer "vc-dispatcher") + (defun vc-git-stash (name) "Create a stash." (interactive "sStash name: ") @@ -1117,6 +1142,9 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (match-string 1) (error "Cannot find stash at point")))) +;; vc-git-stash-delete-at-point must be called from a vc-dir buffer. +(declare-function vc-dir-refresh "vc-dir" ()) + (defun vc-git-stash-delete-at-point () (interactive) (let ((stash (vc-git-stash-get-at-point (point)))) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index f39ef568e8b..a80a103c675 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -152,7 +152,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (2 'change-log-list) (3 'change-log-name) (4 'change-log-date))) - "Mercurial log template for `vc-print-root-log'. + "Mercurial log template for `vc-hg-print-log' short format. This should be a list (TEMPLATE REGEXP KEYWORDS), where TEMPLATE is the \"--template\" argument string to pass to Mercurial, REGEXP is a regular expression matching the resulting Mercurial @@ -245,8 +245,13 @@ highlighting the Log View buffer." (repeat :tag "Argument List" :value ("") string)) :group 'vc-hg) +(autoload 'vc-setup-buffer "vc-dispatcher") + (defun vc-hg-print-log (files buffer &optional shortlog start-revision limit) - "Get change log associated with FILES." + "Print commit log associated with FILES into specified BUFFER. +If SHORTLOG is non-nil, use a short format based on `vc-hg-root-log-format'. +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." ;; `vc-do-command' creates the buffer, but we need it before running ;; the command. (vc-setup-buffer buffer) @@ -257,7 +262,7 @@ highlighting the Log View buffer." buffer (apply 'vc-hg-command buffer 0 files "log" (nconc - (when start-revision (list (format "-r%s:" start-revision))) + (when start-revision (list (format "-r%s:0" start-revision))) (when limit (list "-l" (format "%s" limit))) (when shortlog (list "--template" (car vc-hg-root-log-format))) vc-hg-log-switches))))) @@ -303,6 +308,8 @@ highlighting the Log View buffer." ("^tag: +\\([^ ]+\\)$" (1 'highlight)) ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))) +(autoload 'vc-switches "vc") + (defun vc-hg-diff (files &optional oldvers newvers buffer) "Get a difference report using hg between two revisions of FILES." (let* ((firstfile (car files)) @@ -357,7 +364,7 @@ Optional arg REVISION is a revision to annotate from." ;;215 Wed Jun 20 21:22:58 2007 -0700 foo.c: CONTENTS ;; i.e. VERSION_NUMBER DATE FILENAME: CONTENTS (defconst vc-hg-annotate-re - "^[ \t]*\\([0-9]+\\) \\(.\\{30\\}\\)\\(?:\\(: \\)\\|\\(?: +\\(.+\\): \\)\\)") + "^[ \t]*\\([0-9]+\\) \\(.\\{30\\}\\)\\(?:\\(: \\)\\|\\(?: +\\([^:\n]+\\(?::\\(?:[^: \n][^:\n]*\\)?\\)*\\): \\)\\)") (defun vc-hg-annotate-time () (when (looking-at vc-hg-annotate-re) @@ -588,6 +595,12 @@ REV is the revision to check out into WORKFILE." (forward-line)) (funcall update-function result))) +;; Follows vc-hg-command (or vc-do-async-command), which uses vc-do-command +;; from vc-dispatcher. +(declare-function vc-exec-after "vc-dispatcher" (code)) +;; 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-exec-after @@ -648,6 +661,8 @@ REV is the revision to check out into WORKFILE." ;; modified files "Value of `compilation-error-regexp-alist' in *vc-hg* buffers.") +(autoload 'vc-do-async-command "vc-dispatcher") + (defun vc-hg-pull (prompt) "Issue a Mercurial pull command. If called interactively with a set of marked Log View buffers, diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el index 06827a5e027..29996fafe92 100644 --- a/lisp/vc/vc-mtn.el +++ b/lisp/vc/vc-mtn.el @@ -123,6 +123,9 @@ 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. +(declare-function vc-exec-after "vc-dispatcher" (code)) + (defun vc-mtn-dir-status (dir update-function) (vc-mtn-command (current-buffer) 'async dir "status") (vc-exec-after @@ -202,6 +205,10 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." ;; ) (defun vc-mtn-print-log (files buffer &optional _shortlog start-revision limit) + "Print commit logs associated with FILES into specified BUFFER. +_SHORTLOG is ignored. +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." (apply 'vc-mtn-command buffer 0 files "log" (append (when start-revision (list "--from" (format "%s" start-revision))) @@ -229,6 +236,8 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." ;; (defun vc-mtn-show-log-entry (revision) ;; ) +(autoload 'vc-switches "vc") + (defun vc-mtn-diff (files &optional rev1 rev2 buffer) "Get a difference report using monotone between two revisions of FILES." (apply 'vc-mtn-command (or buffer "*vc-diff*") 1 files "diff" diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index 40d8acb7e07..e85494b2156 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -200,6 +200,8 @@ For a description of possible values, see `vc-check-master-templates'." (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 @@ -270,6 +272,8 @@ When VERSION is given, perform check for that version." ;; RCS is totally file-oriented, so all we have to do is make the directory. (make-directory "RCS")) +(autoload 'vc-switches "vc") + (defun vc-rcs-register (files &optional rev comment) "Register FILES into the RCS version-control system. REV is the optional revision number for the files. COMMENT can be used @@ -567,10 +571,14 @@ directory the operation is applied to all registered files beneath it." (when (looking-at "[\b\t\n\v\f\r ]+") (delete-char (- (match-end 0) (match-beginning 0)))))) -(defun vc-rcs-print-log (files buffer &optional shortlog start-revision-ignored limit) - "Get change log associated with FILE. 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))) +(defun vc-rcs-print-log (files buffer &optional shortlog + start-revision-ignored limit) + "Print commit log associated with FILES into specified BUFFER. +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))) (with-current-buffer (or buffer "*vc*") (vc-rcs-print-log-cleanup)) (when limit 'limit-unsupported)) @@ -817,6 +825,9 @@ systime, or nil if there is none. Also, reposition point." ;;; Tag system ;;; +(autoload 'vc-tag-precondition "vc") +(declare-function vc-file-tree-walk "vc" (dirname func &rest args)) + (defun vc-rcs-create-tag (dir name branchp) (when branchp (error "RCS backend does not support module branches")) @@ -888,6 +899,8 @@ and CVS." (t "rcs2log"))) "Path to the `rcs2log' program (normally in `exec-directory').") +(autoload 'vc-buffer-sync "vc-dispatcher") + (defun vc-rcs-update-changelog (files) "Default implementation of update-changelog. Uses `rcs2log' which only works for RCS and CVS." @@ -954,6 +967,8 @@ Uses `rcs2log' which only works for RCS and CVS." nil t) (replace-match "$\\1$")))) +(autoload 'vc-rename-master "vc") + (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)) diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el index bfbe42222e9..7bce1ea3ba6 100644 --- a/lisp/vc/vc-sccs.el +++ b/lisp/vc/vc-sccs.el @@ -155,6 +155,8 @@ For a description of possible values, see `vc-check-master-templates'." (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. @@ -216,6 +218,8 @@ Optional string REV is a revision." ;; SCCS is totally file-oriented, so all we have to do is make the directory (make-directory "SCCS")) +(autoload 'vc-switches "vc") + (defun vc-sccs-register (files &optional rev comment) "Register FILES into the SCCS version-control system. REV is the optional revision number for the file. COMMENT can be used @@ -350,11 +354,15 @@ revert all subfiles." ;;; (defun vc-sccs-print-log (files buffer &optional shortlog start-revision-ignored limit) - "Get change log associated with FILES." + "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)) (when limit 'limit-unsupported)) +(autoload 'vc-setup-buffer "vc-dispatcher") +(autoload 'vc-delistify "vc-dispatcher") + ;; FIXME use sccsdiff if present? (defun vc-sccs-diff (files &optional oldvers newvers buffer) "Get a difference report using SCCS between two filesets." @@ -431,6 +439,9 @@ revert all subfiles." ;;; our own set of name-to-revision mappings. ;;; +(autoload 'vc-tag-precondition "vc") +(declare-function vc-file-tree-walk "vc" (dirname func &rest args)) + (defun vc-sccs-create-tag (dir name branchp) (when branchp (error "SCCS backend does not support module branches")) @@ -459,6 +470,8 @@ revert all subfiles." (goto-char (point-min)) (re-search-forward "%[A-Z]%" nil t))) +(autoload 'vc-rename-master "vc") + (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) diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index 923888b460b..39b107b81b5 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -215,6 +215,9 @@ 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. +(declare-function vc-exec-after "vc-dispatcher" (code)) + (defun vc-svn-dir-status (dir callback) "Run 'svn status' for DIR and update BUFFER via CALLBACK. CALLBACK is called as (CALLBACK RESULT BUFFER), where @@ -293,6 +296,8 @@ RESULT is a list of conses (FILE . STATE) for directory DIR." (vc-svn-command "*vc*" 0 "." "checkout" (concat "file://" default-directory "SVN"))) +(autoload 'vc-switches "vc") + (defun vc-svn-register (files &optional rev comment) "Register FILES into the SVN version-control system. The COMMENT argument is ignored This does an add but not a commit. @@ -493,8 +498,13 @@ or svn+ssh://." (require 'add-log) (set (make-local-variable 'log-view-per-file-logs) nil)) +(autoload 'vc-setup-buffer "vc-dispatcher") + (defun vc-svn-print-log (files buffer &optional shortlog start-revision limit) - "Get change log(s) associated with FILES." + "Print commit log associated with FILES into specified BUFFER. +SHORTLOG is ignored. +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." (save-current-buffer (vc-setup-buffer buffer) (let ((inhibit-read-only t)) @@ -512,7 +522,7 @@ or svn+ssh://." (append (list (if start-revision - (format "-r%s" start-revision) + (format "-r%s:1" start-revision) ;; By default Subversion only shows the log up to the ;; working revision, whereas we also want the log of the ;; subsequent commits. At least that's what the diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index a0ef6f9d6d7..5e1d27c0ea3 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -356,9 +356,11 @@ ;; If LIMIT is true insert only insert LIMIT log entries. If the ;; backend does not support limiting the number of entries to show ;; it should return `limit-unsupported'. -;; If START-REVISION is given, then show the log starting from the -;; revision. At this point START-REVISION is only required to work -;; in conjunction with LIMIT = 1. +;; If START-REVISION is given, then show the log starting from that +;; revision ("starting" in the sense of it being the _newest_ +;; revision shown, rather than the working revision, which is normally +;; the case). Not all backends support this. At present, this is +;; only ever used with LIMIT = 1 (by vc-annotate-show-log-revision-at-line). ;; ;; * log-outgoing (backend remote-location) ;; @@ -2084,6 +2086,11 @@ Not all VC backends support short logs!") (defvar log-view-vc-fileset) (defun vc-print-log-setup-buttons (working-revision is-start-revision limit pl-return) + "Insert at the end of the current buffer buttons to show more log entries. +In the new log, leave point at WORKING-REVISION (if non-nil). +LIMIT is the number of entries currently shown. +Does nothing if IS-START-REVISION is non-nil, or if LIMIT is nil, +or if PL-RETURN is 'limit-unsupported." (when (and limit (not (eq 'limit-unsupported pl-return)) (not is-start-revision)) (goto-char (point-max)) @@ -2104,6 +2111,14 @@ Not all VC backends support short logs!") (defun vc-print-log-internal (backend files working-revision &optional is-start-revision limit) + "For specified BACKEND and FILES, show the VC log. +Leave point at WORKING-REVISION, if it is non-nil. +If IS-START-REVISION is non-nil, start the log from WORKING-REVISION +\(not all backends support this); i.e., show only WORKING-REVISION and +earlier revisions. Show up to LIMIT entries (non-nil means unlimited)." + ;; As of 2013/04 the only thing that passes IS-START-REVISION non-nil + ;; is vc-annotate-show-log-revision-at-line, which sets LIMIT = 1. + ;; 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. @@ -2189,7 +2204,7 @@ WORKING-REVISION and LIMIT." (interactive (cond (current-prefix-arg - (let ((rev (read-from-minibuffer "Log from revision (default: last revision): " nil + (let ((rev (read-from-minibuffer "Leave point at revision (default: last revision): " nil nil nil nil)) (lim (string-to-number (read-from-minibuffer diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index e0d1abe94c7..44b3cfd3b1d 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -250,6 +250,8 @@ This function is provided for backward compatibility, since ;; Set to a system sound if you want a fancy bell. (set-message-beep nil) +(defvar w32-charset-info-alist) ; w32font.c + (defun w32-add-charset-info (xlfd-charset windows-charset codepage) "Function to add character sets to display with Windows fonts. Creates entries in `w32-charset-info-alist'. diff --git a/lisp/wdired.el b/lisp/wdired.el index 47cd99f45ac..55665fbb6a0 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -239,8 +239,7 @@ See `wdired-mode'." (dired-remember-marks (point-min) (point-max))) (set (make-local-variable 'wdired-old-point) (point)) (set (make-local-variable 'query-replace-skip-read-only) t) - (set (make-local-variable 'isearch-filter-predicate) - 'wdired-isearch-filter-read-only) + (add-hook 'isearch-filter-predicates 'wdired-isearch-filter-read-only nil t) (use-local-map wdired-mode-map) (force-mode-line-update) (setq buffer-read-only nil) @@ -268,9 +267,8 @@ or \\[wdired-abort-changes] to abort changes"))) (defun wdired-isearch-filter-read-only (beg end) "Skip matches that have a read-only property." - (and (isearch-filter-visible beg end) - (not (text-property-not-all (min beg end) (max beg end) - 'read-only nil)))) + (not (text-property-not-all (min beg end) (max beg end) + 'read-only nil))) ;; Protect the buffer so only the filenames can be changed, and put ;; properties so filenames (old and new) can be easily found. diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 975b89f2fc2..801cdc52047 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -554,13 +554,10 @@ See also `whitespace-display-mappings' for documentation." (const :tag "(Mark) NEWLINEs" newline-mark))) :group 'whitespace) - -(defcustom whitespace-space 'whitespace-space +(defvar whitespace-space 'whitespace-space "Symbol face used to visualize SPACE. - -Used when `whitespace-style' includes the value `spaces'." - :type 'face - :group 'whitespace) +Used when `whitespace-style' includes the value `spaces'.") +(make-obsolete-variable 'whitespace-space "use the face instead" "24.4") (defface whitespace-space @@ -573,13 +570,10 @@ Used when `whitespace-style' includes the value `spaces'." :group 'whitespace) -(defcustom whitespace-hspace 'whitespace-hspace +(defvar whitespace-hspace 'whitespace-hspace "Symbol face used to visualize HARD SPACE. - -Used when `whitespace-style' includes the value `spaces'." - :type 'face - :group 'whitespace) - +Used when `whitespace-style' includes the value `spaces'.") +(make-obsolete-variable 'whitespace-hspace "use the face instead" "24.4") (defface whitespace-hspace ; 'nobreak-space '((((class color) (background dark)) @@ -591,13 +585,10 @@ Used when `whitespace-style' includes the value `spaces'." :group 'whitespace) -(defcustom whitespace-tab 'whitespace-tab +(defvar whitespace-tab 'whitespace-tab "Symbol face used to visualize TAB. - -Used when `whitespace-style' includes the value `tabs'." - :type 'face - :group 'whitespace) - +Used when `whitespace-style' includes the value `tabs'.") +(make-obsolete-variable 'whitespace-tab "use the face instead" "24.4") (defface whitespace-tab '((((class color) (background dark)) @@ -609,16 +600,12 @@ Used when `whitespace-style' includes the value `tabs'." :group 'whitespace) -(defcustom whitespace-newline 'whitespace-newline +(defvar whitespace-newline 'whitespace-newline "Symbol face used to visualize NEWLINE char mapping. - See `whitespace-display-mappings'. - Used when `whitespace-style' includes the values `newline-mark' -and `newline'." - :type 'face - :group 'whitespace) - +and `newline'.") +(make-obsolete-variable 'whitespace-newline "use the face instead" "24.4") (defface whitespace-newline '((default :weight normal) @@ -634,13 +621,10 @@ See `whitespace-display-mappings'." :group 'whitespace) -(defcustom whitespace-trailing 'whitespace-trailing +(defvar whitespace-trailing 'whitespace-trailing "Symbol face used to visualize trailing blanks. - -Used when `whitespace-style' includes the value `trailing'." - :type 'face - :group 'whitespace) - +Used when `whitespace-style' includes the value `trailing'.") +(make-obsolete-variable 'whitespace-trailing "use the face instead" "24.4") (defface whitespace-trailing ; 'trailing-whitespace '((default :weight bold) @@ -650,15 +634,11 @@ Used when `whitespace-style' includes the value `trailing'." :group 'whitespace) -(defcustom whitespace-line 'whitespace-line +(defvar whitespace-line 'whitespace-line "Symbol face used to visualize \"long\" lines. - See `whitespace-line-column'. - -Used when `whitespace-style' includes the value `line'." - :type 'face - :group 'whitespace) - +Used when `whitespace-style' includes the value `line'.") +(make-obsolete-variable 'whitespace-line "use the face instead" "24.4") (defface whitespace-line '((((class mono)) :inverse-video t :weight bold :underline t) @@ -669,13 +649,11 @@ See `whitespace-line-column'." :group 'whitespace) -(defcustom whitespace-space-before-tab 'whitespace-space-before-tab +(defvar whitespace-space-before-tab 'whitespace-space-before-tab "Symbol face used to visualize SPACEs before TAB. - -Used when `whitespace-style' includes the value `space-before-tab'." - :type 'face - :group 'whitespace) - +Used when `whitespace-style' includes the value `space-before-tab'.") +(make-obsolete-variable 'whitespace-space-before-tab + "use the face instead" "24.4") (defface whitespace-space-before-tab '((((class mono)) :inverse-video t :weight bold :underline t) @@ -684,13 +662,10 @@ Used when `whitespace-style' includes the value `space-before-tab'." :group 'whitespace) -(defcustom whitespace-indentation 'whitespace-indentation +(defvar whitespace-indentation 'whitespace-indentation "Symbol face used to visualize 8 or more SPACEs at beginning of line. - -Used when `whitespace-style' includes the value `indentation'." - :type 'face - :group 'whitespace) - +Used when `whitespace-style' includes the value `indentation'.") +(make-obsolete-variable 'whitespace-indentation "use the face instead" "24.4") (defface whitespace-indentation '((((class mono)) :inverse-video t :weight bold :underline t) @@ -699,13 +674,10 @@ Used when `whitespace-style' includes the value `indentation'." :group 'whitespace) -(defcustom whitespace-empty 'whitespace-empty +(defvar whitespace-empty 'whitespace-empty "Symbol face used to visualize empty lines at beginning and/or end of buffer. - -Used when `whitespace-style' includes the value `empty'." - :type 'face - :group 'whitespace) - +Used when `whitespace-style' includes the value `empty'.") +(make-obsolete-variable 'whitespace-empty "use the face instead" "24.4") (defface whitespace-empty '((((class mono)) :inverse-video t :weight bold :underline t) @@ -714,13 +686,11 @@ Used when `whitespace-style' includes the value `empty'." :group 'whitespace) -(defcustom whitespace-space-after-tab 'whitespace-space-after-tab +(defvar whitespace-space-after-tab 'whitespace-space-after-tab "Symbol face used to visualize 8 or more SPACEs after TAB. - -Used when `whitespace-style' includes the value `space-after-tab'." - :type 'face - :group 'whitespace) - +Used when `whitespace-style' includes the value `space-after-tab'.") +(make-obsolete-variable 'whitespace-space-after-tab + "use the face instead" "24.4") (defface whitespace-space-after-tab '((((class mono)) :inverse-video t :weight bold :underline t) @@ -730,15 +700,9 @@ Used when `whitespace-style' includes the value `space-after-tab'." (defcustom whitespace-hspace-regexp - "\\(\\(\xA0\\|\x8A0\\|\x920\\|\xE20\\|\xF20\\)+\\)" + "\\(\u00A0+\\)" "Specify HARD SPACE characters regexp. -If you're using `mule' package, there may be other characters besides: - - \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \"\\xF20\" - -that should be considered HARD SPACE. - Here are some examples: \"\\\\(^\\xA0+\\\\)\" \ @@ -806,7 +770,7 @@ Used when `whitespace-style' includes `tabs'." "\\([\t \u00A0]+\\)$" "Specify trailing characters regexp. -If you're using `mule' package, there may be other characters besides: +There may be other characters besides: \" \" \"\\t\" \"\\u00A0\" @@ -823,13 +787,6 @@ Used when `whitespace-style' includes `trailing'." (defcustom whitespace-space-before-tab-regexp "\\( +\\)\\(\t+\\)" "Specify SPACEs before TAB regexp. -If you're using `mule' package, there may be other characters besides: - - \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ -\"\\xF20\" - -that should be considered blank. - Used when `whitespace-style' includes `space-before-tab', `space-before-tab::tab' or `space-before-tab::space'." :type '(regexp :tag "SPACEs Before TAB") @@ -844,30 +801,16 @@ Used when `whitespace-style' includes `space-before-tab', It is a cons where the cons car is used for SPACEs visualization and the cons cdr is used for TABs visualization. -If you're using `mule' package, there may be other characters besides: - - \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ -\"\\xF20\" - -that should be considered blank. - Used when `whitespace-style' includes `indentation', `indentation::tab' or `indentation::space'." - :type '(cons (regexp :tag "Indentation SPACEs") - (regexp :tag "Indentation TABs")) + :type '(cons (string :tag "Indentation SPACEs") + (string :tag "Indentation TABs")) :group 'whitespace) (defcustom whitespace-empty-at-bob-regexp "^\\(\\([ \t]*\n\\)+\\)" "Specify regexp for empty lines at beginning of buffer. -If you're using `mule' package, there may be other characters besides: - - \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ -\"\\xF20\" - -that should be considered blank. - Used when `whitespace-style' includes `empty'." :type '(regexp :tag "Empty Lines At Beginning Of Buffer") :group 'whitespace) @@ -876,13 +819,6 @@ Used when `whitespace-style' includes `empty'." (defcustom whitespace-empty-at-eob-regexp "^\\([ \t\n]+\\)" "Specify regexp for empty lines at end of buffer. -If you're using `mule' package, there may be other characters besides: - - \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ -\"\\xF20\" - -that should be considered blank. - Used when `whitespace-style' includes `empty'." :type '(regexp :tag "Empty Lines At End Of Buffer") :group 'whitespace) @@ -896,16 +832,10 @@ Used when `whitespace-style' includes `empty'." It is a cons where the cons car is used for SPACEs visualization and the cons cdr is used for TABs visualization. -If you're using `mule' package, there may be other characters besides: - - \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ -\"\\xF20\" - -that should be considered blank. - Used when `whitespace-style' includes `space-after-tab', `space-after-tab::tab' or `space-after-tab::space'." - :type '(regexp :tag "SPACEs After TAB") + :type '(cons (string :tag "SPACEs After TAB") + string) :group 'whitespace) @@ -1932,14 +1862,8 @@ cleaning up these problems." ;;;; Internal functions -(defvar whitespace-font-lock-mode nil - "Used to remember whether a buffer had font lock mode on or not.") - -(defvar whitespace-font-lock nil - "Used to remember whether a buffer initially had font lock on or not.") - (defvar whitespace-font-lock-keywords nil - "Used to save locally `font-lock-keywords' value.") + "Used to save the value `whitespace-color-on' adds to `font-lock-keywords'.") (defconst whitespace-help-text @@ -2177,8 +2101,6 @@ resultant list will be returned." ;; prepare local hooks (add-hook 'write-file-functions 'whitespace-write-file-hook nil t) ;; create whitespace local buffer environment - (set (make-local-variable 'whitespace-font-lock-mode) nil) - (set (make-local-variable 'whitespace-font-lock) nil) (set (make-local-variable 'whitespace-font-lock-keywords) nil) (set (make-local-variable 'whitespace-display-table) nil) (set (make-local-variable 'whitespace-display-table-was-local) nil) @@ -2228,10 +2150,6 @@ resultant list will be returned." (defun whitespace-color-on () "Turn on color visualization." (when (whitespace-style-face-p) - (unless whitespace-font-lock - (setq whitespace-font-lock t - whitespace-font-lock-keywords - (copy-sequence font-lock-keywords))) ;; save current point and refontify when necessary (set (make-local-variable 'whitespace-point) (point)) @@ -2245,163 +2163,100 @@ resultant list will be returned." nil) (add-hook 'post-command-hook #'whitespace-post-command-hook nil t) (add-hook 'before-change-functions #'whitespace-buffer-changed nil t) - ;; turn off font lock - (set (make-local-variable 'whitespace-font-lock-mode) - font-lock-mode) - (font-lock-mode 0) - ;; add whitespace-mode color into font lock - (when (memq 'spaces whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show SPACEs - (list whitespace-space-regexp 1 whitespace-space t) - ;; Show HARD SPACEs - (list whitespace-hspace-regexp 1 whitespace-hspace t)) - t)) - (when (memq 'tabs whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show TABs - (list whitespace-tab-regexp 1 whitespace-tab t)) - t)) - (when (memq 'trailing whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show trailing blanks - (list #'whitespace-trailing-regexp 1 whitespace-trailing t)) - t)) - (when (or (memq 'lines whitespace-active-style) - (memq 'lines-tail whitespace-active-style)) - (font-lock-add-keywords - nil - (list - ;; Show "long" lines - (list - (let ((line-column (or whitespace-line-column fill-column))) - (format - "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$" - whitespace-tab-width - (1- whitespace-tab-width) - (/ line-column whitespace-tab-width) - (let ((rem (% line-column whitespace-tab-width))) - (if (zerop rem) - "" - (format ".\\{%d\\}" rem))))) - (if (memq 'lines whitespace-active-style) - 0 ; whole line - 2) ; line tail - whitespace-line t)) - t)) - (cond - ((memq 'space-before-tab whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show SPACEs before TAB (indent-tabs-mode) - (list whitespace-space-before-tab-regexp - (if whitespace-indent-tabs-mode 1 2) - whitespace-space-before-tab t)) - t)) - ((memq 'space-before-tab::tab whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show SPACEs before TAB (SPACEs) - (list whitespace-space-before-tab-regexp - 1 whitespace-space-before-tab t)) - t)) - ((memq 'space-before-tab::space whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show SPACEs before TAB (TABs) - (list whitespace-space-before-tab-regexp - 2 whitespace-space-before-tab t)) - t))) - (cond - ((memq 'indentation whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show indentation SPACEs (indent-tabs-mode) - (list (whitespace-indentation-regexp) - 1 whitespace-indentation t)) - t)) - ((memq 'indentation::tab whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show indentation SPACEs (SPACEs) - (list (whitespace-indentation-regexp 'tab) - 1 whitespace-indentation t)) - t)) - ((memq 'indentation::space whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show indentation SPACEs (TABs) - (list (whitespace-indentation-regexp 'space) - 1 whitespace-indentation t)) - t))) - (when (memq 'empty whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show empty lines at beginning of buffer - (list #'whitespace-empty-at-bob-regexp - 1 whitespace-empty t)) - t) - (font-lock-add-keywords - nil - (list - ;; Show empty lines at end of buffer - (list #'whitespace-empty-at-eob-regexp - 1 whitespace-empty t)) - t)) - (cond - ((memq 'space-after-tab whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show SPACEs after TAB (indent-tabs-mode) - (list (whitespace-space-after-tab-regexp) - 1 whitespace-space-after-tab t)) - t)) - ((memq 'space-after-tab::tab whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show SPACEs after TAB (SPACEs) - (list (whitespace-space-after-tab-regexp 'tab) - 1 whitespace-space-after-tab t)) - t)) - ((memq 'space-after-tab::space whitespace-active-style) - (font-lock-add-keywords - nil - (list - ;; Show SPACEs after TAB (TABs) - (list (whitespace-space-after-tab-regexp 'space) - 1 whitespace-space-after-tab t)) - t))) - ;; now turn on font lock and highlight blanks - (font-lock-mode 1))) + ;; Add whitespace-mode color into font lock. + (setq + whitespace-font-lock-keywords + `( + ,@(when (memq 'spaces whitespace-active-style) + ;; Show SPACEs. + `((,whitespace-space-regexp 1 whitespace-space t) + ;; Show HARD SPACEs. + (,whitespace-hspace-regexp 1 whitespace-hspace t))) + ,@(when (memq 'tabs whitespace-active-style) + ;; Show TABs. + `((,whitespace-tab-regexp 1 whitespace-tab t))) + ,@(when (memq 'trailing whitespace-active-style) + ;; Show trailing blanks. + `((,#'whitespace-trailing-regexp 1 whitespace-trailing t))) + ,@(when (or (memq 'lines whitespace-active-style) + (memq 'lines-tail whitespace-active-style)) + ;; Show "long" lines. + `((,(let ((line-column (or whitespace-line-column fill-column))) + (format + "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$" + whitespace-tab-width + (1- whitespace-tab-width) + (/ line-column whitespace-tab-width) + (let ((rem (% line-column whitespace-tab-width))) + (if (zerop rem) + "" + (format ".\\{%d\\}" rem))))) + ,(if (memq 'lines whitespace-active-style) + 0 ; whole line + 2) ; line tail + whitespace-line prepend))) + ,@(when (or (memq 'space-before-tab whitespace-active-style) + (memq 'space-before-tab::tab whitespace-active-style) + (memq 'space-before-tab::space whitespace-active-style)) + `((,whitespace-space-before-tab-regexp + ,(cond + ((memq 'space-before-tab whitespace-active-style) + ;; Show SPACEs before TAB (indent-tabs-mode). + (if whitespace-indent-tabs-mode 1 2)) + ((memq 'space-before-tab::tab whitespace-active-style) + 1) + ((memq 'space-before-tab::space whitespace-active-style) + 2)) + whitespace-space-before-tab t))) + ,@(when (or (memq 'indentation whitespace-active-style) + (memq 'indentation::tab whitespace-active-style) + (memq 'indentation::space whitespace-active-style)) + `((,(cond + ((memq 'indentation whitespace-active-style) + ;; Show indentation SPACEs (indent-tabs-mode). + (whitespace-indentation-regexp)) + ((memq 'indentation::tab whitespace-active-style) + ;; Show indentation SPACEs (SPACEs). + (whitespace-indentation-regexp 'tab)) + ((memq 'indentation::space whitespace-active-style) + ;; Show indentation SPACEs (TABs). + (whitespace-indentation-regexp 'space))) + 1 whitespace-indentation t))) + ,@(when (memq 'empty whitespace-active-style) + ;; Show empty lines at beginning of buffer. + `((,#'whitespace-empty-at-bob-regexp + 1 whitespace-empty t) + ;; Show empty lines at end of buffer. + (,#'whitespace-empty-at-eob-regexp + 1 whitespace-empty t))) + ,@(when (or (memq 'space-after-tab whitespace-active-style) + (memq 'space-after-tab::tab whitespace-active-style) + (memq 'space-after-tab::space whitespace-active-style)) + `((,(cond + ((memq 'space-after-tab whitespace-active-style) + ;; Show SPACEs after TAB (indent-tabs-mode). + (whitespace-space-after-tab-regexp)) + ((memq 'space-after-tab::tab whitespace-active-style) + ;; Show SPACEs after TAB (SPACEs). + (whitespace-space-after-tab-regexp 'tab)) + ((memq 'space-after-tab::space whitespace-active-style) + ;; Show SPACEs after TAB (TABs). + (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)))) (defun whitespace-color-off () "Turn off color visualization." ;; turn off font lock (when (whitespace-style-face-p) - (font-lock-mode 0) (remove-hook 'post-command-hook #'whitespace-post-command-hook t) (remove-hook 'before-change-functions #'whitespace-buffer-changed t) - (when whitespace-font-lock - (setq whitespace-font-lock nil - font-lock-keywords whitespace-font-lock-keywords)) - ;; restore original font lock state - (font-lock-mode whitespace-font-lock-mode))) + (font-lock-remove-keywords nil whitespace-font-lock-keywords) + (when font-lock-mode + (font-lock-fontify-buffer)))) (defun whitespace-trailing-regexp (limit) diff --git a/lisp/window.el b/lisp/window.el index 627b9a425eb..5b001988ddf 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -3686,7 +3686,7 @@ lines or columns tall. If SIZE is negative, make the new window absolute value can be less than `window-min-height' or `window-min-width'; so this command can make a new window as small as one line or two columns. SIZE defaults to half of -WINDOW's size. Interactively, SIZE is the prefix argument. +WINDOW's size. Optional third argument SIDE nil (or `below') specifies that the new window shall be located below WINDOW. SIDE `above' means the @@ -3718,7 +3718,6 @@ scrollbars are inherited from WINDOW. If WINDOW is an internal window, these properties as well as the buffer displayed in the new window are inherited from the window selected on WINDOW's frame. The selected window is not changed by this function." - (interactive "i") (setq window (window-normalize-window window)) (let* ((side (cond ((not side) 'below) diff --git a/lisp/winner.el b/lisp/winner.el index dfbd15b6676..f521ba0521b 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -45,10 +45,8 @@ (if (featurep 'xemacs) `(if ,store (zmacs-activate-region) (zmacs-deactivate-region)) - `(setq mark-active ,store))))) - (if (boundp 'mark-active) - mark-active - (region-active-p))) + `(if ,store (activate-mark) (deactivate-mark)))))) + (region-active-p)) (defalias 'winner-edges (if (featurep 'xemacs) 'window-pixel-edges 'window-edges)) |