diff options
Diffstat (limited to 'lisp')
94 files changed, 2918 insertions, 1235 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6ecaf7fb33d..68d35379314 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,15 +1,439 @@ -2006-10-29 Stephen Leake <stephen_leake@stephe_leake.org> +2006-11-07 Chong Yidong <cyd@stupidchicken.com> + + * whitespace.el (whitespace-buffer): Call remove-overlays after + overlay-recenter for performance. Suggested by Martin Rudalics. + +2006-11-07 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-default-method): scp is the default method. + +2006-11-07 Juanma Barranquero <lekktu@gmail.com> + + * server.el (server-start): Save also the Emacs pid in the server file. + +2006-11-07 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/reftex-cite.el (reftex-pop-to-bibtex-entry): Preserve + point when displaying a bibtex cross reference in the echo area. + +2006-11-06 Juanma Barranquero <lekktu@gmail.com> + + * international/mule.el (make-char): Fix typo in docstring. + (load-with-code-conversion, charsetp): Doc fixes. + + * international/ja-dic-cnv.el (skkdic-convert): + * cus-edit.el (hook): Fix typo in docstring. + +2006-11-06 Chong Yidong <cyd@stupidchicken.com> + + * cus-edit.el (custom-mode-map): Move defvar above code using it. + (custom-mode-link-map): New variable. + (custom-group-link, custom-manual): Use follow-link. + +2006-11-06 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> + + * textmodes/bibtex.el: Fix typo in name of author of bibtex.el, + "Mark Shapiro" -> "Marc Shapiro". Update his email address. + +2006-11-06 Richard Stallman <rms@gnu.org> + + * textmodes/flyspell.el (flyspell-correct-word-before-point): + New function broken out of flyspell-correct-word. + (flyspell-mode-map): Bind it to M-RET. + (flyspell-correct-word): Call it. + + * textmodes/fill.el (fill-minibuffer-function): New function. + (fill-paragraph): Bind fill-paragraph-function to + fill-minibuffer-function. + + * ruler-mode.el (ruler-mode-map): Add bindings for up-events + so that they aren't undefined. + + * dired.el (dired-readin): Locally bind file-name-coding-system. + + * bindings.el: Shorten and clarify usual mode line mouse help string. + + * Makefile.in (autoloads): Don't include `obsolete'. + +2006-11-06 Chong Yidong <cyd@stupidchicken.com> + + * printing.el (pr-alist-custom-set, pr-ps-utility-custom-set) + (pr-ps-name-custom-set, pr-txt-name-custom-set): Don't update the + Printing menu if it's not initialized. + (pr-menu-bind): Act on menu-bar-file-menu directly. + +2006-11-06 Juanma Barranquero <lekktu@gmail.com> + + * help.el (view-emacs-news): Fix typo in error message. + + * menu-bar.el (menu-bar-update-buffers): Fix typo in menu entry. + + * shadowfile.el (shadow-define-regexp-group) + (shadow-literal-groups, shadow-insert-var): Doc fixes. + (shadow-read-files): Fix typo in message. + (shadow-inhibit-overload, shadow-find, shadow-suffix) + (shadow-site-match, shadow-write-todo-file, shadow-insert-var) + (shadow-suffix, shadow-site-match, shadow-expand-file-name) + (shadow-file-match): Fix typos in docstrings. + + * terminal.el (terminal-emulator): Fix typo in message. + + * emacs-lisp/authors.el (authors-fixed-entries): Fix typo. + + * emacs-lisp/lselect.el (x-kill-primary-selection) + (x-delete-primary-selection, x-copy-primary-selection): + Fix typos in error messages. + + * emulation/edt-mapper.el: Fix typo in interactive message. + + * mail/emacsbug.el (report-emacs-bug): Fix typos in output message. + + * textmodes/ispell.el (ispell, ispell-local-dictionary-alist) + (ispell-help): Fix typos in docstrings. + (ispell-help): Fix typo in output message. + + * allout.el (allout-adjust-file-variable) + (allout-passphrase-verifier-string) + (allout-passphrase-hint-string) + (allout-toggle-current-subtree-encryption): + * apropos.el (apropos-synonyms): + * cus-edit.el (hook): + * emacs-lock.el (emacs-lock-from-exiting): + * follow.el (follow-avoid-tail-recenter-p): + * hexl.el (hexl-mode): + * mouse-copy.el (mouse-copy-work-around-drag-bug): + * mouse.el (mouse-set-font): + * resume.el (resume-emacs-args-file): + * rfn-eshadow.el (file-name-shadow-tty-properties): + * t-mouse.el (t-mouse-process, t-mouse-mode): + * emacs-lisp/cust-print.el (custom-print-install) + (custom-print-uninstall, custom-format): + * emacs-lisp/shadow.el (list-load-path-shadows): + * emulation/tpu-edt.el (tpu-help-text) + (tpu-save-all-buffers-kill-emacs, tpu-emacs-replace) + (tpu-reset-control-keys): + * emulation/vip.el (vip-emacs-local-map) + (vip-change-mode-to-emacs): + * emulation/viper.el (viper-mode, viper-set-hooks) + (viper-major-mode-modifier-list): + * emulation/viper-init.el (viper-emacs-state-cursor-color): + * emulation/viper-keym.el (viper-emacs-kbd-map) + (viper-toggle-key): + * mail/feedmail.el (feedmail-queue-reminder) + (feedmail-queue-reminder-alist, feedmail-confirm-outgoing) + (feedmail-confirm-outgoing-timeout, feedmail-nuke-bcc) + (feedmail-nuke-resent-bcc, feedmail-fill-to-cc-fill-column) + (feedmail-sender-line, feedmail-force-binary-write) + (feedmail-from-line, feedmail-deduce-envelope-from) + (feedmail-x-mailer-line, feedmail-message-id-generator) + (feedmail-date-generator, feedmail-fiddle-plex-user-list) + (feedmail-enable-spray, feedmail-spray-this-address) + (feedmail-spray-address-fiddle-plex-list, feedmail-enable-queue) + (feedmail-queue-runner-confirm-global) + (feedmail-ask-before-queue-prompt) + (feedmail-ask-before-queue-reprompt) + (feedmail-prompt-before-queue-standard-alist) + (feedmail-prompt-before-queue-user-alist) + (feedmail-prompt-before-queue-help-supplement) + (feedmail-queue-use-send-time-for-message-id) + (feedmail-queue-default-file-slug, feedmail-queue-fqm-suffix) + (feedmail-mail-send-hook-splitter, feedmail-mail-send-hook) + (feedmail-mail-send-hook-queued) + (feedmail-confirm-addresses-hook-example) + (feedmail-last-chance-hook, feedmail-before-fcc-hook) + (feedmail-queue-runner-mode-setter) + (feedmail-queue-alternative-mail-header-separator) + (feedmail-queue-runner-message-sender) + (feedmail-buffer-eating-function, feedmail-binmail-template) + (feedmail-run-the-queue-no-prompts) + (feedmail-run-the-queue-global-prompt) + (feedmail-queue-subject-slug-maker, feedmail-fiddle-header) + (feedmail-envelope-deducer, feedmail-fiddle-date) + (feedmail-default-message-id-generator) + (feedmail-fiddle-message-id, feedmail-fiddle-x-mailer) + (feedmail-fiddle-spray-address, feedmail-deduce-address-list): + * mail/vms-pmail.el (vms-pmail-save-and-exit, vms-pmail-abort) + (vms-pmail-setup): + * play/dunnet.el (dun-help): + * play/handwrite.el (handwrite): + * play/hanoi.el (hanoi-unix-64): + * progmodes/idlwave.el (idlwave-rescan-asynchronously): + * textmodes/enriched.el (fixed): + * textmodes/org.el (org-file-apps) + (org-emphasis-regexp-components, org-emphasis-alist): + * textmodes/texinfmt.el (batch-texinfo-format): + Fix typos in docstrings. + +2006-11-05 Juanma Barranquero <lekktu@gmail.com> + + * loadhist.el (read-feature): Don't complete features not loaded + from a file (which make `unload-feature' to fail). + +2006-11-05 Reiner Steib <Reiner.Steib@gmx.de> + + * add-log.el (add-log-time-zone-rule): Mark as safe-local-variable. + +2006-11-05 Chong Yidong <cyd@stupidchicken.com> + + * startup.el (command-line-1): Kill emacs if the last frame is + deleted while evaluating the command-line arguments. + +2006-11-05 Richard Stallman <rms@gnu.org> + + * startup.el (init-file-had-error): Add doc string. + (fancy-splash-text, fancy-splash-head, fancy-splash-tail): + Use fixed-width font for keyboard key descriptions. + + * cus-edit.el (custom-save-all): Error if saving in .emacs + and it had an error when loaded. + + * dired-aux.el (dired-copy-file-recursive): Catch errors + from recursive copies in the loop, around the recursive call. + +2006-11-05 Micha,Ak(Bl Cadilhac <michael.cadilhac@lrde.org> + + * battery.el (battery-linux-proc-acpi): Search an ac_adapter in + `/proc/acpi/ac_adapter/*'. Ditto for the thermometers in + `/proc/acpi/thermal_zone/*'. + (battery-search-for-one-match-in-files): New. Search a regexp in + the content of some files. + +2006-11-05 Martin Rudalics <rudalics@gmx.at> + + * window.el (mouse-autoselect-window-now): Remove variable. + (mouse-autoselect-window-state): New variable. + (mouse-autoselect-window-start, mouse-autoselect-window-cancel) + (mouse-autoselect-window-select, handle-select-window): + Rewritten to make mouse-autoselect-window-timer a one-shot timer. + Suspend delayed autoselection during menu or popup dialog. + + * info-look.el (info-lookup-guess-custom-symbol): New function + for retrieving symbol at point in custom buffers. + (top level) <info-lookup-maybe-add-help>: Add backquote and + comma to ignored characters in regexps of help specifications + for emacs-lisp-mode and lisp-interaction-mode. This permits + looking up symbols in `...' and after a comma. Add help + specifications for custom-mode and help-mode. + +2006-11-04 Eli Zaretskii <eliz@gnu.org> + + * mail/rmail.el (rmail-redecode-body): New optional argument RAW. + Don't encode body if RAW is non-nil, or if the old encoding is + identical to the new encoding, or if the body contains only + eight-bit-* characters. + +2006-11-04 Yoni Rabkin Katzenell <yoni-r@actcom.com> (tiny change) + + * faces.el (faces-sample-overlay, describe-face): Revert last + changes. + (faces-sample-overlay): Remove variable. + (describe-face): Insert sample text in the face being described. + +2006-11-04 Martin Rudalics <rudalics@gmx.at> + + * whitespace.el (whitespace-indent-regexp): Make this match any + multiples of eight spaces near the beginning of a line. + (whitespace-buffer): Use `remove-overlays' instead of + `whitespace-unhighlight-the-space' and `overlay-recenter' to + speed up overlay handling. + (whitespace-buffer-leading, whitespace-buffer-trailing): Make + these functions highlight the text removed by + `whitespace-buffer-leading-cleanup' and + `whitespace-buffer-trailing-cleanup' respectively. + (whitespace-buffer-search): Use `with-local-quit'. Move + `format' out of loop to speed up scanning larger buffers. + (whitespace-unhighlight-the-space): Remove `remove-hook' since + that function is never added to a hook. + (whitespace-spacetab-regexp, whitespace-ateol-regexp) + (whitespace-buffer-leading-cleanup) + (whitespace-refresh-rescan-list): Fix docstrings. + +2006-11-03 Ken Manheimer <ken.manheimer@gmail.com> + + * allout.el (allout-during-yank-processing): Cue for inhibiting + aberrance processing during yanks. + (allout-doublecheck-at-and-shallower): Reduce the limit to reduce + the amount of yanked topics that can be aberrant. + (allout-do-doublecheck): Encapsulate this multiply-used recipe in + a function, and supplement with inihibition of doublechecking + during yanks. + (allout-beginning-of-line, allout-next-heading) + (allout-previous-heading, allout-goto-prefix-doublechecked) + (allout-back-to-current-heading, allout-next-visible-heading) + (allout-next-sibling): Use new allout-do-doublecheck function. + (allout-next-sibling): Ensure we made progress when returning + other than nil. + (allout-rebullet-heading): Preserve text property annotations + indicating the text was hidden, if it was. + (allout-kill-line): Remove any added was-hidden annotations. + (allout-kill-topic): Remove any added was-hidden annotations. + (allout-annotate-hidden): Inhibit adding was-hidden text + properties to the undo list. + (allout-deannotate-hidden): New function to remove was-hidden + annotation. + (allout-hide-by-annotation): Use new allout-deannotate-hidden. + (allout-remove-exposure-annotation): Replaced by + allout-deannotate-hidden. + (allout-yank-processing): Signal that yank processing is happening + with allout-during-yank-processing. Also, wrap + allout-unprotected's closer to the text changes, for easier + debugging. We need to inhibit-field-text-motion explicitly, in + lieu of the encompassing allout-unprotected. + (outlineify-sticky): Adjust criteria for triggering new outline + decorations to presence or absence of any topics, not just a topic + at the beginning of the buffer. + +2006-11-03 Juanma Barranquero <lekktu@gmail.com> + + * bs.el (bs--show-all, bs--redisplay): + * cus-edit.el (custom-unlispify-menu-entries) + (custom-unlispify-tag-names, custom-prompt-variable): + * expand.el (expand-pos): + * speedbar.el (speedbar-generic-list-tag-p): + * wid-edit.el (widget-image-enable): + * emacs-lisp/checkdoc.el (checkdoc-rogue-space-check-engine): + * emacs-lisp/find-func.el (find-function-noselect) + (find-function, find-variable-noselect, find-variable) + (find-definition-noselect, find-face-definition): + * mail/rmail-spam-filter.el (rsf-scanning-messages-now): + * net/eudc-vars.el (eudc-expansion-overwrites-query): + * progmodes/ada-xref.el (ada-find-in-ali): + * textmodes/flyspell.el (flyspell-check-tex-math-command): + * textmodes/org.el (org-copy-subtree): + * textmodes/table.el (table--row-column-insertion-point-p): + Use "non-nil" in docstrings. + +2006-11-03 Mark Davies <mark@mcs.vuw.ac.nz> + + * sort.el (sort-columns): Set the field separator to tab; on + NetBSD, sort complains if "\n" is used as field separator. + +2006-11-03 NIIMI Satoshi <sa2c@sa2c.net> + + * emacs-lisp/pp.el (pp-eval-last-sexp): Evaluate target sexp. + +2006-11-02 Stefan Monnier <monnier@iro.umontreal.ca> + + * server.el (server-auth-key): Remove. Replace by a process-property. + (server-start): Don't remove the file of the previous process, but + instead clear out the place for the new file. + (server-start): Set the :auth-key property. + (server-process-filter): Use the :auth-key property. + +2006-11-02 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/org.el (org-mode-map): No longer copy + `outline-mode-map' explicitly - this is already done by + `define-derived-mode'. + +2006-11-02 Juanma Barranquero <lekktu@gmail.com> + + * server.el (server-visit-files): Use `when'. + (server-process-filter): When authentication fails, send error + message to client. Wrap `process-send-region' in `ignore-errors' + instead of `condition-case', and remove misleading comment. + +2006-11-01 Juri Linkov <juri@jurta.org> + + * simple.el (yank): Doc fix. + +2006-11-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * server.el: Try and fit within 80 columns. + (server-start): Make the auth file unreadable by other users. + +2006-10-31 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> + + * battery.el (battery-linux-proc-acpi): Prevent range error when + `full-capacity' is 0. + +2006-10-31 Yoni Rabkin Katzenell <yoni-r@actcom.com> (tiny change) + + * faces.el (faces-sample-overlay): New defvar. + (faces-sample-overlay): New function to show face sample text. + (describe-face): Use it. + +2006-10-31 Stephen Leake <stephen_leake@stephe-leake.org> + + * progmodes/ada-stmt.el: Change maintainer, apply + whitespace-cleanup, checkdoc. + (ada-func-or-proc-name): Add doc string. + + * progmodes/ada-prj.el (ada-prj-new): Change maintainer, apply + whitespace-cleanup, checkdoc. Minor improvements to many doc + strings and comments. + (ada-prj-display-page): Change buffer name to more accurately + reflect function. + + * progmodes/ada-xref.el: Change maintainer, apply + whitespace-cleanup, checkdoc. Minor improvements to many doc + strings and comments. Don't look for `gvd' or `ddd' debuggers. + (ada-compile-current): Don't add newlines to commands. + +2006-10-31 Juanma Barranquero <lekktu@gmail.com> + + * server.el: Add support for TCP sockets. + (server-use-tcp, server-host, server-auth-dir): New options. + (server-auth-key): New variable. + (server-ensure-safe-dir): Create nonexistent parent dirs. + Ignore Unix-style file modes on Windows. + (server-start): Crete a TCP or Unix socket according to the value + of `server-use-tcp'. For TCP sockets, create the id/auth file in + `server-auth-dir' directory. + (server-process-filter): Delete process if authentication + fails (which never happens for Unix sockets). + +2006-10-30 David Kastrup <dak@gnu.org> + + * subr.el (add-to-list): Don't continue checking if a match has + been found. + +2006-10-30 Chong Yidong <cyd@stupidchicken.com> + + * tutorial.el: Move defvars to avoid bytecomp warnings. + (tutorial--find-changed-keys): Check if viper-current-state is + bound before using it. + (help-with-tutorial): Check if viper-tutorial is defined before + using it. + +2006-10-30 Lennart Borgman <lennart.borgman.073@student.lu.se> + + * help-fns.el (help-with-tutorial): Moved to tutorial.el. + + * tutorial.el: New file. + (help-with-tutorial): Moved here from help-fns.el. Added help for + rebound keys. Fixed resume of tutorial. + (tutorial--describe-nonstandard-key, tutorial--sort-keys) + (tutorial--find-changed-keys, tutorial--display-changes) + (tutorial--saved-dir, tutorial--saved-file) + (tutorial--save-tutorial): New functions to support the changes in + help-with-tutorial. + +2006-10-30 Kenichi Handa <handa@m17n.org> + + * files.el (revert-buffer): If a unibyte buffer is being reverted + with a coding system for multibyte, set buffer multibyte before + calling insert-file-contents. + +2006-10-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * server.el (server-select-display): Use a dummy buffer to detect when + the frame is later used. + (server-select-display): New function. + (server-process-filter): Use it to detect unused temp frames. + +2006-10-29 Stephen Leake <stephen_leake@stephe-leake.org> * progmodes/ada-mode.el: Change maintainer, apply - whitespace-clean, checkdoc. Minor improvements to many doc - strings. + whitespace-clean, checkdoc. Minor improvements to many doc strings. (ada-mode-version): New function. (ada-create-menu): Menu operations are available for all supported compilers. 2006-10-29 Lars Hansen <larsh@soem.dk> - * net/tramp.el (with-parsed-tramp-file-name): Correct debug - spec. Highlight as keyword. + + * net/tramp.el (with-parsed-tramp-file-name): Correct debug spec. + Highlight as keyword. (tramp-do-copy-or-rename-file): Correct data for 'file-already-exists. Don't call tramp-method-out-of-band-p for local files. (tramp-touch): Quote file name. @@ -18,8 +442,7 @@ * calendar/calendar.el (cal-html-cursor-month) (cal-html-cursor-year): Add autoloads for this new package. - (calendar-mode-map): Bind cal-html-cursor-month, - cal-html-cursor-year. + (calendar-mode-map): Bind cal-html-cursor-month, cal-html-cursor-year. 2006-10-28 Anna Bigatti <bigatti@dima.unige.it> @@ -64,7 +487,7 @@ * midnight.el (midnight-buffer-display-time): Doc fix. (clean-buffer-list-kill-never-buffer-names): Add "*server*". -2006-10-22 martin rudalics <rudalics@gmx.at> +2006-10-22 Martin Rudalics <rudalics@gmx.at> * textmodes/flyspell.el (flyspell-check-region-doublons): Fix last fix. @@ -81,7 +504,7 @@ event to unread-command-events as (t . EVENT) so it will be added to this-command-keys by read-key-sequence. -2006-10-22 martin rudalics <rudalics@gmx.at> +2006-10-22 Martin Rudalics <rudalics@gmx.at> * textmodes/flyspell.el (flyspell-word): Skip past all previous whitespace when checking doublons. @@ -1205,7 +1628,7 @@ * select.el (xselect-convert-to-string): If UTF8_STRING is requested and the data doesn't look like UTF8, send STRING instead. -2006-09-16 Agustin Martin <agustin.martin@hispalinux.es> +2006-09-16 Agustin Martin <agustin.martin@hispalinux.es> * textmodes/flyspell.el (flyspell-check-region-doublons): New function to detect duplicated words. @@ -1271,8 +1694,8 @@ (allout-mode): Make allout-old-style-prefixes (ie, enabling use with outline.el outlines) functional again. Change the primary bullet along with the header-lead - level 1 new-style bullets now work. - Engage allout-before-change-handler in mainline emacs, not just - xemacs, to do undo handling. + Engage allout-before-change-handler in mainline Emacs, not just + XEmacs, to do undo handling. (allout-before-change-handler): Expose undo changes occurring in hidden regions. Use allout-get-invisibility-overlay instead of reimplementing it inline. @@ -1666,7 +2089,7 @@ * net/ldap.el (ldap-search-internal): Handle `auth' key. -2006-09-07 Magnus Henoch <mange@freemail.hu> +2006-09-07 Magnus Henoch <mange@freemail.hu> * net/rcirc.el (rcirc-activity-string): Don't quote value in case clause. @@ -12248,7 +12671,7 @@ Add fset of allout-real-isearch-abort during compile to fix byte-compilation warnings. (allout-mode-p): Move definition of this macro above all uses, or - byte compilation in barren emacs (eg, during emacs build) will + byte compilation in barren Emacs (eg, during Emacs build) will lack the definition. (allout-mode): Move this variable above any uses, or byte compilation will fail. @@ -13893,7 +14316,7 @@ 2005-11-02 Mark A. Hershberger <mah@everybody.org> - * xml.el (xml-syntax-table): Allow xml.el to compile in xemacs. + * xml.el (xml-syntax-table): Allow xml.el to compile in XEmacs. (xml-parse-tag): Join strings separated by a comment properly. 2005-11-02 Andreas Schwab <schwab@suse.de> @@ -18642,7 +19065,7 @@ 2005-07-21 Kim F. Storm <storm@cua.dk> * mail/emacsbug.el (report-emacs-bug): Request that backtraces are - included when reporting an emacs crash, and tell about the DEBUG file. + included when reporting an Emacs crash, and tell about the DEBUG file. * image-file.el (insert-image-file): Add yank-handler. (image-file-yank-handler): Yank handler to make unique copies of @@ -19597,7 +20020,7 @@ 2005-07-06 Richard M. Stallman <rms@gnu.org> * progmodes/flymake.el (flymake-float-time): Instead of - with-no-warnings, test for xemacs. + with-no-warnings, test for XEmacs. (flymake-replace-regexp-in-string): Test fboundp of replace-in-string to avoid warning. diff --git a/lisp/ChangeLog.3 b/lisp/ChangeLog.3 index 90604fc8e6f..af6d2f0c382 100644 --- a/lisp/ChangeLog.3 +++ b/lisp/ChangeLog.3 @@ -11829,7 +11829,7 @@ * dbx.el (run-dbx): Set dbx-process. (dbx-stop-at): Use that to decide where to send the string. -1989-02-13 Marc Shapiro (shapiro@sor.inria.fr) +1989-02-13 Marc Shapiro (marc.shapiro@acm.org) * bibtex.el (bibtex-clean-entry, bibtex-empty-field, bibtex-find-text, bibtex-kill-optional-field, bibtex-next-field, bibtex-pop-next, diff --git a/lisp/Makefile.in b/lisp/Makefile.in index d13dfe4c51e..ae7afb0ff1c 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -76,6 +76,8 @@ setwins=subdirs=`(cd $$wd; find . -type d -print)`; \ esac; \ done +# Find all subdirectories except `obsolete'. + setwins_almost=subdirs=`(cd $$wd; find . -type d -print)`; \ for file in $$subdirs; do \ case $$file in */Old | */RCS | */CVS | */CVS/* | */.* | */.*/* | */=* | */obsolete | */term ) ;; \ @@ -108,7 +110,7 @@ $(lisp)/loaddefs.el: echo ";; End:" >> $@ echo ";;; loaddefs.el ends here" >> $@ autoloads: $(lisp)/loaddefs.el doit - wd=$(lisp); $(setwins); \ + wd=$(lisp); $(setwins_almost); \ echo Directories: $$wins; \ LC_ALL=C $(EMACS) $(EMACSOPT) -l autoload --eval '(setq generated-autoload-file "$(lisp)/loaddefs.el")' -f batch-update-autoloads $$wins diff --git a/lisp/add-log.el b/lisp/add-log.el index d60f920244a..a1208d5fdd6 100644 --- a/lisp/add-log.el +++ b/lisp/add-log.el @@ -293,6 +293,8 @@ Note: The search is conducted only within 10%, at the beginning of the file." It takes the same format as the TZ argument of `set-time-zone-rule'. If nil, use local time. If t, use universal time.") +(put 'add-log-time-zone-rule 'safe-local-variable + '(lambda (x) (or (booleanp x) (stringp x)))) (defun add-log-iso8601-time-zone (&optional time) (let* ((utc-offset (or (car (current-time-zone time)) 0)) diff --git a/lisp/allout.el b/lisp/allout.el index b38d38d9e87..b7ae0f52749 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -66,7 +66,7 @@ ;; ;; The outline menubar additions provide quick reference to many of ;; the features, and see the docstring of the variable `allout-init' -;; for instructions on priming your emacs session for automatic +;; for instructions on priming your Emacs session for automatic ;; activation of allout-mode. ;; ;; See the docstring of the variables `allout-layout' and @@ -891,13 +891,18 @@ This is properly set by `set-allout-regexp'.") (make-variable-buffer-local 'allout-plain-bullets-string-len) ;;;_ = allout-doublecheck-at-and-shallower -(defconst allout-doublecheck-at-and-shallower 3 - "Verify apparent topics of this depth and shallower as being non-aberrant. +(defconst allout-doublecheck-at-and-shallower 2 + "Validate apparent topics of this depth and shallower as being non-aberrant. Verified with `allout-aberrant-container-p'. This check's usefulness is limited to shallow prospects, because the determination of aberrance depends on the mistaken item being followed by a legitimate item of -excessively greater depth.") +excessively greater depth. + +A level of 2 is safest, so that yanks, which must ignore +aberrance while rectifying the yanked text to their new location, +is least likely to be fooled by aberrant topics in the yanked +text.") ;;;_ X allout-reset-header-lead (header-lead) (defun allout-reset-header-lead (header-lead) "*Reset the leading string used to identify topic headers." @@ -1380,7 +1385,7 @@ are random binary characters to avoid exposing greater susceptibility to search attacks. The verifier string is retained as an Emacs file variable, as well as in -the emacs buffer state, if file variable adjustments are enabled. See +the Emacs buffer state, if file variable adjustments are enabled. See `allout-enable-file-variable-adjustment' for details about that.") (make-variable-buffer-local 'allout-passphrase-verifier-string) ;;;###autoload @@ -1392,7 +1397,7 @@ the emacs buffer state, if file variable adjustments are enabled. See See the description of `allout-passphrase-hint-handling' for details about how the reminder is deployed. -The hint is retained as an Emacs file variable, as well as in the emacs buffer +The hint is retained as an Emacs file variable, as well as in the Emacs buffer state, if file variable adjustments are enabled. See `allout-enable-file-variable-adjustment' for details about that.") (make-variable-buffer-local 'allout-passphrase-hint-string) @@ -1506,6 +1511,13 @@ and the place for the cursor after the decryption is done." (goto-char (cadr allout-after-save-decrypt)) (setq allout-after-save-decrypt nil)) ) +;;;_ = allout-during-yank-processing nil +;; XXX allout yanks adjust the level of the topic being pasted to that of +;; their target location. aberrance must be inhibited to allow that +;; reconciliation. (this means that actually aberrant topics won't be +;; treated specially while being pasted.) +(defvar allout-during-yank-processing nil + "Internal state, inhibits aberrance doublecheck while adjusting yanks.") ;;;_ #2 Mode activation ;;;_ = allout-explicitly-deactivated @@ -2194,27 +2206,16 @@ to return the current depth of the most recently matched topic." ;;;_ - Position Assessment ;;;_ : Location Predicates -;;;_ > allout-on-current-heading-p () -(defun allout-on-current-heading-p () - "Return non-nil if point is on current visible topics' header line. - -Actually, returns prefix beginning point." - (save-excursion - (allout-beginning-of-current-line) - (and (looking-at allout-regexp) - (allout-prefix-data) - (or (> allout-recent-depth allout-doublecheck-at-and-shallower) - (not (allout-aberrant-container-p)))))) -;;;_ > allout-on-heading-p () -(defalias 'allout-on-heading-p 'allout-on-current-heading-p) -;;;_ > allout-e-o-prefix-p () -(defun allout-e-o-prefix-p () - "True if point is located where current topic prefix ends, heading begins." - (and (save-excursion (let ((inhibit-field-text-motion t)) - (beginning-of-line)) - (looking-at allout-regexp)) - (= (point)(save-excursion (allout-end-of-prefix)(point))))) -;;;_ > allout-aberrant-container-p () +;;;_ > allout-do-doublecheck () +(defsubst allout-do-doublecheck () + "True if current item conditions qualify for checking on topic aberrance." + (and + ;; presume integrity of outline and yanked content during yank - necessary, + ;; to allow for level disparity of yank location and yanked text: + (not allout-during-yank-processing) + ;; allout-doublecheck-at-and-shallower is ceiling for doublecheck: + (<= allout-recent-depth allout-doublecheck-at-and-shallower))) +;;;_ > allout-aberrant-container-p () (defun allout-aberrant-container-p () "True if topic, or next sibling with children, contains them discontinuously. @@ -2247,7 +2248,7 @@ exceeds the topic by more than one." (goto-char allout-recent-prefix-beginning) (cond ;; sibling - continue: - ((eq allout-recent-depth depth)) + ((eq allout-recent-depth depth)) ;; first offspring is excessive - aberrant: ((> allout-recent-depth (1+ depth)) (setq done t aberrant t)) @@ -2259,6 +2260,26 @@ exceeds the topic by more than one." ;; recalibrate allout-recent-* (allout-depth) nil))) +;;;_ > allout-on-current-heading-p () +(defun allout-on-current-heading-p () + "Return non-nil if point is on current visible topics' header line. + +Actually, returns prefix beginning point." + (save-excursion + (allout-beginning-of-current-line) + (and (looking-at allout-regexp) + (allout-prefix-data) + (or (not (allout-do-doublecheck)) + (not (allout-aberrant-container-p)))))) +;;;_ > allout-on-heading-p () +(defalias 'allout-on-heading-p 'allout-on-current-heading-p) +;;;_ > allout-e-o-prefix-p () +(defun allout-e-o-prefix-p () + "True if point is located where current topic prefix ends, heading begins." + (and (save-excursion (let ((inhibit-field-text-motion t)) + (beginning-of-line)) + (looking-at allout-regexp)) + (= (point)(save-excursion (allout-end-of-prefix)(point))))) ;;;_ : Location attributes ;;;_ > allout-depth () (defun allout-depth () @@ -2390,8 +2411,7 @@ Outermost is first." (allout-depth) (let ((beginning-of-body (save-excursion - (while (and (<= allout-recent-depth - allout-doublecheck-at-and-shallower) + (while (and (allout-do-doublecheck) (allout-aberrant-container-p) (allout-previous-visible-heading 1))) (allout-beginning-of-current-entry) @@ -2443,7 +2463,7 @@ We skip anomolous low-level topics, a la `allout-aberrant-container-p'." (when (re-search-forward allout-line-boundary-regexp nil 0) (allout-prefix-data) - (and (<= allout-recent-depth allout-doublecheck-at-and-shallower) + (and (allout-do-doublecheck) ;; this will set allout-recent-* on the first non-aberrant topic, ;; whether it's the current one or one that disqualifies it: (allout-aberrant-container-p)) @@ -2464,13 +2484,13 @@ We skip anomolous low-level topics, a la `allout-aberrant-container-p'." (if (bobp) nil - ;; allout-goto-prefix-doublechecked calls us, so we can't use it here. (let ((start-point (point))) + ;; allout-goto-prefix-doublechecked calls us, so we can't use it here. (allout-goto-prefix) (when (or (re-search-backward allout-line-boundary-regexp nil 0) (looking-at allout-bob-regexp)) (goto-char (allout-prefix-data)) - (if (and (<= allout-recent-depth allout-doublecheck-at-and-shallower) + (if (and (allout-do-doublecheck) (allout-aberrant-container-p)) (or (allout-previous-heading) (and (goto-char start-point) @@ -2705,11 +2725,11 @@ Like `allout-goto-prefix', but shallow topics \(according to `allout-doublecheck-at-and-shallower') are checked and disqualified for child containment discontinuity, according to `allout-aberrant-container-p'." - (allout-goto-prefix) - (if (and (<= allout-recent-depth allout-doublecheck-at-and-shallower) - (allout-aberrant-container-p)) - (allout-previous-heading) - (point))) + (if (allout-goto-prefix) + (if (and (allout-do-doublecheck) + (allout-aberrant-container-p)) + (allout-previous-heading) + (point)))) ;;;_ > allout-end-of-prefix () (defun allout-end-of-prefix (&optional ignore-decorations) @@ -2745,13 +2765,13 @@ of (before any) topics, in which case we return nil." (allout-beginning-of-current-line) (let ((bol-point (point))) - (allout-goto-prefix-doublechecked) - (if (<= (point) bol-point) - (if (interactive-p) - (allout-end-of-prefix) - (point)) - (goto-char (point-min)) - nil))) + (if (allout-goto-prefix-doublechecked) + (if (<= (point) bol-point) + (if (interactive-p) + (allout-end-of-prefix) + (point)) + (goto-char (point-min)) + nil)))) ;;;_ > allout-back-to-heading () (defalias 'allout-back-to-heading 'allout-back-to-current-heading) ;;;_ > allout-pre-next-prefix () @@ -2918,6 +2938,7 @@ Return the start point of the new topic if successful, nil otherwise." nil (let ((target-depth (or depth (allout-depth))) (start-point (point)) + (start-prefix-beginning allout-recent-prefix-beginning) (count 0) leaping last-depth) @@ -2941,7 +2962,9 @@ Return the start point of the new topic if successful, nil otherwise." nil))) ((and (not (eobp)) (and (> (or last-depth (allout-depth)) 0) - (= allout-recent-depth target-depth))) + (= allout-recent-depth target-depth)) + (not (= start-prefix-beginning + allout-recent-prefix-beginning))) allout-recent-prefix-beginning) (t (goto-char start-point) @@ -3067,8 +3090,7 @@ Move to buffer limit in indicated direction if headings are exhausted." ;; not a header line, keep looking: t (allout-prefix-data) - (if (and (<= allout-recent-depth - allout-doublecheck-at-and-shallower) + (if (and (allout-do-doublecheck) (allout-aberrant-container-p)) ;; skip this aberrant prospective header line: t @@ -3480,7 +3502,7 @@ case.) If OFFER-RECENT-BULLET is true, offer to use the bullet of the prior sibling. -Runs +Runs Nuances: @@ -3828,6 +3850,7 @@ this function." (mb allout-recent-prefix-beginning) (me allout-recent-prefix-end) (current-bullet (buffer-substring-no-properties (- me 1) me)) + (has-annotation (get-text-property mb 'allout-was-hidden)) (new-prefix (allout-make-topic-prefix current-bullet nil new-depth @@ -3854,6 +3877,11 @@ this function." (allout-unprotected (delete-region (match-beginning 0)(match-end 0)))) + ;; convey 'allout-was-hidden annotation, if original had it: + (if has-annotation + (put-text-property 0 (length new-prefix) 'allout-was-hidden t + new-prefix)) + ; Put in new prefix: (allout-unprotected (insert new-prefix)) @@ -4183,10 +4211,11 @@ subtopics into siblings of the item." (depth (allout-depth))) (allout-annotate-hidden beg end) - (if (and (not beg-hidden) (not end-hidden)) (allout-unprotected (kill-line arg)) (kill-line arg)) + (allout-deannotate-hidden beg end) + (if allout-numbered-bullet (save-excursion ; Renumber subsequent topics if needed: (if (not (looking-at allout-regexp)) @@ -4218,6 +4247,7 @@ allout-yank-processing for exposure recovery." (interactive) (let* ((inhibit-field-text-motion t) (beg (prog1 (allout-back-to-current-heading) (beginning-of-line))) + end (depth allout-recent-depth)) (allout-end-of-current-subtree) (if (and (/= (current-column) 0) (not (eobp))) @@ -4231,9 +4261,13 @@ allout-yank-processing for exposure recovery." (string= (buffer-substring (- beg 2) beg) "\n\n")))) (forward-char 1))) - (allout-annotate-hidden beg (point)) + (allout-annotate-hidden beg (setq end (point))) + (unwind-protect + (allout-unprotected (kill-region beg end)) + (if buffer-read-only + ;; eg, during copy-as-kill. + (allout-deannotate-hidden beg end))) - (allout-unprotected (kill-region beg (point))) (save-excursion (allout-renumber-to-depth depth)) (run-hook-with-args 'allout-structure-deleted-hook depth (point)))) @@ -4251,8 +4285,7 @@ allout-yank-processing for exposure recovery." (let ((was-modified (buffer-modified-p)) (buffer-read-only nil)) - (allout-unprotected - (remove-text-properties begin end '(allout-was-hidden t))) + (allout-deannotate-hidden begin end) (save-excursion (goto-char begin) (let (done next prev overlay) @@ -4279,9 +4312,19 @@ allout-yank-processing for exposure recovery." (when next (goto-char next) (allout-unprotected - (put-text-property (overlay-start overlay) next - 'allout-was-hidden t)))))))) + (let ((buffer-undo-list t)) + (put-text-property (overlay-start overlay) next + 'allout-was-hidden t))))))))) (set-buffer-modified-p was-modified))) +;;;_ > allout-deannotate-hidden (begin end) +(defun allout-deannotate-hidden (begin end) + "Remove allout hidden-text annotation between BEGIN and END." + + (allout-unprotected + (let ((inhibit-read-only t) + (buffer-undo-list t)) + ;(remove-text-properties begin end '(allout-was-hidden t)) + ))) ;;;_ > allout-hide-by-annotation (begin end) (defun allout-hide-by-annotation (begin end) "Translate text properties indicating exposure status into actual exposure." @@ -4309,16 +4352,10 @@ allout-yank-processing for exposure recovery." nil end)) (overlay-put (make-overlay prev next) 'category 'allout-exposure-category) - (allout-unprotected - (remove-text-properties prev next '(allout-was-hidden t))) + (allout-deannotate-hidden prev next) (setq prev next) (if next (goto-char next))))) (set-buffer-modified-p was-modified)))) -;;;_ > allout-remove-exposure-annotation (begin end) -(defun allout-remove-exposure-annotation (begin end) - "Remove text properties indicating exposure status." - (remove-text-properties begin end '(allout-was-hidden t))) - ;;;_ > allout-yank-processing () (defun allout-yank-processing (&optional arg) @@ -4345,108 +4382,117 @@ however, are left exactly like normal, non-allout-specific yanks." ; region around subject: (if (< (allout-mark-marker t) (point)) (exchange-point-and-mark)) - (allout-unprotected - (let* ((subj-beg (point)) - (into-bol (bolp)) - (subj-end (allout-mark-marker t)) - ;; 'resituate' if yanking an entire topic into topic header: - (resituate (and (allout-e-o-prefix-p) - (looking-at allout-regexp) - (allout-prefix-data))) - ;; `rectify-numbering' if resituating (where several topics may - ;; be resituating) or yanking a topic into a topic slot (bol): - (rectify-numbering (or resituate - (and into-bol (looking-at allout-regexp))))) - (if resituate + (let* ( ;; inhibit aberrance doublecheck while reconciling disparate pastes: + (allout-during-yank-processing t) + (subj-beg (point)) + (into-bol (bolp)) + (subj-end (allout-mark-marker t)) + ;; 'resituate' if yanking an entire topic into topic header: + (resituate (and (allout-e-o-prefix-p) + (looking-at allout-regexp) + (allout-prefix-data))) + ;; `rectify-numbering' if resituating (where several topics may + ;; be resituating) or yanking a topic into a topic slot (bol): + (rectify-numbering (or resituate + (and into-bol (looking-at allout-regexp))))) + (if resituate ; The yanked stuff is a topic: - (let* ((prefix-len (- (match-end 1) subj-beg)) - (subj-depth allout-recent-depth) - (prefix-bullet (allout-recent-bullet)) - (adjust-to-depth - ;; Nil if adjustment unnecessary, otherwise depth to which - ;; adjustment should be made: - (save-excursion - (and (goto-char subj-end) - (eolp) - (goto-char subj-beg) - (and (looking-at allout-regexp) - (progn - (beginning-of-line) - (not (= (point) subj-beg))) - (looking-at allout-regexp) - (allout-prefix-data)) - allout-recent-depth))) - (more t)) - (setq rectify-numbering allout-numbered-bullet) - (if adjust-to-depth + (let* ((inhibit-field-text-motion t) + (prefix-len (if (not (match-end 1)) + 1 + (- (match-end 1) subj-beg))) + (subj-depth allout-recent-depth) + (prefix-bullet (allout-recent-bullet)) + (adjust-to-depth + ;; Nil if adjustment unnecessary, otherwise depth to which + ;; adjustment should be made: + (save-excursion + (and (goto-char subj-end) + (eolp) + (goto-char subj-beg) + (and (looking-at allout-regexp) + (progn + (beginning-of-line) + (not (= (point) subj-beg))) + (looking-at allout-regexp) + (allout-prefix-data)) + allout-recent-depth))) + (more t)) + (setq rectify-numbering allout-numbered-bullet) + (if adjust-to-depth ; Do the adjustment: - (progn - (save-restriction - (narrow-to-region subj-beg subj-end) + (progn + (save-restriction + (narrow-to-region subj-beg subj-end) ; Trim off excessive blank ; line at end, if any: - (goto-char (point-max)) - (if (looking-at "^$") - (allout-unprotected (delete-char -1))) + (goto-char (point-max)) + (if (looking-at "^$") + (allout-unprotected (delete-char -1))) ; Work backwards, with each ; shallowest level, ; successively excluding the ; last processed topic from ; the narrow region: - (while more - (allout-back-to-current-heading) + (while more + (allout-back-to-current-heading) ; go as high as we can in each bunch: - (while (allout-ascend)) - (save-excursion + (while (allout-ascend)) + (save-excursion + (allout-unprotected (allout-rebullet-topic-grunt (- adjust-to-depth - subj-depth)) - (allout-depth)) - (if (setq more (not (bobp))) - (progn (widen) - (forward-char -1) - (narrow-to-region subj-beg (point)))))) - ;; Preserve new bullet if it's a distinctive one, otherwise - ;; use old one: - (if (string-match (regexp-quote prefix-bullet) - allout-distinctive-bullets-string) + subj-depth))) + (allout-depth)) + (if (setq more (not (bobp))) + (progn (widen) + (forward-char -1) + (narrow-to-region subj-beg (point)))))) + ;; Preserve new bullet if it's a distinctive one, otherwise + ;; use old one: + (if (string-match (regexp-quote prefix-bullet) + allout-distinctive-bullets-string) ; Delete from bullet of old to ; before bullet of new: - (progn - (beginning-of-line) - (delete-region (point) subj-beg) - (set-marker (allout-mark-marker t) subj-end) - (goto-char subj-beg) - (allout-end-of-prefix)) + (progn + (beginning-of-line) + (allout-unprotected + (delete-region (point) subj-beg)) + (set-marker (allout-mark-marker t) subj-end) + (goto-char subj-beg) + (allout-end-of-prefix)) ; Delete base subj prefix, ; leaving old one: - (delete-region (point) (+ (point) - prefix-len - (- adjust-to-depth subj-depth))) + (allout-unprotected + (progn + (delete-region (point) (+ (point) + prefix-len + (- adjust-to-depth subj-depth))) ; and delete residual subj ; prefix digits and space: - (while (looking-at "[0-9]") (delete-char 1)) - (if (looking-at " ") (delete-char 1)))) - (exchange-point-and-mark)))) - (if rectify-numbering - (progn - (save-excursion + (while (looking-at "[0-9]") (delete-char 1)) + (if (looking-at " ") (delete-char 1)))))) + (exchange-point-and-mark)))) + (if rectify-numbering + (progn + (save-excursion ; Give some preliminary feedback: - (message "... reconciling numbers") + (message "... reconciling numbers") ; ... and renumber, in case necessary: - (goto-char subj-beg) - (if (allout-goto-prefix-doublechecked) + (goto-char subj-beg) + (if (allout-goto-prefix-doublechecked) + (allout-unprotected (allout-rebullet-heading nil ;;; solicit - (allout-depth) ;;; depth - nil ;;; number-control - nil ;;; index - t)) - (message "")))) - (if (or into-bol resituate) - (allout-hide-by-annotation (point) (allout-mark-marker t)) - (allout-remove-exposure-annotation (allout-mark-marker t) (point))) - (if (not resituate) - (exchange-point-and-mark)) - (run-hook-with-args 'allout-structure-added-hook subj-beg subj-end)))) + (allout-depth) ;;; depth + nil ;;; number-control + nil ;;; index + t))) + (message "")))) + (if (or into-bol resituate) + (allout-hide-by-annotation (point) (allout-mark-marker t)) + (allout-deannotate-hidden (allout-mark-marker t) (point))) + (if (not resituate) + (exchange-point-and-mark)) + (run-hook-with-args 'allout-structure-added-hook subj-beg subj-end))) ;;;_ > allout-yank (&optional arg) (defun allout-yank (&optional arg) "`allout-mode' yank, with depth and numbering adjustment of yanked topics. @@ -5671,7 +5717,7 @@ If allout customization var `allout-passphrase-verifier-handling' is non-nil, an entry for `allout-passphrase-verifier-string' and its value is added to an Emacs 'local variables' section at the end of the file, which is created if necessary. That setting is for retention of the passphrase -verifier across emacs sessions. +verifier across Emacs sessions. Similarly, `allout-passphrase-hint-string' stores a user-provided reminder about their passphrase, and `allout-passphrase-hint-handling' specifies @@ -6356,7 +6402,7 @@ setup for auto-startup." (save-excursion (goto-char (point-min)) - (if (looking-at allout-regexp) + (if (allout-goto-prefix) t (allout-open-topic 2) (insert (concat "Dummy outline topic header - see" @@ -6393,7 +6439,7 @@ Returns list `(beginning-point prefix-string suffix-string)'." ) ;;;_ > allout-adjust-file-variable (varname value) (defun allout-adjust-file-variable (varname value) - "Adjust the setting of an emacs file variable named VARNAME to VALUE. + "Adjust the setting of an Emacs file variable named VARNAME to VALUE. This activity is inhibited if either `enable-local-variables' `allout-enable-file-variable-adjustment' are nil. @@ -6404,7 +6450,7 @@ variables, itself, is created if not already present. When created, the section lines \(including the section line) exist as second-level topics in a top-level topic at the end of the file. -enable-local-variables must be true for any of this to happen." +`enable-local-variables' must be true for any of this to happen." (if (not (and enable-local-variables allout-enable-file-variable-adjustment)) nil diff --git a/lisp/apropos.el b/lisp/apropos.el index cbe571f8fec..0e243415141 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -171,7 +171,7 @@ If value is `verbose', the computed score is shown for each match." ("yank" "paste") ("region" "selection")) "List of synonyms known by apropos. -Each element is a list of words where the first word is the standard emacs +Each element is a list of words where the first word is the standard Emacs term, and the rest of the words are alternative terms.") diff --git a/lisp/battery.el b/lisp/battery.el index 50edc8dde8a..a4c72df0bbb 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -49,8 +49,8 @@ (file-directory-p "/proc/acpi/battery")) 'battery-linux-proc-acpi) ((and (eq system-type 'darwin) - (condition-case nil - (with-temp-buffer + (condition-case nil + (with-temp-buffer (and (eq (call-process "pmset" nil t nil "-g" "ps") 0) (> (buffer-size) 0))) (error nil))) @@ -355,45 +355,19 @@ The following %-sequences are provided: 60))) hours (/ minutes 60))) (list (cons ?c (or (and capacity (number-to-string capacity)) "N/A")) - (cons ?L (or (when (file-exists-p "/proc/acpi/ac_adapter/AC/state") - (with-temp-buffer - (insert-file-contents - "/proc/acpi/ac_adapter/AC/state") - (when (re-search-forward "state: +\\(.*\\)$" nil t) - (match-string 1)))) + (cons ?L (or (battery-search-for-one-match-in-files + (mapcar (lambda (e) (concat e "/state")) + (directory-files "/proc/acpi/ac_adapter/" + t "\\`[^.]")) + "state: +\\(.*\\)$" 1) + "N/A")) - (cons ?d (or (when (file-exists-p - "/proc/acpi/thermal_zone/THRM/temperature") - (with-temp-buffer - (insert-file-contents - "/proc/acpi/thermal_zone/THRM/temperature") - (when (re-search-forward - "temperature: +\\([0-9]+\\) C$" nil t) - (match-string 1)))) - (when (file-exists-p - "/proc/acpi/thermal_zone/THM/temperature") - (with-temp-buffer - (insert-file-contents - "/proc/acpi/thermal_zone/THM/temperature") - (when (re-search-forward - "temperature: +\\([0-9]+\\) C$" nil t) - (match-string 1)))) - (when (file-exists-p - "/proc/acpi/thermal_zone/THM0/temperature") - (with-temp-buffer - (insert-file-contents - "/proc/acpi/thermal_zone/THM0/temperature") - (when (re-search-forward - "temperature: +\\([0-9]+\\) C$" nil t) - (match-string 1)))) - (when (file-exists-p - "/proc/acpi/thermal_zone/THR2/temperature") - (with-temp-buffer - (insert-file-contents - "/proc/acpi/thermal_zone/THR2/temperature") - (when (re-search-forward - "temperature: +\\([0-9]+\\) C$" nil t) - (match-string 1)))) + (cons ?d (or (battery-search-for-one-match-in-files + (mapcar (lambda (e) (concat e "/temperature")) + (directory-files "/proc/acpi/thermal_zone/" + t "\\`[^.]")) + "temperature: +\\([0-9]+\\) C$" 1) + "N/A")) (cons ?r (or (and rate (concat (number-to-string rate) " " rate-type)) "N/A")) @@ -408,6 +382,7 @@ The following %-sequences are provided: (format "%d:%02d" hours (- minutes (* 60 hours)))) "N/A")) (cons ?p (or (and full-capacity capacity + (> full-capacity 0) (number-to-string (floor (/ capacity (/ (float full-capacity) 100))))) @@ -478,6 +453,17 @@ The following %-sequences are provided: (or (cdr (assoc char alist)) "")))) format t t)) +(defun battery-search-for-one-match-in-files (files regexp match-num) + "Search REGEXP in the content of the files listed in FILES. +If a match occured, return the parenthesized expression numbered by +MATCH-NUM in the match. Otherwise, return nil." + (with-temp-buffer + (catch 'found + (dolist (file files) + (and (ignore-errors (insert-file-contents file nil nil nil 'replace)) + (re-search-forward regexp nil t) + (throw 'found (match-string match-num))))))) + (provide 'battery) diff --git a/lisp/bindings.el b/lisp/bindings.el index 6daf3b0585d..40477d0310c 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -279,7 +279,7 @@ Keymap to display on minor modes.") ;; "\ ;; mouse-1: select window, mouse-2: delete others, mouse-3: delete, ;; drag-mouse-1: resize, C-mouse-2: split horizontally" - "mouse-1: select (drag to resize), mouse-2: delete others, mouse-3: delete this") + "mouse-1: select (drag to resize), mouse-2 = C-x 1, mouse-3 = C-x 0") (dashes (propertize "--" 'help-echo help-echo)) (standard-mode-line-format (list diff --git a/lisp/bs.el b/lisp/bs.el index f095a98dc00..047996d27c7 100644 --- a/lisp/bs.el +++ b/lisp/bs.el @@ -441,7 +441,7 @@ naming a sort behavior. Default is \"by nothing\" which means no sorting." (defvar bs--show-all nil "Flag whether showing all buffers regardless of current configuration. -Non nil means to show all buffers. Otherwise show buffers +Non-nil means to show all buffers. Otherwise show buffers defined by current configuration `bs-current-configuration'.") (defvar bs--window-config-coming-from nil @@ -583,7 +583,7 @@ a special function. SORT-DESCRIPTION is an element of `bs-sort-functions'." (defun bs--redisplay (&optional keep-line-p sort-description) "Redisplay whole Buffer Selection Menu. -If KEEP-LINE-P is non nil the point will stay on current line. +If KEEP-LINE-P is non-nil the point will stay on current line. SORT-DESCRIPTION is an element of `bs-sort-functions'" (let ((line (1+ (count-lines 1 (point))))) (bs-show-in-buffer (bs-buffer-list nil sort-description)) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index ab3f7ec2b92..af4cc43daec 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -466,6 +466,37 @@ :version "22.1" :prefix "mac-") +;;; Custom mode keymaps + +(defvar custom-mode-map + ;; This keymap should be dense, but a dense keymap would prevent inheriting + ;; "\r" bindings from the parent map. + ;; Actually, this misfeature of dense keymaps was fixed on 2001-11-26. + (let ((map (make-keymap))) + (set-keymap-parent map widget-keymap) + (define-key map [remap self-insert-command] 'Custom-no-edit) + (define-key map "\^m" 'Custom-newline) + (define-key map " " 'scroll-up) + (define-key map "\177" 'scroll-down) + (define-key map "\C-c\C-c" 'Custom-set) + (define-key map "\C-x\C-s" 'Custom-save) + (define-key map "q" 'Custom-buffer-done) + (define-key map "u" 'Custom-goto-parent) + (define-key map "n" 'widget-forward) + (define-key map "p" 'widget-backward) + map) + "Keymap for `custom-mode'.") + +(defvar custom-mode-link-map + (let ((map (make-keymap))) + (set-keymap-parent map custom-mode-map) + (define-key map [down-mouse-2] nil) + (define-key map [down-mouse-1] 'mouse-drag-region) + (define-key map [mouse-2] 'widget-move-and-invoke) + map) + "Local keymap for links in `custom-mode'.") + + ;;; Utilities. (defun custom-split-regexp-maybe (regexp) @@ -521,7 +552,7 @@ WIDGET is the widget to apply the filter entries of MENU on." "List of prefixes that should be ignored by `custom-unlispify'.") (defcustom custom-unlispify-menu-entries t - "Display menu entries as words instead of symbols if non nil." + "Display menu entries as words instead of symbols if non-nil." :group 'custom-menu :type 'boolean) @@ -568,7 +599,7 @@ WIDGET is the widget to apply the filter entries of MENU on." (buffer-string))))) (defcustom custom-unlispify-tag-names t - "Display tag names as words instead of symbols if non nil." + "Display tag names as words instead of symbols if non-nil." :group 'custom-buffer :type 'boolean) @@ -846,7 +877,7 @@ it were the arg to `interactive' (which see) to interactively read the value. If the variable has a `custom-type' property, it must be a widget and the `:prompt-value' property of that widget will be used for reading the value. -If optional COMMENT argument is non nil, also prompt for a comment and return +If optional COMMENT argument is non-nil, also prompt for a comment and return it as the third element in the list." (let* ((var (read-variable prompt-var)) (minibuffer-help-form '(describe-variable var)) @@ -1781,6 +1812,8 @@ item in another window.\n\n")) (define-widget 'custom-manual 'info-link "Link to the manual entry for this customization option." :help-echo "Read the manual entry for this option." + :keymap custom-mode-link-map + :follow-link 'mouse-face :button-face 'custom-link :mouse-face 'highlight :pressed-face 'highlight @@ -3631,7 +3664,7 @@ restoring it to the state of a face that has never been customized." ;;; The `hook' Widget. (define-widget 'hook 'list - "A emacs lisp hook" + "An Emacs Lisp hook." :value-to-internal (lambda (widget value) (if (and value (symbolp value)) (list value) @@ -3673,6 +3706,8 @@ restoring it to the state of a face that has never been customized." :mouse-face 'highlight :pressed-face 'highlight :help-echo "Create customization buffer for this group." + :keymap custom-mode-link-map + :follow-link 'mouse-face :action 'custom-group-link-action) (defun custom-group-link-action (widget &rest ignore) @@ -4149,6 +4184,8 @@ if only the first line of the docstring is shown.")) ;;;###autoload (defun custom-save-all () "Save all customizations in `custom-file'." + (when (and (null custom-file) init-file-had-error) + (error "Cannot save customizations; init file was not fully loaded")) (let* ((filename (custom-file)) (recentf-exclude (if recentf-mode (cons (concat "\\`" @@ -4267,7 +4304,7 @@ This function does not save the buffer." (eq (get symbol 'force-value) 'rogue)))) (comment (get symbol 'saved-variable-comment))) - ;; Check REQUESTS for validity. + ;; Check REQUESTS for validity. (dolist (request requests) (when (and (symbolp request) (not (featurep request))) (message "Unknown requested feature: %s" request) @@ -4449,25 +4486,6 @@ The format is suitable for use with `easy-menu-define'." ;;; The Custom Mode. -(defvar custom-mode-map - ;; This keymap should be dense, but a dense keymap would prevent inheriting - ;; "\r" bindings from the parent map. - ;; Actually, this misfeature of dense keymaps was fixed on 2001-11-26. - (let ((map (make-keymap))) - (set-keymap-parent map widget-keymap) - (define-key map [remap self-insert-command] 'Custom-no-edit) - (define-key map "\^m" 'Custom-newline) - (define-key map " " 'scroll-up) - (define-key map "\177" 'scroll-down) - (define-key map "\C-c\C-c" 'Custom-set) - (define-key map "\C-x\C-s" 'Custom-save) - (define-key map "q" 'Custom-buffer-done) - (define-key map "u" 'Custom-goto-parent) - (define-key map "n" 'widget-forward) - (define-key map "p" 'widget-backward) - map) - "Keymap for `custom-mode'.") - (defun Custom-no-edit (pos &optional event) "Invoke button at POS, or refuse to allow editing of Custom buffer." (interactive "@d") diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 769d98c9530..257332f4495 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1182,12 +1182,20 @@ Special value `always' suppresses confirmation." dired-create-files-failures) (setq files nil) (dired-log "Copying error for %s:\n%s\n" from err))))) - (while files - (dired-copy-file-recursive - (expand-file-name (car files) from) - (expand-file-name (car files) to) - ok-flag preserve-time nil recursive) - (pop files))) + (dolist (file files) + (let ((thisfrom (expand-file-name file from)) + (thisto (expand-file-name file to))) + ;; Catch errors copying within a directory, + ;; and report them through the dired log mechanism + ;; just as our caller will do for the top level files. + (condition-case err + (dired-copy-file-recursive + thisfrom thisto + ok-flag preserve-time nil recursive) + (file-error + (push (dired-make-relative thisfrom) + dired-create-files-failures) + (dired-log "Copying error for %s:\n%s\n" thisfrom err)))))) ;; Not a directory. (or top (dired-handle-overwrite to)) (condition-case err @@ -1198,11 +1206,7 @@ Special value `always' suppresses confirmation." (file-date-error (push (dired-make-relative from) dired-create-files-failures) - (dired-log "Can't set date on %s:\n%s\n" from err)) - (file-error - (push (dired-make-relative from) - dired-create-files-failures) - (dired-log "Copying error for %s:\n%s\n" from err)))))) + (dired-log "Can't set date on %s:\n%s\n" from err)))))) ;;;###autoload (defun dired-rename-file (file newname ok-if-already-exists) diff --git a/lisp/dired.el b/lisp/dired.el index 491ef261c11..5359b464579 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -791,6 +791,9 @@ wildcards, erases the buffer, and builds the subdir-alist anew (run-hooks 'dired-before-readin-hook) (if (consp buffer-undo-list) (setq buffer-undo-list nil)) + (make-local-variable 'file-name-coding-system) + (setq file-name-coding-system + (or coding-system-for-read file-name-coding-system)) (let (buffer-read-only ;; Don't make undo entries for readin. (buffer-undo-list t)) diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el index db8c3d5d21a..3862a0441f6 100644 --- a/lisp/emacs-lisp/authors.el +++ b/lisp/emacs-lisp/authors.el @@ -176,7 +176,7 @@ listed.") Changes to files in this list are not listed.") (defconst authors-fixed-entries - '(("Richard M. Stallman" :wrote "[The original GNU emacs and numerous files]") + '(("Richard M. Stallman" :wrote "[The original GNU Emacs and numerous files]") ("Joseph Arceneaux" :wrote "xrdb.c") ("Blitz Product Development Corporation" :wrote "ispell.el") ("Frank Bresz" :wrote "diff.el") diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 666b373ca53..0bacbf1c683 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -2155,7 +2155,7 @@ before using the Ispell engine on it." (defun checkdoc-rogue-space-check-engine (&optional start end interact) "Return a message list if there is a line with white space at the end. If `checkdoc-autofix-flag' permits, delete that whitespace instead. -If optional arguments START and END are non nil, bound the check to +If optional arguments START and END are non-nil, bound the check to this region. Optional argument INTERACT may permit the user to fix problems on the fly." (let ((p (point)) diff --git a/lisp/emacs-lisp/cust-print.el b/lisp/emacs-lisp/cust-print.el index 332ea81932e..f37a5348552 100644 --- a/lisp/emacs-lisp/cust-print.el +++ b/lisp/emacs-lisp/cust-print.el @@ -256,7 +256,7 @@ Any pair that has the same PREDICATE is first removed." (defun custom-print-install () "Replace print functions with general, customizable, Lisp versions. -The emacs subroutines are saved away, and you can reinstall them +The Emacs subroutines are saved away, and you can reinstall them by running `custom-print-uninstall'." (interactive) (mapcar 'cust-print-set-function-cell @@ -271,7 +271,7 @@ by running `custom-print-uninstall'." t) (defun custom-print-uninstall () - "Reset print functions to their emacs subroutines." + "Reset print functions to their Emacs subroutines." (interactive) (mapcar 'cust-print-set-function-cell '((prin1 cust-print-original-prin1) @@ -375,7 +375,7 @@ The argument used by %s must be a string or a symbol; the argument used by %d, %b, %o, %x or %c must be a number. This is the custom-print replacement for the standard `format'. It -calls the emacs `format' after first making strings for list, +calls the Emacs `format' after first making strings for list, vector, or symbol args. The format specification for such args should be `%s' in any case, so a string argument will also work. The string is generated with `custom-prin1-to-string', which quotes quotable diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 42c5d3183e7..10a052dc97e 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -264,7 +264,7 @@ not selected. If the function definition can't be found in the buffer, returns (BUFFER). If the file where FUNCTION is defined is not known, then it is -searched for in `find-function-source-path' if non nil, otherwise +searched for in `find-function-source-path' if non-nil, otherwise in `load-path'." (if (not function) (error "You didn't specify a function")) @@ -357,7 +357,7 @@ places point before the definition. Set mark before moving, if the buffer already existed. The library where FUNCTION is defined is searched for in -`find-function-source-path', if non nil, otherwise in `load-path'. +`find-function-source-path', if non-nil, otherwise in `load-path'. See also `find-function-recenter-line' and `find-function-after-hook'." (interactive (find-function-read)) (find-function-do-it function nil 'switch-to-buffer)) @@ -387,7 +387,7 @@ the point of the definition. The buffer is not selected. If the variable's definition can't be found in the buffer, return (BUFFER). The library where VARIABLE is defined is searched for in FILE or -`find-function-source-path', if non nil, otherwise in `load-path'." +`find-function-source-path', if non-nil, otherwise in `load-path'." (if (not variable) (error "You didn't specify a variable") (let ((library (or file @@ -406,7 +406,7 @@ places point before the definition. Set mark before moving, if the buffer already existed. The library where VARIABLE is defined is searched for in -`find-function-source-path', if non nil, otherwise in `load-path'. +`find-function-source-path', if non-nil, otherwise in `load-path'. See also `find-function-recenter-line' and `find-function-after-hook'." (interactive (find-function-read 'defvar)) (find-function-do-it variable 'defvar 'switch-to-buffer)) @@ -436,7 +436,7 @@ variable, `defface' for a face. This function does not switch to the buffer nor display it. The library where SYMBOL is defined is searched for in FILE or -`find-function-source-path', if non nil, otherwise in `load-path'." +`find-function-source-path', if non-nil, otherwise in `load-path'." (cond ((not symbol) (error "You didn't specify a symbol")) @@ -461,7 +461,7 @@ places point before the definition. Set mark before moving, if the buffer already existed. The library where FACE is defined is searched for in -`find-function-source-path', if non nil, otherwise in `load-path'. +`find-function-source-path', if non-nil, otherwise in `load-path'. See also `find-function-recenter-line' and `find-function-after-hook'." (interactive (find-function-read 'defface)) (find-function-do-it face 'defface 'switch-to-buffer)) diff --git a/lisp/emacs-lisp/lselect.el b/lisp/emacs-lisp/lselect.el index 1d40d2e8368..5aed4822818 100644 --- a/lisp/emacs-lisp/lselect.el +++ b/lisp/emacs-lisp/lselect.el @@ -191,7 +191,7 @@ secondary selection instead of the primary selection." "If there is a selection, delete the text it covers, and copy it to both the kill ring and the Clipboard." (interactive) - (or (x-selection-owner-p) (error "emacs does not own the primary selection")) + (or (x-selection-owner-p) (error "Emacs does not own the primary selection")) (setq last-command nil) (or primary-selection-extent (error "the primary selection is not an extent?")) @@ -205,7 +205,7 @@ both the kill ring and the Clipboard." "If there is a selection, delete the text it covers *without* copying it to the kill ring or the Clipboard." (interactive) - (or (x-selection-owner-p) (error "emacs does not own the primary selection")) + (or (x-selection-owner-p) (error "Emacs does not own the primary selection")) (setq last-command nil) (or primary-selection-extent (error "the primary selection is not an extent?")) @@ -219,7 +219,7 @@ the kill ring or the Clipboard." "If there is a selection, copy it to both the kill ring and the Clipboard." (interactive) (setq last-command nil) - (or (x-selection-owner-p) (error "emacs does not own the primary selection")) + (or (x-selection-owner-p) (error "Emacs does not own the primary selection")) (or primary-selection-extent (error "the primary selection is not an extent?")) (save-excursion diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index a9cb2abd741..77f8854e022 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -161,7 +161,7 @@ Ignores leading comment characters." (set-syntax-table stab) (if arg (insert (pp-to-string (eval exp))) - (pp-eval-expression exp)))) + (pp-eval-expression (eval exp))))) ;;; Test cases for quote ;; (pp-eval-expression ''(quote quote)) diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el index 5a2521ff7cb..7162aa822b7 100644 --- a/lisp/emacs-lisp/shadow.el +++ b/lisp/emacs-lisp/shadow.el @@ -184,17 +184,17 @@ 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. -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 -it. Later, XXX was updated and included in the emacs distribution. -Unless the emacs maintainer checks for this, the new version of XXX +XXX package was not distributed with versions of Emacs prior to +19.30. An Emacs maintainer 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\). +Emacs version\). This function performs these checks and flags all possible shadowings. Because a .el file may exist without a corresponding .elc diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el index 7a084adcb6b..615f2f44df3 100644 --- a/lisp/emacs-lock.el +++ b/lisp/emacs-lock.el @@ -38,7 +38,7 @@ ;;; Code: (defvar emacs-lock-from-exiting nil - "Whether emacs is locked to prevent exiting. See `check-emacs-lock'.") + "Whether Emacs is locked to prevent exiting. See `check-emacs-lock'.") (make-variable-buffer-local 'emacs-lock-from-exiting) (defvar emacs-lock-buffer-locked nil diff --git a/lisp/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el index 14838987d1d..cee60c6ec8e 100644 --- a/lisp/emulation/edt-mapper.el +++ b/lisp/emulation/edt-mapper.el @@ -202,7 +202,7 @@ Sometimes, edt-mapper will ignore a key you press, and just continue to prompt for the same key. This can happen when your window manager sucks - up the key and doesn't pass it on to emacs, or it could be an emacs bug. + up the key and doesn't pass it on to Emacs, or it could be an Emacs bug. Either way, there's nothing that edt-mapper can do about it. You must press RETURN, to skip the current key and continue. Later, you and/or your local system guru can try to figure out why the key is being ignored. diff --git a/lisp/emulation/tpu-edt.el b/lisp/emulation/tpu-edt.el index 878ac56ac8d..5d90728898a 100644 --- a/lisp/emulation/tpu-edt.el +++ b/lisp/emulation/tpu-edt.el @@ -432,7 +432,7 @@ CSI is DEC's name for the sequence <ESC>[.") (let ((map (make-keymap))) (define-key map "\e[" GOLD-CSI-map) ; GOLD-CSI map (define-key map "\eO" GOLD-SS3-map) ; GOLD-SS3 map - ;; + ;; (define-key map "\C-A" 'tpu-toggle-overwrite-mode) ; ^A (define-key map "\C-B" 'nil) ; ^B (define-key map "\C-C" 'nil) ; ^C @@ -557,7 +557,7 @@ GOLD is the ASCII 7-bit escape sequence <ESC>OP.") (defvar SS3-map (let ((map (make-sparse-keymap))) (define-key map "P" GOLD-map) ; GOLD map - ;; + ;; (define-key map "A" 'tpu-previous-line) ; up (define-key map "B" 'tpu-next-line) ; down (define-key map "C" 'tpu-forward-char) ; right @@ -1141,7 +1141,7 @@ This is useful for inserting control characters." R Toggle rectangular mode for remove and insert S Search and substitute - line mode REPLACE command - ^T Toggle control key bindings between TPU and emacs + ^T Toggle control key bindings between TPU and Emacs U Undo - undo the last edit W Write - save current buffer X Exit - save all modified buffers and exit @@ -1292,7 +1292,7 @@ kills modified buffers without asking." (kill-buffer (current-buffer))) (defun tpu-save-all-buffers-kill-emacs nil - "Save all buffers and exit emacs." + "Save all buffers and exit Emacs." (interactive) (let ((delete-old-versions t)) (save-buffers-kill-emacs t))) @@ -1852,8 +1852,8 @@ A negative argument means replace all occurrences of the search string." (message "Replaced %s occurrence%s." strings (if (not (= 1 strings)) "s" "")))) (defun tpu-emacs-replace (&optional dont-ask) - "A TPU-edt interface to the emacs replace functions. If TPU-edt is -currently in regular expression mode, the emacs regular expression + "A TPU-edt interface to the Emacs replace functions. If TPU-edt is +currently in regular expression mode, the Emacs regular expression replace functions are used. If an argument is supplied, replacements are performed without asking. Only works in forward direction." (interactive "P") @@ -2285,7 +2285,7 @@ Accepts a prefix argument for the number of tpu-pan-columns to scroll." (setq tpu-control-keys t)) (defun tpu-reset-control-keys (tpu-style) - "Set control keys to TPU or emacs style functions." + "Set control keys to TPU or Emacs style functions." (let* ((tpu (and tpu-style (not tpu-control-keys))) (emacs (and (not tpu-style) tpu-control-keys)) (doit (or tpu emacs))) diff --git a/lisp/emulation/vip.el b/lisp/emulation/vip.el index 227fe88b1a1..8b5109793c0 100644 --- a/lisp/emulation/vip.el +++ b/lisp/emulation/vip.el @@ -45,7 +45,7 @@ ;; external variables (defvar vip-emacs-local-map nil - "Local map used in emacs mode. (Buffer-specific.)") + "Local map used in Emacs mode. (Buffer-specific.)") (defvar vip-insert-local-map nil "Local map used in insert command mode. (Buffer-specific.)") @@ -447,7 +447,7 @@ Type `n' to quit this window for now.\n") (vip-change-mode 'insert-mode)) (defun vip-change-mode-to-emacs () - "Change mode to emacs mode." + "Change mode to Emacs mode." (interactive) (vip-change-mode 'emacs-mode)) diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index 465f6e5cfb8..bf85d282fed 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -438,7 +438,7 @@ delete the text being replaced, as in standard Vi." ;; confused in some cases. So, this var is nulled for now. ;; (defcustom viper-emacs-state-cursor-color "Magenta" (defcustom viper-emacs-state-cursor-color nil - "Cursor color when Viper is in emacs state." + "Cursor color when Viper is in Emacs state." :type 'string :group 'viper) (if (fboundp 'make-variable-frame-local) diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el index 6f9ade2f9e4..8eeb5b4f3fc 100644 --- a/lisp/emulation/viper-keym.el +++ b/lisp/emulation/viper-keym.el @@ -144,7 +144,7 @@ viper-insert-basic-map. Not recommended, except for novice users.") "Auxiliary map for global user-defined bindings in Emacs state.") (defvar viper-emacs-kbd-map (make-sparse-keymap) - "This keymap keeps Vi-style kbd macros for emacs mode.") + "This keymap keeps Vi-style kbd macros for Emacs mode.") (viper-deflocalvar viper-emacs-local-user-map (make-sparse-keymap) "Auxiliary map for local user-defined bindings in Emacs state.") @@ -160,10 +160,10 @@ viper-insert-basic-map. Not recommended, except for novice users.") ;; Some important keys used in viper (defcustom viper-toggle-key [(control ?z)] ; "\C-z" - "The key used to change states from emacs to Vi and back. + "The key used to change states from Emacs to Vi and back. In insert mode, this key also functions as Meta. -Enter as a sexp. Examples: \"\\C-z\", [(control ?z)]." +Enter as a sexp. Examples: \"\\C-z\", [(control ?z)]." :type 'sexp :group 'viper :set (lambda (symbol value) diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 82c070d5264..fd1a8aa92ea 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -359,7 +359,7 @@ user decide when to invoke Viper in a major mode." (defcustom viper-mode (cond (noninteractive nil) (t 'ask)) "To Viperize or not to Viperize. -If t, viperize emacs. If nil -- don't. If `ask', ask the user. +If t, viperize Emacs. If nil -- don't. If `ask', ask the user. This variable is used primatily when Viper is being loaded. Must be set in `~/.emacs' before Viper is loaded. @@ -502,10 +502,10 @@ unless it is coming up in a wrong Viper state." The list has the structure: ((mode viper-state keymap) (mode viper-state keymap) ...). If `mode' is on the list, the `kemap' will be made active (on the minor-mode-map-alist) in the specified viper state. -If you change this list, have to restart emacs for the change to take effect. -However, if you did the change through the customization widget, then emacs +If you change this list, have to restart Emacs for the change to take effect. +However, if you did the change through the customization widget, then Emacs needs to be restarted only if you deleted a triple mode-state-keymap from the -list. No need to restart emacs in case of insertion or modification of an +list. No need to restart Emacs in case of insertion or modification of an existing triple." :type '(repeat (list symbol @@ -891,7 +891,7 @@ It also can't undo some Viper settings." (eval-after-load "passwd" '(defadvice read-passwd-1 (before viper-passwd-ad activate) - "Switch to emacs state while reading password." + "Switch to Emacs state while reading password." (viper-change-state-to-emacs))) (defadvice self-insert-command (around viper-self-insert-ad activate) @@ -939,7 +939,7 @@ It also can't undo some Viper settings." (eval-after-load "rmailedit" '(defadvice rmail-cease-edit (after viper-rmail-advice activate) - "Switch to emacs state when done editing message." + "Switch to Emacs state when done editing message." (viper-change-state-to-emacs))) ;; In case RMAIL was loaded before Viper. (defadvice rmail-cease-edit (after viper-rmail-advice activate) @@ -1121,7 +1121,7 @@ It also can't undo some Viper settings." (save-window-excursion (with-output-to-temp-buffer " *viper-info*" (princ " -You have loaded Viper, and are about to Viperize your emacs! +You have loaded Viper, and are about to Viperize your Emacs! Viper is a Package for Emacs Rebels and a venomous VI PERil, diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index 72754aa1cd3..e885887f453 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,11 @@ +2006-11-06 Juanma Barranquero <lekktu@gmail.com> + + * erc-dcc.el (erc-dcc-send-file): Fix typo in error message. + + * erc.el (read-passwd): + * erc-autoaway.el (erc-autoaway-reestablish-idletimer): + * erc-truncate.el (truncate): Fix typo in docstring. + 2006-08-13 Romain Francoise <romain@orebokech.com> * erc-match.el (erc-log-matches-make-buffer): End `y-or-n-p' @@ -256,7 +264,7 @@ 2006-05-01 Edward O'Connor <ted@oconnor.cx> - * erc-goodies.el: (erc-handle-irc-url): New function, suitable as + * erc-goodies.el (erc-handle-irc-url): New function, suitable as a value for `url-irc-function'. 2006-04-18 Diane Murray <disumu@x3y2z1.net> @@ -360,14 +368,14 @@ 2006-02-12 Michael Olson <mwolson@gnu.org> - * erc-autoaway.el, erc-dcc.el, erc-ezbounce.el, erc-fill.el, - erc-goodies.el, erc-hecomplete.el, erc-ibuffer.el, erc-identd.el, - erc-imenu.el, erc-join.el, erc-lang.el, erc-list.el, erc-log.el, - erc-match.el, erc-menu.el, erc-netsplit.el, erc-networks.el, - erc-notify.el, erc-page.el, erc-pcomplete.el, erc-replace.el, - erc-ring.el, erc-services.el, erc-sound.el, erc-speedbar.el, - erc-spelling.el, erc-track.el, erc-truncate.el, erc-xdcc.el: Add - 2006 to copyright years, to comply with the changed guidelines. + * erc-autoaway.el, erc-dcc.el, erc-ezbounce.el, erc-fill.el + * erc-goodies.el, erc-hecomplete.el, erc-ibuffer.el, erc-identd.el + * erc-imenu.el, erc-join.el, erc-lang.el, erc-list.el, erc-log.el + * erc-match.el, erc-menu.el, erc-netsplit.el, erc-networks.el + * erc-notify.el, erc-page.el, erc-pcomplete.el, erc-replace.el + * erc-ring.el, erc-services.el, erc-sound.el, erc-speedbar.el + * erc-spelling.el, erc-track.el, erc-truncate.el, erc-xdcc.el: + Add 2006 to copyright years, to comply with the changed guidelines. 2006-02-11 Michael Olson <mwolson@gnu.org> @@ -528,7 +536,7 @@ 2006-01-29 Edward O'Connor <ted@oconnor.cx> - * erc-viper.el: Remove. Now that ERC is included in Emacs, these + * erc-viper.el: Remove. Now that ERC is included in Emacs, these work-arounds live in Viper itself. 2006-01-28 Michael Olson <mwolson@gnu.org> @@ -669,10 +677,10 @@ 2006-01-22 Johan Bockgård <bojohan@users.sourceforge.net> * erc-track.el: Use `(eval-when-compile (require 'cl))' (for - `case'). Doc fixes. + `case'). Doc fixes. (erc-find-parsed-property): Simplify. - (erc-track-get-active-buffer): Fix logic. Simplify. - (erc-track-switch-buffer): Remove unused variable `dir'. Simplify. + (erc-track-get-active-buffer): Fix logic. Simplify. + (erc-track-switch-buffer): Remove unused variable `dir'. Simplify. * erc-speak.el: Doc fixes. (erc-speak-region): `propertize' --> `erc-propertize'. diff --git a/lisp/erc/erc-autoaway.el b/lisp/erc/erc-autoaway.el index 4614bd70e27..3eff0015b4c 100644 --- a/lisp/erc/erc-autoaway.el +++ b/lisp/erc/erc-autoaway.el @@ -136,7 +136,7 @@ See `erc-auto-discard-away'." (eval-when-compile (defvar erc-autoaway-idle-seconds)) (defun erc-autoaway-reestablish-idletimer () - "Reestablish the emacs idletimer. + "Reestablish the Emacs idletimer. If `erc-autoaway-idle-method' is 'emacs, you must call this function each time you change `erc-autoaway-idle-seconds'." (interactive) diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 4b9172f06d7..098e9085d74 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -808,7 +808,7 @@ other client." (erc-ip-to-decimal (nth 0 contact)) (nth 1 contact) size))) - (error "`make-network-process' not supported by your emacs."))) + (error "`make-network-process' not supported by your Emacs"))) ;;; GET handling diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el index 7a1feaaedd2..76475ab8ee5 100644 --- a/lisp/erc/erc-truncate.el +++ b/lisp/erc/erc-truncate.el @@ -48,7 +48,7 @@ Used only when auto-truncation is enabled. (define-erc-module truncate nil "Truncate a query buffer if it gets too large. This prevents the query buffer from getting too large, which can -bring any grown emacs to its knees after a few days worth of +bring any grown Emacs to its knees after a few days worth of tracking heavy-traffic channels." ;;enable ((add-hook 'erc-insert-post-hook 'erc-truncate-buffer)) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 41d59576251..315c01c7348 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2002,7 +2002,7 @@ If no buffer matches, return nil." (if (not (fboundp 'read-passwd)) (defun read-passwd (prompt) - "Substitute for read-passwd in early emacsen" + "Substitute for `read-passwd' in early emacsen." (read-from-minibuffer prompt))) (defcustom erc-before-connect nil diff --git a/lisp/expand.el b/lisp/expand.el index 5d213128ad4..c67ed2cab77 100644 --- a/lisp/expand.el +++ b/lisp/expand.el @@ -296,7 +296,7 @@ If ARG is omitted, point is placed at the end of the expanded text." (defvar expand-list nil "Temporary variable used by the Expand package.") (defvar expand-pos nil - "If non nil, stores a vector containing markers to positions defined by the last expansion. + "If non-nil, stores a vector containing markers to positions defined by the last expansion. This variable is local to a buffer.") (make-variable-buffer-local 'expand-pos) diff --git a/lisp/faces.el b/lisp/faces.el index fd2788c240c..a7b93568f13 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1351,6 +1351,7 @@ If FRAME is omitted or nil, use the selected frame." (insert " undefined face.\n") (let ((customize-label "customize this face") file-name) + (insert (concat " (" (propertize "sample" 'font-lock-face f) ")")) (princ (concat " (" customize-label ")\n")) (insert "Documentation: " (or (face-documentation f) diff --git a/lisp/ffap.el b/lisp/ffap.el index bd0c213ba6e..686d761eb4d 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -4,7 +4,7 @@ ;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Michelangelo Grigni <mic@mathcs.emory.edu> -;; Maintainer: Rajesh Vaidheeswarran <rv@gnu.org> +;; Maintainer: FSF ;; Created: 29 Mar 1993 ;; Keywords: files, hypermedia, matching, mouse, convenience ;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/ diff --git a/lisp/files.el b/lisp/files.el index 4b746225f60..a78d798f38b 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4094,6 +4094,15 @@ non-nil, it is called instead of rereading visited file contents." (if auto-save-p 'auto-save-coding (or coding-system-for-read buffer-file-coding-system-explicit)))) + (if (and (not enable-multibyte-characters) + (not (memq (coding-system-base + coding-system-for-read) + '(no-conversion raw-text)))) + ;; As a coding system suitable for multibyte + ;; buffer is specified, make the current + ;; buffer multibyte. + (set-buffer-multibyte t)) + ;; This force after-insert-file-set-coding ;; (called from insert-file-contents) to set ;; buffer-file-coding-system to a proper value. diff --git a/lisp/follow.el b/lisp/follow.el index 27c37132f0a..c44b5156ec8 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -449,7 +449,7 @@ After that, changing the prefix key requires manipulating keymaps." (if follow-mode menu '(["Activate " follow-mode t])))) - + mainmap) "Minor mode keymap for Follow mode.") @@ -473,7 +473,7 @@ are \" Fw\", or simply \"\"." :group 'follow) (defvar follow-avoid-tail-recenter-p (not (featurep 'xemacs)) - "*When non-nil, patch emacs so that tail windows won't be recentered. + "*When non-nil, patch Emacs so that tail windows won't be recentered. A \"tail window\" is a window that displays only the end of the buffer. Normally it is practical for the user that empty diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index fd9de602fb0..77a8b32333b 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,7 +1,23 @@ +2006-11-03 Juanma Barranquero <lekktu@gmail.com> + + * gnus-diary.el (gnus-diary-delay-format-function): + * nndiary.el (nndiary-reminders): + * nnsoup.el (nnsoup-always-save): Use "non-nil" in docstrings. + +2006-11-01 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-art.el (article-hide-boring-headers): Fetch date from + gnus-original-article-buffer to avoid problems with localized date + strings. + +2006-10-30 Katsumi Yamaoka <yamaoka@jpl.org> + + * html2text.el (html2text-format-tags): Avoid infloop on open tags. + 2006-10-29 Reiner Steib <Reiner.Steib@gmx.de> - * mm-util.el (mm-codepage-iso-8859-list, mm-codepage-ibm-list): New - variables. + * mm-util.el (mm-codepage-iso-8859-list, mm-codepage-ibm-list): + New variables. (mm-setup-codepage-iso-8859, mm-setup-codepage-ibm): New functions. (mm-charset-synonym-alist): Move some entries to mm-codepage-iso-8859-list. @@ -610,7 +626,7 @@ (rfc2231-encode-string): Be sure to work on multibyte buffer at first, and after mm-encode-body, change the buffer to unibyte. -2006-03-21 Daniel Pittman <daniel@rimspace.net> +2006-03-21 Daniel Pittman <daniel@rimspace.net> * nnimap.el (nnimap-request-update-info-internal): Optimize. Don't `gnus-uncompress-range' to avoid excessive memory usage. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index ecee7ff6847..bc7f27c97c8 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1917,7 +1917,11 @@ always hide." 'string<)))) (gnus-article-hide-header "reply-to"))))) ((eq elem 'date) - (let ((date (message-fetch-field "date"))) + (let ((date (with-current-buffer gnus-original-article-buffer + ;; If date in `gnus-article-buffer' is localized + ;; (`gnus-treat-date-user-defined'), + ;; `days-between' might fail. + (message-fetch-field "date")))) (when (and date (< (days-between (current-time-string) date) 4)) diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el index e4834131aa7..bc2f096fd70 100644 --- a/lisp/gnus/gnus-diary.el +++ b/lisp/gnus/gnus-diary.el @@ -121,7 +121,7 @@ Please refer to `format-time-string' for information on possible values." (defcustom gnus-diary-delay-format-function 'gnus-diary-delay-format-english "*Function called to format a diary delay string. -It is passed two arguments. The first one is non nil if the delay is in +It is passed two arguments. The first one is non-nil if the delay is in the past. The second one is of the form ((NUM . UNIT) ...) where NUM is an integer and UNIT is one of 'year 'month 'week 'day 'hour or 'minute. It should return strings like \"In 2 months, 3 weeks\", \"3 hours, diff --git a/lisp/gnus/html2text.el b/lisp/gnus/html2text.el index 68934c909e9..08044225ab4 100644 --- a/lisp/gnus/html2text.el +++ b/lisp/gnus/html2text.el @@ -423,7 +423,9 @@ See the documentation for that variable." (p3) (p4)) (search-backward "<" (point-min) t) (setq p1 (point)) - (re-search-forward (format "</%s>" tag) (point-max) t) + (unless (search-forward (format "</%s>" tag) (point-max) t) + (goto-char p2) + (insert (format "</%s>" tag))) (setq p4 (point)) (search-backward "</" (point-min) t) (setq p3 (point)) diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index 0c83a2d5124..a569314d6d7 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -263,7 +263,7 @@ not 'century, sorry). NOTE: the units of measure actually express dates, not durations: if you use 'week, messages will pop up on Sundays at 00:00 (or Mondays if -`nndiary-week-starts-on-monday' is non nil) and *not* 7 days before the +`nndiary-week-starts-on-monday' is non-nil) and *not* 7 days before the appointement, if you use 'month, messages will pop up on the first day of each months, at 00:00 and so on. diff --git a/lisp/gnus/nnsoup.el b/lisp/gnus/nnsoup.el index 9dc429ec135..e520121a266 100644 --- a/lisp/gnus/nnsoup.el +++ b/lisp/gnus/nnsoup.el @@ -75,7 +75,7 @@ The SOUP packet file name will be inserted at the %s.") "*Regular expression matching SOUP packets in `nnsoup-packet-directory'.") (defvoo nnsoup-always-save t - "If non nil commit the reply buffer on each message send. + "If non-nil commit the reply buffer on each message send. This is necessary if using message mode outside Gnus with nnsoup as a backend for the messages.") diff --git a/lisp/help-fns.el b/lisp/help-fns.el index cddfa3611ed..8df079433f1 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -35,72 +35,6 @@ (require 'help-mode) - -;;;###autoload -(defun help-with-tutorial (&optional arg) - "Select the Emacs learn-by-doing tutorial. -If there is a tutorial version written in the language -of the selected language environment, that version is used. -If there's no tutorial in that language, `TUTORIAL' is selected. -With ARG, you are asked to choose which language." - (interactive "P") - (let ((lang (if arg - (let ((minibuffer-setup-hook minibuffer-setup-hook)) - (add-hook 'minibuffer-setup-hook - 'minibuffer-completion-help) - (read-language-name 'tutorial "Language: " "English")) - (if (get-language-info current-language-environment 'tutorial) - current-language-environment - "English"))) - file filename) - (setq filename (get-language-info lang 'tutorial)) - (setq file (expand-file-name (concat "~/" filename))) - (delete-other-windows) - (if (get-file-buffer file) - (switch-to-buffer (get-file-buffer file)) - (switch-to-buffer (create-file-buffer file)) - (setq buffer-file-name file) - (setq default-directory (expand-file-name "~/")) - (setq buffer-auto-save-file-name nil) - (insert-file-contents (expand-file-name filename data-directory)) - (hack-local-variables) - (goto-char (point-min)) - (search-forward "\n<<") - (beginning-of-line) - ;; Convert the <<...>> line to the proper [...] line, - ;; or just delete the <<...>> line if a [...] line follows. - (cond ((save-excursion - (forward-line 1) - (looking-at "\\[")) - (delete-region (point) (progn (forward-line 1) (point)))) - ((looking-at "<<Blank lines inserted.*>>") - (replace-match "[Middle of page left blank for didactic purposes. Text continues below]")) - (t - (looking-at "<<") - (replace-match "[") - (search-forward ">>") - (replace-match "]"))) - (beginning-of-line) - (let ((n (- (window-height (selected-window)) - (count-lines (point-min) (point)) - 6))) - (if (< n 8) - (progn - ;; For a short gap, we don't need the [...] line, - ;; so delete it. - (delete-region (point) (progn (end-of-line) (point))) - (newline n)) - ;; Some people get confused by the large gap. - (newline (/ n 2)) - - ;; Skip the [...] line (don't delete it). - (forward-line 1) - (newline (- n (/ n 2))))) - (goto-char (point-min)) - (setq buffer-undo-list nil) - (set-buffer-modified-p nil)))) - - ;; Functions ;;;###autoload diff --git a/lisp/help.el b/lisp/help.el index 34b1a2fac61..08899d61415 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -361,7 +361,7 @@ With argument, display info only for the selected version." ((<= version 18) (setq version (format "%d" version))) ((> version emacs-major-version) - (error "No news about emacs %d (yet)" version)))) + (error "No news about Emacs %d (yet)" version)))) (let* ((vn (if (stringp version) (string-to-number version) version)) diff --git a/lisp/hexl.el b/lisp/hexl.el index d753fc83017..47bfc76940c 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -169,7 +169,7 @@ A sample format: 000000b0: 7461 626c 6520 6368 6172 6163 7465 7220 table character 000000c0: 7265 6769 6f6e 2e0a region.. -Movement is as simple as movement in a normal emacs text buffer. Most +Movement is as simple as movement in a normal Emacs text buffer. Most cursor movement bindings are the same (ie. Use \\[hexl-backward-char], \\[hexl-forward-char], \\[hexl-next-line], and \\[hexl-previous-line] to move the cursor left, right, down, and up). diff --git a/lisp/info-look.el b/lisp/info-look.el index 2ac461aa669..3918eb00eee 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -250,10 +250,10 @@ system." ;;;###autoload (defun info-lookup-symbol (symbol &optional mode) "Display the definition of SYMBOL, as found in the relevant manual. -When this command is called interactively, it reads SYMBOL from the minibuffer. -In the minibuffer, use M-n to yank the default argument value -into the minibuffer so you can edit it. -The default symbol is the one found at point. +When this command is called interactively, it reads SYMBOL from the +minibuffer. In the minibuffer, use M-n to yank the default argument +value into the minibuffer so you can edit it. The default symbol is the +one found at point. With prefix arg a query for the symbol help mode is offered." (interactive @@ -566,6 +566,45 @@ Return nil if there is nothing appropriate in the buffer near point." (concat prefix name)))) (error nil))) +(defun info-lookup-guess-custom-symbol () + "Get symbol at point in custom buffers." + (condition-case nil + (save-excursion + (let ((case-fold-search t) + (ignored-chars "][()`',:.\" \t\n") + (significant-chars "^][()`',:.\" \t\n") + beg end) + (cond + ((and (memq (get-char-property (point) 'face) + '(custom-variable-tag custom-variable-tag-face)) + (setq beg (previous-single-char-property-change + (point) 'face nil (line-beginning-position))) + (setq end (next-single-char-property-change + (point) 'face nil (line-end-position))) + (> end beg)) + (subst-char-in-string + ?\ ?\- (buffer-substring-no-properties beg end))) + ((or (and (looking-at (concat "[" significant-chars "]")) + (save-excursion + (skip-chars-backward significant-chars) + (setq beg (point))) + (skip-chars-forward significant-chars) + (setq end (point)) + (> end beg)) + (and (looking-at "[ \t\n]") + (looking-back (concat "[" significant-chars "]")) + (setq end (point)) + (skip-chars-backward significant-chars) + (setq beg (point)) + (> end beg)) + (and (skip-chars-forward ignored-chars) + (setq beg (point)) + (skip-chars-forward significant-chars) + (setq end (point)) + (> end beg))) + (buffer-substring-no-properties beg end))))) + (error nil))) + ;;;###autoload (defun info-complete-symbol (&optional mode) "Perform completion on symbol preceding point." @@ -789,7 +828,7 @@ Return nil if there is nothing appropriate in the buffer near point." (info-lookup-maybe-add-help :mode 'emacs-lisp-mode - :regexp "[^][()'\" \t\n]+" + :regexp "[^][()`',\" \t\n]+" :doc-spec '(;; Commands with key sequences appear in nodes as `foo' and ;; those without as `M-x foo'. ("(emacs)Command Index" nil "`\\(M-x[ \t\n]+\\)?" "'") @@ -806,13 +845,13 @@ Return nil if there is nothing appropriate in the buffer near point." (info-lookup-maybe-add-help :mode 'lisp-interaction-mode - :regexp "[^][()'\" \t\n]+" + :regexp "[^][()`',\" \t\n]+" :parse-rule 'ignore :other-modes '(emacs-lisp-mode)) (info-lookup-maybe-add-help :mode 'lisp-mode - :regexp "[^()'\" \t\n]+" + :regexp "[^()`',\" \t\n]+" :parse-rule 'ignore :other-modes '(emacs-lisp-mode)) @@ -913,6 +952,18 @@ Return nil if there is nothing appropriate in the buffer near point." ;; This gets functions in evaluated classes. Other ;; possible patterns don't seem to work too well. "`" "("))) + +(info-lookup-maybe-add-help + :mode 'custom-mode + :ignore-case t + :regexp "[^][()`',:\" \t\n]+" + :parse-rule 'info-lookup-guess-custom-symbol + :other-modes '(emacs-lisp-mode)) + +(info-lookup-maybe-add-help + :mode 'help-mode + :regexp "[^][()`',:\" \t\n]+" + :other-modes '(emacs-lisp-mode)) (provide 'info-look) diff --git a/lisp/international/ja-dic-cnv.el b/lisp/international/ja-dic-cnv.el index 550fd6a4d43..0d3c5577fb9 100644 --- a/lisp/international/ja-dic-cnv.el +++ b/lisp/international/ja-dic-cnv.el @@ -345,7 +345,7 @@ (insert ")\n\n"))) (defun skkdic-convert (filename &optional dirname) - "Generate Emacs lisp file form Japanese dictionary file FILENAME. + "Generate Emacs Lisp file form Japanese dictionary file FILENAME. The format of the dictionary file should be the same as SKK dictionaries. Optional argument DIRNAME if specified is the directory name under which the generated Emacs Lisp is saved. diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 5f3aebc78db..c093e56fee5 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -296,10 +296,10 @@ attribute." (defun load-with-code-conversion (fullname file &optional noerror nomessage) "Execute a file of Lisp code named FILE whose absolute name is FULLNAME. The file contents are decoded before evaluation if necessary. -If optional second arg NOERROR is non-nil, +If optional third arg NOERROR is non-nil, report no error if FILE doesn't exist. Print messages at start and end of loading unless - optional third arg NOMESSAGE is non-nil. + optional fourth arg NOMESSAGE is non-nil. Return t if file exists." (if (null (file-readable-p fullname)) (and (null noerror) @@ -358,7 +358,7 @@ Return t if file exists." (kill-buffer buffer))) (unless purify-flag (do-after-load-evaluation fullname)) - + (unless (or nomessage noninteractive) (if source (message "Loading %s (source)...done" file) @@ -1665,8 +1665,7 @@ cons (CODING . SOURCE), where CODING is the specified coding system and SOURCE is a symbol `auto-coding-alist', `auto-coding-regexp-alist', `coding:', or `auto-coding-functions' indicating by what CODING is specified. Note that the validity -of CODING is not checked; it's callers responsibility to check -it. +of CODING is not checked; it's callers responsibility to check it. If nothing is specified, the return value is nil." (or (let ((coding-system (auto-coding-alist-lookup filename))) @@ -1687,7 +1686,7 @@ If nothing is specified, the return value is nil." ;; and for "unibyte:" at the head and tail of SIZE bytes. (setq head-found (or (search-forward "coding:" head-end t) (search-forward "unibyte:" head-end t) - (search-forward "enable-character-translation:" + (search-forward "enable-character-translation:" head-end t))) (if (and head-found (> head-found tail-start)) ;; Head and tail are overlapped. diff --git a/lisp/loadhist.el b/lisp/loadhist.el index 61f15c8ef1c..6683f8ae413 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el @@ -119,7 +119,9 @@ return the feature \(symbol\)." (mapcar (lambda (feature) (list (symbol-name feature))) features) - nil t))) + ;; Complete only features loaded from a file + #'(lambda (f) (feature-file (intern (car f)))) + t))) (defvaralias 'loadhist-hook-functions 'unload-feature-special-hooks) (defvar unload-feature-special-hooks diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index c58411c1e56..84a92e30b2c 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -126,7 +126,7 @@ usually do not have translators to read other languages for them.\n\n") (setq user-point (point)) (insert "\n\n") - (insert "If emacs crashed, and you have the emacs process in the gdb debugger,\n" + (insert "If Emacs crashed, and you have the Emacs process in the gdb debugger,\n" "please include the output from the following gdb commands:\n" " `bt full' and `xbacktrace'.\n") diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index 04928fb537b..3180b05c818 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -330,11 +330,11 @@ This is done after the message is completely prepped, and you'll be looking at the top of the message in a buffer when you get the prompt. If set to the symbol 'queued, give the confirmation prompt only while running the queue (however, the prompt is always suppressed if you are -processing the queue via feedmail-run-the-queue-no-prompts). If set +processing the queue via `feedmail-run-the-queue-no-prompts'). If set to the symbol 'immediate, give the confirmation prompt only when sending immediately. For any other non-nil value, prompt in both cases. You can give a timeout for the prompt; see variable -feedmail-confirm-outgoing-timeout." +`feedmail-confirm-outgoing-timeout'." :group 'feedmail-misc :type 'boolean ) @@ -344,7 +344,7 @@ feedmail-confirm-outgoing-timeout." "*If non-nil, a timeout in seconds at the send confirmation prompt. If a positive number, it's a timeout before sending. If a negative number, it's a timeout before not sending. This will not work if your -version of Emacs doesn't include the function y-or-n-p-with-timeout +version of Emacs doesn't include the function `y-or-n-p-with-timeout' \(e.g., some versions of XEmacs\)." :group 'feedmail-misc :type '(choice (const nil) integer) @@ -355,7 +355,7 @@ version of Emacs doesn't include the function y-or-n-p-with-timeout "*If non-nil remove Bcc: lines from the message headers. In any case, the Bcc: lines do participate in the composed address list. You may want to leave them in if you're using sendmail -\(see feedmail-buffer-eating-function\)." +\(see `feedmail-buffer-eating-function'\)." :group 'feedmail-headers :type 'boolean ) @@ -365,7 +365,7 @@ list. You may want to leave them in if you're using sendmail "*If non-nil remove Resent-Bcc: lines from the message headers. In any case, the Resent-Bcc: lines do participate in the composed address list. You may want to leave them in if you're using sendmail -\(see feedmail-buffer-eating-function\)." +\(see `feedmail-buffer-eating-function'\)." :group 'feedmail-headers :type 'boolean ) @@ -410,7 +410,7 @@ as-is. The filling is done after mail address alias expansion." (defcustom feedmail-fill-to-cc-fill-column default-fill-column - "*Fill column used by feedmail-fill-to-cc." + "*Fill column used by `feedmail-fill-to-cc'." :group 'feedmail-headers :type 'integer ) @@ -481,7 +481,7 @@ another function, but let's not be ridiculous). If a string, it should be just the contents of the header, not the name of the header itself nor the trailing newline. If a function, it will be called with no arguments. For an explanation of fiddle-plexes, see the -documentation for the variable feedmail-fiddle-plex-blurb. In all +documentation for the variable `feedmail-fiddle-plex-blurb'. In all cases the name element of the fiddle-plex is ignored and is hardwired by feedmail to either \"X-Sender\" or \"X-Resent-Sender\". @@ -498,7 +498,7 @@ header is fiddled after the From: header is fiddled." "*If non-nil, force writing file as binary (this applies to queues and Fcc:). On systems where there is a difference between binary and text files, feedmail will temporarily manipulate the values of `buffer-file-type' -and/or default-buffer-file-type to make the writing as binary. If +and/or `default-buffer-file-type' to make the writing as binary. If nil, writing will be in text mode. On systems where there is no distinction or where it is controlled by other variables or other means, this option has no effect." @@ -521,7 +521,7 @@ another function, but let's not be ridiculous). If a string, it should be just the contents of the header, not the name of the header itself nor the trailing newline. If a function, it will be called with no arguments. For an explanation of fiddle-plexes, see the -documentation for the variable feedmail-fiddle-plex-blurb. In all +documentation for the variable `feedmail-fiddle-plex-blurb'. In all cases the name element of the fiddle-plex is ignored and is hardwired by feedmail to either \"X-From\" or \"X-Resent-From\". @@ -544,7 +544,7 @@ change the value of `user-mail-address' to be the same while the message is being sent. If there is no Sender: header, use the From: header, if any. Address values are taken from the actual message just before it is sent, and the process is independent of the values of -feedmail-from-line and/or feedmail-sender-line. +`feedmail-from-line' and/or `feedmail-sender-line'. There are many and good reasons for having the message header From:/Sender: be different from the message envelope \"from\" @@ -595,7 +595,7 @@ another function, but let's not be ridiculous). If a string, it should be just the contents of the header, not the name of the header itself nor the trailing newline. If a function, it will be called with no arguments. For an explanation of fiddle-plexes, see the -documentation for the variable feedmail-fiddle-plex-blurb. In all +documentation for the variable `feedmail-fiddle-plex-blurb'. In all cases the name element of the fiddle-plex is ignored and is hardwired by feedmail to either \"X-Mailer\" or \"X-Resent-Mailer\"." :group 'feedmail-headers @@ -619,7 +619,7 @@ should be just the contents of the header, not the name of the header itself nor the trailing newline. If a function, it will be called with one argument: the possibly-nil name of the file associated with the message buffer. For an explanation of fiddle-plexes, see the -documentation for the variable feedmail-fiddle-plex-blurb. In all +documentation for the variable `feedmail-fiddle-plex-blurb'. In all cases the name element of the fiddle-plex is ignored and is hardwired by feedmail to either \"Message-Id\" or \"Resent-Message-Id\". @@ -655,7 +655,7 @@ If nil, nothing is done about Date:. If t, a Date: header of a predetermined format is produced, but only if there is not already a Date: in the message. A value of t is -equivalent to using the function feedmail-default-date-generator. +equivalent to using the function `feedmail-default-date-generator'. If neither nil nor t, it may be a string, a fiddle-plex, or a function which returns either nil, t, a string, or a fiddle-plex (or, in fact, @@ -664,7 +664,7 @@ should be just the contents of the header, not the name of the header itself nor the trailing newline. If a function, it will be called with one argument: the possibly-nil name of the file associated with the message buffer. For an explanation of fiddle-plexes, see the -documentation for the variable feedmail-fiddle-plex-blurb. In all +documentation for the variable `feedmail-fiddle-plex-blurb'. In all cases the name element of the fiddle-plex is ignored and is hardwired by feedmail to either \"Date\" or \"Resent-Date\". @@ -700,10 +700,10 @@ fiddle-plex. feedmail will use this list of fiddle-plexes to manipulate user-specified message header fields. It does this after it has completed all normal -message header field manipulation and before calling feedmail-last-chance-hook. +message header field manipulation and before calling `feedmail-last-chance-hook'. For an explanation of fiddle-plexes, see the documentation for the -variable feedmail-fiddle-plex-blurb. In contrast to some other fiddle-plex +variable `feedmail-fiddle-plex-blurb'. In contrast to some other fiddle-plex manipulation functions, in this context, it makes no sense to have an element which is nil, t, or a simple string." :group 'feedmail-headers @@ -727,7 +727,7 @@ it, you should avoid it since it is inherently less efficient than normal multiple delivery. One reason to use it is to overcome mis-featured mail transports which betray your trust by revealing Bcc: addressees in the headers of a message. Another use is to do a crude form of mailmerge, for -which see feedmail-spray-address-fiddle-plex-list. +which see `feedmail-spray-address-fiddle-plex-list'. If one of the calls to the buffer-eating function results in an error, what happens next is carelessly defined, so beware." @@ -736,12 +736,12 @@ what happens next is carelessly defined, so beware." ) (defvar feedmail-spray-this-address nil - "Do not set or change this variable. See feedmail-spray-address-fiddle-plex-list.") + "Do not set or change this variable. See `feedmail-spray-address-fiddle-plex-list'.") (defcustom feedmail-spray-address-fiddle-plex-list nil "User-supplied specification for a crude form of mailmerge capability. When spraying is enabled, feedmail composes a list of envelope addresses. -In turn, feedmail-spray-this-address is temporarily set to each address +In turn, `feedmail-spray-this-address' is temporarily set to each address \(stripped of any comments and angle brackets\) and calls a function which fiddles message headers according to this variable. See the documentation for `feedmail-fiddle-plex-blurb', for an overview of fiddle-plex data structures. @@ -772,15 +772,15 @@ For example, The idea of the example is that, during spray mode, as each message is about to be transmitted to an individual address, the function will be -called and will consult feedmail-spray-this-address to find the +called and will consult `feedmail-spray-this-address' to find the stripped envelope email address (no comments or angle brackets). The function should return an embellished form of the address. The recipe for sending form letters is: (1) create a message with all addressees on Bcc: headers; (2) tell feedmail to remove Bcc: headers before sending the message; (3) create a function which will embellish -stripped addresses, if desired; (4) define feedmail-spray-address-fiddle-plex-list -appropriately; (5) send the message with feedmail-enable-spray set +stripped addresses, if desired; (4) define `feedmail-spray-address-fiddle-plex-list' +appropriately; (5) send the message with `feedmail-enable-spray' set non-nil; (6) stand back and watch co-workers wonder at how efficient you are at accomplishing inherently inefficient things." :group 'feedmail-spray @@ -809,7 +809,7 @@ versa by pretending to send it and then selecting whichever queue directory you want at the prompt. The right thing will happen. To transmit all the messages in the queue, invoke the command -feedmail-run-the-queue or feedmail-run-the-queue-no-prompts." +`feedmail-run-the-queue' or `feedmail-run-the-queue-no-prompts'." :group 'feedmail-queue :type 'boolean ) @@ -818,7 +818,7 @@ feedmail-run-the-queue or feedmail-run-the-queue-no-prompts." (defcustom feedmail-queue-runner-confirm-global nil "*If non-nil, give a y-or-n confirmation prompt before running the queue. Prompt even if the queue is about to be processed as a result of a call to -feedmail-run-the-queue-no-prompts. This gives you a way to bail out +`feedmail-run-the-queue-no-prompts'. This gives you a way to bail out without having to answer no to the individual message prompts." :group 'feedmail-queue :type 'boolean) @@ -868,7 +868,7 @@ without a prompt." (defcustom feedmail-ask-before-queue-prompt "FQM: Message action (q, i, d, e, ?)? [%s]: " "*A string which will be used for the message action prompt. If it contains a \"%s\", that will be replaced with the value of -feedmail-ask-before-queue-default." +`feedmail-ask-before-queue-default'." :group 'feedmail-queue :type 'string ) @@ -877,7 +877,7 @@ feedmail-ask-before-queue-default." (defcustom feedmail-ask-before-queue-reprompt "FQM: Please type q, i, d, or e; or ? for help [%s]: " "*A string which will be used for repompting after invalid input. If it contains a \"%s\", that will be replaced with the value of -feedmail-ask-before-queue-default." +`feedmail-ask-before-queue-default'." :group 'feedmail-queue :type 'string ) @@ -921,7 +921,7 @@ the help for the message action prompt." All of the values are function names, except help, which is a special symbol that calls up help for the prompt (the help describes the actions from the standard alist). To customize your own choices, -define a similar alist called feedmail-prompt-before-queue-user-alist. +define a similar alist called `feedmail-prompt-before-queue-user-alist'. The actual alist used for message action will be the standard alist overlaid with the user-alist. To neutralize an item in the standard alist without providing a replacement, define an appropriate element @@ -929,7 +929,7 @@ in the user alist with a value of nil." ) (defcustom feedmail-prompt-before-queue-user-alist nil - "See feedmail-prompt-before-queue-standard-alist." + "See `feedmail-prompt-before-queue-standard-alist'." :group 'feedmail-queue :type '(repeat (cons character function)) ) @@ -940,10 +940,10 @@ in the user alist with a value of nil." ) When the message action prompt is shown, the user can as for verbose help, at which point a buffer pops up describing the meaning of possible responses to the prompt. Through various customizations (see, for -example, feedmail-prompt-before-queue-user-alist), the available responses +example, `feedmail-prompt-before-queue-user-alist'), the available responses and the prompt itself can be changed. If this variable is set to a string value, that string is written to the help buffer after the standard info. -It may contain embedded line breaks. It will be printed via princ." +It may contain embedded line breaks. It will be printed via `princ'." :group 'feedmail-queue :type '(choice (const nil) string) ) @@ -955,7 +955,7 @@ It may contain embedded line breaks. It will be printed via princ." (after-draft . feedmail-queue-reminder-medium) (after-run . feedmail-queue-reminder-brief) (on-demand . feedmail-run-the-queue-global-prompt)) - "See feedmail-queue-reminder." + "See `feedmail-queue-reminder'." :group 'feedmail-queue :type '(repeat (cons (choice :tag "Event" (const on-demand) @@ -1017,7 +1017,7 @@ used." (defcustom feedmail-queue-use-send-time-for-message-id nil "*If non-nil, use send time for the Message-Id: header value. This variable is used by the default Message-Id: generating function, -feedmail-default-message-id-generator. If nil, the default, the +`feedmail-default-message-id-generator'. If nil, the default, the last-modified timestamp of the queue file is used to create the message Message-Id: header; if there is no queue file, the current time is used." @@ -1061,7 +1061,7 @@ any." When feedmail queues a message, it creates a unique file name. By default, the file name is based in part on the subject of the message being queued. If there is no subject, consult this variable. See documentation for the -function feedmail-queue-subject-slug-maker. +function `feedmail-queue-subject-slug-maker'. If t, an innocuous default is used. @@ -1083,8 +1083,8 @@ it's not expected to be a complete filename." "*The FQM suffix used to distinguish feedmail queued message files. You probably want this to be a period followed by some letters and/or digits. The distinction is to be able to tell them from other random -files that happen to be in the feedmail-queue-directory or -feedmail-queue-draft-directory. By the way, FQM stands for feedmail +files that happen to be in the `feedmail-queue-directory' or +`feedmail-queue-draft-directory'. By the way, FQM stands for feedmail queued message." :group 'feedmail-queue :type 'string @@ -1133,20 +1133,20 @@ variable, but may depend on its value as described here.") (defun feedmail-mail-send-hook-splitter () - "Facilitate dividing mail-send-hook things into queued and immediate cases. -If you have mail-send-hook functions that should only be called for sending/ + "Facilitate dividing `mail-send-hook' things into queued and immediate cases. +If you have `mail-send-hook' functions that should only be called for sending/ queueing messages or only be called for the sending of queued messages, this is -for you. Add this function to mail-send-hook with something like this: +for you. Add this function to `mail-send-hook' with something like this: (add-hook 'mail-send-hook 'feedmail-mail-send-hook-splitter) -Then add the functions you want called to either feedmail-mail-send-hook-queued -or feedmail-mail-send-hook, as apprpriate. The distinction is that -feedmail-mail-send-hook will be called when you send mail from a composition +Then add the functions you want called to either `feedmail-mail-send-hook-queued' +or `feedmail-mail-send-hook', as apprpriate. The distinction is that +`feedmail-mail-send-hook' will be called when you send mail from a composition buffer (typically by typing C-c C-c), whether the message is sent immediately -or placed in the queue or drafts directory. feedmail-mail-send-hook-queued is +or placed in the queue or drafts directory. `feedmail-mail-send-hook-queued' is called when messages are being sent from the queue directory, typically via a -call to feedmail-run-the-queue." +call to `feedmail-run-the-queue'." (if feedmail-queue-runner-is-active (run-hooks 'feedmail-mail-send-hook-queued) (run-hooks 'feedmail-mail-send-hook)) @@ -1154,15 +1154,15 @@ call to feedmail-run-the-queue." (defvar feedmail-mail-send-hook nil - "*See documentation for feedmail-mail-send-hook-splitter.") + "*See documentation for `feedmail-mail-send-hook-splitter'.") (defvar feedmail-mail-send-hook-queued nil - "*See documentation for feedmail-mail-send-hook-splitter.") + "*See documentation for `feedmail-mail-send-hook-splitter'.") (defun feedmail-confirm-addresses-hook-example () - "An example of a feedmail-last-chance-hook. + "An example of a `feedmail-last-chance-hook'. It shows the simple addresses and gets a confirmation. Use as: (setq feedmail-last-chance-hook 'feedmail-confirm-addresses-hook-example)." (save-window-excursion @@ -1179,10 +1179,10 @@ It shows the simple addresses and gets a confirmation. Use as: It has already had all the header prepping from the standard package. The next step after running the hook will be to push the buffer into a subprocess that mails the mail. The hook might be interested in -these: (1) feedmail-prepped-text-buffer contains the header and body -of the message, ready to go; (2) feedmail-address-list contains a list +these: (1) `feedmail-prepped-text-buffer' contains the header and body +of the message, ready to go; (2) `feedmail-address-list' contains a list of simplified recipients of addresses which are to be given to the -subprocess (the hook may change the list); (3) feedmail-error-buffer +subprocess (the hook may change the list); (3) `feedmail-error-buffer' is an empty buffer intended to soak up errors for display to the user. If the hook allows interactive activity, the user should not send more mail while in the hook since some of the internal buffers will be @@ -1197,10 +1197,10 @@ reused and things will get confused." It has already had all the header prepping from the standard package. The next step after running the hook will be to save the message via Fcc: processing. The hook might be interested in these: (1) -feedmail-prepped-text-buffer contains the header and body of the -message, ready to go; (2) feedmail-address-list contains a list of +`feedmail-prepped-text-buffer' contains the header and body of the +message, ready to go; (2) `feedmail-address-list' contains a list of simplified recipients of addressees to whom the message was sent (3) -feedmail-error-buffer is an empty buffer intended to soak up errors +`feedmail-error-buffer' is an empty buffer intended to soak up errors for display to the user. If the hook allows interactive activity, the user should not send more mail while in the hook since some of the internal buffers will be reused and things will get confused." @@ -1213,7 +1213,7 @@ internal buffers will be reused and things will get confused." "*A function to set the proper mode of a message file. Called when the message is read back out of the queue directory with a single argument, the optional argument used in the call to -feedmail-run-the-queue or feedmail-run-the-queue-no-prompts. +`feedmail-run-the-queue' or `feedmail-run-the-queue-no-prompts'. Most people want `mail-mode', so the default value is an anonymous function which is just a wrapper to ignore the supplied argument when @@ -1235,7 +1235,7 @@ When trying to send a queued message, if the value of this variable is non-nil, feedmail will first try to send the message using the value of `mail-header-separator'. If it can't find that, it will temporarily set `mail-header-separator' to the value of -feedmail-queue-alternative-mail-header-separator and try again." +`feedmail-queue-alternative-mail-header-separator' and try again." :group 'feedmail-queue :type '(choice (const nil) string) ) @@ -1245,11 +1245,11 @@ feedmail-queue-alternative-mail-header-separator and try again." "*Function to initiate sending a message file. Called for each message read back out of the queue directory with a single argument, the optional argument used in the call to -feedmail-run-the-queue or feedmail-run-the-queue-no-prompts. +`feedmail-run-the-queue' or `feedmail-run-the-queue-no-prompts'. Interactively, that argument will be the prefix argument. Most people -want mail-send-and-exit (bound to C-c C-c in mail-mode), but here's -your chance to have something different. Called with funcall, not -call-interactively." +want `mail-send-and-exit' (bound to C-c C-c in mail-mode), but here's +your chance to have something different. Called with `funcall', not +`call-interactively'." :group 'feedmail-queue :type 'function ) @@ -1291,11 +1291,11 @@ The function's three (mandatory) arguments are: (1) the buffer containing the prepped message; (2) a buffer where errors should be directed; and (3) a list containing the addresses individually as strings. Three popular choices for this are -feedmail-buffer-to-binmail, feedmail-buffer-to-smtpmail, and -feedmail-buffer-to-sendmail. If you use the sendmail form, you -probably want to set feedmail-nuke-bcc and/or feedmail-nuke-resent-bcc +`feedmail-buffer-to-binmail', `feedmail-buffer-to-smtpmail', and +`feedmail-buffer-to-sendmail'. If you use the sendmail form, you +probably want to set `feedmail-nuke-bcc' and/or `feedmail-nuke-resent-bcc' to nil. If you use the binmail form, check the value of -feedmail-binmail-template." +`feedmail-binmail-template'." :group 'feedmail-misc :type 'function ) @@ -1306,7 +1306,7 @@ feedmail-binmail-template." It can result in any command understandable by /bin/sh. Might not work at all in non-Unix environments. The single '%s', if present, gets replaced by the space-separated, simplified list of addressees. -Used in feedmail-buffer-to-binmail to form the shell command which +Used in `feedmail-buffer-to-binmail' to form the shell command which will receive the contents of the prepped buffer as stdin. If you'd like your errors to come back as mail instead of immediately in a buffer, try /bin/rmail instead of /bin/mail (this can be accomplished @@ -1535,13 +1535,13 @@ with various lower-level mechanisms to provide features such as queueing." ;;;###autoload (defun feedmail-run-the-queue-no-prompts (&optional arg) - "Like feedmail-run-the-queue, but suppress confirmation prompts." + "Like `feedmail-run-the-queue', but suppress confirmation prompts." (interactive "p") (let ((feedmail-confirm-outgoing nil)) (feedmail-run-the-queue arg))) ;;;###autoload (defun feedmail-run-the-queue-global-prompt (&optional arg) - "Like feedmail-run-the-queue, but with a global confirmation prompt. + "Like `feedmail-run-the-queue', but with a global confirmation prompt. This is generally most useful if run non-interactively, since you can bail out with an appropriate answer to the global confirmation prompt." (interactive "p") @@ -1678,7 +1678,7 @@ backup file names and the like)." "Perform some kind of reminder activity about queued and draft messages. Called with an optional symbol argument which says what kind of event is triggering the reminder activity. The default is 'on-demand, which -is what you typically would use if you were putting this in your emacs start-up +is what you typically would use if you were putting this in your Emacs start-up or mail hook code. Other recognized values for WHAT-EVENT (these are passed internally by feedmail): @@ -1687,11 +1687,11 @@ internally by feedmail): after-draft (a message has just been placed in the draft directory) after-run (the queue has just been run, possibly sending messages) -WHAT-EVENT is used as a key into the table feedmail-queue-reminder-alist. If +WHAT-EVENT is used as a key into the table `feedmail-queue-reminder-alist'. If the associated value is a function, it is called without arguments and is expected to perform the reminder activity. You can supply your own reminder functions -by redefining feedmail-queue-reminder-alist. If you don't want any reminders, -you can set feedmail-queue-reminder-alist to nil." +by redefining `feedmail-queue-reminder-alist'. If you don't want any reminders, +you can set `feedmail-queue-reminder-alist' to nil." (interactive "p") (let ((key (if (and what-event (symbolp what-event)) what-event 'on-demand)) entry reminder) (setq entry (assoc key feedmail-queue-reminder-alist)) @@ -1871,7 +1871,7 @@ the counts." Optional argument QUEUE-DIRECTORY specifies into which directory the file will be placed. The name is based on the Subject: header (if there is one). If there is no subject, -feedmail-queue-default-file-slug is consulted Special characters are +`feedmail-queue-default-file-slug' is consulted. Special characters are mapped to mostly alphanumerics for safety." (let ((eoh-marker) (case-fold-search t) (subject "") (s-point)) (setq eoh-marker (feedmail-find-eoh)) @@ -2152,7 +2152,7 @@ mapped to mostly alphanumerics for safety." "Internal feedmail function for jamming fields into message header. NAME, VALUE, ACTION, and FOLDING are the four elements of a fiddle-plex, as described in the documentation for the variable -feedmail-fiddle-plex-blurb." +`feedmail-fiddle-plex-blurb'." (let ((case-fold-search t) (header-colon (concat (regexp-quote name) ":")) header-regexp eoh-marker has-like ag-like val-like that-point) @@ -2249,7 +2249,7 @@ feedmail-fiddle-plex-blurb." (defun feedmail-envelope-deducer (eoh-marker) - "If feedmail-deduce-envelope-from is false, simply return `user-mail-address'. + "If `feedmail-deduce-envelope-from' is false, simply return `user-mail-address'. Else, look for Sender: or From: (or Resent-*) and return that value." (if (not feedmail-deduce-envelope-from) @@ -2345,7 +2345,7 @@ return that value." (defun feedmail-fiddle-date (maybe-file) - "Fiddle Date:. See documentation of feedmail-date-generator." + "Fiddle Date:. See documentation of `feedmail-date-generator'." ;; default is to fall off the end of the list and do nothing (cond ;; nil means do nothing @@ -2377,7 +2377,7 @@ return that value." (defun feedmail-default-message-id-generator (maybe-file) "Default function for generating Message-Id: header contents. Based on a date and a sort of random number for tie breaking. Unless -feedmail-message-id-suffix is defined, uses `user-mail-address', so be +`feedmail-message-id-suffix' is defined, uses `user-mail-address', so be sure it's set." (let ((date-time) (end-stuff (if feedmail-message-id-suffix feedmail-message-id-suffix user-mail-address))) @@ -2395,7 +2395,7 @@ sure it's set." ) (defun feedmail-fiddle-message-id (maybe-file) - "Fiddle Message-Id:. See documentation of feedmail-message-id-generator." + "Fiddle Message-Id:. See documentation of `feedmail-message-id-generator'." ;; default is to fall off the end of the list and do nothing (cond ;; nil means do nothing @@ -2436,7 +2436,7 @@ sure it's set." (defun feedmail-fiddle-x-mailer () - "Fiddle X-Mailer:. See documentation of feedmail-x-mailer-line." + "Fiddle X-Mailer:. See documentation of `feedmail-x-mailer-line'." ;; default is to fall off the end of the list and do nothing (cond ;; t is the same a using the function feedmail-default-x-mailer-generator, so let it and recurse @@ -2464,7 +2464,7 @@ sure it's set." (defun feedmail-fiddle-spray-address (addy-plex) - "Fiddle header for single spray address. Uses feedmail-spray-this-address." + "Fiddle header for single spray address. Uses `feedmail-spray-this-address'." ;; default is to fall off the end of the list and do nothing (cond ;; nil means do nothing @@ -2607,7 +2607,7 @@ Resent-To:, Resent-Cc:, and Resent-Bcc:." (defun feedmail-deduce-address-list (message-buffer header-start header-end addr-regexp address-list) "Get address list with all comments and other excitement trimmed. Addresses are collected only from headers whose names match the fourth -argument Returns a list of strings. Duplicate addresses will have +argument. Returns a list of strings. Duplicate addresses will have been weeded out." (let ((simple-address) (address-blob) diff --git a/lisp/mail/rmail-spam-filter.el b/lisp/mail/rmail-spam-filter.el index bba23111612..14edab92191 100644 --- a/lisp/mail/rmail-spam-filter.el +++ b/lisp/mail/rmail-spam-filter.el @@ -211,7 +211,7 @@ specify 'this\\&that' in the appropriate spam definition field." :group 'rmail-spam-filter) (defvar rsf-scanning-messages-now nil - "Non nil when `rmail-spam-filter' scans messages. + "Non-nil when `rmail-spam-filter' scans messages. This is for interaction with `rsf-bbdb-auto-delete-spam-entries'.") ;; the advantage over the automatic filter definitions is the AND conjunction diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 40e611152a1..707f62131cf 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -2828,7 +2828,7 @@ If summary buffer is currently displayed, update current message there also." (if blurb (message blurb)))))) -(defun rmail-redecode-body (coding) +(defun rmail-redecode-body (coding &optional raw) "Decode the body of the current message using coding system CODING. This is useful with mail messages that have malformed or missing charset= headers. @@ -2838,6 +2838,16 @@ and displayed in the RMAIL buffer, but the coding system used to decode it was incorrect. It then encodes the message back to its original form, and decodes it again, using the coding system CODING. +Optional argument RAW, if non-nil, means don't encode the message +before decoding it with the new CODING. This is useful if the current +message text was produced by some function which invokes `insert', +since `insert' leaves unibyte character codes 128 through 255 unconverted +to multibyte. One example of such a situation is when the text was +produced by `base64-decode-region'. + +Interactively, invoke the function with a prefix argument to set RAW +non-nil. + Note that if Emacs erroneously auto-detected one of the iso-2022 encodings in the message, this function might fail because the escape sequences that switch between character sets and also single-shift and @@ -2849,7 +2859,8 @@ iso-8859, koi8-r, etc." (or (eq major-mode 'rmail-mode) (switch-to-buffer rmail-buffer)) (save-excursion - (let ((pruned (rmail-msg-is-pruned))) + (let ((pruned (rmail-msg-is-pruned)) + (raw (or raw current-prefix-arg))) (unwind-protect (let ((msgbeg (rmail-msgbeg rmail-current-message)) (msgend (rmail-msgend rmail-current-message)) @@ -2883,7 +2894,22 @@ iso-8859, koi8-r, etc." (car (find-coding-systems-region msgbeg msgend)))) (setq x-coding-header (point-marker)) (narrow-to-region msgbeg msgend) - (encode-coding-region (point) msgend old-coding) + (and (null raw) + ;; If old and new encoding are the same, it + ;; clearly doesn't make sense to encode. + (not (coding-system-equal + (coding-system-base old-coding) + (coding-system-base coding))) + ;; If the body includes only eight-bit-* + ;; characters, encoding might fail, e.g. with + ;; UTF-8, and isn't needed anyway. + (> (length (delq 'ascii + (delq 'eight-bit-graphic + (delq 'eight-bit-control + (find-charset-region + msgbeg msgend))))) + 0) + (encode-coding-region (point) msgend old-coding)) (decode-coding-region (point) msgend coding) (setq last-coding-system-used coding) ;; Rewrite the coding-system header according diff --git a/lisp/mail/vms-pmail.el b/lisp/mail/vms-pmail.el index 3126f813000..e7c44edbeb2 100644 --- a/lisp/mail/vms-pmail.el +++ b/lisp/mail/vms-pmail.el @@ -40,9 +40,9 @@ ;;; then execute them as though emacs were just starting up. ;;; (defun vms-pmail-save-and-exit () - "Save current buffer and exit emacs. -If this emacs cannot be suspended, you will be prompted about modified -buffers other than the mail buffer. BEWARE --- suspending emacs without + "Save current buffer and exit Emacs. +If this Emacs cannot be suspended, you will be prompted about modified +buffers other than the mail buffer. BEWARE --- suspending Emacs without saving your mail buffer causes mail to abort the send (potentially useful since the mail buffer is still here)." (interactive) @@ -55,7 +55,7 @@ since the mail buffer is still here)." (suspend-emacs))) (defun vms-pmail-abort () - "Mark buffer as unmodified and exit emacs. + "Mark buffer as unmodified and exit Emacs. When the editor is exited without saving its buffer, VMS mail does not send a message. If you have other modified buffers you will be prompted for what to do with them." @@ -78,7 +78,7 @@ following bindings are established. \\[vms-pmail-save-and-exit] vms-pmail-save-and-exit \\[vms-pmail-abort] vms-pmail-abort -All other emacs commands are still available." +All other Emacs commands are still available." (interactive) (auto-save-mode -1) (text-mode) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 9a89aa42401..0252cb60eab 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1669,7 +1669,7 @@ Buffers menu is regenerated." 'menu-item "List All Buffers" 'list-buffers - :help "Pop up a window listing all emacs buffers" + :help "Pop up a window listing all Emacs buffers" )))) (setq buffers-menu (nconc buffers-menu menu-bar-buffers-menu-command-entries)) diff --git a/lisp/mouse-copy.el b/lisp/mouse-copy.el index 445b64ecb26..7703f62f336 100644 --- a/lisp/mouse-copy.el +++ b/lisp/mouse-copy.el @@ -111,9 +111,9 @@ See `mouse-copy-work-around-drag-bug' for details.") (defun mouse-copy-work-around-drag-bug (start-event end-event) - "Code to work around a bug in post-19.29 emacs: it drops mouse-drag events. + "Code to work around a bug in post-19.29 Emacs: it drops mouse-drag events. The problem occurs under XFree86-3.1.1 (X11R6pl11) but not under X11R5, -and under post-19.29 but not early versions of emacs. +and under post-19.29 but not early versions of Emacs. 19.29 and 19.30 seems to drop mouse drag events sometimes. (Reproducible under XFree86-3.1.1 (X11R6pl11) and diff --git a/lisp/mouse.el b/lisp/mouse.el index 0b6cccd86c6..a5f208baf11 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -846,7 +846,7 @@ at the same position." ;; Should we instead decide that `action' takes a `posn'? (if (consp pos) (with-current-buffer (window-buffer (posn-window pos)) - (funcall action (posn-point pos))) + (funcall action (posn-point pos))) (funcall action pos))) (t action)))) @@ -889,7 +889,7 @@ at the same position." (let ((range (mouse-start-end start end mode))) (move-overlay ol (car range) (nth 1 range)))) -(defun mouse-drag-track (start-event &optional +(defun mouse-drag-track (start-event &optional do-mouse-drag-region-post-process) "Track mouse drags by highlighting area between point and cursor. The region will be defined with mark and point, and the overlay @@ -983,8 +983,8 @@ should only be used by mouse-drag-region." (let* ((fun (key-binding (vector (car event)))) (do-multi-click (and (> (event-click-count event) 0) (functionp fun) - (not (memq fun - '(mouse-set-point + (not (memq fun + '(mouse-set-point mouse-set-region)))))) ;; Run the binding of the terminating up-event, if possible. (if (and (not (= (overlay-start mouse-drag-overlay) @@ -2377,7 +2377,7 @@ and selects that window." "X fonts suitable for use in Emacs.") (defun mouse-set-font (&rest fonts) - "Select an emacs font from a list of known good fonts and fontsets." + "Select an Emacs font from a list of known good fonts and fontsets." (interactive (progn (unless (display-multi-font-p) (error "Cannot change fonts on this display")) diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el index 987b71f3613..74e3deddc06 100644 --- a/lisp/net/eudc-vars.el +++ b/lisp/net/eudc-vars.el @@ -165,7 +165,7 @@ must be set in a protocol/server-local fashion, see `eudc-server-set' and :group 'eudc) (defcustom eudc-expansion-overwrites-query t - "*If non nil, expanding a query overwrites the query string." + "*If non-nil, expanding a query overwrites the query string." :type 'boolean :group 'eudc) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 0b914a811d1..ae815b7d434 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -676,7 +676,7 @@ various functions for details." (if (and (fboundp 'executable-find) (executable-find "plink")) "plink" - "ssh") + "scp") "*Default method to use for transferring files. See `tramp-methods' for possibilities. Also see `tramp-default-method-alist'." diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index ae8a62c48f1..930ceac9a71 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -935,7 +935,7 @@ or more clues in here): - If you go down a hole in the floor without an aid such as a ladder, you probably won't be able to get back up the way you came, if at all. -- To run this game in batch mode (no emacs window), use: +- To run this game in batch mode (no Emacs window), use: emacs -batch -l dunnet NOTE: This game *should* be run in batch mode! diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el index 5e9ba975607..ed273de635d 100644 --- a/lisp/play/handwrite.el +++ b/lisp/play/handwrite.el @@ -77,7 +77,7 @@ ;; Variables (defgroup handwrite nil - "Turns your emacs buffer into a handwritten document." + "Turns your Emacs buffer into a handwritten document." :prefix "handwrite-" :group 'games) diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el index 40a96f4e6c2..fddfe22870e 100644 --- a/lisp/play/hanoi.el +++ b/lisp/play/hanoi.el @@ -133,7 +133,7 @@ Repent before ring 31 moves." ;;;###autoload (defun hanoi-unix-64 () "Like hanoi-unix, but pretend to have a 64-bit clock. -This is, necessarily (as of emacs 20.3), a crock. When the +This is, necessarily (as of Emacs 20.3), a crock. When the current-time interface is made s2G-compliant, hanoi.el will need to be updated." (interactive) @@ -152,7 +152,7 @@ BITS must be of length nrings. Start at START-TIME." (buffer-disable-undo (current-buffer)) (unwind-protect (let* - (;; These lines can cause emacs to crash if you ask for too + (;; These lines can cause Emacs to crash if you ask for too ;; many rings. If you uncomment them, on most systems you ;; can get 10,000+ rings. ;;(max-specpdl-size (max max-specpdl-size (* nrings 15))) diff --git a/lisp/printing.el b/lisp/printing.el index 18252155e49..508d0bde585 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -1144,6 +1144,7 @@ If SUFFIX is non-nil, add that at the end of the file name." "Set the value of custom variables for printer & utility selection." (set symbol value) (and (featurep 'printing) ; update only after printing is loaded + (not pr-menu-print-item) (pr-update-menus t))) @@ -1151,6 +1152,7 @@ If SUFFIX is non-nil, add that at the end of the file name." "Update utility menu entry." (set symbol value) (and (featurep 'printing) ; update only after printing is loaded + (not pr-menu-print-item) (pr-menu-set-utility-title value))) @@ -1158,6 +1160,7 @@ If SUFFIX is non-nil, add that at the end of the file name." "Update `PostScript Printer:' menu entry." (set symbol value) (and (featurep 'printing) ; update only after printing is loaded + (not pr-menu-print-item) (pr-menu-set-ps-title value))) @@ -1165,6 +1168,7 @@ If SUFFIX is non-nil, add that at the end of the file name." "Update `Text Printer:' menu entry." (set symbol value) (and (featurep 'printing) ; update only after printing is loaded + (not pr-menu-print-item) (pr-menu-set-txt-title value))) @@ -3096,23 +3100,21 @@ Calls `pr-update-menus' to adjust menus." (pr-get-symbol "Printing"))))) ;; Emacs 21 & 22 (t - (let* ((has-file (lookup-key global-map (vector 'menu-bar 'file))) - (item-file (if has-file '("file") '("files")))) - (cond - (pr-menu-print-item - (easy-menu-change item-file "Print" pr-menu-spec "print-buffer") - (let ((items '("print-buffer" "print-region" - "ps-print-buffer-faces" "ps-print-region-faces" - "ps-print-buffer" "ps-print-region"))) - (while items - (easy-menu-remove-item nil item-file (car items)) - (setq items (cdr items))) - (setq pr-menu-print-item nil - pr-menu-bar (vector 'menu-bar - (if has-file 'file 'files) - (pr-get-symbol "Print"))))) - (t - (easy-menu-change item-file "Print" pr-menu-spec)))))))) + (cond + (pr-menu-print-item + (easy-menu-add-item menu-bar-file-menu nil + (easy-menu-create-menu "Print" pr-menu-spec) + "print-buffer") + (dolist (item '("print-buffer" "print-region" + "ps-print-buffer-faces" "ps-print-region-faces" + "ps-print-buffer" "ps-print-region")) + (easy-menu-remove-item menu-bar-file-menu nil item)) + (setq pr-menu-print-item nil + pr-menu-bar (vector 'menu-bar + 'file + (pr-get-symbol "Print")))) + (t + (easy-menu-change '("file") "Print" pr-menu-spec))))))) (pr-update-menus t)) diff --git a/lisp/progmodes/ada-prj.el b/lisp/progmodes/ada-prj.el index 1d42a391066..e1906df5f96 100644 --- a/lisp/progmodes/ada-prj.el +++ b/lisp/progmodes/ada-prj.el @@ -1,9 +1,10 @@ -;;; ada-prj.el --- easy editing of project files for the ada-mode +;;; ada-prj.el --- GUI editing of project files for the ada-mode -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006 +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006 ;; Free Software Foundation, Inc. ;; Author: Emmanuel Briot <briot@gnat.com> +;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org> ;; Keywords: languages, ada, project file ;; This file is part of GNU Emacs. @@ -33,6 +34,10 @@ ;;; Internally, a project file is represented as a property list, with each ;;; field of the project file matching one property of the list. + +;;; History: +;; + ;;; Code: @@ -64,7 +69,7 @@ ;; ----- Functions -------------------------------------------------------- (defun ada-prj-new () - "Open a new project file" + "Open a new project file." (interactive) (let* ((prj (if (and ada-prj-default-project-file @@ -93,7 +98,7 @@ If there is none, opens a new project file" "Set SYMBOL to the property list of the project file FILENAME. If FILENAME is null, read the file associated with ADA-BUFFER. If no project file is found, returns the default values." - +;; FIXME: rationalize arguments; make ada-buffer optional? (if (and filename (not (string= filename "")) (assoc filename ada-xref-project-files)) @@ -108,7 +113,7 @@ project file is found, returns the default values." (defun ada-prj-save-specific-option (field) - "Returns the string to print in the project file to save FIELD. + "Return the string to print in the project file to save FIELD. If the current value of FIELD is the default value, returns an empty string." (if (string= (plist-get ada-prj-current-values field) (plist-get ada-prj-default-values field)) @@ -170,7 +175,7 @@ If the current value of FIELD is the default value, returns an empty string." (kill-buffer nil) ;; kill the editor buffer - (kill-buffer "*Customize Ada Mode*") + (kill-buffer "*Edit Ada Mode Project*") ;; automatically set the new project file as the active one (set 'ada-prj-default-project-file file-name) @@ -208,7 +213,7 @@ If the current value of FIELD is the default value, returns an empty string." )) (defun ada-prj-subdirs-of (dir) - "Returns a list of all the subdirectories of dir, recursively." + "Return a list of all the subdirectories of DIR, recursively." (let ((subdirs (directory-files dir t "^[^.].*")) (dirlist (list dir))) (while subdirs @@ -220,7 +225,7 @@ If the current value of FIELD is the default value, returns an empty string." dirlist)) (defun ada-prj-load-directory (field &optional file-name) - "Append the content of FILE-NAME to FIELD in the current project file. + "Append to FIELD in the current project the subdirectories of FILE-NAME. If FILE-NAME is nil, ask the user for the name." ;; Do not use an external dialog for this, since it wouldn't allow @@ -238,8 +243,7 @@ If FILE-NAME is nil, ask the user for the name." (ada-prj-display-page 2)) (defun ada-prj-display-page (tab-num) - "Display one of the pages available in the notebook. TAB-NUM should have -a value between 1 and the maximum number of pages. + "Display page TAB-NUM in the notebook. The current buffer must be the project editing buffer." (let ((inhibit-read-only t)) @@ -255,7 +259,7 @@ The current buffer must be the project editing buffer." ;; Display the tabs - (widget-insert "\n Project and Editor configuration.\n + (widget-insert "\n Project configuration.\n ___________ ____________ ____________ ____________ ____________\n / ") (widget-create 'push-button :notify (lambda (&rest dummy) (ada-prj-display-page 1)) "General") @@ -346,9 +350,9 @@ Note that src_dir includes both the build directory and the standard runtime." t t (mapconcat (lambda(x) - (concat " " x)) - ada-xref-runtime-library-specs-path - "\n") + (concat " " x)) + ada-xref-runtime-library-specs-path + "\n") ) (widget-insert "\n\n") @@ -361,9 +365,9 @@ Note that obj_dir includes both the build directory and the standard runtime." t t (mapconcat (lambda(x) - (concat " " x)) - ada-xref-runtime-library-ali-path - "\n") + (concat " " x)) + ada-xref-runtime-library-ali-path + "\n") ) (widget-insert "\n\n") ) @@ -512,7 +516,7 @@ If FILENAME is given, edit that file." (ada-reread-prj-file))) ;; Else start the interactive editor - (switch-to-buffer "*Customize Ada Mode*") + (switch-to-buffer "*Edit Ada Mode Project*") (ada-xref-set-default-prj-values 'ada-prj-default-values ada-buffer) (ada-prj-initialize-values 'ada-prj-current-values @@ -536,30 +540,30 @@ If FILENAME is given, edit that file." ;; ---------------- Utilities -------------------------------- (defun ada-prj-set-list (string ada-list &optional is-directory) - "Join the strings in ADA-LIST into a single string. -Each name is put on a separate line that begins with STRING. -If IS-DIRECTORY is non-nil, each name is explicitly converted to a -directory name." + "Prepend STRING to strings in ADA-LIST, return new-line separated string. +If IS-DIRECTORY is non-nil, each element of ADA-LIST is explicitly +converted to a directory name." (mapconcat (lambda (x) (concat string "=" (if is-directory (file-name-as-directory x) x))) - ada-list "\n")) + ada-list "\n")) (defun ada-prj-field-modified (widget &rest dummy) - "Callback called each time the value of WIDGET is modified. Save the -change in ada-prj-current-values so that selecting another page and coming -back keeps the new value." + "Callback for modification of WIDGET. +Remaining args DUMMY are ignored. +Save the change in `ada-prj-current-values' so that selecting +another page and coming back keeps the new value." (set 'ada-prj-current-values (plist-put ada-prj-current-values (widget-get widget ':prj-field) (widget-value widget)))) (defun ada-prj-display-help (widget widget-modified event) - "An help button in WIDGET was clicked on. The parameters are so that -this function can be used as :notify for the widget." + "Callback for help button in WIDGET. +Parameters WIDGET-MODIFIED, EVENT match :notify for the widget." (let ((text (widget-get widget 'prj-help))) (if event ;; If we have a mouse-event, popup a menu @@ -575,6 +579,8 @@ this function can be used as :notify for the widget." ))) (defun ada-prj-show-value (widget widget-modified event) + "Show the current field value in WIDGET. +Parameters WIDGET-MODIFIED, EVENT match :notify for the widget." (let* ((field (widget-get widget ':prj-field)) (value (plist-get ada-prj-current-values field)) (inhibit-read-only t) diff --git a/lisp/progmodes/ada-stmt.el b/lisp/progmodes/ada-stmt.el index 525b53c2146..27a6eb66be0 100644 --- a/lisp/progmodes/ada-stmt.el +++ b/lisp/progmodes/ada-stmt.el @@ -6,9 +6,8 @@ ;; This file is part of GNU Emacs. ;; Authors: Daniel Pfeiffer, Markus Heritsch, Rolf Ebert <ebert@waporo.muc.de> -;; Maintainer: Emmanuel Briot <briot@gnat.com> +;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org> ;; Keywords: languages, ada -;; Rolf Ebert's version: 2.26 ;;; Commentary: ;; This file is now automatically loaded from ada-mode.el, and creates a submenu @@ -64,7 +63,7 @@ (require 'ada-mode) (defun ada-func-or-proc-name () - ;; Get the name of the current function or procedure." + "Return the name of the current function or procedure." (save-excursion (let ((case-fold-search t)) (if (re-search-backward ada-procedure-start-regexp nil t) @@ -305,7 +304,7 @@ Invoke right after `ada-function-spec' or `ada-procedure-spec'." (backward-char 1) (forward-sexp 1))) (if (looking-at ";") - (delete-char 1))) + (delete-char 1))) " is" \n _ \n < "begin" \n diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index 05d2a8bf65b..c6fcc670038 100644 --- a/lisp/progmodes/ada-xref.el +++ b/lisp/progmodes/ada-xref.el @@ -1,4 +1,4 @@ -;;; ada-xref.el --- for lookup and completion in Ada mode +;; ada-xref.el --- for lookup and completion in Ada mode ;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, ;; 2004, 2005, 2006 Free Software Foundation, Inc. @@ -6,8 +6,7 @@ ;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de> ;; Rolf Ebert <ebert@inf.enst.fr> ;; Emmanuel Briot <briot@gnat.com> -;; Maintainer: Emmanuel Briot <briot@gnat.com> -;; Ada Core Technologies's version: Revision: 1.181 +;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org> ;; Keywords: languages ada xref ;; This file is part of GNU Emacs. @@ -38,6 +37,10 @@ ;;; You need Emacs >= 20.2 to run this package + +;;; History: +;; + ;;; Code: ;; ----- Requirements ----------------------------------------------------- @@ -47,7 +50,7 @@ (require 'find-file) (require 'ada-mode) -;; ------ Use variables +;; ------ User variables (defcustom ada-xref-other-buffer t "*If nil, always display the cross-references in the same buffer. Otherwise create either a new buffer or a new frame." @@ -59,7 +62,7 @@ If nil, the cross-reference mode never runs gcc." :type 'boolean :group 'ada) (defcustom ada-xref-confirm-compile nil - "*If non-nil, ask for confirmation before compiling or running the application." + "*Non-nil means ask for confirmation before compiling or running the application." :type 'boolean :group 'ada) (defcustom ada-krunch-args "0" @@ -105,26 +108,25 @@ The command `gnatfind' is used every time you choose the menu (concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs" " ${comp_opt}") "*Default command to be used to compile a single file. -Emacs will add the filename at the end of this command. This is the same -syntax as in the project file." +Emacs will substitute the current filename for ${full_current}, or add +the filename at the end. This is the same syntax as in the project file." :type 'string :group 'ada) (defcustom ada-prj-default-debugger "${cross_prefix}gdb" - "*Default name of the debugger. We recommend either `gdb', -`gdb --emacs_gdbtk' or `ddd --tty -fullname'." + "*Default name of the debugger." :type 'string :group 'ada) (defcustom ada-prj-default-make-cmd (concat "${cross_prefix}gnatmake -o ${main} ${main_unit} ${gnatmake_opt} " - "-cargs ${comp_opt} -bargs ${bind_opt} -largs ${link_opt}") + "-cargs ${comp_opt} -bargs ${bind_opt} -largs ${link_opt}") "*Default command to be used to compile the application. This is the same syntax as in the project file." :type 'string :group 'ada) (defcustom ada-prj-default-project-file "" - "*Name of the project file to use for every Ada file. -Emacs will not try to use the standard algorithm to find the project file if -this string is not empty." + "*Name of the current project file. +Emacs will not try to use the search algorithm to find the project file if +this string is not empty. It is set whenever a project file is found." :type '(file :must-match t) :group 'ada) (defcustom ada-gnatstub-opts "-q -I${src_dir}" @@ -238,7 +240,7 @@ As always, the values of the project file are defined through properties.") (defmacro ada-set-on-declaration (ident value) (list 'aset ident 7 value)) (defsubst ada-get-ali-buffer (file) - "Reads the ali file into a new buffer, and returns this buffer's name" + "Read the ali file FILE into a new buffer, and return the buffer's name." (find-file-noselect (ada-get-ali-file-name file))) @@ -250,7 +252,7 @@ As always, the values of the project file are defined through properties.") (defun ada-initialize-runtime-library (cross-prefix) "Initialize the variables for the runtime library location. -CROSS-PREFIX is the prefix to use for the gnatls command." +CROSS-PREFIX is the prefix to use for the `gnatls' command." (save-excursion (setq ada-xref-runtime-library-specs-path '() ada-xref-runtime-library-ali-path '()) @@ -305,9 +307,9 @@ CROSS-PREFIX is the prefix to use for the gnatls command." (defun ada-treat-cmd-string (cmd-string) "Replace meta-sequences like ${...} in CMD-STRING with the appropriate value. -The project file must have been loaded first. -As a special case, ${current} is replaced with the name of the currently -edited file, minus extension but with directory, and ${full_current} is +Assumes project exists. +As a special case, ${current} is replaced with the name of the current +file, minus extension but with directory, and ${full_current} is replaced by the name including the extension." (while (string-match "\\(-[^-\$IO]*[IO]\\)?\${\\([^}]+\\)}" cmd-string) @@ -349,9 +351,8 @@ replaced by the name including the extension." (set-buffer ada-buffer) (set 'plist - ;; Try hard to find a default value for filename, so that the user - ;; can edit his project file even if the current buffer is not an - ;; Ada file or not even associated with a file + ;; Try hard to find a project file, even if the current + ;; buffer is not an Ada file or not associated with a file (list 'filename (expand-file-name (cond (ada-prj-default-project-file @@ -403,8 +404,7 @@ replaced by the name including the extension." (defun ada-xref-get-project-field (field) "Extract the value of FIELD from the current project file. -The project file must have been loaded first. -A default value is returned if the file was not found. +Project variables are substituted. Note that for src_dir and obj_dir, you should rather use `ada-xref-get-src-dir-field' or `ada-xref-get-obj-dir-field' which will in @@ -443,7 +443,6 @@ addition return the default paths." ) )) - (defun ada-xref-get-src-dir-field () "Return the full value for src_dir, including the default directories. All the directories are returned as absolute directories." @@ -529,6 +528,7 @@ All the directories are returned as absolute directories." "Completion function when reading a file from the minibuffer. Completion is attempted in all the directories in the source path, as defined in the project file." + ;; FIXME: doc arguments (let (list (dirs (ada-xref-get-src-dir-field))) @@ -547,7 +547,7 @@ defined in the project file." ;;;###autoload (defun ada-find-file (filename) - "Open a file anywhere in the source path. + "Open FILENAME, from anywhere in the source path. Completion is available." (interactive (list (completing-read "File: " 'ada-do-file-completion))) @@ -582,9 +582,10 @@ Completion is available." (goto-char (car pos))))) (defun ada-convert-file-name (name) - "Converts from NAME to a name that can be used by the compilation commands. + "Convert from NAME to a name that can be used by the compilation commands. This is overriden on VMS to convert from VMS filenames to Unix filenames." name) +;; FIXME: use convert-standard-filename instead (defun ada-set-default-project-file (name &optional keep-existing) "Set the file whose name is NAME as the default project file. @@ -694,12 +695,12 @@ file. If none is set, return nil." (defun ada-parse-prj-file (prj-file) - "Reads and parses the PRJ-FILE file if it was found. -The current buffer should be the ada-file buffer." + "Read PRJ-FILE, set it as the active project." + ;; FIXME: doc nil, search, etc. (if prj-file (let (project src_dir obj_dir make_cmd comp_cmd check_cmd casing run_cmd debug_pre_cmd debug_post_cmd - (ada-buffer (current-buffer))) + (ada-buffer (current-buffer))) (setq prj-file (expand-file-name prj-file)) ;; Set the project file as the active one. @@ -728,6 +729,8 @@ The current buffer should be the ada-file buffer." (while (not (eobp)) (if (looking-at "^\\([^=]+\\)=\\(.*\\)") (cond + ;; fields that are lists or paths require special processing + ;; FIXME: strip trailing spaces ((string= (match-string 1) "src_dir") (add-to-list 'src_dir (file-name-as-directory (match-string 2)))) @@ -753,6 +756,7 @@ The current buffer should be the ada-file buffer." ((string= (match-string 1) "debug_post_cmd") (add-to-list 'debug_post_cmd (match-string 2))) (t + ;; any other field in the file is just copied (set 'project (plist-put project (intern (match-string 1)) (match-string 2)))))) (forward-line 1)) @@ -783,20 +787,20 @@ The current buffer should be the ada-file buffer." ;; Else the file wasn't readable (probably the default project). ;; We initialize it with the current environment variables. - ;; We need to add the startup directory in front so that - ;; files locally redefined are properly found. We cannot - ;; add ".", which varies too much depending on what the - ;; current buffer is. + ;; We need to add the startup directory in front so that + ;; files locally redefined are properly found. We cannot + ;; add ".", which varies too much depending on what the + ;; current buffer is. (set 'project (plist-put project 'src_dir (append - (list command-line-default-directory) + (list command-line-default-directory) (split-string (or (getenv "ADA_INCLUDE_PATH") "") ":") (list "." default-directory)))) (set 'project (plist-put project 'obj_dir (append - (list command-line-default-directory) + (list command-line-default-directory) (split-string (or (getenv "ADA_OBJECTS_PATH") "") ":") (list "." default-directory)))) ) @@ -817,11 +821,11 @@ The current buffer should be the ada-file buffer." ;; go to the source of the errors in a compilation buffer (setq compilation-search-path (ada-xref-get-src-dir-field)) - ;; Set the casing exceptions file list - (if casing - (progn - (setq ada-case-exception-file (reverse casing)) - (ada-case-read-exceptions))) + ;; Set the casing exceptions file list + (if casing + (progn + (setq ada-case-exception-file (reverse casing)) + (ada-case-read-exceptions))) ;; Add the directories to the search path for ff-find-other-file ;; Do not add the '/' or '\' at the end @@ -850,21 +854,21 @@ If LOCAL-ONLY is t, only the declarations in the current file are returned." (ada-require-project-file) (let* ((identlist (ada-read-identifier pos)) - (alifile (ada-get-ali-file-name (ada-file-of identlist))) + (alifile (ada-get-ali-file-name (ada-file-of identlist))) (process-environment (ada-set-environment))) (set-buffer (get-file-buffer (ada-file-of identlist))) ;; if the file is more recent than the executable (if (or (buffer-modified-p (current-buffer)) - (file-newer-than-file-p (ada-file-of identlist) alifile)) - (ada-find-any-references (ada-name-of identlist) - (ada-file-of identlist) - nil nil local-only arg) + (file-newer-than-file-p (ada-file-of identlist) alifile)) + (ada-find-any-references (ada-name-of identlist) + (ada-file-of identlist) + nil nil local-only arg) (ada-find-any-references (ada-name-of identlist) - (ada-file-of identlist) - (ada-line-of identlist) - (ada-column-of identlist) local-only arg))) + (ada-file-of identlist) + (ada-line-of identlist) + (ada-column-of identlist) local-only arg))) ) (defun ada-find-local-references (&optional pos arg) @@ -897,9 +901,9 @@ buffer `*gnatfind*', if there is one." (switches (ada-xref-get-project-field 'gnatfind_opt)) (command (concat "gnat find " switches " " quote-entity - (if file (concat ":" (file-name-nondirectory file))) - (if line (concat ":" line)) - (if column (concat ":" column)) + (if file (concat ":" (file-name-nondirectory file))) + (if line (concat ":" line)) + (if column (concat ":" column)) (if local-only (concat " " (file-name-nondirectory file))) )) old-contents) @@ -907,10 +911,10 @@ buffer `*gnatfind*', if there is one." ;; If a project file is defined, use it (if (and ada-prj-default-project-file (not (string= ada-prj-default-project-file ""))) - (if (string-equal (file-name-extension ada-prj-default-project-file) - "gpr") - (setq command (concat command " -P" ada-prj-default-project-file)) - (setq command (concat command " -p" ada-prj-default-project-file)))) + (if (string-equal (file-name-extension ada-prj-default-project-file) + "gpr") + (setq command (concat command " -P" ada-prj-default-project-file)) + (setq command (concat command " -p" ada-prj-default-project-file)))) (if (and append (get-buffer "*gnatfind*")) (save-excursion @@ -937,21 +941,19 @@ buffer `*gnatfind*', if there is one." ;; ----- Identifier Completion -------------------------------------------- (defun ada-complete-identifier (pos) - "Tries to complete the identifier around POS. -The feature is only available if the files where compiled without -the option `-gnatx'." + "Try to complete the identifier around POS, using compiler cross-reference information." (interactive "d") (ada-require-project-file) ;; Initialize function-local variables and jump to the .ali buffer ;; Note that for regexp search is case insensitive too (let* ((curbuf (current-buffer)) - (identlist (ada-read-identifier pos)) - (sofar (concat "^[0-9]+[a-zA-Z][0-9]+[ *]\\(" - (regexp-quote (ada-name-of identlist)) - "[a-zA-Z0-9_]*\\)")) - (completed nil) - (symalist nil)) + (identlist (ada-read-identifier pos)) + (sofar (concat "^[0-9]+[a-zA-Z][0-9]+[ *]\\(" + (regexp-quote (ada-name-of identlist)) + "[a-zA-Z0-9_]*\\)")) + (completed nil) + (symalist nil)) ;; Open the .ali file (set-buffer (ada-get-ali-buffer (buffer-file-name))) @@ -990,6 +992,7 @@ the option `-gnatx'." (defun ada-goto-body (pos &optional other-frame) "Display the body of the entity around POS. +OTHER-FRAME non-nil means display in another frame. If the entity doesn't have a body, display its declaration. As a side effect, the buffer for the declaration is also open." (interactive "d") @@ -1023,7 +1026,7 @@ If OTHER-FRAME is non-nil, display the cross-reference in another frame." ;; entity, whose references are not given by GNAT (if (and (file-exists-p ali-file) (file-newer-than-file-p ali-file (ada-file-of identlist))) - (message "No cross-reference found--may be a predefined entity.") + (message "No cross-reference found -- may be a predefined entity.") ;; Else, look in every ALI file, except if the user doesn't want that (if ada-xref-search-with-egrep @@ -1048,8 +1051,8 @@ The declation is shown in another frame if `ada-xref-other-buffer' is non-nil." command)))) (defun ada-get-absolute-dir-list (dir-list root-dir) - "Returns the list of absolute directories found in dir-list. -If a directory is a relative directory, add the value of ROOT-DIR in front." + "Return the list of absolute directories found in DIR-LIST. +If a directory is a relative directory, ROOT-DIR is prepended." (mapcar (lambda (x) (expand-file-name x root-dir)) dir-list)) (defun ada-set-environment () @@ -1134,12 +1137,6 @@ command, and should be either comp_cmd (default) or check_cmd." (if (or ada-xref-confirm-compile arg) (setq cmd (read-from-minibuffer "enter command to compile: " cmd))) - ;; Insert newlines so as to separate the name of the commands to run - ;; and the output of the commands. This doesn't work with cmdproxy.exe, - ;; which gets confused by newline characters. - (if (not (string-match ".exe" shell-file-name)) - (setq cmd (concat cmd "\n\n"))) - (compile (ada-quote-cmd cmd)))) (defun ada-check-current (&optional arg) @@ -1162,7 +1159,7 @@ if ARG is not-nil, ask for user confirmation." ;; Guess the command if it wasn't specified (if (not command) - (set 'command (list (file-name-sans-extension (buffer-name))))) + (set 'command (list (file-name-sans-extension (buffer-name))))) ;; Modify the command to run remotely (setq command (ada-remote (mapconcat 'identity command @@ -1197,9 +1194,9 @@ if ARG is not-nil, ask for user confirmation." (defun ada-gdb-application (&optional arg executable-name) "Start the debugger on the application. +If ARG is non-nil, ask the user to confirm the command. EXECUTABLE-NAME, if non-nil, is debugged instead of the file specified in the -project file. -If ARG is non-nil, ask the user to confirm the command." +project file." (interactive "P") (let ((buffer (current-buffer)) cmd pre-cmd post-cmd) @@ -1303,13 +1300,8 @@ If ARG is non-nil, ask the user to confirm the command." (switch-to-buffer buffer) ))) - (defun ada-reread-prj-file (&optional filename) - "Forces Emacs to read either FILENAME or the project file associated -with the current buffer. -Otherwise, this file is only read once, and never read again. -Since the information in the project file is shared between all buffers, this -automatically modifies the setup for all the Ada buffer that use this file." + "Reread either the current project, or FILENAME if non-nil." (interactive "P") (if filename (ada-parse-prj-file filename) @@ -1330,7 +1322,7 @@ the cross-reference information. Note that the ali file can then be deduced by replacing the file extension with `.ali'." ;; kill old buffer (if (and ali-file-name - (get-file-buffer ali-file-name)) + (get-file-buffer ali-file-name)) (kill-buffer (get-file-buffer ali-file-name))) (let* ((name (ada-convert-file-name file)) @@ -1375,15 +1367,15 @@ replacing the file extension with `.ali'." found)) (defun ada-find-ali-file-in-dir (file) - "Find an .ali file in obj_dir. The current buffer must be the Ada file. + "Find the ali file FILE, searching obj_dir for the current project. Adds build_dir in front of the search path to conform to gnatmake's behavior, and the standard runtime location at the end." (ada-find-file-in-dir file (ada-xref-get-obj-dir-field))) (defun ada-find-src-file-in-dir (file) - "Find a source file in src_dir. The current buffer must be the Ada file. -Adds src_dir in front of the search path to conform to gnatmake's behavior, -and the standard runtime location at the end." + "Find the source file FILE, searching src_dir for the current project. +Adds the standard runtime location at the end of the search path to conform +to gnatmake's behavior." (ada-find-file-in-dir file (ada-xref-get-src-dir-field))) (defun ada-get-ali-file-name (file) @@ -1414,9 +1406,9 @@ the project file." (save-excursion (set-buffer (get-file-buffer file)) (let ((short-ali-file-name - (concat (file-name-sans-extension (file-name-nondirectory file)) - ".ali")) - ali-file-name + (concat (file-name-sans-extension (file-name-nondirectory file)) + ".ali")) + ali-file-name is-spec) ;; If we have a non-standard file name, and this is a spec, we first @@ -1514,15 +1506,15 @@ file for possible paths." ;; return the absolute file name (let ((filename (ada-find-src-file-in-dir file))) (if filename - (expand-file-name filename) - (error (concat - (file-name-nondirectory file) - " not found in src_dir; please check your project file"))) + (expand-file-name filename) + (error (concat + (file-name-nondirectory file) + " not found in src_dir; please check your project file"))) ))) (defun ada-find-file-number-in-ali (file) - "Returns the file number for FILE in the associated ali file." + "Return the file number for FILE in the associated ali file." (set-buffer (ada-get-ali-buffer file)) (goto-char (point-min)) @@ -1532,7 +1524,7 @@ file for possible paths." (count-lines begin (point)))) (defun ada-read-identifier (pos) - "Returns the identlist around POS and switch to the .ali buffer. + "Return the identlist around POS and switch to the .ali buffer. The returned list represents the entity, and can be manipulated through the macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..." @@ -1553,7 +1545,7 @@ macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..." ;; Just in front of a string => we could have an operator declaration, ;; as in "+", "-", .. (if (= (char-after) ?\") - (forward-char 1)) + (forward-char 1)) ;; if looking at an operator ;; This is only true if: @@ -1563,19 +1555,19 @@ macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..." (or (not (= (char-syntax (char-after)) ?w)) (not (or (= (char-syntax (char-after (match-end 0))) ?w) (= (char-after (match-end 0)) ?_))))) - (progn - (if (and (= (char-before) ?\") - (= (char-after (+ (length (match-string 0)) (point))) ?\")) - (forward-char -1)) - (set 'identifier (regexp-quote (concat "\"" (match-string 0) "\"")))) + (progn + (if (and (= (char-before) ?\") + (= (char-after (+ (length (match-string 0)) (point))) ?\")) + (forward-char -1)) + (set 'identifier (regexp-quote (concat "\"" (match-string 0) "\"")))) (if (ada-in-string-p) - (error "Inside string or character constant")) + (error "Inside string or character constant")) (if (looking-at (concat ada-keywords "[^a-zA-Z_]")) - (error "No cross-reference available for reserved keyword")) + (error "No cross-reference available for reserved keyword")) (if (looking-at "[a-zA-Z0-9_]+") - (set 'identifier (match-string 0)) - (error "No identifier around"))) + (set 'identifier (match-string 0)) + (error "No identifier around"))) ;; Build the identlist (set 'identlist (ada-make-identlist)) @@ -1589,8 +1581,8 @@ macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..." )) (defun ada-get-all-references (identlist) - "Completes and returns IDENTLIST with the information extracted -from the ali file (definition file and places where it is referenced)." + "Complete IDENTLIST with definition file and places where it is referenced. +Information is extracted from the ali file." (let ((ali-buffer (ada-get-ali-buffer (ada-file-of identlist))) declaration-found) @@ -1605,8 +1597,8 @@ from the ali file (definition file and places where it is referenced)." (if (re-search-forward (concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist))) nil t) - (let ((bound (save-excursion (re-search-forward "^X " nil t)))) - (set 'declaration-found + (let ((bound (save-excursion (re-search-forward "^X " nil t)))) + (set 'declaration-found (re-search-forward (concat "^" (ada-line-of identlist) "." (ada-column-of identlist) @@ -1636,10 +1628,10 @@ from the ali file (definition file and places where it is referenced)." (ada-column-of identlist) "\\>") nil t) - ;; if we did not find it, it may be because the first reference - ;; is not required to have a 'unit_number|' item included. - ;; Or maybe we are already on the declaration... - (unless (re-search-forward + ;; if we did not find it, it may be because the first reference + ;; is not required to have a 'unit_number|' item included. + ;; Or maybe we are already on the declaration... + (unless (re-search-forward (concat "^[0-9]+.[0-9]+[ *]" (ada-name-of identlist) @@ -1653,7 +1645,7 @@ from the ali file (definition file and places where it is referenced)." ;; or the source file has been modified since the ali file was ;; created (set 'declaration-found nil) - ) + ) ) ;; Last check to be completly sure we have found the correct line (the @@ -1688,15 +1680,15 @@ from the ali file (definition file and places where it is referenced)." ;; information available (beginning-of-line) (if declaration-found - (let ((current-line (buffer-substring + (let ((current-line (buffer-substring (point) (save-excursion (end-of-line) (point))))) - (save-excursion - (next-line 1) - (beginning-of-line) - (while (looking-at "^\\.\\(.*\\)") - (set 'current-line (concat current-line (match-string 1))) - (next-line 1)) - ) + (save-excursion + (next-line 1) + (beginning-of-line) + (while (looking-at "^\\.\\(.*\\)") + (set 'current-line (concat current-line (match-string 1))) + (next-line 1)) + ) (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t) @@ -1725,7 +1717,7 @@ This function is disabled for operators, and only works for identifiers." (unless (= (string-to-char (ada-name-of identlist)) ?\") (progn - (let ((declist '()) ;;; ( (line_in_ali_file line_in_ada) ( ... )) + (let ((declist '()) ;;; ( (line_in_ali_file line_in_ada) ( ... )) (my-regexp (concat "[ *]" (regexp-quote (ada-name-of identlist)) " ")) (line-ada "--") @@ -1735,43 +1727,43 @@ This function is disabled for operators, and only works for identifiers." (choice 0) (ali-buffer (current-buffer))) - (goto-char (point-max)) - (while (re-search-backward my-regexp nil t) - (save-excursion - (set 'line-ali (count-lines 1 (point))) - (beginning-of-line) - ;; have a look at the line and column numbers - (if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]") - (progn - (setq line-ada (match-string 1)) - (setq col-ada (match-string 2))) - (setq line-ada "--") - (setq col-ada "--") - ) - ;; construct a list with the file names and the positions within - (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9._-]+\\)" nil t) + (goto-char (point-max)) + (while (re-search-backward my-regexp nil t) + (save-excursion + (set 'line-ali (count-lines 1 (point))) + (beginning-of-line) + ;; have a look at the line and column numbers + (if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]") + (progn + (setq line-ada (match-string 1)) + (setq col-ada (match-string 2))) + (setq line-ada "--") + (setq col-ada "--") + ) + ;; construct a list with the file names and the positions within + (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9._-]+\\)" nil t) (add-to-list 'declist (list line-ali (match-string 1) line-ada col-ada)) - ) - ) - ) - - ;; how many possible declarations have we found ? - (setq len (length declist)) - (cond - ;; none => error - ((= len 0) - (kill-buffer (current-buffer)) - (error (concat "No declaration of " - (ada-name-of identlist) - " recorded in .ali file"))) - - ;; one => should be the right one - ((= len 1) - (goto-line (caar declist))) - - ;; more than one => display choice list - (t + ) + ) + ) + + ;; how many possible declarations have we found ? + (setq len (length declist)) + (cond + ;; none => error + ((= len 0) + (kill-buffer (current-buffer)) + (error (concat "No declaration of " + (ada-name-of identlist) + " recorded in .ali file"))) + + ;; one => should be the right one + ((= len 1) + (goto-line (caar declist))) + + ;; more than one => display choice list + (t (save-window-excursion (with-output-to-temp-buffer "*choice list*" @@ -1782,13 +1774,13 @@ This function is disabled for operators, and only works for identifiers." (let ((counter 0)) (while (< counter len) (princ (format " %2d) %-21s %4s %4s\n" - (1+ counter) + (1+ counter) (ada-get-ada-file-name (nth 1 (nth counter declist)) (ada-file-of identlist)) - (nth 2 (nth counter declist)) - (nth 3 (nth counter declist)) - )) + (nth 2 (nth counter declist)) + (nth 3 (nth counter declist)) + )) (setq counter (1+ counter)) ) ; end of while ) ; end of let @@ -1804,13 +1796,13 @@ This function is disabled for operators, and only works for identifiers." (read-from-minibuffer "Enter No. of your choice: ")))) ) (set-buffer ali-buffer) - (goto-line (car (nth (1- choice) declist))) - )))))) + (goto-line (car (nth (1- choice) declist))) + )))))) (defun ada-find-in-ali (identlist &optional other-frame) "Look in the .ali file for the definition of the identifier in IDENTLIST. -If OTHER-FRAME is non nil, and `ada-xref-other-buffer' is non nil, +If OTHER-FRAME is non-nil, and `ada-xref-other-buffer' is non-nil, opens a new window to show the declaration." (ada-get-all-references identlist) @@ -1899,7 +1891,7 @@ This command requires the external `egrep' program to be available. This works well when one is using an external librarie and wants to find the declaration and documentation of the subprograms one is is using." - +;; FIXME: what does this function do? (let (list (dirs (ada-xref-get-obj-dir-field)) (regexp (concat "[ *]" (ada-name-of identlist))) @@ -2020,12 +2012,12 @@ If OTHER-FRAME is non-nil, creates a new frame to show the file." ;; Select and display the destination buffer (if ada-xref-other-buffer - (if other-frame - (find-file-other-frame file) - (set 'declaration-buffer (find-file-noselect file)) - (set-buffer declaration-buffer) - (switch-to-buffer-other-window declaration-buffer) - ) + (if other-frame + (find-file-other-frame file) + (set 'declaration-buffer (find-file-noselect file)) + (set-buffer declaration-buffer) + (switch-to-buffer-other-window declaration-buffer) + ) (find-file file) ) @@ -2043,11 +2035,11 @@ If OTHER-FRAME is non-nil, creates a new frame to show the file." (defun ada-xref-search-nearest (name) - "Searches for NAME nearest to the position recorded in the Xref file. -It returns the position of the declaration in the buffer or nil if not found." + "Search for NAME nearest to the position recorded in the Xref file. +Return the position of the declaration in the buffer, or nil if not found." (let ((orgpos (point)) - (newpos nil) - (diff nil)) + (newpos nil) + (diff nil)) (goto-char (point-max)) @@ -2056,33 +2048,33 @@ It returns the position of the declaration in the buffer or nil if not found." ;; check if it really is a complete Ada identifier (if (and - (not (save-excursion - (goto-char (match-end 0)) - (looking-at "_"))) - (not (ada-in-string-or-comment-p)) - (or - ;; variable declaration ? - (save-excursion - (skip-chars-forward "a-zA-Z_0-9" ) - (ada-goto-next-non-ws) - (looking-at ":[^=]")) - ;; procedure, function, task or package declaration ? - (save-excursion - (ada-goto-previous-word) - (looking-at "\\<[pP][rR][oO][cC][eE][dD][uU][rR][eE]\\>\\|\\<[fF][uU][nN][cC][tT][iI][oO][nN]\\>\\|\\<[tT][yY][pP][eE]\\>\\|\\<[tT][aA][sS][kK]\\>\\|\\<[pP][aA][cC][kK][aA][gG][eE]\\>\\|\\<[bB][oO][dD][yY]\\>")))) - - ;; check if it is nearer than the ones before if any - (if (or (not diff) - (< (abs (- (point) orgpos)) diff)) - (progn - (setq newpos (point) + (not (save-excursion + (goto-char (match-end 0)) + (looking-at "_"))) + (not (ada-in-string-or-comment-p)) + (or + ;; variable declaration ? + (save-excursion + (skip-chars-forward "a-zA-Z_0-9" ) + (ada-goto-next-non-ws) + (looking-at ":[^=]")) + ;; procedure, function, task or package declaration ? + (save-excursion + (ada-goto-previous-word) + (looking-at "\\<[pP][rR][oO][cC][eE][dD][uU][rR][eE]\\>\\|\\<[fF][uU][nN][cC][tT][iI][oO][nN]\\>\\|\\<[tT][yY][pP][eE]\\>\\|\\<[tT][aA][sS][kK]\\>\\|\\<[pP][aA][cC][kK][aA][gG][eE]\\>\\|\\<[bB][oO][dD][yY]\\>")))) + + ;; check if it is nearer than the ones before if any + (if (or (not diff) + (< (abs (- (point) orgpos)) diff)) + (progn + (setq newpos (point) diff (abs (- newpos orgpos)))))) ) (if newpos - (progn - (message "ATTENTION: this declaration is only a (good) guess ...") - (goto-char newpos)) + (progn + (message "ATTENTION: this declaration is only a (good) guess ...") + (goto-char newpos)) nil))) @@ -2093,26 +2085,26 @@ It returns the position of the declaration in the buffer or nil if not found." (ada-require-project-file) (let ((buffer (ada-get-ali-buffer (buffer-file-name))) - (unit-name nil) - (body-name nil) - (ali-name nil)) + (unit-name nil) + (body-name nil) + (ali-name nil)) (save-excursion (set-buffer buffer) (goto-char (point-min)) (re-search-forward "^U \\([^ \t%]+\\)%[bs][ \t]+\\([^ \t]+\\)") (setq unit-name (match-string 1)) (if (not (string-match "\\(.*\\)\\.[^.]+" unit-name)) - (progn - (kill-buffer buffer) - (error "No parent unit !")) - (setq unit-name (match-string 1 unit-name)) - ) + (progn + (kill-buffer buffer) + (error "No parent unit !")) + (setq unit-name (match-string 1 unit-name)) + ) ;; look for the file name for the parent unit specification (goto-char (point-min)) (re-search-forward (concat "^W " unit-name - "%s[ \t]+\\([^ \t]+\\)[ \t]+" - "\\([^ \t\n]+\\)")) + "%s[ \t]+\\([^ \t]+\\)[ \t]+" + "\\([^ \t\n]+\\)")) (setq body-name (match-string 1)) (setq ali-name (match-string 2)) (kill-buffer buffer) @@ -2123,15 +2115,15 @@ It returns the position of the declaration in the buffer or nil if not found." (save-excursion ;; Tries to open the new ali file to find the spec file (if ali-name - (progn - (find-file ali-name) - (goto-char (point-min)) - (re-search-forward (concat "^U " unit-name "%s[ \t]+" - "\\([^ \t]+\\)")) - (setq body-name (match-string 1)) - (kill-buffer (current-buffer)) - ) - ) + (progn + (find-file ali-name) + (goto-char (point-min)) + (re-search-forward (concat "^U " unit-name "%s[ \t]+" + "\\([^ \t]+\\)")) + (setq body-name (match-string 1)) + (kill-buffer (current-buffer)) + ) + ) ) (find-file body-name) @@ -2146,14 +2138,14 @@ This is a GNAT specific function that uses gnatkrunch." (set-buffer krunch-buf) ;; send adaname to external process `gnatkr'. (call-process "gnatkr" nil krunch-buf nil - adaname ada-krunch-args) + adaname ada-krunch-args) ;; fetch output of that process (setq adaname (buffer-substring - (point-min) - (progn - (goto-char (point-min)) - (end-of-line) - (point)))) + (point-min) + (progn + (goto-char (point-min)) + (end-of-line) + (point)))) (kill-buffer krunch-buf))) adaname ) @@ -2187,10 +2179,10 @@ This function typically is to be hooked into `ff-file-created-hooks'." ;; Call the external process gnatstub (let* ((gnatstub-opts (ada-treat-cmd-string ada-gnatstub-opts)) - (filename (buffer-file-name (car (buffer-list)))) - (output (concat (file-name-sans-extension filename) ".adb")) - (gnatstub-cmd (concat "gnatstub " gnatstub-opts " " filename)) - (buffer (get-buffer-create "*gnatstub*"))) + (filename (buffer-file-name (car (buffer-list)))) + (output (concat (file-name-sans-extension filename) ".adb")) + (gnatstub-cmd (concat "gnatstub " gnatstub-opts " " filename)) + (buffer (get-buffer-create "*gnatstub*"))) (save-excursion (set-buffer buffer) @@ -2203,25 +2195,25 @@ This function typically is to be hooked into `ff-file-created-hooks'." (call-process shell-file-name nil buffer nil "-c" gnatstub-cmd) (if (save-excursion - (set-buffer buffer) - (goto-char (point-min)) - (search-forward "command not found" nil t)) - (progn - (message "gnatstub was not found -- using the basic algorithm") - (sleep-for 2) - (kill-buffer buffer) - (ada-make-body)) + (set-buffer buffer) + (goto-char (point-min)) + (search-forward "command not found" nil t)) + (progn + (message "gnatstub was not found -- using the basic algorithm") + (sleep-for 2) + (kill-buffer buffer) + (ada-make-body)) ;; Else clean up the output (if (file-exists-p output) - (progn - (find-file output) - (kill-buffer buffer)) + (progn + (find-file output) + (kill-buffer buffer)) - ;; display the error buffer - (display-buffer buffer) - ) + ;; display the error buffer + (display-buffer buffer) + ) ))) (defun ada-xref-initialize () @@ -2237,22 +2229,9 @@ find-file...." (ada-xref-update-project-menu) ) - ;; ----- Add to ada-mode-hook --------------------------------------------- -;; Use gvd or ddd as the default debugger if it was found -;; On windows, do not use the --tty switch for GVD, since this is -;; not supported. Actually, we do not use this on Unix either, -;; since otherwise there is no console window left in GVD, -;; and people have to use the Emacs one. ;; This must be done before initializing the Ada menu. -(if (ada-find-file-in-dir "gvd" exec-path) - (set 'ada-prj-default-debugger "gvd ") - (if (ada-find-file-in-dir "gvd.exe" exec-path) - (set 'ada-prj-default-debugger "gvd ") - (if (ada-find-file-in-dir "ddd" exec-path) - (set 'ada-prj-default-debugger "ddd --tty -fullname -toolbar")))) - (add-hook 'ada-mode-hook 'ada-xref-initialize) ;; Initializes the cross references to the runtime library diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 52cfa602e59..86b4bea321c 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -4387,7 +4387,7 @@ Does not run after automatic updates of buffer or the shell.") (idlwave-update-routine-info '(16))) (defun idlwave-rescan-asynchronously () - "Dispatch another emacs instance to update the idlwave catalog. + "Dispatch another Emacs instance to update the idlwave catalog. After the process finishes normally, the first access to routine info will re-read the catalog." (interactive) diff --git a/lisp/resume.el b/lisp/resume.el index 0a719278266..d913782e0c8 100644 --- a/lisp/resume.el +++ b/lisp/resume.el @@ -49,7 +49,7 @@ ;;; Code: (defvar resume-emacs-args-file (expand-file-name "~/.emacs_args") - "*This file is where arguments are placed for a suspended emacs job.") + "*This file is where arguments are placed for a suspended Emacs job.") (defvar resume-emacs-args-buffer " *Command Line Args*" "Buffer that is used by resume-process-args.") diff --git a/lisp/rfn-eshadow.el b/lisp/rfn-eshadow.el index e8f0ab74caa..8e580039273 100644 --- a/lisp/rfn-eshadow.el +++ b/lisp/rfn-eshadow.el @@ -106,8 +106,8 @@ If Emacs is not running under a window system, (defcustom file-name-shadow-tty-properties '(before-string "{" after-string "} " field shadow) "Properties given to the `shadowed' part of a filename in the minibuffer. -Only used when `file-name-shadow-mode' is active and emacs -is not running under a window-system; if emacs is running under a window +Only used when `file-name-shadow-mode' is active and Emacs +is not running under a window-system; if Emacs is running under a window system, `file-name-shadow-properties' is used instead." :type file-name-shadow-properties-custom-type :group 'minibuffer diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index 67af1c13d91..29b4224c573 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -526,6 +526,16 @@ START-EVENT is the mouse click event." #'ruler-mode-mouse-del-tab-stop) (define-key km [header-line (control down-mouse-2)] #'ruler-mode-toggle-show-tab-stops) + (define-key km [header-line (shift mouse-1)] + 'ignore) + (define-key km [header-line (shift mouse-3)] + 'ignore) + (define-key km [header-line (control mouse-1)] + 'ignore) + (define-key km [header-line (control mouse-3)] + 'ignore) + (define-key km [header-line (control mouse-2)] + 'ignore) km) "Keymap for ruler minor mode.") diff --git a/lisp/server.el b/lisp/server.el index fc0f90f6f05..9214391d861 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -82,6 +82,36 @@ "Emacs running as a server process." :group 'external) +(defcustom server-use-tcp nil + "If non-nil, use TCP sockets instead of local sockets." + :set #'(lambda (sym val) + (unless (featurep 'make-network-process '(:family local)) + (setq val t) + (unless load-in-progress + (message "Local sockets unsupported, using TCP sockets"))) + (when val (random t)) + (set-default sym val)) + :group 'server + :type 'boolean + :version "22.1") + +(defcustom server-host nil + "The name or IP address to use as host address of the server process. +If set, the server accepts remote connections; otherwise it is local." + :group 'server + :type '(choice + (string :tag "Name or IP address") + (const :tag "Local" nil)) + :version "22.1") +(put 'server-host 'risky-local-variable t) + +(defcustom server-auth-dir "~/.emacs.d/server/" + "Directory for server authentication files." + :group 'server + :type 'directory + :version "22.1") +(put 'server-auth-dir 'risky-local-variable t) + (defcustom server-visit-hook nil "*Hook run when visiting a file for the Emacs server." :group 'server @@ -151,7 +181,7 @@ this way." :version "21.1") (or (assq 'server-buffer-clients minor-mode-alist) - (setq minor-mode-alist (cons '(server-buffer-clients " Server") minor-mode-alist))) + (push '(server-buffer-clients " Server") minor-mode-alist)) (defvar server-existing-buffer nil "Non-nil means the buffer existed before the server was asked to visit it. @@ -166,13 +196,13 @@ are done with it in the server.") (defun server-log (string &optional client) "If a *server* buffer exists, write STRING to it for logging purposes." - (if (get-buffer "*server*") - (with-current-buffer "*server*" - (goto-char (point-max)) - (insert (current-time-string) - (if client (format " %s:" client) " ") - string) - (or (bolp) (newline))))) + (when (get-buffer "*server*") + (with-current-buffer "*server*" + (goto-char (point-max)) + (insert (current-time-string) + (if client (format " %s:" client) " ") + string) + (or (bolp) (newline))))) (defun server-sentinel (proc msg) (let ((client (assq proc server-clients))) @@ -194,6 +224,12 @@ are done with it in the server.") (when (and (eq (process-status proc) 'open) (process-query-on-exit-flag proc)) (set-process-query-on-exit-flag proc nil)) + ;; Delete the associated connection file, if applicable. + ;; This is actually problematic: the file may have been overwritten by + ;; another Emacs server in the mean time, so it's not ours any more. + ;; (and (process-contact proc :server) + ;; (eq (process-status proc) 'closed) + ;; (ignore-errors (delete-file (process-get proc :server-file)))) (server-log (format "Status changed to %s" (process-status proc)) proc)) (defun server-select-display (display) @@ -205,12 +241,34 @@ are done with it in the server.") (select-frame frame))) ;; If there's no frame on that display yet, create and select one. (unless (equal (frame-parameter (selected-frame) 'display) display) - (select-frame - (make-frame-on-display - display - ;; This frame may be deleted later (see server-process-filter) - ;; so we want it to be as unobtrusive as possible. - '((visibility . nil))))))) + (let* ((buffer (generate-new-buffer " *server-dummy*")) + (frame (make-frame-on-display + display + ;; Make it display (and remember) some dummy buffer, so + ;; we can detect later if the frame is in use or not. + `((server-dummmy-buffer . ,buffer) + ;; This frame may be deleted later (see + ;; server-unselect-display) so we want it to be as + ;; unobtrusive as possible. + (visibility . nil))))) + (select-frame frame) + (set-window-buffer (selected-window) buffer))))) + +(defun server-unselect-display (frame) + ;; If the temporary frame is in use (displays something real), make it + ;; visible. If not (which can happen if the user's customizations call + ;; pop-to-buffer etc.), delete it to avoid preserving the connection after + ;; the last real frame is deleted. + (if (and (eq (frame-first-window frame) + (next-window (frame-first-window frame) 'nomini)) + (eq (window-buffer (frame-first-window frame)) + (frame-parameter frame 'server-dummy-buffer))) + ;; The temp frame still only shows one buffer, and that is the + ;; internal temp buffer. + (delete-frame frame) + (set-frame-parameter frame 'visibility t)) + (kill-buffer (frame-parameter frame 'server-dummy-buffer)) + (set-frame-parameter frame 'server-dummy-buffer nil)) (defun server-unquote-arg (arg) (replace-regexp-in-string @@ -231,11 +289,12 @@ Creates the directory if necessary and makes sure: (setq dir (directory-file-name dir)) (let ((attrs (file-attributes dir))) (unless attrs - (letf (((default-file-modes) ?\700)) (make-directory dir)) + (letf (((default-file-modes) ?\700)) (make-directory dir t)) (setq attrs (file-attributes dir))) ;; Check that it's safe for use. (unless (and (eq t (car attrs)) (eq (nth 2 attrs) (user-uid)) - (zerop (logand ?\077 (file-modes dir)))) + (or (eq system-type 'windows-nt) + (zerop (logand ?\077 (file-modes dir))))) (error "The directory %s is unsafe" dir)))) ;;;###autoload @@ -248,33 +307,61 @@ Emacs distribution as your standard \"editor\". Prefix arg means just kill any existing server communications subprocess." (interactive "P") - ;; kill it dead! - (if server-process - (condition-case () (delete-process server-process) (error nil))) - ;; Delete the socket files made by previous server invocations. - (condition-case () - (delete-file (expand-file-name server-name server-socket-dir)) - (error nil)) + (when server-process + ;; kill it dead! + (ignore-errors (delete-process server-process))) ;; If this Emacs already had a server, clear out associated status. (while server-clients (let ((buffer (nth 1 (car server-clients)))) (server-buffer-done buffer))) ;; Now any previous server is properly stopped. (unless leave-dead - ;; Make sure there is a safe directory in which to place the socket. - (server-ensure-safe-dir server-socket-dir) - (if server-process - (server-log (message "Restarting server"))) - (letf (((default-file-modes) ?\700)) - (setq server-process - (make-network-process - :name "server" :family 'local :server t :noquery t - :service (expand-file-name server-name server-socket-dir) - :sentinel 'server-sentinel :filter 'server-process-filter - ;; We must receive file names without being decoded. - ;; Those are decoded by server-process-filter according - ;; to file-name-coding-system. - :coding 'raw-text))))) + (let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir)) + (server-file (expand-file-name server-name server-dir))) + ;; Make sure there is a safe directory in which to place the socket. + (server-ensure-safe-dir server-dir) + ;; Remove any leftover socket or authentication file. + (ignore-errors (delete-file server-file)) + (when server-process + (server-log (message "Restarting server"))) + (letf (((default-file-modes) ?\700)) + (setq server-process + (apply #'make-network-process + :name server-name + :server t + :noquery t + :sentinel 'server-sentinel + :filter 'server-process-filter + ;; We must receive file names without being decoded. + ;; Those are decoded by server-process-filter according + ;; to file-name-coding-system. + :coding 'raw-text + ;; The rest of the args depends on the kind of socket used. + (if server-use-tcp + (list :family nil + :service t + :host (or server-host 'local) + :plist '(:authenticated nil)) + (list :family 'local + :service server-file + :plist '(:authenticated t))))) + (unless server-process (error "Could not start server process")) + (when server-use-tcp + (let ((auth-key + (loop + ;; The auth key is a 64-byte string of random chars in the + ;; range `!'..`~'. + for i below 64 + collect (+ 33 (random 94)) into auth + finally return (concat auth)))) + (process-put server-process :auth-key auth-key) + (with-temp-file server-file + (set-buffer-multibyte nil) + (setq buffer-file-coding-system 'no-conversion) + (insert (format-network-address + (process-contact server-process :local)) + " " (int-to-string (emacs-pid)) + "\n" auth-key)))))))) ;;;###autoload (define-minor-mode server-mode @@ -289,14 +376,27 @@ Server mode runs a process that accepts commands from the ;; nothing if there is one (for multiple Emacs sessions)? (server-start (not server-mode))) -(defun server-process-filter (proc string) +(defun* server-process-filter (proc string) "Process a request from the server to edit some files. PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." + ;; First things first: let's check the authentication + (unless (process-get proc :authenticated) + (if (and (string-match "-auth \\(.*?\\)\n" string) + (equal (match-string 1 string) (process-get proc :auth-key))) + (progn + (setq string (substring string (match-end 0))) + (process-put proc :authenticated t) + (server-log "Authentication successful" proc)) + (server-log "Authentication failed" proc) + (process-send-string proc "Authentication failed") + (delete-process proc) + ;; We return immediately + (return-from server-process-filter))) (server-log string proc) - (let ((prev (process-get proc 'previous-string))) + (let ((prev (process-get proc :previous-string))) (when prev (setq string (concat prev string)) - (process-put proc 'previous-string nil))) + (process-put proc :previous-string nil))) ;; If the input is multiple lines, ;; process each line individually. (while (string-match "\n" string) @@ -307,7 +407,7 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." client nowait eval (files nil) (lineno 1) - (tmp-frame nil) ; Sometimes used to embody the selected display. + (tmp-frame nil) ;; Sometimes used to embody the selected display. (columnno 0)) ;; Remove this line from STRING. (setq string (substring string (match-end 0))) @@ -316,51 +416,48 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." (let ((arg (substring request (match-beginning 0) (1- (match-end 0))))) (setq request (substring request (match-end 0))) (cond - ((equal "-nowait" arg) (setq nowait t)) - ((equal "-eval" arg) (setq eval t)) - ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request)) - (let ((display (server-unquote-arg (match-string 1 request)))) - (setq request (substring request (match-end 0))) - (condition-case err - (setq tmp-frame (server-select-display display)) - (error (process-send-string proc (nth 1 err)) - (setq request ""))))) - ;; ARG is a line number option. - ((string-match "\\`\\+[0-9]+\\'" arg) - (setq lineno (string-to-number (substring arg 1)))) - ;; ARG is line number:column option. - ((string-match "\\`+\\([0-9]+\\):\\([0-9]+\\)\\'" arg) - (setq lineno (string-to-number (match-string 1 arg)) - columnno (string-to-number (match-string 2 arg)))) - (t - ;; Undo the quoting that emacsclient does - ;; for certain special characters. - (setq arg (server-unquote-arg arg)) - ;; Now decode the file name if necessary. - (if coding-system - (setq arg (decode-coding-string arg coding-system))) - (if eval - (let* (errorp - (v (condition-case errobj - (eval (car (read-from-string arg))) - (error (setq errorp t) errobj)))) - (when v - (with-temp-buffer - (let ((standard-output (current-buffer))) - (if errorp (princ "error: ")) - (pp v) - ;; Suppress the error rose when the pipe to PROC is closed. - (condition-case err - (process-send-region proc (point-min) (point-max)) - (file-error nil) - (error nil)) - )))) - ;; ARG is a file name. - ;; Collapse multiple slashes to single slashes. - (setq arg (command-line-normalize-file-name arg)) - (push (list arg lineno columnno) files)) - (setq lineno 1) - (setq columnno 0))))) + ((equal "-nowait" arg) (setq nowait t)) + ((equal "-eval" arg) (setq eval t)) + ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request)) + (let ((display (server-unquote-arg (match-string 1 request)))) + (setq request (substring request (match-end 0))) + (condition-case err + (setq tmp-frame (server-select-display display)) + (error (process-send-string proc (nth 1 err)) + (setq request ""))))) + ;; ARG is a line number option. + ((string-match "\\`\\+[0-9]+\\'" arg) + (setq lineno (string-to-number (substring arg 1)))) + ;; ARG is line number:column option. + ((string-match "\\`+\\([0-9]+\\):\\([0-9]+\\)\\'" arg) + (setq lineno (string-to-number (match-string 1 arg)) + columnno (string-to-number (match-string 2 arg)))) + (t + ;; Undo the quoting that emacsclient does + ;; for certain special characters. + (setq arg (server-unquote-arg arg)) + ;; Now decode the file name if necessary. + (when coding-system + (setq arg (decode-coding-string arg coding-system))) + (if eval + (let* (errorp + (v (condition-case errobj + (eval (car (read-from-string arg))) + (error (setq errorp t) errobj)))) + (when v + (with-temp-buffer + (let ((standard-output (current-buffer))) + (when errorp (princ "error: ")) + (pp v) + (ignore-errors + (process-send-region proc (point-min) (point-max))) + )))) + ;; ARG is a file name. + ;; Collapse multiple slashes to single slashes. + (setq arg (command-line-normalize-file-name arg)) + (push (list arg lineno columnno) files)) + (setq lineno 1) + (setq columnno 0))))) (when files (run-hooks 'pre-command-hook) (server-visit-files files client nowait) @@ -378,24 +475,20 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." (run-hooks 'server-switch-hook) (unless nowait (message "%s" (substitute-command-keys - "When done with a buffer, type \\[server-edit]"))))) - ;; If the temporary frame is still the selected frame, make it - ;; real. If not (which can happen if the user's customizations - ;; call pop-to-buffer etc.), delete it to avoid preserving the - ;; connection after the last real frame is deleted. - (if tmp-frame - (if (eq (selected-frame) tmp-frame) - (set-frame-parameter tmp-frame 'visibility t) - (delete-frame tmp-frame))))) + "When done with a buffer, type \\[server-edit]"))))) + (when (frame-live-p tmp-frame) + ;; Delete tmp-frame or make it visible depending on whether it's + ;; been used or not. + (server-unselect-display tmp-frame)))) ;; Save for later any partial line that remains. (when (> (length string) 0) - (process-put proc 'previous-string string))) + (process-put proc :previous-string string))) (defun server-goto-line-column (file-line-col) (goto-line (nth 1 file-line-col)) (let ((column-number (nth 2 file-line-col))) - (if (> column-number 0) - (move-to-column (1- column-number))))) + (when (> column-number 0) + (move-to-column (1- column-number))))) (defun server-visit-files (files client &optional nowait) "Find FILES and return the list CLIENT with the buffers nconc'd. @@ -418,14 +511,14 @@ so don't mark these buffers specially, just visit them normally." (if (and obuf (set-buffer obuf)) (progn (cond ((file-exists-p filen) - (if (not (verify-visited-file-modtime obuf)) - (revert-buffer t nil))) + (when (not (verify-visited-file-modtime obuf)) + (revert-buffer t nil))) (t - (if (y-or-n-p - (concat "File no longer exists: " - filen - ", write buffer to file? ")) - (write-file filen)))) + (when (y-or-n-p + (concat "File no longer exists: " + filen + ", write buffer to file? ")) + (write-file filen)))) (setq server-existing-buffer t) (server-goto-line-column file)) (set-buffer (find-file-noselect filen)) @@ -467,33 +560,33 @@ FOR-KILLING if non-nil indicates that we are called from `kill-buffer'." (server-log "Close" (car client)) (setq server-clients (delq client server-clients)))) (setq old-clients (cdr old-clients))) - (if (and (bufferp buffer) (buffer-name buffer)) - ;; We may or may not kill this buffer; - ;; if we do, do not call server-buffer-done recursively - ;; from kill-buffer-hook. - (let ((server-kill-buffer-running t)) - (with-current-buffer buffer - (setq server-buffer-clients nil) - (run-hooks 'server-done-hook)) - ;; Notice whether server-done-hook killed the buffer. - (if (null (buffer-name buffer)) + (when (and (bufferp buffer) (buffer-name buffer)) + ;; We may or may not kill this buffer; + ;; if we do, do not call server-buffer-done recursively + ;; from kill-buffer-hook. + (let ((server-kill-buffer-running t)) + (with-current-buffer buffer + (setq server-buffer-clients nil) + (run-hooks 'server-done-hook)) + ;; Notice whether server-done-hook killed the buffer. + (if (null (buffer-name buffer)) + (setq killed t) + ;; Don't bother killing or burying the buffer + ;; when we are called from kill-buffer. + (unless for-killing + (when (and (not killed) + server-kill-new-buffers + (with-current-buffer buffer + (not server-existing-buffer))) (setq killed t) - ;; Don't bother killing or burying the buffer - ;; when we are called from kill-buffer. - (unless for-killing - (when (and (not killed) - server-kill-new-buffers - (with-current-buffer buffer - (not server-existing-buffer))) - (setq killed t) - (bury-buffer buffer) - (kill-buffer buffer)) - (unless killed - (if (server-temp-file-p buffer) - (progn - (kill-buffer buffer) - (setq killed t)) - (bury-buffer buffer))))))) + (bury-buffer buffer) + (kill-buffer buffer)) + (unless killed + (if (server-temp-file-p buffer) + (progn + (kill-buffer buffer) + (setq killed t)) + (bury-buffer buffer))))))) (list next-buffer killed))) (defun server-temp-file-p (&optional buffer) @@ -520,10 +613,10 @@ specifically for the clients and did not exist before their request for it." (let ((version-control nil) (buffer-backed-up nil)) (save-buffer)) - (if (and (buffer-modified-p) - buffer-file-name - (y-or-n-p (concat "Save file " buffer-file-name "? "))) - (save-buffer))) + (when (and (buffer-modified-p) + buffer-file-name + (y-or-n-p (concat "Save file " buffer-file-name "? "))) + (save-buffer))) (server-buffer-done (current-buffer)))) ;; Ask before killing a server buffer. @@ -543,8 +636,8 @@ specifically for the clients and did not exist before their request for it." (tail server-clients)) ;; See if any clients have any buffers that are still alive. (while tail - (if (memq t (mapcar 'stringp (mapcar 'buffer-name (cdr (car tail))))) - (setq live-client t)) + (when (memq t (mapcar 'stringp (mapcar 'buffer-name (cdr (car tail))))) + (setq live-client t)) (setq tail (cdr tail))) (or (not live-client) (yes-or-no-p "Server buffers still have clients; exit anyway? ")))) @@ -579,12 +672,12 @@ If invoked with a prefix argument, or if there is no server process running, starts server process and that is all. Invoked by \\[server-edit]." (interactive "P") (cond - ((or arg - (not server-process) - (memq (process-status server-process) '(signal exit))) - (server-mode 1)) - (server-clients (apply 'server-switch-buffer (server-done))) - (t (message "No server editing buffers exist")))) + ((or arg + (not server-process) + (memq (process-status server-process) '(signal exit))) + (server-mode 1)) + (server-clients (apply 'server-switch-buffer (server-done))) + (t (message "No server editing buffers exist")))) (defun server-switch-buffer (&optional next-buffer killed-one) "Switch to another buffer, preferably one that has a client. @@ -610,8 +703,8 @@ Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it." (if (and win (not server-window)) ;; The buffer is already displayed: just reuse the window. (let ((frame (window-frame win))) - (if (eq (frame-visible-p frame) 'icon) - (raise-frame frame)) + (when (eq (frame-visible-p frame) 'icon) + (raise-frame frame)) (select-window win) (set-buffer next-buffer)) ;; Otherwise, let's find an appropriate window. @@ -619,11 +712,11 @@ Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it." (window-live-p server-window)) (select-window server-window)) ((framep server-window) - (if (not (frame-live-p server-window)) - (setq server-window (make-frame))) + (unless (frame-live-p server-window) + (setq server-window (make-frame))) (select-window (frame-selected-window server-window)))) - (if (window-minibuffer-p (selected-window)) - (select-window (next-window nil 'nomini 0))) + (when (window-minibuffer-p (selected-window)) + (select-window (next-window nil 'nomini 0))) ;; Move to a non-dedicated window, if we have one. (when (window-dedicated-p (selected-window)) (select-window diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index f5f8bac7edc..ac2ab0fd0f8 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -97,12 +97,12 @@ is no buffer currently visiting the file." :group 'shadow) (defcustom shadow-inhibit-message nil - "*If nonnil, do not display a message when a file needs copying." + "*If non-nil, do not display a message when a file needs copying." :type 'boolean :group 'shadow) (defcustom shadow-inhibit-overload nil - "If nonnil, shadowfile won't redefine \\[save-buffers-kill-emacs]. + "If non-nil, shadowfile won't redefine \\[save-buffers-kill-emacs]. Normally it overloads the function `save-buffers-kill-emacs' to check for files have been changed and need to be copied to other systems." :type 'boolean @@ -146,7 +146,7 @@ Default: ~/.shadow_todo" (defvar shadow-literal-groups nil "List of files that are shared between hosts. This list contains shadow structures with literal filenames, created by -shadow-define-group.") +`shadow-define-literal-group'.") (defvar shadow-regexp-groups nil "List of file types that are shared between hosts. @@ -178,7 +178,7 @@ created by `shadow-define-regexp-group'.") (shadow-union (cdr a) (cons (car a) b))))) (defun shadow-find (func list) - "If FUNC applied to some element of LIST is nonnil, return first such element." + "If FUNC applied to some element of LIST is non-nil, return first such element." (while (and list (not (funcall func (car list)))) (setq list (cdr list))) (car list)) @@ -205,7 +205,7 @@ This makes sure regexp matches nothing but STRING." (defun shadow-suffix (prefix string) "If PREFIX begins STRING, return the rest. -Return value is nonnil if PREFIX and STRING are string= up to the length of +Return value is non-nil if PREFIX and STRING are `string=' up to the length of PREFIX." (let ((lp (length prefix)) (ls (length string))) @@ -285,9 +285,9 @@ information defining the cluster. For interactive use, call ans))) (defun shadow-site-match (site1 site2) - "Nonnil iff SITE1 is or includes SITE2. -Each may be a host or cluster name; if they are clusters, regexp of site1 will -be matched against the primary of site2." + "Non-nil iff SITE1 is or includes SITE2. +Each may be a host or cluster name; if they are clusters, regexp of SITE1 will +be matched against the primary of SITE2." (or (string-equal site1 site2) ; quick check (let* ((cluster1 (shadow-get-cluster site1)) (primary2 (shadow-site-primary site2))) @@ -355,7 +355,7 @@ Will return the name bare if it is a local file." (nth 2 hup)))))) (defun shadow-expand-file-name (file &optional default) - "Expand file name and get file's true name." + "Expand file name and get FILE's true name." (file-truename (expand-file-name file default))) (defun shadow-contract-file-name (file) @@ -398,7 +398,7 @@ local filename." "Return t if PATTERN matches FILE. If REGEXP is supplied and non-nil, the file part of the pattern is a regular expression, otherwise it must match exactly. The sites and usernames must -match---see shadow-same-site. The pattern must be in full ange-ftp format, but +match---see `shadow-same-site'. The pattern must be in full ange-ftp format, but the file can be any valid filename. This function does not do any filename expansion or contraction, you must do that yourself first." (let* ((pattern-sup (shadow-parse-fullname pattern)) @@ -475,7 +475,7 @@ specific hostnames, or names of clusters \(see `shadow-define-cluster')." "Make each of a group of files be shared between hosts. Prompts for regular expression; files matching this are shared between a list of sites, which are also prompted for. The filenames must be identical on all -hosts \(if they aren't, use shadow-define-group instead of this function). +hosts \(if they aren't, use `shadow-define-literal-group' instead of this function). Each site can be either a hostname or the name of a cluster \(see `shadow-define-cluster')." (interactive) @@ -661,7 +661,7 @@ Returns t unless files were locked; then returns nil." (or (stringp (file-locked-p shadow-info-file)) (stringp (file-locked-p shadow-todo-file)))) (progn - (message "Shadowfile is running in another emacs; can't have two.") + (message "Shadowfile is running in another Emacs; can't have two.") (beep) (sit-for 3) nil) @@ -707,8 +707,8 @@ defined, the old hashtable info is invalid." (shadow-insert-var 'shadow-regexp-groups)))) (defun shadow-write-todo-file (&optional save) - "Write out information to shadow-todo-file. -With nonnil argument also saves the buffer." + "Write out information to `shadow-todo-file'. +With non-nil argument also saves the buffer." (save-excursion (if (not shadow-todo-buffer) (setq shadow-todo-buffer (find-file-noselect shadow-todo-file))) @@ -731,9 +731,9 @@ With nonnil argument also saves the buffer." (setq shadow-hashtable (make-vector 37 0))) (defun shadow-insert-var (variable) - "Prettily insert a setq command for VARIABLE. + "Prettily insert a `setq' command for VARIABLE, which, when later evaluated, will restore it to its current setting. -SYMBOL must be the name of a variable whose value is a list." +VARIABLE must be the name of a variable whose value is a list." (let ((standard-output (current-buffer))) (insert (format "(setq %s" variable)) (cond ((consp (eval variable)) diff --git a/lisp/simple.el b/lisp/simple.el index e06b93c1a30..8b0b591710e 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2725,7 +2725,7 @@ When this command inserts killed text into the buffer, it honors `yank-excluded-properties' and `yank-handler' as described in the doc string for `insert-for-yank-1', which see. -See also the command \\[yank-pop]." +See also the command `yank-pop' (\\[yank-pop])." (interactive "*P") (setq yank-window-start (window-start)) ;; If we don't get all the way thru, make last-command indicate that diff --git a/lisp/sort.el b/lisp/sort.el index 359067a4af3..798d2da584a 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -505,8 +505,9 @@ Use \\[untabify] to convert tabs to spaces before sorting." ;; Use the sort utility if we can; it is 4 times as fast. ;; Do not use it if there are any non-font-lock properties ;; in the region, since the sort utility would lose the - ;; properties. - (let ((sort-args (list (if reverse "-rt\n" "-t\n") + ;; properties. Tabs are used as field separator; on NetBSD, + ;; sort complains if "\n" is used as field separator. + (let ((sort-args (list (if reverse "-rt\t" "-t\t") (format "-k1.%d,1.%d" (1+ col-start) (1+ col-end))))) diff --git a/lisp/speedbar.el b/lisp/speedbar.el index e5ab181e8c6..aa09e018803 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -2157,7 +2157,7 @@ Groups may optionally contain a position." )))) (defun speedbar-generic-list-tag-p (sublst) - "Non nil if SUBLST is a tag." + "Non-nil if SUBLST is a tag." (and (stringp (car-safe sublst)) (or (and (number-or-marker-p (cdr-safe sublst)) (not (cdr-safe (cdr-safe sublst)))) diff --git a/lisp/startup.el b/lisp/startup.el index ba740a721d5..3a2916e1d80 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -283,7 +283,8 @@ from being initialized." (defvar init-file-debug nil) -(defvar init-file-had-error nil) +(defvar init-file-had-error nil + "Non-nil if there was an error loading the user's init file.") (defvar normal-top-level-add-subdirs-inode-list nil) @@ -1150,8 +1151,16 @@ Getting New Versions\tHow to obtain the latest version of Emacs More Manuals / Ordering Manuals Buying printed manuals from the FSF\n") (:face (variable-pitch :weight bold) "Useful File menu items:\n" - :face variable-pitch "\ -Exit Emacs\t\t(Or type Control-x followed by Control-c) + :face variable-pitch + "Exit Emacs\t\t(Or type " + :face default + "Control-x" + :face variable-pitch + " followed by " + :face default + "Control-c" + :face variable-pitch + ") Recover Crashed Session\tRecover files you were editing before a crash @@ -1269,16 +1278,19 @@ where FACE is a valid face specification, as it can be used with :face 'variable-pitch "You can do basic editing with the menu bar and scroll bar \ using the mouse.\n\n") - (if fancy-splash-outer-buffer - (fancy-splash-insert - :face 'variable-pitch - (substitute-command-keys - (concat - "Type \\[recenter] to begin editing" - (if (equal (buffer-name fancy-splash-outer-buffer) - "*scratch*") - ".\n" - " your file.\n")))))) + (when fancy-splash-outer-buffer + (fancy-splash-insert + :face 'variable-pitch + "Type " + :face 'default + (substitute-command-keys + "\\[recenter]") + :face 'variable-pitch + " to begin editing" + (if (equal (buffer-name fancy-splash-outer-buffer) + "*scratch*") + ".\n" + " your file.\n")))) (defun fancy-splash-tail () "Insert the tail part of the splash screen into the current buffer." @@ -1305,7 +1317,11 @@ using the mouse.\n\n") t) (fancy-splash-insert :face '(variable-pitch :foreground "red") "\n\nIf an Emacs session crashed recently, " - "type Meta-x recover-session RET\nto recover" + "type " + :face '(fixed-pitch :foreground "red") + "Meta-x recover-session RET" + :face '(variable-pitch :foreground "red") + "\nto recover" " the files you were editing.")))) (defun fancy-splash-screens-1 (buffer) @@ -1881,7 +1897,12 @@ With a prefix argument, any user input hides the splash screen." (setq line 0) (unless (< column 1) (move-to-column (1- column))) - (setq column 0)))))))) + (setq column 0)))))) + ;; In unusual circumstances, the execution of Lisp code due + ;; to command-line options can cause the last visible frame + ;; to be deleted. In this case, kill emacs to avoid an + ;; abort later. + (unless (frame-live-p (selected-frame)) (kill-emacs nil)))) ;; If 3 or more files visited, and not all visible, ;; show user what they all are. But leave the last one current. diff --git a/lisp/subr.el b/lisp/subr.el index 17f401ba14b..28efcdf4c15 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1108,11 +1108,11 @@ other hooks, such as major mode hooks, can do the job." ((eq compare-fn 'eql) (memql element (symbol-value list-var))) (t - (let (present) - (dolist (elt (symbol-value list-var)) - (if (funcall compare-fn element elt) - (setq present t))) - present))) + (let ((lst (symbol-value list-var))) + (while (and lst + (not (funcall compare-fn element (car lst)))) + (setq lst (cdr lst))) + lst))) (symbol-value list-var) (set list-var (if append diff --git a/lisp/t-mouse.el b/lisp/t-mouse.el index 06b77840c0d..1a4ca969954 100644 --- a/lisp/t-mouse.el +++ b/lisp/t-mouse.el @@ -38,7 +38,7 @@ ;; now position sensitive. (defvar t-mouse-process nil - "Embeds the process which passes mouse events to emacs. + "Embeds the process which passes mouse events to Emacs. It is used by the program t-mouse.") (defvar t-mouse-filter-accumulator "" @@ -123,7 +123,7 @@ For example, \"2\" for /dev/tty2." (if (null l1) l2 (append (mapcar (function (lambda (x) (append (nth 0 l1) x))) l2) (t-mouse-cartesian (cdr l1) l2)))) - + (let* ((modifier-sets (t-mouse-powerset '(control meta shift))) (typed-sets (t-mouse-cartesian '((down) (drag)) '((mouse-1) (mouse-2) (mouse-3)))) @@ -178,9 +178,9 @@ Also trim the accumulator by all the data used to build the event." ((event-name-string (symbol-name event-type)) end-of-root-event-name new-event-name-string) - + (if (string-match "-\\(21\\|\\12\\)$" event-name-string) - + ;;Transform the name to what it should have been. (progn (setq end-of-root-event-name (match-beginning 0)) @@ -188,12 +188,12 @@ Also trim the accumulator by all the data used to build the event." (concat (substring event-name-string 0 end-of-root-event-name) "-3")) - + ;;Change the event to the symbol that corresponds to the ;;name we made. The proper symbol already exists. (setq event-type (intern new-event-name-string)))))) - + ;;store current position for mouse-position (setq t-mouse-current-xy (nth 0 current-xy-avec-time)) @@ -269,7 +269,7 @@ The (secret) scrollbar interface is not implemented yet." "Toggle t-mouse mode. With prefix arg, turn t-mouse mode on iff arg is positive. -Turn it on to use emacs mouse commands, and off to use t-mouse commands." +Turn it on to use Emacs mouse commands, and off to use t-mouse commands." nil " Mouse" nil :global t (if t-mouse-mode ;; Turn it on diff --git a/lisp/terminal.el b/lisp/terminal.el index 63092e3caea..51f2b37509b 100644 --- a/lisp/terminal.el +++ b/lisp/terminal.el @@ -1162,7 +1162,7 @@ subprocess started." (setq inhibit-quit t) ;sport death (use-local-map terminal-map) (run-hooks 'terminal-mode-hook) - (message "Entering emacs terminal-emulator... Type %s %s for help" + (message "Entering Emacs terminal-emulator... Type %s %s for help" (single-key-description terminal-escape-char) (mapconcat 'single-key-description (where-is-internal 'te-escape-help terminal-escape-map t) diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index c82f2dcf3d0..9597b136d7d 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -5,7 +5,7 @@ ;; Author: Stefan Schoef <schoef@offis.uni-oldenburg.de> ;; Bengt Martensson <bengt@mathematik.uni-Bremen.de> -;; Mark Shapiro <shapiro@corto.inria.fr> +;; Marc Shapiro <marc.shapiro@acm.org> ;; Mike Newton <newton@gumby.cs.caltech.edu> ;; Aaron Larson <alarson@src.honeywell.com> ;; Dirk Herrmann <D.Herrmann@tu-bs.de> diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index 1c81b5cf25e..cd1079e0924 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -66,7 +66,7 @@ (defface fixed '((t (:weight bold))) "Face used for text that must be shown in fixed width. -Currently, emacs can only display fixed-width fonts, but this may change. +Currently, Emacs can only display fixed-width fonts, but this may change. This face is used for text specifically marked as fixed-width, for example in text/enriched files." :group 'enriched) diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index 1ef6783e341..6aae79a825f 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -746,6 +746,12 @@ space does not end a sentence, so don't break a line there." (looking-at (regexp-quote prefix)))) (goto-char (match-end 0)))) +(defun fill-minibuffer-function (arg) + "Fill a paragraph in the minibuffer, ignoring the prompt." + (save-restriction + (narrow-to-region (minibuffer-prompt-end) (point-max)) + (fill-paragraph arg))) + (defun fill-paragraph (arg) "Fill paragraph at or after point. Prefix ARG means justify as well. If `sentence-end-double-space' is non-nil, then period followed by one @@ -760,8 +766,13 @@ If `fill-paragraph-function' is nil, return the `fill-prefix' used for filling." (barf-if-buffer-read-only) (list (if current-prefix-arg 'full)))) ;; First try fill-paragraph-function. - (or (and fill-paragraph-function - (let ((function fill-paragraph-function) + (or (and (or fill-paragraph-function + (and (window-minibuffer-p (selected-window)) + (= 1 (point-min)))) + (let ((function (or fill-paragraph-function + ;; In the minibuffer, don't count the width + ;; of the prompt. + 'fill-minibuffer-function)) ;; If fill-paragraph-function is set, it probably takes care ;; of comments and stuff. If not, it will have to set ;; fill-paragraph-handle-comment back to t explicitly or diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index b24124851de..5268988f427 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -189,7 +189,7 @@ Ispell's ultimate default dictionary." :type 'string) (defcustom flyspell-check-tex-math-command nil - "Non nil means check even inside TeX math environment. + "Non-nil means check even inside TeX math environment. TeX math environments are discovered by the TEXMATHP that implemented inside the texmathp.el Emacs package. That package may be found at: http://strw.leidenuniv.nl/~dominik/Tools" @@ -412,6 +412,7 @@ property of the major mode name.") (define-key map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word) (define-key map [(control ?\,)] 'flyspell-goto-next-error) (define-key map [(control ?\.)] 'flyspell-auto-correct-word) + (define-key map [(meta ?\^m)] 'flyspell-correct-word-before-point) map) "Minor mode keymap for Flyspell mode--for the whole buffer.") @@ -1999,52 +2000,62 @@ But don't look beyond what's visible on the screen." ;;*---------------------------------------------------------------------*/ ;;* flyspell-correct-word ... */ ;;*---------------------------------------------------------------------*/ + (defun flyspell-correct-word (event) "Pop up a menu of possible corrections for a misspelled word. The word checked is the word at the mouse position." (interactive "e") - ;; use the correct dictionary - (flyspell-accept-buffer-local-defs) - ;; retain cursor location (I don't know why but save-excursion here fails). (let ((save (point))) (mouse-set-point event) - (let ((cursor-location (point)) - (word (flyspell-get-word nil))) - (if (consp word) - (let ((start (car (cdr word))) - (end (car (cdr (cdr word)))) - (word (car word)) - poss ispell-filter) - ;; now check spelling of word. - (ispell-send-string "%\n") ;put in verbose mode - (ispell-send-string (concat "^" word "\n")) - ;; wait until ispell has processed word - (while (progn - (accept-process-output ispell-process) - (not (string= "" (car ispell-filter))))) - ;; Remove leading empty element - (setq ispell-filter (cdr ispell-filter)) - ;; ispell process should return something after word is sent. - ;; Tag word as valid (i.e., skip) otherwise - (or ispell-filter - (setq ispell-filter '(*))) - (if (consp ispell-filter) - (setq poss (ispell-parse-output (car ispell-filter)))) - (cond - ((or (eq poss t) (stringp poss)) - ;; don't correct word - t) - ((null poss) - ;; ispell error - (error "Ispell: error in Ispell process")) - ((featurep 'xemacs) - (flyspell-xemacs-popup - poss word cursor-location start end save)) - (t - ;; The word is incorrect, we have to propose a replacement. - (flyspell-do-correct (flyspell-emacs-popup event poss word) - poss word cursor-location start end save))) - (ispell-pdict-save t)))))) + (flyspell-correct-word-before-point event save))) + +(defun flyspell-correct-word-before-point (&optional event opoint) + "Pop up a menu of possible corrections for misspelled word before point. +If EVENT is non-nil, it is the mouse event that invoked this operation; +that controls where to put the menu. +If OPOINT is non-nil, restore point there after adjusting it for replacement." + (interactive) + (unless (mouse-position) + (error "Pop-up menus do not work on this terminal")) + ;; use the correct dictionary + (flyspell-accept-buffer-local-defs) + (let ((cursor-location (point)) + (word (flyspell-get-word nil))) + (if (consp word) + (let ((start (car (cdr word))) + (end (car (cdr (cdr word)))) + (word (car word)) + poss ispell-filter) + ;; now check spelling of word. + (ispell-send-string "%\n") ;put in verbose mode + (ispell-send-string (concat "^" word "\n")) + ;; wait until ispell has processed word + (while (progn + (accept-process-output ispell-process) + (not (string= "" (car ispell-filter))))) + ;; Remove leading empty element + (setq ispell-filter (cdr ispell-filter)) + ;; ispell process should return something after word is sent. + ;; Tag word as valid (i.e., skip) otherwise + (or ispell-filter + (setq ispell-filter '(*))) + (if (consp ispell-filter) + (setq poss (ispell-parse-output (car ispell-filter)))) + (cond + ((or (eq poss t) (stringp poss)) + ;; don't correct word + t) + ((null poss) + ;; ispell error + (error "Ispell: error in Ispell process")) + ((featurep 'xemacs) + (flyspell-xemacs-popup + poss word cursor-location start end opoint)) + (t + ;; The word is incorrect, we have to propose a replacement. + (flyspell-do-correct (flyspell-emacs-popup event poss word) + poss word cursor-location start end opoint))) + (ispell-pdict-save t))))) ;;*---------------------------------------------------------------------*/ ;;* flyspell-do-correct ... */ diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 53cc61c48a2..a8b7d1bd7df 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -217,7 +217,7 @@ "Empty replacement for defgroup when not supplied."))) (defgroup ispell nil - "User variables for emacs ispell interface." + "User variables for Emacs ispell interface." :group 'applications) (if (not (fboundp 'buffer-substring-no-properties)) @@ -496,7 +496,7 @@ These can override the values in `ispell-dictionary-alist'. To make permanent changes to your dictionary definitions, you will need to make your changes in this variable, save, and then -re-start emacs." +re-start Emacs." :type '(repeat (list (choice :tag "Dictionary" (string :tag "Dictionary name") (const :tag "default" nil)) @@ -900,13 +900,13 @@ and added as a submenu of the \"Edit\" menu.") (buffer-string)))) ;; Search for the named dictionaries. (found - (delq nil + (delq nil (mapcar #'ispell-aspell-find-dictionary dictionaries)))) ;; Ensure aspell's alias dictionary will override standard ;; definitions. (setq found (ispell-aspell-add-aliases found)) ;; Merge into FOUND any elements from the standard ispell-dictionary-alist - ;; which have no element in FOUND at all. + ;; which have no element in FOUND at all. (dolist (dict ispell-dictionary-alist) (unless (assoc (car dict) found) (setq found (nconc found (list dict))))) @@ -2074,7 +2074,7 @@ SPC: Accept word this time. `m': Place typed-in value in personal dictionary, then recheck current word. `C-l': redraws screen `C-r': recursive edit -`C-z': suspend emacs or iconify frame" +`C-z': suspend Emacs or iconify frame" (if (equal ispell-help-in-bufferp 'electric) (progn @@ -2106,7 +2106,7 @@ SPC: Accept word this time. `m': Place typed-in value in personal dictionary, then recheck current word. `C-l': redraws screen `C-r': recursive edit -`C-z': suspend emacs or iconify frame") +`C-z': suspend Emacs or iconify frame") nil ;undocumented requirement of with-electric-help )))) diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el index caca6a6ae7d..5e15855a69d 100644 --- a/lisp/textmodes/org.el +++ b/lisp/textmodes/org.el @@ -1103,7 +1103,7 @@ for some files for which the OS does not have a good default. See `org-file-apps'.") (defconst org-file-apps-defaults-windowsnt - (list + (list '(remote . emacs) (cons t (list (if (featurep 'xemacs) @@ -1132,7 +1132,7 @@ file identifier are \"ext\" A string identifying an extension `directory' Matches a directory `remote' Matches a remote file, accessible through tramp or efs. - Remote files most likely should be visited through emacs + Remote files most likely should be visited through Emacs because external applications cannot handle such paths. t Default for all remaining files @@ -2342,7 +2342,7 @@ stacked Non-nil means, allow stacked styles. This works only in HTML export. When this is set, all marker characters (as given in `org-emphasis-alist') will be allowed as pre/post, aiding inside-out matching. -Use customize to modify this, or restart emacs after changing it." +Use customize to modify this, or restart Emacs after changing it." :group 'org-font-lock :set 'org-set-emph-re :type '(list @@ -2360,12 +2360,12 @@ Use customize to modify this, or restart emacs after changing it." ("=" shadow "<code>" "</code>") ("+" (:strike-through t) "<del>" "</del>") ) -"Special syntax for emphasised text. +"Special syntax for emphasized text. Text starting and ending with a special character will be emphasized, for example *bold*, _underlined_ and /italic/. This variable sets the marker characters, the face to bbe used by font-lock for highlighting in Org-mode -emacs buffers, and the HTML tags to be used for this. -Use customize to modify this, or restart emacs after changing it." +Emacs buffers, and the HTML tags to be used for this. +Use customize to modify this, or restart Emacs after changing it." :group 'org-font-lock :set 'org-set-emph-re :type '(repeat @@ -2897,11 +2897,8 @@ Also put tags into group 4 if tags are present.") ;;; Define the mode -(defvar org-mode-map - (if (and (not (keymapp outline-mode-map)) (featurep 'allout)) - (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or ugrade to newer allout, for example by switching to Emacs 22.") - (copy-keymap outline-mode-map)) - "Keymap for Org-mode.") +(if (and (not (keymapp outline-mode-map)) (featurep 'allout)) + (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or ugrade to newer allout, for example by switching to Emacs 22.")) (defvar org-struct-menu) ; defined later in this file (defvar org-org-menu) ; defined later in this file @@ -2913,6 +2910,7 @@ Also put tags into group 4 if tags are present.") "Indicates that a table might need an update. This variable is set by `org-before-change-function'. `org-table-align' sets it back to nil.") +(defvar org-mode-map) (defvar org-mode-hook nil) (defvar org-inhibit-startup nil) ; Dynamically-scoped param. (defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. @@ -3453,7 +3451,7 @@ between words." (call-interactively 'org-table-next-field))))) ((eq arg t) ;; Global cycling - + (cond ((and (eq last-command this-command) (eq org-cycle-global-status 'overview)) @@ -3953,7 +3951,7 @@ would end up with no indentation after the change, nothing at all is done." (let ((end (save-excursion (outline-next-heading) (point-marker))) (prohibit (if (> diff 0) - "^\\S-" + "^\\S-" (concat "^ \\{0," (int-to-string (- diff)) "\\}\\S-"))) col) (unless (save-excursion (re-search-forward prohibit end t)) @@ -4029,7 +4027,7 @@ This is a short-hand for marking the subtree and then cutting it." (defun org-copy-subtree (&optional cut) "Cut the current subtree into the clipboard. This is a short-hand for marking the subtree and then copying it. -If CUT is non nil, actually cut the subtree." +If CUT is non-nil, actually cut the subtree." (interactive) (let (beg end folded) (org-back-to-heading) @@ -4217,7 +4215,7 @@ If optional TXT is given, check this string instead of the current kill." (setq status (equal (match-string 0) "[X]")) (when (eq firstnew 'unknown) (setq firstnew (not status))) - (replace-match + (replace-match (if (if arg (not status) firstnew) "[X]" "[ ]") t t)) (beginning-of-line 2)))))) @@ -4513,7 +4511,7 @@ this heading. " (if find-done (org-archive-all-done) ;; Save all relevant TODO keyword-relatex variables - + (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler (tr-org-todo-keywords org-todo-keywords) (tr-org-todo-interpretation org-todo-interpretation) @@ -4620,7 +4618,7 @@ When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." (if (org-on-heading-p) (progn (setq re1 (concat "^" (regexp-quote - (make-string + (make-string (1+ (- (match-end 0) (match-beginning 0))) ?*)) " ")) @@ -4751,7 +4749,7 @@ the children that do not contain any open TODO items." (org-end-of-subtree) (throw :skip t)) (if (equal (char-after p) ?#) (throw :skip t)))) - + (defun org-agenda-toggle-archive-tag () "Toggle the archive tag for the current entry." (interactive) @@ -6192,12 +6190,12 @@ the returned times will be formatted strings." (apply 'encode-time (org-parse-time-string te))))) (move-marker ins (point)) (setq ipos (point)) - (insert-before-markers "Clock summary at [" + (insert-before-markers "Clock summary at [" (substring (format-time-string (cdr org-time-stamp-formats)) 1 -1) "]." - (if block + (if block (format " Considered range is /%s/." block) "") "\n\n|L|Headline|Time|\n") @@ -6223,7 +6221,7 @@ the returned times will be formatted strings." (goto-char ins) (if (= level 1) (insert-before-markers "|-\n")) (insert-before-markers - "| " (int-to-string level) "|" hlc hdl hlc " |" + "| " (int-to-string level) "|" hlc hdl hlc " |" (make-string (1- level) ?|) hlc (format "%d:%02d" h m) @@ -8818,7 +8816,7 @@ With prefix ARG, realign all tags in headings in the current buffer." nil nil current 'org-tags-history)))) (while (string-match "[-+&]+" tags) (setq tags (replace-match ":" t t tags)))) - + (unless (setq empty (string-match "\\`[\t ]*\\'" tags)) (unless (string-match ":$" tags) (setq tags (concat tags ":"))) (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) @@ -9971,7 +9969,7 @@ For file links, arg negates `org-context-in-file-links'." ((eq major-mode 'image-mode) (setq cpltxt (concat "file:" (abbreviate-file-name buffer-file-name)) - link (org-make-link cpltxt))) + link (org-make-link cpltxt))) ((org-mode-p) ;; Just link to current headline @@ -13354,7 +13352,7 @@ translations. There is currently no way for users to extend this.") ;; Convert LaTeX fragments to images (when (memq :LaTeX-fragments parameters) - (org-format-latex + (org-format-latex (concat "ltxpng/" (file-name-sans-extension (file-name-nondirectory org-current-export-file))) @@ -13873,7 +13871,7 @@ org-mode's default settings, but still inferior to file-local settings." (all_lines (org-skip-comments (org-split-string (org-cleaned-string-for-export - region :emph-multiline + region :emph-multiline (if (plist-get opt-plist :LaTeX-fragments) :LaTeX-fragments)) "[\r\n]"))) @@ -14137,7 +14135,7 @@ lang=\"%s\" xml:lang=\"%s\"> (setq valid (if (functionp link-validate) (funcall link-validate filename current-dir) - t)) + t)) (setq file-is-image-p (string-match (org-image-file-name-regexp) filename)) (setq thefile (if abs-p (expand-file-name filename) filename)) @@ -14993,7 +14991,7 @@ a time), or the day by one (if it does not contain a time)." (defvar org-cdlatex-texmathp-advice-is-done nil "Flag remembering if we have applied the advice to texmathp already.") -(define-minor-mode org-cdlatex-mode +(define-minor-mode org-cdlatex-mode "Toggle the minor `org-cdlatex-mode'. This mode supports entering LaTeX environment and math in LaTeX fragments in Org-mode. @@ -15121,7 +15119,7 @@ Revert to the normal definition outside of these fragments." If the cursor is in a LaTeX fragment, create the image and overlay it over the source code. If there is no fragment at point, display all fragments in the current text, from one headline to the next. With -prefix SUBTREE, display all fragments in the current subtree. With a +prefix SUBTREE, display all fragments in the current subtree. With a double prefix `C-u C-u', or when the cursor is before the first headline, display all fragments in the buffer. The images can be removed again with \\[org-ctrl-c-ctrl-c]." @@ -15209,16 +15207,16 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (progn (org-overlay-put ov 'invisible t) (org-overlay-put - ov 'end-glyph + ov 'end-glyph (make-glyph (vector 'png :file movefile)))) - (org-overlay-put - ov 'display + (org-overlay-put + ov 'display (list 'image :type 'png :file movefile :ascent 'center))) (push ov org-latex-fragment-image-overlays) (goto-char end)) (delete-region beg end) (insert link)))))))) - + ;; This function borrows from Ganesh Swami's latex2png.el (defun org-create-formula-image (string tofile options) (let* ((tmpdir (if (featurep 'xemacs) @@ -15870,7 +15868,7 @@ See the individual commands for more information." :style toggle :selected (not org-agenda-skip-archived-trees)] "--" ["Move Subtree to Archive" org-archive-subtree t] - ["Check and Move Children" (org-archive-subtree '(4)) + ["Check and Move Children" (org-archive-subtree '(4)) :active t :keys "C-u C-c $"]) "--" ("TODO Lists" @@ -15940,14 +15938,14 @@ See the individual commands for more information." "--" ["Export/Publish" org-export t] ("LaTeX" - ["Org CDLaTeX mode" org-cdlatex-mode :style toggle + ["Org CDLaTeX mode" org-cdlatex-mode :style toggle :selected org-cdlatex-mode] ["Insert Environment" cdlatex-environment (fboundp 'cdlatex-environment)] ["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)] ["Modify math symbol" org-cdlatex-math-modify (org-inside-LaTeX-fragment-p)] ["Export LaTeX fragments as images" - (setq org-export-with-LaTeX-fragments (not org-export-with-LaTeX-fragments)) + (setq org-export-with-LaTeX-fragments (not org-export-with-LaTeX-fragments)) :style toggle :selected org-export-with-LaTeX-fragments]) "--" ("Documentation" @@ -16097,13 +16095,13 @@ and :keyword." (push (org-point-in-group p 0 :radio-target) clist)) (goto-char p)) ((setq o (car (delq nil - (mapcar + (mapcar (lambda (x) (if (memq x org-latex-fragment-image-overlays) x)) (org-overlays-at (point)))))) - (push (list :latex-fragment + (push (list :latex-fragment (org-overlay-start o) (org-overlay-end o)) clist) - (push (list :latex-preview + (push (list :latex-preview (org-overlay-start o) (org-overlay-end o)) clist)) ((org-inside-LaTeX-fragment-p) ;; FIXME: positions wring. @@ -16413,7 +16411,7 @@ Show the heading too, if it is currently invisible." ;;; Finish up - + (provide 'org) (run-hooks 'org-load-hook) diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index ced44757ffd..a83c790f076 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -125,7 +125,7 @@ ;; If MARK-TO-KILL is non-nil, mark new buffer to kill. ;; If HIGHLIGHT is non-nil, highlight the match. ;; If ITEM in non-nil, search for bibitem instead of database entry. - ;; If RETURN is non-nil, just return the entry. + ;; If RETURN is non-nil, just return the entry and restore point. (let* ((re (if item @@ -133,7 +133,7 @@ (concat "@[a-zA-Z]+[ \t\n\r]*[{(][ \t\n\r]*" (regexp-quote key) "[, \t\r\n}]"))) (buffer-conf (current-buffer)) - file buf pos) + file buf pos oldpos) (catch 'exit (while file-list @@ -142,9 +142,11 @@ (unless (setq buf (reftex-get-file-buffer-force file mark-to-kill)) (error "No such file %s" file)) (set-buffer buf) + (setq oldpos (point)) (widen) (goto-char (point-min)) - (when (re-search-forward re nil t) + (if (not (re-search-forward re nil t)) + (goto-char oldpos) ;; restore previous position of point (goto-char (match-beginning 0)) (setq pos (point)) (when return @@ -152,6 +154,7 @@ (if item (goto-char (match-end 0))) (setq return (buffer-substring (point) (reftex-end-of-bib-entry item))) + (goto-char oldpos) ;; restore point. (set-buffer buffer-conf) (throw 'exit return)) (switch-to-buffer-other-window buf) diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 169eeb249f2..70bd3a07a9f 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -4692,7 +4692,7 @@ of line." (point))) (defun table--row-column-insertion-point-p (&optional columnp) - "Return non nil if it makes sense to insert a row or a column at point." + "Return non-nil if it makes sense to insert a row or a column at point." (and (not buffer-read-only) (or (get-text-property (point) 'table-cell) (let ((column (current-column))) diff --git a/lisp/textmodes/texinfmt.el b/lisp/textmodes/texinfmt.el index 9e0b6b63901..35ac181817a 100644 --- a/lisp/textmodes/texinfmt.el +++ b/lisp/textmodes/texinfmt.el @@ -2125,7 +2125,7 @@ This command is executed when texinfmt sees @item inside @multitable." (setq tab-number (1+ tab-number))) (let ((needed-tabs (- (length table-widths) tab-number))) (when (> needed-tabs 0) - (goto-char (point-min)) + (goto-char (point-min)) (end-of-line) (while (> needed-tabs 0) (insert "@w{ }\n@tab") @@ -4292,7 +4292,7 @@ the @ifeq command." (defun batch-texinfo-format () "Runs texinfo-format-buffer on the files remaining on the command line. -Must be used only with -batch, and kills emacs on completion. +Must be used only with -batch, and kills Emacs on completion. Each file will be processed even if an error occurred previously. For example, invoke \"emacs -batch -funcall batch-texinfo-format $docs/ ~/*.texinfo\"." diff --git a/lisp/tutorial.el b/lisp/tutorial.el new file mode 100644 index 00000000000..9cb890388f5 --- /dev/null +++ b/lisp/tutorial.el @@ -0,0 +1,1005 @@ +;;; tutorial.el --- tutorial for Emacs + +;; Copyright (C) 2006 Free Software Foundation, Inc. + +;; Maintainer: FSF +;; Keywords: help, internal + +;; 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 2, 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; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Code for running the Emacs tutorial. + +;;; History: + +;; File was created 2006-09. + +;;; Code: + +(require 'help-mode) ;; for function help-buffer +(eval-when-compile (require 'cl)) + +(defvar tutorial--point-before-chkeys 0 + "Point before display of key changes.") +(make-variable-buffer-local 'tutorial--point-before-chkeys) + +(defvar tutorial--point-after-chkeys 0 + "Point after display of key changes.") +(make-variable-buffer-local 'tutorial--point-after-chkeys) + +(defvar tutorial--lang nil + "Tutorial language.") +(make-variable-buffer-local 'tutorial--lang) + +(defun tutorial--describe-nonstandard-key (value) + "Give more information about a changed key binding. +This is used in `help-with-tutorial'. The information includes +the key sequence that no longer has a default binding, the +default binding and the current binding. It also tells in what +keymap the new binding has been done and how to access the +function in the default binding from the keyboard. + +For `cua-mode' key bindings that try to combine CUA key bindings +with default Emacs bindings information about this is shown. + +VALUE should have either of these formats: + + \(cua-mode) + \(current-binding KEY-FUN DEF-FUN KEY WHERE) + +Where + KEY is a key sequence whose standard binding has been changed + KEY-FUN is the actual binding for KEY + DEF-FUN is the standard binding of KEY + WHERE is a text describing the key sequences to which DEF-FUN is + bound now (or, if it is remapped, a key sequence + for the function it is remapped to)" + (with-output-to-temp-buffer (help-buffer) + (help-setup-xref (list #'tutorial--describe-nonstandard-key value) + (interactive-p)) + (with-current-buffer (help-buffer) + (insert + "Your Emacs customizations override the default binding for this key:" + "\n\n") + (let ((inhibit-read-only t)) + (cond + ((eq (car value) 'cua-mode) + (insert + "CUA mode is enabled. + +When CUA mode is enabled, you can use C-z, C-x, C-c, and C-v to +undo, cut, copy, and paste in addition to the normal Emacs +bindings. The C-x and C-c keys only do cut and copy when the +region is active, so in most cases, they do not conflict with the +normal function of these prefix keys. + +If you really need to perform a command which starts with one of +the prefix keys even when the region is active, you have three +options: +- press the prefix key twice very quickly (within 0.2 seconds), +- press the prefix key and the following key within 0.2 seconds, or +- use the SHIFT key with the prefix key, i.e. C-S-x or C-S-c.")) + ((eq (car value) 'current-binding) + (let ((cb (nth 1 value)) + (db (nth 2 value)) + (key (nth 3 value)) + (where (nth 4 value)) + map + (maps (current-active-maps)) + mapsym) + ;; Look at the currently active keymaps and try to find + ;; first the keymap where the current binding occurs: + (while maps + (let* ((m (car maps)) + (mb (lookup-key m key t))) + (setq maps (cdr maps)) + (when (eq mb cb) + (setq map m) + (setq maps nil)))) + ;; Now, if a keymap was found we must found the symbol + ;; name for it to display to the user. This can not + ;; always be found since all keymaps does not have a + ;; symbol pointing to them, but here they should have + ;; that: + (when map + (mapatoms (lambda (s) + (and + ;; If not already found + (not mapsym) + ;; and if s is a keymap + (and (boundp s) + (keymapp (symbol-value s))) + ;; and not the local symbol map + (not (eq s 'map)) + ;; and the value of s is map + (eq map (symbol-value s)) + ;; then save this value in mapsym + (setq mapsym s))))) + (insert "The default Emacs binding for the key " + (key-description key) + " is the command `") + (insert (format "%s" db)) + (insert "'. " + "However, your customizations have rebound it to the command `") + (insert (format "%s" cb)) + (insert "'.") + (when mapsym + (insert " (For the more advanced user:" + " This binding is in the keymap `" + (format "%s" mapsym) + "'.)")) + (if (string= where "") + (unless (keymapp db) + (insert "\n\nYou can use M-x " + (format "%s" db) + " RET instead.")) + (insert "\n\nWith you current key bindings" + " you can use the key " + where + " to get the function `" + (format "%s" db) + "'.")) + ) + (fill-region (point-min) (point))))) + (print-help-return-message)))) + +(defun tutorial--sort-keys (left right) + "Sort predicate for use with `tutorial--default-keys'. +This is a predicate function to `sort'. + +The sorting is for presentation purpose only and is done on the +key sequence. + +LEFT and RIGHT are the elements to compare." + (let ((x (append (cadr left) nil)) + (y (append (cadr right) nil))) + ;; Skip the front part of the key sequences if they are equal: + (while (and x y + (listp x) (listp y) + (equal (car x) (car y))) + (setq x (cdr x)) + (setq y (cdr y))) + ;; Try to make a comparision that is useful for presentation (this + ;; could be made nicer perhaps): + (let ((cx (car x)) + (cy (car y))) + ;;(message "x=%s, y=%s;;;; cx=%s, cy=%s" x y cx cy) + (cond + ;; Lists? Then call this again + ((and cx cy + (listp cx) + (listp cy)) + (tutorial--sort-keys cx cy)) + ;; Are both numbers? Then just compare them + ((and (wholenump cx) + (wholenump cy)) + (> cx cy)) + ;; Is one of them a number? Let that be bigger then. + ((wholenump cx) + t) + ((wholenump cy) + nil) + ;; Are both symbols? Compare the names then. + ((and (symbolp cx) + (symbolp cy)) + (string< (symbol-name cy) + (symbol-name cx))) + )))) + +(defconst tutorial--default-keys + (let* ( + ;; On window system suspend Emacs is replaced in the + ;; default keymap so honor this here. + (suspend-emacs (if window-system + 'iconify-or-deiconify-frame + 'suspend-emacs)) + (default-keys + `( + ;; These are not mentioned but are basic: + (ESC-prefix [27]) + (Control-X-prefix [?\C-x]) + (mode-specific-command-prefix [?\C-c]) + + (save-buffers-kill-emacs [?\C-x ?\C-c]) + + + ;; * SUMMARY + (scroll-up [?\C-v]) + (scroll-down [?\M-v]) + (recenter [?\C-l]) + + + ;; * BASIC CURSOR CONTROL + (forward-char [?\C-f]) + (backward-char [?\C-b]) + + (forward-word [?\M-f]) + (backward-word [?\M-b]) + + (next-line [?\C-n]) + (previous-line [?\C-p]) + + (move-beginning-of-line [?\C-a]) + (move-end-of-line [?\C-e]) + + (backward-sentence [?\M-a]) + (forward-sentence [?\M-e]) + + + (beginning-of-buffer [?\M-<]) + (end-of-buffer [?\M->]) + + (universal-argument [?\C-u]) + + + ;; * WHEN EMACS IS HUNG + (keyboard-quit [?\C-g]) + + + ;; * DISABLED COMMANDS + (downcase-region [?\C-x ?\C-l]) + + + ;; * WINDOWS + (delete-other-windows [?\C-x ?1]) + ;; C-u 0 C-l + ;; Type CONTROL-h k CONTROL-f. + + + ;; * INSERTING AND DELETING + ;; C-u 8 * to insert ********. + + (delete-backward-char [backspace]) + (delete-char [?\C-d]) + + (backward-kill-word [(meta backspace)]) + (kill-word [?\M-d]) + + (kill-line [?\C-k]) + (kill-sentence [?\M-k]) + + (set-mark-command [?\C-@]) + (set-mark-command [?\C- ]) + (kill-region [?\C-w]) + (yank [?\C-y]) + (yank-pop [?\M-y]) + + + ;; * UNDO + (advertised-undo [?\C-x ?u]) + (advertised-undo [?\C-x ?u]) + + + ;; * FILES + (find-file [?\C-x ?\C-f]) + (save-buffer [?\C-x ?\C-s]) + + + ;; * BUFFERS + (list-buffers [?\C-x ?\C-b]) + (switch-to-buffer [?\C-x ?b]) + (save-some-buffers [?\C-x ?s]) + + + ;; * EXTENDING THE COMMAND SET + ;; C-x Character eXtend. Followed by one character. + (execute-extended-command [?\M-x]) + + ;; C-x C-f Find file + ;; C-x C-s Save file + ;; C-x s Save some buffers + ;; C-x C-b List buffers + ;; C-x b Switch buffer + ;; C-x C-c Quit Emacs + ;; C-x 1 Delete all but one window + ;; C-x u Undo + + + ;; * MODE LINE + (describe-mode [?\C-h ?m]) + + (set-fill-column [?\C-x ?f]) + (fill-paragraph [?\M-q]) + + + ;; * SEARCHING + (isearch-forward [?\C-s]) + (isearch-backward [?\C-r]) + + + ;; * MULTIPLE WINDOWS + (split-window-vertically [?\C-x ?2]) + (scroll-other-window [?\C-\M-v]) + (other-window [?\C-x ?o]) + (find-file-other-window [?\C-x ?4 ?\C-f]) + + + ;; * RECURSIVE EDITING LEVELS + (keyboard-escape-quit [27 27 27]) + + + ;; * GETTING MORE HELP + ;; The most basic HELP feature is C-h c + (describe-key-briefly [?\C-h ?c]) + (describe-key [?\C-h ?k]) + + + ;; * MORE FEATURES + ;; F10 + + + ;; * CONCLUSION + ;;(iconify-or-deiconify-frame [?\C-z]) + (,suspend-emacs [?\C-z]) + ))) + (sort default-keys 'tutorial--sort-keys)) + "Default Emacs key bindings that the tutorial depends on.") + +(defun tutorial--detailed-help (button) + "Give detailed help about changed keys." + (with-output-to-temp-buffer (help-buffer) + (help-setup-xref (list #'tutorial--detailed-help button) + (interactive-p)) + (with-current-buffer (help-buffer) + (let* ((tutorial-buffer (button-get button 'tutorial-buffer)) + ;;(tutorial-arg (button-get button 'tutorial-arg)) + (explain-key-desc (button-get button 'explain-key-desc)) + (changed-keys (with-current-buffer tutorial-buffer + (tutorial--find-changed-keys tutorial--default-keys)))) + (when changed-keys + (insert + "The following key bindings used in the tutorial had been changed +from Emacs default in the " (buffer-name tutorial-buffer) " buffer:\n\n" ) + (let ((frm " %-9s %-27s %-11s %s\n")) + (insert (format frm "Key" "Standard Binding" "Is Now On" "Remark"))) + (dolist (tk changed-keys) + (let* ((def-fun (nth 1 tk)) + (key (nth 0 tk)) + (def-fun-txt (nth 2 tk)) + (where (nth 3 tk)) + (remark (nth 4 tk)) + (rem-fun (command-remapping def-fun)) + (key-txt (key-description key)) + (key-fun (with-current-buffer tutorial-buffer (key-binding key))) + tot-len) + (unless (eq def-fun key-fun) + ;; Insert key binding description: + (when (string= key-txt explain-key-desc) + (put-text-property 0 (length key-txt) 'face '(:background "yellow") key-txt)) + (insert " " key-txt " ") + (setq tot-len (length key-txt)) + (when (> 9 tot-len) + (insert (make-string (- 9 tot-len) ? )) + (setq tot-len 9)) + ;; Insert a link describing the old binding: + (insert-button def-fun-txt + 'value def-fun + 'action + (lambda(button) (interactive) + (describe-function + (button-get button 'value))) + 'follow-link t) + (setq tot-len (+ tot-len (length def-fun-txt))) + (when (> 36 tot-len) + (insert (make-string (- 36 tot-len) ? ))) + (when (listp where) + (setq where "list")) + ;; Tell where the old binding is now: + (insert (format " %-11s " where)) + ;; Insert a link with more information, for example + ;; current binding and keymap or information about + ;; cua-mode replacements: + (insert-button (car remark) + 'action + (lambda(b) (interactive) + (let ((value (button-get b 'value))) + (tutorial--describe-nonstandard-key value))) + 'value (cdr remark) + 'follow-link t) + (insert "\n"))))) + + (insert " +It is legitimate to change key bindings, but changed bindings do not +correspond to what the tutorial says. (See also " ) + (insert-button "Key Binding Conventions" + 'action + (lambda(button) (interactive) + (info + "(elisp) Key Binding Conventions") + (message "Type C-x 0 to close the new window")) + 'follow-link t) + (insert ".)\n\n") + (print-help-return-message))))) + +(defun tutorial--find-changed-keys (default-keys) + "Find the key bindings that have changed. +Check if the default Emacs key bindings that the tutorial depends +on have been changed. + +Return a list with the keys that have been changed. The element +of this list have the following format: + + \(list KEY DEF-FUN DEF-FUN-TXT WHERE REMARK) + +Where + KEY is a key sequence whose standard binding has been changed + DEF-FUN is the standard binding of KEY + DEF-FUN-TXT is a short descriptive text for DEF-FUN + WHERE is a text describing the key sequences to which DEF-FUN is + bound now (or, if it is remapped, a key sequence + for the function it is remapped to) + REMARK is a list with info about rebinding. It has either of these + formats: + + \(TEXT cua-mode) + \(TEXT current-binding KEY-FUN DEF-FUN KEY WHERE) + + Here TEXT is a link text to show to the user. The + rest of the list is used to show information when + the user clicks the link. + + KEY-FUN is the actual binding for KEY." + (let (changed-keys remark) + ;; (default-keys tutorial--default-keys)) + (dolist (kdf default-keys) + ;; The variables below corresponds to those with the same names + ;; described in the doc string. + (let* ((key (nth 1 kdf)) + (def-fun (nth 0 kdf)) + (def-fun-txt (format "%s" def-fun)) + (rem-fun (command-remapping def-fun)) + (key-fun (key-binding key)) + (where (where-is-internal (if rem-fun rem-fun def-fun)))) + (when (eq key-fun 'ESC-prefix) + (message "ESC-prefix!!!!")) + (if where + (progn + (setq where (key-description (car where))) + (when (and (< 10 (length where)) + (string= (substring where 0 (length "<menu-bar>")) + "<menu-bar>")) + (setq where "The menus"))) + (setq where "")) + (setq remark nil) + (unless + (cond ((eq key-fun def-fun) + ;; No rebinding, return t + t) + ((eq key-fun (command-remapping def-fun)) + ;; Just a remapping, return t + t) + ;; cua-mode specials: + ((and cua-mode + (or (and + (equal key [?\C-v]) + (eq key-fun 'cua-paste)) + (and + (equal key [?\C-z]) + (eq key-fun 'undo)))) + (setq remark (list "cua-mode, more info" 'cua-mode)) + nil) + ((and cua-mode + (or + (and (eq def-fun 'ESC-prefix) + (equal key-fun + `(keymap + (118 . cua-repeat-replace-region)))) + (and (eq def-fun 'mode-specific-command-prefix) + (equal key-fun + '(keymap + (timeout . copy-region-as-kill)))) + (and (eq def-fun 'Control-X-prefix) + (equal key-fun + '(keymap (timeout . kill-region)))))) + (setq remark (list "cua-mode replacement" 'cua-mode)) + (cond + ((eq def-fun 'mode-specific-command-prefix) + (setq def-fun-txt "\"C-c prefix\"")) + ((eq def-fun 'Control-X-prefix) + (setq def-fun-txt "\"C-x prefix\"")) + ((eq def-fun 'ESC-prefix) + (setq def-fun-txt "\"ESC prefix\""))) + (setq where "Same key") + nil) + ;; viper-mode specials: + ((and (boundp 'viper-mode-string) + (boundp 'viper-current-state) + (eq viper-current-state 'vi-state) + (or (and (eq def-fun 'isearch-forward) + (eq key-fun 'viper-isearch-forward)) + (and (eq def-fun 'isearch-backward) + (eq key-fun 'viper-isearch-backward)))) + ;; These bindings works as the default bindings, + ;; return t + t) + ((when normal-erase-is-backspace + (or (and (equal key [C-delete]) + (equal key-fun 'kill-word)) + (and (equal key [C-backspace]) + (equal key-fun 'backward-kill-word)))) + ;; This is the strange handling of C-delete and + ;; C-backspace, return t + t) + (t + ;; This key has indeed been rebound. Put information + ;; in `remark' and return nil + (setq remark + (list "more info" 'current-binding + key-fun def-fun key where)) + nil)) + (add-to-list 'changed-keys + (list key def-fun def-fun-txt where remark))))) + changed-keys)) + +(defvar tutorial--tab-map + (let ((map (make-sparse-keymap))) + (define-key map [tab] 'forward-button) + (define-key map [(shift tab)] 'backward-button) + (define-key map [(meta tab)] 'backward-button) + map) + "Keymap that allows tabbing between buttons.") + +(defun tutorial--display-changes (changed-keys) + "Display changes to some default key bindings. +If some of the default key bindings that the tutorial depends on +have been changed then display the changes in the tutorial buffer +with some explanatory links. + +CHANGED-KEYS should be a list in the format returned by +`tutorial--find-changed-keys'." + (when (or changed-keys + (boundp 'viper-mode-string)) + ;; Need the custom button face for viper buttons: + (when (boundp 'viper-mode-string) + (require 'cus-edit)) + (let ((start (point)) + end + (head (get-lang-string tutorial--lang 'tut-chgdhead)) + (head2 (get-lang-string tutorial--lang 'tut-chgdhead2))) + (when (and head head2) + (goto-char tutorial--point-before-chkeys) + (insert head) + (insert-button head2 + 'tutorial-buffer + (current-buffer) + ;;'tutorial-arg arg + 'action + 'tutorial--detailed-help + 'follow-link t + 'face '(:inherit link :background "yellow")) + (insert "]\n\n" ) + (when changed-keys + (dolist (tk changed-keys) + (let* ((def-fun (nth 1 tk)) + (key (nth 0 tk)) + (def-fun-txt (nth 2 tk)) + (where (nth 3 tk)) + (remark (nth 4 tk)) + (rem-fun (command-remapping def-fun)) + (key-txt (key-description key)) + (key-fun (key-binding key)) + tot-len) + (unless (eq def-fun key-fun) + ;; Mark the key in the tutorial text + (unless (string= "Same key" where) + (let ((here (point)) + (key-desc (key-description key))) + (while (search-forward key-desc nil t) + (put-text-property (match-beginning 0) + (match-end 0) + 'tutorial-remark 'only-colored) + (put-text-property (match-beginning 0) + (match-end 0) + 'face '(:background "yellow")) + (forward-line) + (let ((s (get-lang-string tutorial--lang 'tut-chgdkey)) + (s2 (get-lang-string tutorial--lang 'tut-chgdkey2)) + (start (point)) + end) + ;;(concat "** The key " key-desc " has been rebound, but you can use " where " instead [")) + (when (and s s2) + (setq s (format s key-desc where s2)) + (insert s) + (insert-button s2 + 'tutorial-buffer + (current-buffer) + ;;'tutorial-arg arg + 'action + 'tutorial--detailed-help + 'explain-key-desc key-desc + 'follow-link t + 'face '(:inherit link :background "yellow")) + (insert "] **") + (insert "\n") + (setq end (point)) + (put-text-property start end 'local-map tutorial--tab-map) + ;; Add a property so we can remove the remark: + (put-text-property start end 'tutorial-remark t) + (put-text-property start end + 'face '(:background "yellow" :foreground "#c00")) + (put-text-property start end 'read-only t)))) + (goto-char here))))))) + + + (setq end (point)) + ;; Make the area with information about change key + ;; bindings stand out: + (put-text-property start end 'tutorial-remark t) + (put-text-property start end + 'face + ;; The default warning face does not + ;;look good in this situation. Instead + ;;try something that could be + ;;recognized from warnings in normal + ;;life: + ;; 'font-lock-warning-face + (list :background "yellow" :foreground "#c00")) + ;; Make it possible to use Tab/S-Tab between fields in + ;; this area: + (put-text-property start end 'local-map tutorial--tab-map) + (setq tutorial--point-after-chkeys (point-marker)) + ;; Make this area read-only: + (put-text-property start end 'read-only t))))) + +(defun tutorial--saved-dir () + "Directory where to save tutorials." + (expand-file-name ".emacstut" "~/")) + +(defun tutorial--saved-file () + "File name in which to save tutorials." + (let ((file-name tutorial--lang) + (ext (file-name-extension tutorial--lang))) + (when (or (not ext) + (string= ext "")) + (setq file-name (concat file-name ".tut"))) + (expand-file-name file-name (tutorial--saved-dir)))) + +(defun tutorial--remove-remarks() + "Remove the remark lines that was added to the tutorial buffer." + (save-excursion + (goto-char (point-min)) + (let (prop-start + prop-end + prop-val) + ;; Catch the case when we already are on a remark line + (while (if (get-text-property (point) 'tutorial-remark) + (setq prop-start (point)) + (setq prop-start (next-single-property-change (point) 'tutorial-remark))) + (setq prop-end (next-single-property-change prop-start 'tutorial-remark)) + (setq prop-val (get-text-property prop-start 'tutorial-remark)) + (unless prop-end + (setq prop-end (point-max))) + (goto-char prop-end) + (if (eq prop-val 'only-colored) + (put-text-property prop-start prop-end 'face '(:background nil)) + (let ((orig-text (get-text-property prop-start 'tutorial-orig))) + (delete-region prop-start prop-end) + (when orig-text (insert orig-text)))))))) + +(defun tutorial--save-tutorial () + "Save the tutorial buffer. +This saves the part of the tutorial before and after the area +showing changed keys. It also saves the point position and the +position where the display of changed bindings was inserted." + ;; This runs in a hook so protect it: + (condition-case err + (tutorial--save-tutorial-to (tutorial--saved-file)) + (error (message "Error saving tutorial state: %s" (error-message-string err)) + (sit-for 4)))) + +(defun tutorial--save-tutorial-to (saved-file) + "Save the tutorial buffer to SAVED-FILE. +See `tutorial--save-tutorial' for more information." + ;; Anything to save? + (when (or (buffer-modified-p) + (< 1 (point))) + (let ((tutorial-dir (tutorial--saved-dir)) + save-err) + ;; The tutorial is saved in a subdirectory in the user home + ;; directory. Create this subdirectory first. + (unless (file-directory-p tutorial-dir) + (condition-case err + (make-directory tutorial-dir nil) + (error (setq save-err t) + (warn "Could not create directory %s: %s" tutorial-dir + (error-message-string err))))) + ;; Make sure we have that directory. + (if (file-directory-p tutorial-dir) + (let ((tut-point (if (= 0 tutorial--point-after-chkeys) + ;; No info about changed keys is + ;; displayed. + (point) + (if (< (point) tutorial--point-after-chkeys) + (- (point)) + (- (point) tutorial--point-after-chkeys)))) + (old-point (point)) + ;; Use a special undo list so that we easily can undo + ;; the changes we make to the tutorial buffer. This is + ;; currently not needed since we now delete the buffer + ;; after saving, but kept for possible future use of + ;; this function. + buffer-undo-list + (inhibit-read-only t)) + ;; Delete the area displaying info about changed keys. + ;; (when (< 0 tutorial--point-after-chkeys) + ;; (delete-region tutorial--point-before-chkeys + ;; tutorial--point-after-chkeys)) + ;; Delete the remarks: + (tutorial--remove-remarks) + ;; Put the value of point first in the buffer so it will + ;; be saved with the tutorial. + (goto-char (point-min)) + (insert (number-to-string tut-point) + "\n" + (number-to-string (marker-position + tutorial--point-before-chkeys)) + "\n") + (condition-case err + (write-region nil nil saved-file) + (error (setq save-err t) + (warn "Could not save tutorial to %s: %s" + saved-file + (error-message-string err)))) + ;; An error is raised here?? Is this a bug? + (condition-case err + (undo-only) + (error nil)) + ;; Restore point + (goto-char old-point) + (if save-err + (message "Could not save tutorial state.") + (message "Saved tutorial state."))) + (message "Can't save tutorial: %s is not a directory" + tutorial-dir))))) + + +;;;###autoload +(defun help-with-tutorial (&optional arg dont-ask-for-revert) + "Select the Emacs learn-by-doing tutorial. +If there is a tutorial version written in the language +of the selected language environment, that version is used. +If there's no tutorial in that language, `TUTORIAL' is selected. +With ARG, you are asked to choose which language. +If DONT-ASK-FOR-REVERT is non-nil the buffer is reverted without +any question when restarting the tutorial. + +If any of the standard Emacs key bindings that are used in the +tutorial have been changed then an explanatory note about this is +shown in the beginning of the tutorial buffer. + +When the tutorial buffer is killed the content and the point +position in the buffer is saved so that the tutorial may be +resumed later." + (interactive "P") + (if (boundp 'viper-current-state) + (let ((prompt1 + "You can not run the Emacs tutorial directly because you have \ +enabled Viper.") + (prompt2 "\nThere is however a Viper tutorial you can run instead. +Run the Viper tutorial? ")) + (if (fboundp 'viper-tutorial) + (if (y-or-n-p (concat prompt1 prompt2)) + (progn (message "") + (funcall 'viper-tutorial 0)) + (message "Tutorial aborted by user")) + (message prompt1))) + (let* ((lang (if arg + (let ((minibuffer-setup-hook minibuffer-setup-hook)) + (add-hook 'minibuffer-setup-hook + 'minibuffer-completion-help) + (read-language-name 'tutorial "Language: " "English")) + (if (get-language-info current-language-environment 'tutorial) + current-language-environment + "English"))) + (filename (get-language-info lang 'tutorial)) + ;; Choose a buffer name including the language so that + ;; several languages can be tested simultaneously: + (tut-buf-name (concat "TUTORIAL (" lang ")")) + (old-tut-buf (get-buffer tut-buf-name)) + (old-tut-win (when old-tut-buf (get-buffer-window old-tut-buf t))) + (old-tut-is-ok (when old-tut-buf + (not (buffer-modified-p old-tut-buf)))) + old-tut-file + (old-tut-point 1)) + (setq tutorial--point-after-chkeys (point-min)) + ;; Try to display the tutorial buffer before asking to revert it. + ;; If the tutorial buffer is shown in some window make sure it is + ;; selected and displayed: + (if old-tut-win + (raise-frame + (window-frame + (select-window (get-buffer-window old-tut-buf t)))) + ;; Else, is there an old tutorial buffer? Then display it: + (when old-tut-buf + (switch-to-buffer old-tut-buf))) + ;; Use whole frame for tutorial + (delete-other-windows) + ;; If the tutorial buffer has been changed then ask if it should + ;; be reverted: + (when (and old-tut-buf + (not old-tut-is-ok)) + (setq old-tut-is-ok + (if dont-ask-for-revert + nil + (not (y-or-n-p + "You have changed the Tutorial buffer. Revert it? "))))) + ;; (Re)build the tutorial buffer if it is not ok + (unless old-tut-is-ok + (switch-to-buffer (get-buffer-create tut-buf-name)) + (unless old-tut-buf (text-mode)) + (unless lang (error "Variable lang is nil")) + (setq tutorial--lang lang) + (setq old-tut-file (file-exists-p (tutorial--saved-file))) + (let ((inhibit-read-only t)) + (erase-buffer)) + (message "Preparing tutorial ...") (sit-for 0) + + ;; Do not associate the tutorial buffer with a file. Instead use + ;; a hook to save it when the buffer is killed. + (setq buffer-auto-save-file-name nil) + (add-hook 'kill-buffer-hook 'tutorial--save-tutorial nil t) + + ;; Insert the tutorial. First offer to resume last tutorial + ;; editing session. + (when dont-ask-for-revert + (setq old-tut-file nil)) + (when old-tut-file + (setq old-tut-file + (y-or-n-p "Resume your last saved tutorial? "))) + (if old-tut-file + (progn + (insert-file-contents (tutorial--saved-file)) + (goto-char (point-min)) + (setq old-tut-point + (string-to-number + (buffer-substring-no-properties + (line-beginning-position) (line-end-position)))) + (forward-line) + (setq tutorial--point-before-chkeys + (string-to-number + (buffer-substring-no-properties + (line-beginning-position) (line-end-position)))) + (forward-line) + (delete-region (point-min) (point)) + (goto-char tutorial--point-before-chkeys) + (setq tutorial--point-before-chkeys (point-marker))) + (insert-file-contents (expand-file-name filename data-directory)) + (forward-line) + (setq tutorial--point-before-chkeys (point-marker))) + + + ;; Check if there are key bindings that may disturb the + ;; tutorial. If so tell the user. + (let ((changed-keys (tutorial--find-changed-keys tutorial--default-keys))) + (when changed-keys + (tutorial--display-changes changed-keys))) + + + ;; Clear message: + (unless dont-ask-for-revert + (message "") (sit-for 0)) + + + (if old-tut-file + ;; Just move to old point in saved tutorial. + (let ((old-point + (if (> 0 old-tut-point) + (- old-tut-point) + (+ old-tut-point tutorial--point-after-chkeys)))) + (when (< old-point 1) + (setq old-point 1)) + (goto-char old-point)) + (goto-char (point-min)) + (search-forward "\n<<") + (beginning-of-line) + ;; Convert the <<...>> line to the proper [...] line, + ;; or just delete the <<...>> line if a [...] line follows. + (cond ((save-excursion + (forward-line 1) + (looking-at "\\[")) + (delete-region (point) (progn (forward-line 1) (point)))) + ((looking-at "<<Blank lines inserted.*>>") + (replace-match "[Middle of page left blank for didactic purposes. Text continues below]")) + (t + (looking-at "<<") + (replace-match "[") + (search-forward ">>") + (replace-match "]"))) + (beginning-of-line) + (let ((n (- (window-height (selected-window)) + (count-lines (point-min) (point)) + 6))) + (if (< n 8) + (progn + ;; For a short gap, we don't need the [...] line, + ;; so delete it. + (delete-region (point) (progn (end-of-line) (point))) + (newline n)) + ;; Some people get confused by the large gap. + (newline (/ n 2)) + + ;; Skip the [...] line (don't delete it). + (forward-line 1) + (newline (- n (/ n 2))))) + (goto-char (point-min))) + (setq buffer-undo-list nil) + (set-buffer-modified-p nil))))) + + +;; Below is some attempt to handle language specific strings. These +;; are currently only used in the tutorial. + +(defconst lang-strings + '( + ("English" . + ( + (tut-chgdkey . "** The key %s has been rebound, but you can use %s instead [") + (tut-chgdkey2 . "More information") + (tut-chgdhead . " + NOTICE: The main purpose of the Emacs tutorial is to teach you + the most important standard Emacs commands (key bindings). + However, your Emacs has been customized by changing some of + these basic editing commands, so it doesn't correspond to the + tutorial. We have inserted colored notices where the altered + commands have been introduced. [") + (tut-chgdhead2 . "Details") + ) + ) + ) + "Language specific strings for Emacs. +This is an association list with the keys equal to the strings +that can be returned by `read-language-name'. The elements in +the list are themselves association lists with keys that are +string ids and values that are the language specific strings. + +See `get-lang-string' for more information.") + +(defun get-lang-string(lang stringid &optional no-eng-fallback) + "Get a language specific string for Emacs. +In certain places Emacs can replace a string showed to the user with a language specific string. +This function retrieves such strings. + +LANG is the language specification. It should be one of those +strings that can be returned by `read-language-name'. STRINGID +is a symbol that specifies the string to retrieve. + +If no string is found for STRINGID in the choosen language then +the English string is returned unless NO-ENG-FALLBACK is non-nil. + +See `lang-strings' for more information. + +Currently this feature is only used in `help-with-tutorial'." + (let ((my-lang-strings (assoc lang lang-strings)) + (found-string)) + (when my-lang-strings + (let ((entry (assoc stringid (cdr my-lang-strings)))) + (when entry + (setq found-string (cdr entry))))) + ;; Fallback to English strings + (unless (or found-string + no-eng-fallback) + (setq found-string (get-lang-string "English" stringid t))) + found-string)) + +;;(get-lang-string "English" 'tut-chgdkey) + +(provide 'tutorial) + +;; arch-tag: c8e80aef-c3bb-4ffb-8af6-22171bf0c100 +;;; tutorial.el ends here diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index e63759f216a..678e7e5a8db 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,14 @@ +2006-11-03 Shun-ichi GOTO <gotoh@taiyo.co.jp> (tiny change) + + * url-http.el (url-http-handle-authentication): If there are + several authentication headers, use the first with a supported + method. + +2006-11-01 Magnus Henoch <mange@freemail.hu> + + * url-http.el (url-http-create-request): Use buffer-local + equivalents of dynamically bound variables. + 2006-10-29 Magnus Henoch <mange@freemail.hu> * url-gw.el (url-open-stream): Really use asynchronous diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 181a4b8db9a..c0bc2d9739e 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -151,13 +151,15 @@ request.") (defun url-http-create-request (url &optional ref-url) "Create an HTTP request for URL, referred to by REF-URL." - (declare (special proxy-object proxy-info)) + (declare (special proxy-object proxy-info + url-http-method url-http-data + url-http-extra-headers)) (let* ((extra-headers) (request nil) - (no-cache (cdr-safe (assoc "Pragma" url-request-extra-headers))) + (no-cache (cdr-safe (assoc "Pragma" url-http-extra-headers))) (proxy-obj (and (boundp 'proxy-object) proxy-object)) (proxy-auth (if (or (cdr-safe (assoc "Proxy-Authorization" - url-request-extra-headers)) + url-http-extra-headers)) (not proxy-obj)) nil (let ((url-basic-auth-storage @@ -166,7 +168,7 @@ request.") (real-fname (concat (url-filename (or proxy-obj url)) (url-recreate-url-attributes (or proxy-obj url)))) (host (url-host (or proxy-obj url))) - (auth (if (cdr-safe (assoc "Authorization" url-request-extra-headers)) + (auth (if (cdr-safe (assoc "Authorization" url-http-extra-headers)) nil (url-get-authentication (or (and (boundp 'proxy-info) @@ -191,12 +193,12 @@ request.") (memq 'lastloc url-privacy-level))) (setq ref-url nil)) - ;; url-request-extra-headers contains an assoc-list of + ;; url-http-extra-headers contains an assoc-list of ;; header/value pairs that we need to put into the request. (setq extra-headers (mapconcat (lambda (x) (concat (car x) ": " (cdr x))) - url-request-extra-headers "\r\n")) + url-http-extra-headers "\r\n")) (if (not (equal extra-headers "")) (setq extra-headers (concat extra-headers "\r\n"))) @@ -219,7 +221,7 @@ request.") (delq nil (list ;; The request - (or url-request-method "GET") " " + (or url-http-method "GET") " " (if proxy-obj (url-recreate-url proxy-obj) real-fname) " HTTP/" url-http-version "\r\n" ;; Version of MIME we speak @@ -267,7 +269,7 @@ request.") (equal "https" (url-type url))) ;; If-modified-since (if (and (not no-cache) - (member url-request-method '("GET" nil))) + (member url-http-method '("GET" nil))) (let ((tm (url-is-cached (or proxy-obj url)))) (if tm (concat "If-modified-since: " @@ -277,15 +279,15 @@ request.") "Referer: " ref-url "\r\n")) extra-headers ;; Length of data - (if url-request-data + (if url-http-data (concat "Content-length: " (number-to-string - (length url-request-data)) + (length url-http-data)) "\r\n")) ;; End request "\r\n" ;; Any data - url-request-data)) + url-http-data)) "")) (url-http-debug "Request is: \n%s" request) request)) @@ -303,21 +305,29 @@ This allows us to use `mail-fetch-field', etc." (declare (special status success url-http-method url-http-data url-callback-function url-callback-arguments)) (url-http-debug "Handling %s authentication" (if proxy "proxy" "normal")) - (let ((auth (or (mail-fetch-field (if proxy "proxy-authenticate" "www-authenticate")) - "basic")) + (let ((auths (or (nreverse + (mail-fetch-field + (if proxy "proxy-authenticate" "www-authenticate") + nil nil t)) + '("basic"))) (type nil) (url (url-recreate-url url-current-object)) (url-basic-auth-storage 'url-http-real-basic-auth-storage) - ) - + auth) ;; Cheating, but who cares? :) (if proxy (setq url-basic-auth-storage 'url-http-proxy-basic-auth-storage)) - (setq auth (url-eat-trailing-space (url-strip-leading-spaces auth))) - (if (string-match "[ \t]" auth) - (setq type (downcase (substring auth 0 (match-beginning 0)))) - (setq type (downcase auth))) + ;; find first supported auth + (while auths + (setq auth (url-eat-trailing-space (url-strip-leading-spaces (car auths)))) + (if (string-match "[ \t]" auth) + (setq type (downcase (substring auth 0 (match-beginning 0)))) + (setq type (downcase auth))) + (if (url-auth-registered type) + (setq auths nil) ; no more check + (setq auth nil + auths (cdr auths)))) (if (not (url-auth-registered type)) (progn diff --git a/lisp/whitespace.el b/lisp/whitespace.el index bb829278ef3..cdb743c1494 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -194,7 +194,7 @@ It can be overriden by setting a buffer local variable :group 'whitespace) (defcustom whitespace-spacetab-regexp "[ ]+\t" - "Regexp to match a space followed by a TAB." + "Regexp to match one or more spaces followed by a TAB." :type 'regexp :group 'whitespace) @@ -205,8 +205,9 @@ It can be overriden by setting a buffer local variable :type 'boolean :group 'whitespace) -(defcustom whitespace-indent-regexp (concat "^\\(\t*\\) " " ") - "Regexp to match (any TABS followed by) 8/more whitespaces at start of line." +(defcustom whitespace-indent-regexp "^\t*\\( \\)+" + "Regexp to match multiples of eight spaces near line beginnings. +The default value ignores leading TABs." :type 'regexp :group 'whitespace) @@ -217,9 +218,8 @@ It can be overriden by setting a buffer local variable :type 'boolean :group 'whitespace) -;; (defcustom whitespace-ateol-regexp "[ \t]$" (defcustom whitespace-ateol-regexp "[ \t]+$" - "Regexp to match a TAB or a space at the EOL." + "Regexp to match one or more TABs or spaces at line ends." :type 'regexp :group 'whitespace) @@ -425,7 +425,8 @@ and: (progn (whitespace-check-buffer-list (buffer-name) buffer-file-name) (whitespace-tickle-timer) - (whitespace-unhighlight-the-space) + (overlay-recenter (point-max)) + (remove-overlays nil nil 'face 'whitespace-highlight) (if whitespace-auto-cleanup (if buffer-read-only (if (not quiet) @@ -591,74 +592,53 @@ See `whitespace-buffer' docstring for a summary of the problems." (whitespace-buffer t))) (defun whitespace-buffer-leading () - "Check to see if there are any empty lines at the top of the file." + "Return t if the current buffer has leading newline characters. +If highlighting is enabled, highlight these characters." (save-excursion - (let ((pmin nil) - (pmax nil)) - (goto-char (point-min)) - (beginning-of-line) - (setq pmin (point)) - (end-of-line) - (setq pmax (point)) - (if (equal pmin pmax) - (progn - (whitespace-highlight-the-space pmin (1+ pmax)) - t) - nil)))) + (goto-char (point-min)) + (skip-chars-forward "\n") + (unless (bobp) + (whitespace-highlight-the-space (point-min) (point)) + t))) (defun whitespace-buffer-leading-cleanup () - "Remove any empty lines at the top of the file." + "Remove any leading newline characters from current buffer." (save-excursion (goto-char (point-min)) (skip-chars-forward "\n") (delete-region (point-min) (point)))) (defun whitespace-buffer-trailing () - "Check to see if are is more than one empty line at the bottom." + "Return t if the current buffer has extra trailing newline characters. +If highlighting is enabled, highlight these characters." (save-excursion - (let ((pmin nil) - (pmax nil)) - (goto-char (point-max)) - (beginning-of-line) - (setq pmin (point)) - (end-of-line) - (setq pmax (point)) - (if (equal pmin pmax) - (progn - (goto-char (- (point) 1)) - (beginning-of-line) - (setq pmin (point)) - (end-of-line) - (setq pmax (point)) - (if (equal pmin pmax) - (progn - (whitespace-highlight-the-space (- pmin 1) pmax) - t) - nil)) - nil)))) + (goto-char (point-max)) + (skip-chars-backward "\n") + (forward-line) + (unless (eobp) + (whitespace-highlight-the-space (point) (point-max)) + t))) (defun whitespace-buffer-trailing-cleanup () - "Delete all the empty lines at the bottom." + "Remove extra trailing newline characters from current buffer." (save-excursion (goto-char (point-max)) (skip-chars-backward "\n") - (if (not (bolp)) - (forward-char 1)) - (delete-region (point) (point-max)))) + (unless (eobp) + (forward-line) + (delete-region (point) (point-max))))) (defun whitespace-buffer-search (regexp) "Search for any given whitespace REGEXP." - (let ((whitespace-retval "")) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (progn - (setq whitespace-retval (format "%s %s" whitespace-retval - (match-beginning 0))) - (whitespace-highlight-the-space (match-beginning 0) (match-end 0)))) - (if (equal "" whitespace-retval) - nil - whitespace-retval)))) + (with-local-quit + (let (whitespace-retval) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (whitespace-highlight-the-space (match-beginning 0) (match-end 0)) + (push (match-beginning 0) whitespace-retval))) + (when whitespace-retval + (format " %s" (nreverse whitespace-retval)))))) (defun whitespace-buffer-cleanup (regexp newregexp) "Search for any given whitespace REGEXP and replace it with the NEWREGEXP." @@ -713,17 +693,14 @@ Also with whitespaces whose testing has been turned off." "Highlight the current line, unhighlighting a previously jumped to line." (if whitespace-display-spaces-in-color (let ((ol (whitespace-make-overlay b e))) - (push ol whitespace-highlighted-space) (whitespace-overlay-put ol 'face 'whitespace-highlight)))) -;; (add-hook 'pre-command-hook 'whitespace-unhighlight-the-space)) (defun whitespace-unhighlight-the-space() "Unhighlight the currently highlight line." (if (and whitespace-display-spaces-in-color whitespace-highlighted-space) (progn (mapc 'whitespace-delete-overlay whitespace-highlighted-space) - (setq whitespace-highlighted-space nil)) - (remove-hook 'pre-command-hook 'whitespace-unhighlight-the-space))) + (setq whitespace-highlighted-space nil)))) (defun whitespace-check-buffer-list (buf-name buf-file) "Add a buffer and its file to the whitespace monitor list. @@ -780,7 +757,7 @@ If timer is not set, then set it to scan the files in (whitespace-refresh-rescan-list buffile bufname)))))) (defun whitespace-refresh-rescan-list (buffile bufname) - "Refresh the list of files to be rescaned for whitespace creep." + "Refresh the list of files to be rescanned for whitespace creep." (if whitespace-all-buffer-files (setq whitespace-all-buffer-files (delete (list buffile bufname) whitespace-all-buffer-files)) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 04e6b0751ee..ee15211f391 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -598,7 +598,7 @@ automatically." :type 'directory) (defcustom widget-image-enable t - "If non nil, use image buttons in widgets when available." + "If non-nil, use image buttons in widgets when available." :version "21.1" :group 'widgets :type 'boolean) @@ -1719,7 +1719,7 @@ If END is omitted, it defaults to the length of LIST." ;;; The `push-button' Widget. ;; (defcustom widget-push-button-gui t -;; "If non nil, use GUI push buttons when available." +;; "If non-nil, use GUI push buttons when available." ;; :group 'widgets ;; :type 'boolean) @@ -2562,7 +2562,7 @@ Return an alist of (TYPE MATCH)." ;;; The `editable-list' Widget. ;; (defcustom widget-editable-list-gui nil -;; "If non nil, use GUI push-buttons in editable list when available." +;; "If non-nil, use GUI push-buttons in editable list when available." ;; :type 'boolean ;; :group 'widgets) diff --git a/lisp/window.el b/lisp/window.el index ac4fc0b7c96..2316eb916eb 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -795,8 +795,11 @@ and the buffer that is killed or buried is the one in that window." (defvar mouse-autoselect-window-window nil "Last window recorded by delayed window autoselection.") -(defvar mouse-autoselect-window-now nil - "When non-nil don't delay autoselection in `handle-select-window'.") +(defvar mouse-autoselect-window-state nil + "When non-nil, special state of delayed window autoselection. +Possible values are `suspend' \(suspend autoselection after a menu or +scrollbar interaction\) and `select' \(the next invocation of +'handle-select-window' shall select the window immediately\).") (defun mouse-autoselect-window-cancel (&optional force) "Cancel delayed window autoselection. @@ -806,32 +809,26 @@ Optional argument FORCE means cancel unconditionally." (eq this-command 'scroll-bar-toolkit-scroll) (memq (nth 4 (event-end last-input-event)) '(handle end-scroll))) - (setq mouse-autoselect-window-now nil) + (setq mouse-autoselect-window-state nil) (when (timerp mouse-autoselect-window-timer) (cancel-timer mouse-autoselect-window-timer)) (remove-hook 'pre-command-hook 'mouse-autoselect-window-cancel))) -(defun mouse-autoselect-window-start (window) +(defun mouse-autoselect-window-start (mouse-position &optional window suspend) "Start delayed window autoselection. -Called when Emacs detects that the mouse has moved to the non-selected -window WINDOW and the variable `mouse-autoselect-window' has a numeric, -non-zero value. The return value is non-nil iff delayed autoselection -started successfully. Delayed window autoselection is canceled when the -mouse position has stabilized or a command is executed." - ;; Cancel any active window autoselection. - (mouse-autoselect-window-cancel t) - ;; Record current mouse position in `mouse-autoselect-window-position' and - ;; WINDOW in `mouse-autoselect-window-window'. - (setq mouse-autoselect-window-position (mouse-position)) - (setq mouse-autoselect-window-window window) - ;; Install timer which runs `mouse-autoselect-window-select' every +MOUSE-POSITION is the last position where the mouse was seen as returned +by `mouse-position'. Optional argument WINDOW non-nil denotes the +window where the mouse was seen. Optional argument SUSPEND non-nil +means suspend autoselection." + ;; Record values for MOUSE-POSITION, WINDOW, and SUSPEND. + (setq mouse-autoselect-window-position mouse-position) + (when window (setq mouse-autoselect-window-window window)) + (setq mouse-autoselect-window-state (when suspend 'suspend)) + ;; Install timer which runs `mouse-autoselect-window-select' after ;; `mouse-autoselect-window' seconds. (setq mouse-autoselect-window-timer (run-at-time - (abs mouse-autoselect-window) (abs mouse-autoselect-window) - 'mouse-autoselect-window-select)) - ;; Executing a command cancels window autoselection. - (add-hook 'pre-command-hook 'mouse-autoselect-window-cancel)) + (abs mouse-autoselect-window) nil 'mouse-autoselect-window-select))) (defun mouse-autoselect-window-select () "Select window with delayed window autoselection. @@ -840,9 +837,21 @@ that window. The minibuffer window is selected iff the minibuffer is active. This function is run by `mouse-autoselect-window-timer'." (condition-case nil (let* ((mouse-position (mouse-position)) - (window (window-at (cadr mouse-position) (cddr mouse-position) - (car mouse-position)))) + (window + (condition-case nil + (window-at (cadr mouse-position) (cddr mouse-position) + (car mouse-position)) + (error nil)))) (cond + ((or (menu-or-popup-active-p) + (and window + (not (coordinates-in-window-p (cdr mouse-position) window)))) + ;; A menu / popup dialog is active or the mouse is on the scroll-bar + ;; of WINDOW, temporarily suspend delayed autoselection. + (mouse-autoselect-window-start mouse-position nil t)) + ((eq mouse-autoselect-window-state 'suspend) + ;; Delayed autoselection was temporarily suspended, reenable it. + (mouse-autoselect-window-start mouse-position)) ((and window (not (eq window (selected-window))) (or (not (numberp mouse-autoselect-window)) (and (> mouse-autoselect-window 0) @@ -851,24 +860,23 @@ active. This function is run by `mouse-autoselect-window-timer'." (eq window mouse-autoselect-window-window)) ;; Otherwise select window iff the mouse is at the same ;; position as before. Observe that the first test after - ;; `mouse-autoselect-window-start' usually fails since the - ;; value of `mouse-autoselect-window-position' recorded there - ;; is the position where the mouse has entered the new window - ;; and not necessarily where the mouse has stopped moving. + ;; starting autoselection usually fails since the value of + ;; `mouse-autoselect-window-position' recorded there is the + ;; position where the mouse has entered the new window and + ;; not necessarily where the mouse has stopped moving. (equal mouse-position mouse-autoselect-window-position)) ;; The minibuffer is a candidate window iff it's active. (or (not (window-minibuffer-p window)) (eq window (active-minibuffer-window)))) - ;; Mouse position has stabilized in non-selected window: Cancel window - ;; autoselection and try to select that window. + ;; Mouse position has stabilized in non-selected window: Cancel + ;; delayed autoselection and try to select that window. (mouse-autoselect-window-cancel t) ;; Select window where mouse appears unless the selected window is the ;; minibuffer. Use `unread-command-events' in order to execute pre- ;; and post-command hooks and trigger idle timers. To avoid delaying - ;; autoselection again, temporarily set `mouse-autoselect-window-now' - ;; to t. + ;; autoselection again, set `mouse-autoselect-window-state'." (unless (window-minibuffer-p (selected-window)) - (setq mouse-autoselect-window-now t) + (setq mouse-autoselect-window-state 'select) (setq unread-command-events (cons (list 'select-window (list window)) unread-command-events)))) @@ -876,14 +884,12 @@ active. This function is run by `mouse-autoselect-window-timer'." (not (numberp mouse-autoselect-window)) (equal mouse-position mouse-autoselect-window-position)) ;; Mouse position has either stabilized in the selected window or at - ;; `mouse-autoselect-window-position': Cancel window autoselection. + ;; `mouse-autoselect-window-position': Cancel delayed autoselection. (mouse-autoselect-window-cancel t)) (t - ;; Mouse position has not stabilized yet, record new mouse position in - ;; `mouse-autoselect-window-position' and any window at that position - ;; in `mouse-autoselect-window-window'. - (setq mouse-autoselect-window-position mouse-position) - (setq mouse-autoselect-window-window window)))) + ;; Mouse position has not stabilized yet, resume delayed + ;; autoselection. + (mouse-autoselect-window-start mouse-position window)))) (error nil))) (defun handle-select-window (event) @@ -901,14 +907,18 @@ active. This function is run by `mouse-autoselect-window-timer'." (minibuffer-window-active-p window))) (unless (and (numberp mouse-autoselect-window) (not (zerop mouse-autoselect-window)) - (not mouse-autoselect-window-now) - ;; When `mouse-autoselect-window' has a numeric, non-zero - ;; value, delay window autoselection by that value. - ;; `mouse-autoselect-window-start' returns non-nil iff it - ;; successfully installed a timer for this purpose. - (mouse-autoselect-window-start window)) - ;; Re-enable delayed window autoselection. - (setq mouse-autoselect-window-now nil) + (not (eq mouse-autoselect-window-state 'select)) + (progn + ;; Cancel any delayed autoselection. + (mouse-autoselect-window-cancel t) + ;; Start delayed autoselection from current mouse position + ;; and window. + (mouse-autoselect-window-start (mouse-position) window) + ;; Executing a command cancels delayed autoselection. + (add-hook + 'pre-command-hook 'mouse-autoselect-window-cancel))) + ;; Reset state of delayed autoselection. + (setq mouse-autoselect-window-state nil) (when mouse-autoselect-window ;; Run `mouse-leave-buffer-hook' when autoselecting window. (run-hooks 'mouse-leave-buffer-hook)) |