diff options
| author | Karoly Lorentey <lorentey@elte.hu> | 2005-04-04 16:43:15 +0000 |
|---|---|---|
| committer | Karoly Lorentey <lorentey@elte.hu> | 2005-04-04 16:43:15 +0000 |
| commit | ee00ea6e18c2aeae86e262fae703f67f4705032a (patch) | |
| tree | 9e7fc6bfb33de2b2f861589a2f7674ad35de85a8 /lisp | |
| parent | 4a932511428a2b61ec51deebd6e16ec1efbda800 (diff) | |
| parent | 8c6ef2ca34c444c1dea1f11b999b4b2ec16cdea3 (diff) | |
| download | emacs-ee00ea6e18c2aeae86e262fae703f67f4705032a.tar.gz | |
Merged from miles@gnu.org--gnu-2005 (patch 45-55, 214-231)
Patches applied:
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-214
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-215
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-216
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-217
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-218
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-219
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-220
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-221
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-222
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-223
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-224
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-225
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-226
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-227
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-228
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-229
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-230
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-231
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-45
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-46
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-47
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-48
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-49
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-50
Update from CVS: texi Makefile.in CVS keyw cruft
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-51
Update from CVS: ChangeLog tweaks
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-52
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-53
Merge from emacs--cvs-trunk--0
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-54
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-55
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-324
Diffstat (limited to 'lisp')
106 files changed, 3098 insertions, 1052 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ac6f62b9a40..d5a58deb7e4 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,482 @@ +2005-04-04 Lute Kamstra <lute@gnu.org> + + * autorevert.el (auto-revert-mode): Specify :group. + * battery.el (display-battery-mode): Specify :group. + * diff-mode.el (diff-minor-mode): Specify :group. + * font-core.el (font-lock-mode): Specify :group. + * hl-line.el (hl-line-mode): Specify :group. + * iimage.el (iimage): New customization group. + (iimage-mode): Specify :group. + * longlines.el (longlines-mode): Specify :group. + * master.el: Don't require easy-mmode. + (master): New customization group. + (master-mode): Specify :group. + * msb.el (msb-mode): Specify :group. + * reveal.el (reveal-mode): Specify :group. + * simple.el (next-error-follow-minor-mode): Specify :group. + * smerge-mode.el (smerge-mode): Specify :group. + * emacs-lisp/eldoc.el (eldoc-mode): Specify :group. + * emulation/cua-base.el (cua-mode): Specify :group. + * international/encoded-kb.el (encoded-kbd-mode): Specify :group. + * language/thai-util.el (thai-auto-composition-mode) + (thai-word-mode): Specify :group. + * mail/supercite.el (sc-minor-mode): Specify :group. + * progmodes/cwarn.el (cwarn-mode): Specify :group. + * progmodes/flymake.el (flymake-mode): Specify :group. + * progmodes/glasses.el (glasses-mode): Specify :group. + * progmodes/hideif.el (hide-ifdef-mode): Specify :group. + * textmodes/enriched.el (enriched-mode): Specify :group. + * textmodes/refill.el (refill-mode): Specify :group. + + * add-log.el (change-log-font-lock-keywords): Names in + parenthesized lists can contain spaces. + +2005-04-04 Thien-Thi Nguyen <ttn@gnu.org> + + * startup.el (fancy-splash-text): Shorten default text of + "Emacs Tutorial" line. Also, if the current language env + indicates an available tutorial file other than TUTORIAL, + extract its title and append it to the line in parentheses. + (fancy-splash-insert): If arg is a thunk, funcall it. + +2005-04-04 Jay Belanger <belanger@truman.edu> + + * calc.el (calc-language-alist): Add tags to customization type. + +2005-04-03 Luc Teirlinck <teirllm@auburn.edu> + + * xt-mouse.el (xterm-mouse-mode): Add explicit Custom group, mouse. + Doc fix. + +2005-04-03 Marcelo Toledo <marcelo@marcelotoledo.org> + + * add-log.el (change-log-font-lock-keywords): The manual + describing a Change Log entry, says: (...) "Aside from these + header lines, every line in the change log starts with a space or + a tab.". The font-lock was not highlighting lines started with + spaces, added support for it. + +2005-04-03 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> + + * textmodes/bibtex.el (bibtex-url): Use format to generate the url. + (bibtex-generate-url-list): Update docstring accordingly. Put the + complex example in the docstring. + (bibtex-font-lock-url): Use pop. + +2005-04-03 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/tcl.el (tcl-set-font-lock-keywords): Use new \_< ops. + + * pcvs.el (cvs-checkout): Prompt for cvsroot as well. + +2005-04-03 Glenn Morris <gmorris@ast.cam.ac.uk> + + * filesets.el (filesets-set-default): Doc fix. + +2005-04-03 Lute Kamstra <lute@gnu.org> + + * generic.el (define-generic-mode): Add argument to specify + keywords for defcustom. + (default-generic-mode): Specify :group. + + * generic-x.el: Specify :group for all generic modes. + + * desktop.el (desktop-no-desktop-file-hook) + (desktop-after-read-hook): Fix docstring. + +2005-04-02 Luc Teirlinck <teirllm@auburn.edu> + + * simple.el (visible-mode): Use explicit :group keyword. + This changes the group of `visible-mode-hook' from paren-blinking + to editing-basics. + +2005-04-02 Sergey Poznyakoff <gray@Mirddin.farlep.net> (tiny change) + + * mail/rmail.el (rmail-parse-url): Bugfix. Parse traditional + mailbox specifications as well as URLs. + (rmail-insert-inbox-text): Remove unused conditional branches. + +2005-04-01 Jay Belanger <belanger@truman.edu> + + * calc/calc-graph.el (calc-gnuplot-name, calc-gnuplot-plot-command) + (calc-gnuplot-print-command): Move definitions to calc.el. + + * calc/calc-embed.el (calc-embedded-announce-formula) + (calc-embedded-open-formula, calc-embedded-close-formula) + (calc-embedded-open-word, calc-embedded-close-word) + (calc-embedded-open-plain, calc-embedded-close-plain) + (calc-embedded-open-new-formula, calc-embedded-close-new-formula) + (calc-embedded-open-mode, calc-embedded-close-mode): + Move definitions to calc.el. + + * calc/calc.el (calc-settings-file, calc-language-alist): + Make customizable. + (calc-embedded-announce-formula, calc-embedded-open-formula) + (calc-embedded-close-formula, calc-embedded-open-word) + (calc-embedded-close-word, calc-embedded-open-plain) + (calc-embedded-close-plain, calc-embedded-open-new-formula) + (calc-embedded-close-new-formula, calc-embedded-open-mode) + (calc-embedded-close-mode, calc-gnuplot-name) + (calc-gnuplot-plot-command, calc-gnuplot-print-command): Move here + from other files and make customizable. + +2005-04-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * pcvs.el (cvs-temp-buffer, cvs-mode-kill-process, cvs-buffer-check): + Use buffer-live-p. + (cvs-mode-run): Don't call cvs-update-header here. + (cvs-run-process): Call cvs-update-header. + Use process properties for cvs-postprocess and cvs-buffer so that + the sentinel can behave better if the temp buffer is killed. + Use a pipe rather than a tty, to better handle unexpected prompts. + (cvs-sentinel): Rewrite. Call cvs-update-header. + +2005-04-01 Andre Spiegel <spiegel@gnu.org> + + * vc-hooks.el (vc-workfile-unchanged-p): Disable mtime check when + we go via Tramp or Ange-FTP. Suggested by Kai Grossjohann. + +2005-03-31 Stefan Monnier <monnier@iro.umontreal.ca> + + * generic.el (define-generic-mode): Add indentation rule. + +2005-03-31 Luc Teirlinck <teirllm@auburn.edu> + + * files.el (mode-require-final-newline): Make Custom correctly + report a nil value and allow to set it to nil via Custom. + Doc fix. + +2005-04-01 Kenichi Handa <handa@m17n.org> + + * international/characters.el: Enable the correct case setting for + dotless-i and dotted-I. + +2005-04-01 Kim F. Storm <storm@cua.dk> + + * ido.el (ido-file-internal): Fall back to non-ido command if + initial directory is on slow ftp (or tramp) host. + +2005-03-31 Richard M. Stallman <rms@gnu.org> + + * emacs-lisp/autoload.el (make-autoload): + Handle define-global-minor-mode. + + * emacs-lisp/easy-mmode.el (define-global-minor-mode): + Rename from easy-mmode-define-global-mode. + (easy-mmode-define-global-mode): Alias for define-global-minor-mode. + + * progmodes/scheme.el (scheme-mode-syntax-table): + Update syntax of | and # for two-character comment syntax. + +2005-03-31 Lute Kamstra <lute@gnu.org> + + * emacs-lisp/easy-mmode.el (easy-mmode-define-global-mode) + (define-minor-mode): Call custom-current-group at load-time. + + * generic.el (define-generic-mode): Add debug declaration. + Add defcustom for the mode hook. + (generic-mode-internal): Use run-mode-hooks. + +2005-03-31 Kim F. Storm <storm@cua.dk> + + * mouse.el (mouse-1-click-follows-link): Increase to 450 ms. + (mouse-fixup-help-message): New defun called by show_help_echo + to fixup mouse-2 prefix in help messages when applicable. + + * tooltip.el (tooltip-show-help-function): Don't fixup message here. + +2005-03-31 Kenichi Handa <handa@m17n.org> + + * language/thai-word.el (thai-find-word-ends): Pay attention to + the case that we reach the end of buffer. + + * textmodes/fill.el (fill-text-properties-at): New function. + (fill-newline): Use fill-text-properties-at instead of + text-properties-at. + +2005-03-31 Karl Berry <karl@freefriends.org> + + * textmodes/tex-mode.el (tex-compile): shell-quote-argument, + not comint-quote-filename. + +2005-03-31 Olive Lin <olive.lin@versateladsl.be> (tiny change) + + * textmodes/tex-mode.el (tex-start-tex) shell-quote-argument, + not comint-quote-filename. + +2005-03-31 Thien-Thi Nguyen <ttn@gnu.org> + + * help-fns.el (help-with-tutorial): Revert last change. + +2005-03-31 Kim F. Storm <storm@cua.dk> + + * emulation/cua-base.el (cua-scroll-down): Add CUA property. + +2005-03-30 Paul Eggert <eggert@cs.ucla.edu> + + * calendar/cal-china.el: Update reference to "Calendrical + Calculations" book; there's a new edition. + * calendar/cal-coptic.el: Likewise. + * calendar/cal-french.el: Likewise. + * calendar/cal-hebrew.el: Likewise. + * calendar/cal-islam.el: Likewise. + * calendar/cal-iso.el: Likewise. + * calendar/cal-julian.el: Likewise. + * calendar/cal-mayan.el: Likewise. + * calendar/cal-persia.el: Likewise. + * calendar/calendar.el: Likewise. + * calendar/holidays.el: Likewise. + * calendar/lunar.el: Likewise. + * calendar/solar.el: Likewise. + + * calendar/calendar.el (calendar-day-abbrev-array): Remove trailing + white space from doc string. + +2005-03-30 Jay Belanger <belanger@truman.edu> + + * calc/calc-help.el (calc-full-help): Remove email address. + +2005-03-30 Thien-Thi Nguyen <ttn@gnu.org> + + * help-fns.el (help-with-tutorial): Delete title line. + +2005-03-30 Glenn Morris <gmorris@ast.cam.ac.uk> + + * calendar/cal-x.el (calendar-one-frame-setup) + (calendar-only-one-frame-setup, calendar-two-frame-setup): Use t + rather than 'symbol for set-window-dedicated-p. + + * calendar/appt.el (appt-buffer-name): Make it a constant. + (appt-add): Doc fix. + + * filesets.el (filesets-menu-path, filesets-menu-before) + (filesets-menu-in-menu): Doc fix. Now valid in GNU Emacs. + (filesets-menu-cache-file): Use directory ~/.emacs.d. + (filesets-add-submenu): Delete and use add-submenu instead. + +2005-03-30 Carsten Dominik <dominik@science.uva.nl> + + * org.el (org-agenda-phases-of-moon, org-agenda-sunrise-sunset) + (org-agenda-convert-date, org-agenda-goto-calendar): New commands. + (org-diary-default-entry): New function. + (org-get-entries-from-diary): Better parsing of diary entries. + (org-agenda-check-no-diary): New function. + ("diary-lib"): Advice to function `add-to-diary-list', to allow + linking to diary entries. + (org-agenda-execute-calendar-command): New function. + (org-agenda): Improve visible section in window. + Use `org-fit-agenda-window'. + (org-fit-agenda-window): New option. + (org-move-subtree-down): Better handling of empty lines + at end of subtree. + (org-cycle): Numeric prefix is interpreted now as show-subtree N + levels up. + (org-fontify-done-headline): New option. + (org-headline-done-face): New face. + (org-set-font-lock-defaults): Use `org-headline-done-face'. + (org-table-copy-down): Rename from `org-table-copy-from-above'. + When current field is non-empty, it is copied to next row. + (org-table-copy-from-above): Fix bug which made it + impossible to copy fields containing only a single non-white character. + +2005-03-30 Kim F. Storm <storm@cua.dk> + + * kmacro.el (kmacro-end-macro): Isearch may store this command + into the macro -- so ignore it when executing keyboard macro. + +2005-03-30 Nick Roberts <nickrob@snap.net.nz> + + * tooltip.el (tooltip-gud-display): Use gud-overlay-arrow-position. + +2005-03-29 Kenichi Handa <handa@m17n.org> + + * language/thai.el ("Thai"): Set setup-function and exit-function + for Thai language environment. + + * language/thai-util.el: Require thai-word. + (thai-word-mode-map): New variable. + (thai-word-mode): New minor mode. + (setup-thai-language-environment-internal): New function. + (exit-thai-language-environment-internal): New function. + + * language/thai-word.el (thai-word-table): Declare it by defvar, + use dolist to initialize it. + (thai-kill-word, thai-backward-kill-word, thai-transpose-words) + (thai-fill-find-break-point): New functions. + +2005-03-29 Richard M. Stallman <rms@gnu.org> + + * simple.el (idle-update-delay): Move definition up. + (set-mark): Doc fix. + +2005-03-29 Chong Yidong <cyd@stupidchicken.com> + + * longlines.el: New file. + + * simple.el (buffer-substring-filters): New variable. + (filter-buffer-substring): New function. + (kill-region, copy-region-as-kill): Use it. + + * register.el (copy-to-register, append-to-register) + (prepend-to-register): Use filter-buffer-substring. + +2005-03-30 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gud.el (gdb): (Re)-initialise gud-filter-pending-text. + (gud-filter-pending-text): Move in front of gdb. + (gud-overlay-arrow-position): New variable. + (gud-sentinel, gud-display-line): Use it in place of + overlay-arrow-position. + +2005-03-29 Glenn Morris <gmorris@ast.cam.ac.uk> + + * progmodes/fortran.el (fortran-if-indent): Doc fix. + (fortran-font-lock-keywords-2): Add "where", "elsewhere". + (fortran-font-lock-keywords-4): New variable. + (fortran-blocks-re, fortran-end-block-re) + (fortran-start-block-re): New constants, for hideshow. + (hs-special-modes-alist): Add a Fortran entry. + (fortran-mode-map): Bind fortran-end-of-block, + fortran-beginning-of-block to \M-\C-n, \M-\C-p. + (fortran-mode): Doc fix. Add fortran-font-lock-keywords-4. + (fortran-looking-at-if-then, fortran-end-of-block) + (fortran-beginning-of-block): New functions, for hideshow. + + * progmodes/f90.el (f90-end-block-re, f90-start-block-re): Doc + fix. Tweak regexp. + (f90-beginning-of-block): Push mark first. + +2005-03-29 Jay Belanger <belanger@truman.edu> + + * calc/calc.el: Update copyright date. + (calc-version): Increase to 2.1. + (calc-version-date): Remove. + + * calc/calc-help.el: Update copyright date. + (calc-full-help): Remove reference to calc-version-date. + Update copyright date. + +2005-03-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc.el (vc-do-command): Use a pipe for async processes, so password + prompts don't show up at places where the user can't reply. + +2005-03-29 Olive Lin <olive.lin@versateladsl.be> (tiny change) + + * textmodes/tex-mode.el (tex-send-command): shell-quote-argument + on the file name we pass to the inferior shell. + +2005-03-29 Stephan Stahl <stahl@eos.franken.de> (tiny change) + + * progmodes/which-func.el (which-function): Be robust in the face of an + imenu--make-index-alist failure. + +2005-03-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * reveal.el (reveal-mode-map): Don't override C-a and C-e. + + * progmodes/python.el (python-preoutput-filter): Fix last change. + +2005-03-29 Lute Kamstra <lute@gnu.org> + + * emacs-lisp/debug.el (debug-on-entry): Handle autoloaded + functions and compiled macros. + (debug-convert-byte-code): Handle macros too. + (debug-on-entry-1): Don't signal an error when trying to clear a + function that is not set to debug on entry. + +2005-03-29 Jay Belanger <belanger@truman.edu> + + * calc/calc-lang.el: Add functions to math-function-table + properties of tex and math. + +2005-03-29 Kenichi Handa <handa@m17n.org> + + * ps-mule.el (ps-mule-plot-string): Translate characters by + ps-print-translation-table. + (ps-mule-begin-job): Call find-charset-region/string with + ps-print-translation-table. + (ps-mule-printable-p): Return t if CHARSET is ascii or latin-iso8859-1. + + * ps-print.el (ps-print-translation-table): New variable. + (ps-plot-region): Translate characters by ps-print-translation-table. + +2005-03-29 Juri Linkov <juri@jurta.org> + + * simple.el (next-error-highlight-timer): New variable. + + * progmodes/compile.el (compilation-goto-locus): + Use `next-error-highlight-timer' instead of `sit-for'. + +2005-03-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * mail/supercite.el (sc-mail-field): Use assoc-string. + (sc-get-address): Simplify regexps. + + * files.el (minibuffer-with-setup-hook): New macro. + (find-file-read-args): Use it to avoid let-binding + minibuffer-with-setup-hook (which breaks turning on/off + file-name-shadow-mode while in the prompt). + + * complete.el (PC-read-include-file-name-internal): Use test-completion. + +2005-03-28 Luc Teirlinck <teirllm@auburn.edu> + + * font-lock.el: Bind `font-lock-fontify-block' to M-o M-o. + +2005-03-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * window.el (window-buffer-height): Use count-screen-lines. + + * progmodes/python.el (python-preoutput-leftover): New var. + (python-preoutput-filter): Use it. + (python-send-receive): Loop until all the result has been received. + +2005-03-28 Juri Linkov <juri@jurta.org> + + * dired.el (dired-mode-map): Add ellipsis to "Compare directories". + + * menu-bar.el (menu-bar-file-menu): Remove ellipsis from + "Recover Crashed Session". + (menu-bar-search-menu): Add ellipsis to "Search tagged files". + (menu-bar-replace-menu): Add ellipsis to "Replace in tagged files". + (menu-bar-goto-menu): Add ellipsis to "Set Tags File Name". + (menu-bar-goto-menu): Add ellipsis to "Tags Apropos". + (menu-bar-options-menu): Add ellipsis to "Set Font/Fontset". + (menu-bar-manuals-menu): Add ellipsis to "Find Command in Manual". + (menu-bar-manuals-menu): Add ellipsis to "Find Key in Manual". + (menu-bar-help-menu): Remove ellipsis from "Find Emacs Packages". + + * ediff-hook.el (menu-bar-ediff-misc-menu, ediff-misc-menu): + Remove ellipsis from "Ediff Manual", "Customize Ediff", "List + Ediff Sessions", "Toggle use of separate control buffer frame", + "Use separate frame for Ediff control buffer". + + * bookmark.el (menu-bar-bookmark-map): Add ellipsis to "Jump to + Bookmark", "Set Bookmark", "Insert Contents", "Insert Location", + "Rename Bookmark", "Delete Bookmark". + + * info.el (Info-mode-menu): Remove ellipsis from "Index". + Add ellipsis to "Lookup a String", "Lookup a string in all indices". + Add `:active Info-index-alternatives' to "Next Matching Item". + + * wdired.el (wdired-change-to-wdired-mode): + Mention `wdired-abort-changes' key in the initial message. + + * international/mule.el (auto-coding-alist): Associate non-ascii + image filename extensions with `no-conversion'. + +2005-03-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * international/iso-acc.el: + * obsolete/iso-acc.el: Move iso-acc to the obsolete subdir. + +2005-03-26 Luc Teirlinck <teirllm@auburn.edu> + + * textmodes/sgml-mode.el (html-mode): Doc update. + + * autorevert.el (auto-revert-check-vc-info): Minor doc fix. + 2005-03-26 Dan Nicolaescu <dann@ics.uci.edu> * term.el (term-move-columns): Fix face after extending a line. @@ -345,8 +824,7 @@ 2005-03-21 Lute Kamstra <lute@gnu.org> - * generic.el: Fix commentary section. Don't require cl for - compilation. + * generic.el: Fix commentary section. Don't require cl for compilation. (generic-mode-list): Add autoload cookie. (generic-use-find-file-hook, generic-lines-to-scan) (generic-find-file-regexp, generic-ignore-files-regexp) @@ -396,20 +874,27 @@ * tramp-smb.el (all): Remove debug construct for `with-parsed-tramp-file-name'. - (tramp-smb-prompt): Prompt can contain spaces inside directory - names. + (tramp-smb-prompt): Prompt can contain spaces inside directory names. (tramp-smb-handle-delete-directory, tramp-smb-handle-delete-file): No error message if DIRECTORY or FILENAME doesn't exist. (tramp-smb-open-connection): Check existence of `tramp-smb-program'. +2005-03-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/perl-mode.el (perl-font-lock-syntactic-face-function): + Properly handle the case where the `m' or `s' command's argument is not + yet terminated. + (perl-indent-new-calculate): New function. + (perl-indent-line): Use it. + 2005-03-20 Miles Bader <miles@gnu.org> * progmodes/gdb-ui.el (gdb-put-breakpoint-icon): Use breakpoint faces in text-mode too. Change to new face names. - (breakpoint-enabled): Renamed from `breakpoint-enabled-bitmap-face'. + (breakpoint-enabled): Rename from `breakpoint-enabled-bitmap-face'. Add `:weight bold' attribute. - (breakpoint-disabled): Renamed from `breakpoint-disabled-bitmap-face'. + (breakpoint-disabled): Rename from `breakpoint-disabled-bitmap-face'. 2005-03-19 Juri Linkov <juri@jurta.org> @@ -426,8 +911,7 @@ 2005-03-19 Yoichi NAKAYAMA <yoichi@geiin.org> (tiny changes) - * finder.el (finder-current-item): Throw an error on an empty - line. + * finder.el (finder-current-item): Throw an error on an empty line. * man.el (Man-follow-manual-reference): If current-word returns nil, use "". @@ -466,8 +950,8 @@ 2005-03-19 Vinicius Jose Latorre <viniciusjl@ig.com.br> - * ps-print.el (ps-generate-string-list, ps-generate-header-line): Use - functionp instead of symbolp and fboundp. Reported by Drkm + * ps-print.el (ps-generate-string-list, ps-generate-header-line): + Use functionp instead of symbolp and fboundp. Reported by Drkm <darkman_spam@yahoo.fr>. (ps-print-version): New version 6.6.6. @@ -2290,7 +2774,7 @@ * simple.el (eval-expression-print-format): Avoid warning about edebug-active. -2005-01-15 "James R. Van Zandt" <jrvz@comcast.net> (Tiny change) +2005-01-15 James R. Van Zandt <jrvz@comcast.net> (Tiny change) * progmodes/sh-script.el: Code copied from make-mode.el with small changes, @@ -7012,8 +7496,7 @@ 2004-09-21 Kenichi Handa <handa@m17n.org> - * descr-text.el (describe-char): Checking of quail activation - fixed. + * descr-text.el (describe-char): Checking of quail activation fixed. 2004-09-21 Jay Belanger <belanger@truman.edu> diff --git a/lisp/add-log.el b/lisp/add-log.el index 7706a697755..126e7ecbaa5 100644 --- a/lisp/add-log.el +++ b/lisp/add-log.el @@ -1,7 +1,7 @@ ;;; add-log.el --- change log maintenance commands for Emacs -;; Copyright (C) 1985, 86, 88, 93, 94, 97, 98, 2000, 03, 2004 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1988, 1993, 1994, 1997, 1998, 2000, 2003, +;; 2004, 2005 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: tools @@ -225,20 +225,20 @@ Note: The search is conducted only within 10%, at the beginning of the file." (2 'change-log-email-face))) ;; ;; File names. - ("^\t\\* \\([^ ,:([\n]+\\)" + ("^\\(?: +\\|\t\\)\\* \\([^ ,:([\n]+\\)" (1 'change-log-file-face) ;; Possibly further names in a list: ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 'change-log-file-face)) ;; Possibly a parenthesized list of names: - ("\\= (\\([^() ,\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" + ("\\= (\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" nil nil (1 'change-log-list-face)) - ("\\=, *\\([^() ,\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" + ("\\=, *\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" nil nil (1 'change-log-list-face))) ;; ;; Function or variable names. - ("^\t(\\([^() ,\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" + ("^\t(\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" (1 'change-log-list-face) - ("\\=, *\\([^() ,\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" nil nil + ("\\=, *\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" nil nil (1 'change-log-list-face))) ;; ;; Conditionals. diff --git a/lisp/autorevert.el b/lisp/autorevert.el index d4a3d10d167..36b5a6f5a37 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -1,6 +1,6 @@ ;;; autorevert.el --- revert buffers when files on disk change -;; Copyright (C) 1997, 1998, 1999, 2001, 2004 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1998, 1999, 2001, 2004, 2005 Free Software Foundation, Inc. ;; Author: Anders Lindgren <andersl@andersl.com> ;; Keywords: convenience @@ -246,7 +246,7 @@ This currently works by automatically updating the version control info every `auto-revert-interval' seconds. Nevertheless, it should not cause excessive CPU usage on a reasonably fast machine, if it does not apply to too many version controlled -buffers. CPU usage depends on the version control system" +buffers. CPU usage depends on the version control system." :group 'auto-revert :type 'boolean :version "22.1") @@ -290,7 +290,7 @@ This is a minor mode that affects only the current buffer. Use `global-auto-revert-mode' to automatically revert all buffers. Use `auto-revert-tail-mode' if you know that the file will only grow without being changed in the part that is already in the buffer." - nil auto-revert-mode-text nil + :group 'auto-revert :lighter auto-revert-mode-text (if auto-revert-mode (if (not (memq (current-buffer) auto-revert-buffer-list)) (push (current-buffer) auto-revert-buffer-list)) diff --git a/lisp/battery.el b/lisp/battery.el index 69bd68bb0b9..42ceec0c90c 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -114,7 +114,7 @@ The text being displayed in the mode line is controlled by the variables `battery-mode-line-format' and `battery-status-function'. The mode line will be updated automatically every `battery-update-interval' seconds." - :global t + :global t :group 'battery (setq battery-mode-line-string "") (or global-mode-string (setq global-mode-string '(""))) (and battery-update-timer (cancel-timer battery-update-timer)) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 949434baffb..869896b087a 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -2111,12 +2111,12 @@ strings returned are not." (define-key map [write] '("Save Bookmarks As..." . bookmark-write)) (define-key map [save] '("Save Bookmarks" . bookmark-save)) (define-key map [edit] '("Edit Bookmark List" . bookmark-bmenu-list)) - (define-key map [delete] '("Delete Bookmark" . bookmark-delete)) - (define-key map [rename] '("Rename Bookmark" . bookmark-rename)) - (define-key map [locate] '("Insert Location" . bookmark-locate)) - (define-key map [insert] '("Insert Contents" . bookmark-insert)) - (define-key map [set] '("Set Bookmark" . bookmark-set)) - (define-key map [jump] '("Jump to Bookmark" . bookmark-jump)) + (define-key map [delete] '("Delete Bookmark..." . bookmark-delete)) + (define-key map [rename] '("Rename Bookmark..." . bookmark-rename)) + (define-key map [locate] '("Insert Location..." . bookmark-locate)) + (define-key map [insert] '("Insert Contents..." . bookmark-insert)) + (define-key map [set] '("Set Bookmark..." . bookmark-set)) + (define-key map [jump] '("Jump to Bookmark..." . bookmark-jump)) map)) ;;;###autoload diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el index 2d2f66b1ebf..4f45419c136 100644 --- a/lisp/calc/calc-embed.el +++ b/lisp/calc/calc-embed.el @@ -1,6 +1,6 @@ ;;; calc-embed.el --- embed Calc in a buffer -;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2005 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <belanger@truman.edu> @@ -48,48 +48,18 @@ (defvar calc-embedded-some-active nil) (make-variable-buffer-local 'calc-embedded-some-active) -(defvar calc-embedded-open-formula "\\`\\|^\n\\|\\$\\$?\\|\\\\\\[\\|^\\\\begin[^{].*\n\\|^\\\\begin{.*[^x]}.*\n\\|^@.*\n\\|^\\.EQ.*\n\\|\\\\(\\|^%\n\\|^\\.\\\\\"\n" - "*A regular expression for the opening delimiter of a formula used by -calc-embedded.") - -(defvar calc-embedded-close-formula "\\'\\|\n$\\|\\$\\$?\\|\\\\]\\|^\\\\end[^{].*\n\\|^\\\\end{.*[^x]}.*\n\\|^@.*\n\\|^\\.EN.*\n\\|\\\\)\\|\n%\n\\|^\\.\\\\\"\n" - "*A regular expression for the closing delimiter of a formula used by -calc-embedded.") - -(defvar calc-embedded-open-word "^\\|[^-+0-9.eE]" - "*A regular expression for the opening delimiter of a formula used by -calc-embedded-word.") - -(defvar calc-embedded-close-word "$\\|[^-+0-9.eE]" - "*A regular expression for the closing delimiter of a formula used by -calc-embedded-word.") - -(defvar calc-embedded-open-plain "%%% " - "*A string which is the opening delimiter for a \"plain\" formula. -If calc-show-plain mode is enabled, this is inserted at the front of -each formula.") - -(defvar calc-embedded-close-plain " %%%\n" - "*A string which is the closing delimiter for a \"plain\" formula. -See calc-embedded-open-plain.") - -(defvar calc-embedded-open-new-formula "\n\n" - "*A string which is inserted at front of formula by calc-embedded-new-formula.") - -(defvar calc-embedded-close-new-formula "\n\n" - "*A string which is inserted at end of formula by calc-embedded-new-formula.") - -(defvar calc-embedded-announce-formula "%Embed\n\\(% .*\n\\)*" - "*A regular expression which is sure to be followed by a calc-embedded formula." ) - -(defvar calc-embedded-open-mode "% " - "*A string which should precede calc-embedded mode annotations. -This is not required to be present for user-written mode annotations.") - -(defvar calc-embedded-close-mode "\n" - "*A string which should follow calc-embedded mode annotations. -This is not required to be present for user-written mode annotations.") - +;; The following variables are customizable and defined in calc.el. +(defvar calc-embedded-announce-formula) +(defvar calc-embedded-open-formula) +(defvar calc-embedded-close-formula) +(defvar calc-embedded-open-word) +(defvar calc-embedded-close-word) +(defvar calc-embedded-open-plain) +(defvar calc-embedded-close-plain) +(defvar calc-embedded-open-new-formula) +(defvar calc-embedded-close-new-formula) +(defvar calc-embedded-open-mode) +(defvar calc-embedded-close-mode) (defconst calc-embedded-mode-vars '(("precision" . calc-internal-prec) ("word-size" . calc-word-size) diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el index 662de5db867..6a58a6215fa 100644 --- a/lisp/calc/calc-graph.el +++ b/lisp/calc/calc-graph.el @@ -1,6 +1,6 @@ ;;; calc-graph.el --- graph output functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2005 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <belanger@truman.edu> @@ -33,14 +33,10 @@ ;;; Graphics -(defvar calc-gnuplot-name "gnuplot" - "*Name of GNUPLOT program, for calc-graph features.") - -(defvar calc-gnuplot-plot-command nil - "*Name of command for displaying GNUPLOT output; %s = file name to print.") - -(defvar calc-gnuplot-print-command "lp %s" - "*Name of command for printing GNUPLOT output; %s = file name to print.") +;; The following three variables are customizable and defined in calc.el. +(defvar calc-gnuplot-name) +(defvar calc-gnuplot-plot-command) +(defvar calc-gnuplot-print-command) (defvar calc-gnuplot-tempfile "calc") diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el index dc7f0b17c1d..46b8cec2ac6 100644 --- a/lisp/calc/calc-help.el +++ b/lisp/calc/calc-help.el @@ -1,6 +1,6 @@ ;;; calc-help.el --- help display functions for Calc, -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2004 +;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2004, 2005 ;; Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> @@ -409,10 +409,10 @@ C-w Describe how there is no warranty for Calc." (defun calc-full-help () (interactive) (with-output-to-temp-buffer "*Help*" - (princ (format "GNU Emacs Calculator version %s of %s.\n" - calc-version calc-version-date)) - (princ " By Dave Gillespie, daveg@synaptics.com.\n") - (princ " Copyright (C) 1990, 1993 Free Software Foundation, Inc.\n\n") + (princ (format "GNU Emacs Calculator version %s.\n" + calc-version)) + (princ " By Dave Gillespie.\n") + (princ " Copyright (C) 2005 Free Software Foundation, Inc.\n\n") (princ "Type `h s' for a more detailed summary.\n") (princ "Or type `h i' to read the full Calc manual on-line.\n\n") (princ "Basic keys:\n") diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el index 2e5737349bc..9510507e276 100644 --- a/lisp/calc/calc-lang.el +++ b/lisp/calc/calc-lang.el @@ -388,6 +388,9 @@ ( \\arg . calcFunc-arg ) ( \\cos . calcFunc-cos ) ( \\cosh . calcFunc-cosh ) + ( \\cot . calcFunc-cot ) + ( \\coth . calcFunc-coth ) + ( \\csc . calcFunc-csc ) ( \\det . calcFunc-det ) ( \\exp . calcFunc-exp ) ( \\gcd . calcFunc-gcd ) @@ -395,10 +398,11 @@ ( \\log . calcFunc-log10 ) ( \\max . calcFunc-max ) ( \\min . calcFunc-min ) - ( \\tan . calcFunc-tan ) + ( \\sec . calcFunc-sec ) ( \\sin . calcFunc-sin ) ( \\sinh . calcFunc-sinh ) ( \\sqrt . calcFunc-sqrt ) + ( \\tan . calcFunc-tan ) ( \\tanh . calcFunc-tanh ) ( \\phi . calcFunc-totient ) ( \\mu . calcFunc-moebius ))) @@ -686,6 +690,10 @@ ( Conjugate . calcFunc-conj ) ( Cos . calcFunc-cos ) ( Cosh . calcFunc-cosh ) + ( Cot . calcFunc-cot ) + ( Coth . calcFunc-coth ) + ( Csc . calcFunc-csc ) + ( Csch . calcFunc-csch ) ( D . calcFunc-deriv ) ( Dt . calcFunc-tderiv ) ( Det . calcFunc-det ) @@ -708,6 +716,8 @@ ( Random . calcFunc-random ) ( Round . calcFunc-round ) ( Re . calcFunc-re ) + ( Sec . calcFunc-sec ) + ( Sech . calcFunc-sech ) ( Sign . calcFunc-sign ) ( Sin . calcFunc-sin ) ( Sinh . calcFunc-sinh ) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 24336ad9333..ceee013e493 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -1,6 +1,7 @@ ;;; calc.el --- the GNU Emacs calculator -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 2005 +;; Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <belanger@truman.edu> @@ -205,9 +206,122 @@ (require 'calc-macs) +(defgroup calc nil + "GNU Calc" + :prefix "calc-" + :tag "Calc") + ;;;###autoload -(defvar calc-settings-file (convert-standard-filename "~/.calc.el") - "*File in which to record permanent settings.") +(defcustom calc-settings-file + (convert-standard-filename "~/.calc.el") + "*File in which to record permanent settings." + :group 'calc + :type '(file)) + +(defcustom calc-language-alist + '((latex-mode . latex) + (tex-mode . tex) + (plain-tex-mode . tex) + (context-mode . tex) + (nroff-mode . eqn) + (pascal-mode . pascal) + (c-mode . c) + (c++-mode . c) + (fortran-mode . fortran) + (f90-mode . fortran)) + "*Alist of major modes with appropriate Calc languages." + :group 'calc + :type '(alist :key-type (symbol :tag "Major mode") + :value-type (symbol :tag "Calc language"))) + +(defcustom calc-embedded-announce-formula + "%Embed\n\\(% .*\n\\)*" + "*A regular expression which is sure to be followed by a calc-embedded formula." + :group 'calc + :type '(regexp)) + +(defcustom calc-embedded-open-formula + "\\`\\|^\n\\|\\$\\$?\\|\\\\\\[\\|^\\\\begin[^{].*\n\\|^\\\\begin{.*[^x]}.*\n\\|^@.*\n\\|^\\.EQ.*\n\\|\\\\(\\|^%\n\\|^\\.\\\\\"\n" + "*A regular expression for the opening delimiter of a formula used by calc-embedded." + :group 'calc + :type '(regexp)) + +(defcustom calc-embedded-close-formula + "\\'\\|\n$\\|\\$\\$?\\|\\\\]\\|^\\\\end[^{].*\n\\|^\\\\end{.*[^x]}.*\n\\|^@.*\n\\|^\\.EN.*\n\\|\\\\)\\|\n%\n\\|^\\.\\\\\"\n" + "*A regular expression for the closing delimiter of a formula used by calc-embedded." + :group 'calc + :type '(regexp)) + +(defcustom calc-embedded-open-word + "^\\|[^-+0-9.eE]" + "*A regular expression for the opening delimiter of a formula used by calc-embedded-word." + :group 'calc + :type '(regexp)) + +(defcustom calc-embedded-close-word + "$\\|[^-+0-9.eE]" + "*A regular expression for the closing delimiter of a formula used by calc-embedded-word." + :group 'calc + :type '(regexp)) + +(defcustom calc-embedded-open-plain + "%%% " + "*A string which is the opening delimiter for a \"plain\" formula. +If calc-show-plain mode is enabled, this is inserted at the front of +each formula." + :group 'calc + :type '(string)) + +(defcustom calc-embedded-close-plain + " %%%\n" + "*A string which is the closing delimiter for a \"plain\" formula. +See calc-embedded-open-plain." + :group 'calc + :type '(string)) + +(defcustom calc-embedded-open-new-formula + "\n\n" + "*A string which is inserted at front of formula by calc-embedded-new-formula." + :group 'calc + :type '(string)) + +(defcustom calc-embedded-close-new-formula + "\n\n" + "*A string which is inserted at end of formula by calc-embedded-new-formula." + :group 'calc + :type '(string)) + +(defcustom calc-embedded-open-mode + "% " + "*A string which should precede calc-embedded mode annotations. +This is not required to be present for user-written mode annotations." + :group 'calc + :type '(string)) + +(defcustom calc-embedded-close-mode + "\n" + "*A string which should follow calc-embedded mode annotations. +This is not required to be present for user-written mode annotations." + :group 'calc + :type '(string)) + +(defcustom calc-gnuplot-name + "gnuplot" + "*Name of GNUPLOT program, for calc-graph features." + :group 'calc + :type '(string)) + +(defcustom calc-gnuplot-plot-command + nil + "*Name of command for displaying GNUPLOT output; %s = file name to print." + :group 'calc + :type '(choice (string) (sexp))) + +(defcustom calc-gnuplot-print-command + "lp %s" + "*Name of command for printing GNUPLOT output; %s = file name to print." + :group 'calc + :type '(choice (string) (sexp))) (defvar calc-bug-address "belanger@truman.edu" "Address of the author of Calc, for use by `report-calc-bug'.") @@ -656,8 +770,7 @@ If nil, selections displayed but ignored.") (put 'math-underflow 'error-conditions '(error math-underflow calc-error)) (put 'math-underflow 'error-message "Floating-point underflow occurred") -(defconst calc-version "2.02g") -(defconst calc-version-date "Mon Nov 19 2001") +(defconst calc-version "2.1") (defvar calc-trail-pointer nil) ; "Current" entry in trail buffer. (defvar calc-trail-overlay nil) ; Value of overlay-arrow-string. (defvar calc-undo-list nil) ; List of previous operations for undo. diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el index e11129414d3..8ace0be910b 100644 --- a/lisp/calendar/appt.el +++ b/lisp/calendar/appt.el @@ -1,9 +1,9 @@ ;;; appt.el --- appointment notification functions -;; Copyright (C) 1989, 1990, 1994, 1998, 2004 Free Software Foundation, Inc. +;; Copyright (C) 1989, 1990, 1994, 1998, 2004 Free Software Foundation, Inc. ;; Author: Neil Mager <neilm@juliet.ll.mit.edu> -;; Maintainer: FSF +;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk> ;; Keywords: calendar ;; This file is part of GNU Emacs. @@ -181,7 +181,7 @@ Only relevant if reminders are being displayed in a window." ;;; Internal variables below this point. -(defvar appt-buffer-name " *appt-buf*" +(defconst appt-buffer-name " *appt-buf*" "Name of the appointments buffer.") (defvar appt-time-msg-list nil @@ -486,9 +486,8 @@ Usually just deletes the appointment buffer." ;;;###autoload (defun appt-add (new-appt-time new-appt-msg) - "Add an appointment for the day at NEW-APPT-TIME and issue message NEW-APPT-MSG. + "Add an appointment for today at NEW-APPT-TIME with message NEW-APPT-MSG. The time should be in either 24 hour format or am/pm format." - (interactive "sTime (hh:mm[am/pm]): \nsMessage: ") (unless (string-match "[0-9]?[0-9][:.][0-9][0-9]\\(am\\|pm\\)?" new-appt-time) diff --git a/lisp/calendar/cal-china.el b/lisp/calendar/cal-china.el index 6e506b93f7d..303193e3d73 100644 --- a/lisp/calendar/cal-china.el +++ b/lisp/calendar/cal-china.el @@ -38,8 +38,8 @@ ;; The date of Chinese New Year is correct from 1644-2051. ;; Technical details of all the calendrical calculations can be found in -;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, -;; Cambridge University Press (1997). +;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold +;; and Nachum Dershowitz, Cambridge University Press (2001). ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science diff --git a/lisp/calendar/cal-coptic.el b/lisp/calendar/cal-coptic.el index df1201a23c4..2aa111f2109 100644 --- a/lisp/calendar/cal-coptic.el +++ b/lisp/calendar/cal-coptic.el @@ -29,8 +29,8 @@ ;; diary.el that deal with the Coptic and Ethiopic calendars. ;; Technical details of all the calendrical calculations can be found in -;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, -;; Cambridge University Press (1997). +;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold +;; and Nachum Dershowitz, Cambridge University Press (2001). ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el index d988b008f53..c42e415eb25 100644 --- a/lisp/calendar/cal-french.el +++ b/lisp/calendar/cal-french.el @@ -29,8 +29,8 @@ ;; diary.el that deal with the French Revolutionary calendar. ;; Technical details of the French Revolutionary calendar can be found in -;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, -;; Cambridge University Press (1997), and in +;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold +;; and Nachum Dershowitz, Cambridge University Press (2001), and in ;; ``Calendrical Calculations, Part II: Three Historical Calendars'' by ;; E. M. Reingold, N. Dershowitz, and S. M. Clamen, Software--Practice and ;; Experience, Volume 23, Number 4 (April, 1993), pages 383-404. diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el index 776868159be..f66b4966e57 100644 --- a/lisp/calendar/cal-hebrew.el +++ b/lisp/calendar/cal-hebrew.el @@ -30,8 +30,8 @@ ;; diary.el that deal with the Hebrew calendar. ;; Technical details of all the calendrical calculations can be found in -;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, -;; Cambridge University Press (1997). +;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold +;; and Nachum Dershowitz, Cambridge University Press (2001). ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science diff --git a/lisp/calendar/cal-islam.el b/lisp/calendar/cal-islam.el index 8dcf5c29b1f..1ac6f0677b1 100644 --- a/lisp/calendar/cal-islam.el +++ b/lisp/calendar/cal-islam.el @@ -29,8 +29,8 @@ ;; diary.el that deal with the Islamic calendar. ;; Technical details of all the calendrical calculations can be found in -;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, -;; Cambridge University Press (1997). +;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold +;; and Nachum Dershowitz, Cambridge University Press (2001). ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science diff --git a/lisp/calendar/cal-iso.el b/lisp/calendar/cal-iso.el index 058bdf071d7..8a40442e4fe 100644 --- a/lisp/calendar/cal-iso.el +++ b/lisp/calendar/cal-iso.el @@ -30,8 +30,8 @@ ;; diary.el that deal with the ISO calendar. ;; Technical details of all the calendrical calculations can be found in -;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, -;; Cambridge University Press (1997). +;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold +;; and Nachum Dershowitz, Cambridge University Press (2001). ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el index 67fb8515b24..2b7278f8ea6 100644 --- a/lisp/calendar/cal-julian.el +++ b/lisp/calendar/cal-julian.el @@ -29,8 +29,8 @@ ;; diary.el that deal with the Julian calendar. ;; Technical details of all the calendrical calculations can be found in -;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, -;; Cambridge University Press (1997). +;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold +;; and Nachum Dershowitz, Cambridge University Press (2001). ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science diff --git a/lisp/calendar/cal-mayan.el b/lisp/calendar/cal-mayan.el index c2c3e027c4b..92bbb5df23e 100644 --- a/lisp/calendar/cal-mayan.el +++ b/lisp/calendar/cal-mayan.el @@ -44,8 +44,8 @@ ;; Comments, improvements, and bug reports should be sent to Reingold. ;; Technical details of the Mayan calendrical calculations can be found in -;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, -;; Cambridge University Press (1997), and in +;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold +;; and Nachum Dershowitz, Cambridge University Press (2001), and in ;; ``Calendrical Calculations, Part II: Three Historical Calendars'' ;; by E. M. Reingold, N. Dershowitz, and S. M. Clamen, ;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993), diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el index ff09c14b47d..dcbbcbd637e 100644 --- a/lisp/calendar/cal-persia.el +++ b/lisp/calendar/cal-persia.el @@ -29,8 +29,8 @@ ;; diary.el that deal with the Persian calendar. ;; Technical details of all the calendrical calculations can be found in -;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, -;; Cambridge University Press (1997). +;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold +;; and Nachum Dershowitz, Cambridge University Press (2001). ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science diff --git a/lisp/calendar/cal-x.el b/lisp/calendar/cal-x.el index 97fbb72af61..03b485a438a 100644 --- a/lisp/calendar/cal-x.el +++ b/lisp/calendar/cal-x.el @@ -1,9 +1,10 @@ ;;; cal-x.el --- calendar windows in dedicated frames in X -;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 2005 Free Software Foundation, Inc. ;; Author: Michael Kifer <kifer@cs.sunysb.edu> ;; Edward M. Reingold <reingold@cs.uiuc.edu> +;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk> ;; Keywords: calendar ;; Human-Keywords: calendar, dedicated frames, X Window System @@ -88,7 +89,7 @@ This function requires a display capable of multiple frames, else (frame-parameters calendar-frame)))) (iconify-or-deiconify-frame)) (calendar-basic-setup arg) - (set-window-dedicated-p (selected-window) 'calendar) + (set-window-dedicated-p (selected-window) t) (set-window-dedicated-p (display-buffer (if (not (memq 'fancy-diary-display diary-display-hook)) @@ -96,7 +97,7 @@ This function requires a display capable of multiple frames, else (if (not (bufferp (get-buffer fancy-diary-buffer))) (make-fancy-diary-buffer)) fancy-diary-buffer)) - 'diary)))))) + t)))))) (defun calendar-only-one-frame-setup (&optional arg) "Start calendar and display it in a dedicated frame. @@ -117,7 +118,7 @@ This function requires a display capable of multiple frames, else (frame-parameters calendar-frame)))) (iconify-or-deiconify-frame)) (calendar-basic-setup arg) - (set-window-dedicated-p (selected-window) 'calendar)))))) + (set-window-dedicated-p (selected-window) t)))))) (defun calendar-two-frame-setup (&optional arg) "Start calendar and diary in separate, dedicated frames. @@ -139,7 +140,7 @@ This function requires a display capable of multiple frames, else (frame-parameters calendar-frame)))) (iconify-or-deiconify-frame)) (display-buffer calendar-buffer) - (set-window-dedicated-p (selected-window) 'calendar) + (set-window-dedicated-p (selected-window) t) (setq diary-frame (make-frame diary-frame-parameters)) (run-hooks 'calendar-after-frame-setup-hooks) (select-frame diary-frame) @@ -154,7 +155,7 @@ This function requires a display capable of multiple frames, else (if (not (bufferp (get-buffer fancy-diary-buffer))) (make-fancy-diary-buffer)) fancy-diary-buffer)) - 'diary))))) + t))))) ;; Formerly (get-file-buffer diary-file) was added to the list here, ;; but that isn't clean, and the value could even be nil. diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 89d32c4952b..5fc23a15cc9 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -75,13 +75,13 @@ ;; solar.el Sunrise/sunset, equinoxes/solstices ;; Technical details of all the calendrical calculations can be found in -;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, -;; Cambridge University Press (1997). +;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold +;; and Nachum Dershowitz, Cambridge University Press (2001). ;; An earlier version of the technical details appeared in ;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, ;; Software--Practice and Experience, Volume 20, Number 9 (September, 1990), -;; pages 899-928. ``Calendrical Calculations, Part II: Three Historical +;; pages 899-928, and in ``Calendrical Calculations, Part II: Three Historical ;; Calendars'' by E. M. Reingold, N. Dershowitz, and S. M. Clamen, ;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993), ;; pages 383-404. @@ -2763,7 +2763,7 @@ in `calendar-day-name-array'. These abbreviations may be used instead of the full names in the diary file. Do not include a trailing `.' in the strings specified in this variable, though you may use such in the diary file. If any element of this array -is nil, then the abbreviation will be constructed as the first +is nil, then the abbreviation will be constructed as the first `calendar-abbrev-length' characters of the corresponding full name.") (defvar calendar-month-name-array diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el index 4493bd02a9c..6596657d454 100644 --- a/lisp/calendar/holidays.el +++ b/lisp/calendar/holidays.el @@ -30,8 +30,8 @@ ;; in calendar.el. ;; Technical details of all the calendrical calculations can be found in -;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, -;; Cambridge University Press (1997). +;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold +;; and Nachum Dershowitz, Cambridge University Press (2001). ;; An earlier version of the technical details appeared in ;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el index 7efed3ff275..057419969fc 100644 --- a/lisp/calendar/lunar.el +++ b/lisp/calendar/lunar.el @@ -38,8 +38,8 @@ ;; person rewrite the code for the lunar calculations in this file! ;; Technical details of all the calendrical calculations can be found in -;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, -;; Cambridge University Press (1997). +;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold +;; and Nachum Dershowitz, Cambridge University Press (2001). ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el index 8a514fa6415..57a6c6a40a8 100644 --- a/lisp/calendar/solar.el +++ b/lisp/calendar/solar.el @@ -48,8 +48,8 @@ ;; 1951--2050. For other years the times will be within +/- 1 minute. ;; Technical details of all the calendrical calculations can be found in -;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, -;; Cambridge University Press (1997). +;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold +;; and Nachum Dershowitz, Cambridge University Press (2001). ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index a4acb8b9291..7160d26ef42 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -1,5 +1,5 @@ -;;; time-date.el --- date and time handling functions -;; Copyright (C) 1998, 1999, 2000, 2004, 2005 Free Software Foundation, Inc. +;;; time-date.el --- Date and time handling functions +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2004, 2005 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Masanobu Umeda <umerin@mse.kyutech.ac.jp> diff --git a/lisp/complete.el b/lisp/complete.el index 337af81de71..60bddd01f17 100644 --- a/lisp/complete.el +++ b/lisp/complete.el @@ -937,12 +937,11 @@ absolute rather than relative to some directory on the SEARCH-PATH." ((not completion-table) nil) ((eq action nil) (try-completion str2 completion-table nil)) ((eq action t) (all-completions str2 completion-table nil)) - ((eq action 'lambda) - (eq (try-completion str2 completion-table nil) t)))) + ((eq action 'lambda) (test-completion str2 completion-table nil)))) (funcall PC-old-read-file-name-internal string dir action))) (provide 'complete) -;;; arch-tag: fc7e2768-ff44-4e22-b579-4d825b968458 +;; arch-tag: fc7e2768-ff44-4e22-b579-4d825b968458 ;;; complete.el ends here diff --git a/lisp/desktop.el b/lisp/desktop.el index 6ec81fcac70..ed663d375d5 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -1,6 +1,6 @@ ;;; desktop.el --- save partial status of Emacs when killed -;; Copyright (C) 1993, 1994, 1995, 1997, 2000, 2001 +;; Copyright (C) 1993, 1994, 1995, 1997, 2000, 2001, 2005 ;; Free Software Foundation, Inc. ;; Author: Morten Welinder <terra@diku.dk> @@ -158,14 +158,14 @@ If nil, just print error messages in the message buffer." (defcustom desktop-no-desktop-file-hook nil "Normal hook run when `desktop-read' can't find a desktop file. -May e.g. be used to show a dired buffer." +May be used to show a dired buffer." :type 'hook :group 'desktop :version "22.1") (defcustom desktop-after-read-hook nil "Normal hook run after a successful `desktop-read'. -May e.g. be used to show a buffer list." +May be used to show a buffer list." :type 'hook :group 'desktop :version "22.1") diff --git a/lisp/diff-mode.el b/lisp/diff-mode.el index c945a6a7221..d69685ac86f 100644 --- a/lisp/diff-mode.el +++ b/lisp/diff-mode.el @@ -1,7 +1,7 @@ ;;; diff-mode.el --- a mode for viewing/editing context diffs -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 -;; Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 +;; Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@cs.yale.edu> ;; Keywords: convenience patch diff @@ -263,7 +263,7 @@ when editing big diffs)." (save-excursion (while (re-search-backward re start t) (replace-match "" t t))))))) - + (defvar diff-font-lock-keywords `(("^\\(@@ -[0-9,]+ \\+[0-9,]+ @@\\)\\(.*\\)$" ;unified @@ -484,7 +484,7 @@ If the OLD prefix arg is passed, tell the file NAME of the old file." (let ((fs (diff-hunk-file-names old))) (unless fs (error "No file name to look for")) (push (cons fs name) diff-remembered-files-alist))) - + (defun diff-hunk-file-names (&optional old) "Give the list of file names textually mentioned for the current hunk." (save-excursion @@ -952,7 +952,7 @@ a diff with \\[diff-reverse-direction]." (define-minor-mode diff-minor-mode "Minor mode for viewing/editing context diffs. \\{diff-minor-mode-map}" - nil " Diff" nil + :group 'diff-mode :lighter " Diff" ;; FIXME: setup font-lock ;; setup change hooks (if (not diff-update-on-the-fly) diff --git a/lisp/dired.el b/lisp/dired.el index b42d4f8cece..8ee19486a7e 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1252,7 +1252,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." '("--")) (define-key map [menu-bar immediate compare-directories] - '(menu-item "Compare directories" dired-compare-directories + '(menu-item "Compare directories..." dired-compare-directories :help "Mark files with different attributes in two dired buffers")) (define-key map [menu-bar immediate backup-diff] '(menu-item "Compare with Backup" dired-backup-diff diff --git a/lisp/ediff-hook.el b/lisp/ediff-hook.el index 7ea6f24d7bb..5394923aa36 100644 --- a/lisp/ediff-hook.el +++ b/lisp/ediff-hook.el @@ -131,10 +131,10 @@ )) (defvar ediff-misc-menu '("Ediff Miscellanea" - ["Ediff Manual..." ediff-documentation t] - ["Customize Ediff..." ediff-customize t] - ["List Ediff Sessions..." ediff-show-registry t] - ["Use separate frame for Ediff control buffer..." + ["Ediff Manual" ediff-documentation t] + ["Customize Ediff" ediff-customize t] + ["List Ediff Sessions" ediff-show-registry t] + ["Use separate frame for Ediff control buffer" ediff-toggle-multiframe :style toggle :selected (if (and (featurep 'ediff-util) @@ -242,14 +242,14 @@ ;; define ediff miscellanea (define-key menu-bar-ediff-misc-menu [emultiframe] - '("Toggle use of separate control buffer frame..." + '("Toggle use of separate control buffer frame" . ediff-toggle-multiframe)) (define-key menu-bar-ediff-misc-menu [eregistry] - '("List Ediff Sessions..." . ediff-show-registry)) + '("List Ediff Sessions" . ediff-show-registry)) (define-key menu-bar-ediff-misc-menu [ediff-cust] - '("Customize Ediff..." . ediff-customize)) + '("Customize Ediff" . ediff-customize)) (define-key menu-bar-ediff-misc-menu [ediff-doc] - '("Ediff Manual..." . ediff-documentation)) + '("Ediff Manual" . ediff-documentation)) ) ) ; emacs case diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 0a75a43827e..68d1287d98c 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -72,7 +72,7 @@ or macro definition or a defcustom)." (let ((car (car-safe form)) expand) (cond ;; For complex cases, try again on the macro-expansion. - ((and (memq car '(easy-mmode-define-global-mode + ((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode easy-mmode-define-minor-mode define-minor-mode)) (setq expand (let ((load-file-name file)) (macroexpand form))) (eq (car expand) 'progn) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 1e45439658c..2149cba8720 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -632,24 +632,31 @@ which must be written in Lisp, not predefined. Use \\[cancel-debug-on-entry] to cancel the effect of this command. Redefining FUNCTION also cancels it." (interactive "aDebug on entry (to function): ") - ;; Handle a function that has been aliased to some other function. - (if (and (subrp (symbol-function function)) - (eq (cdr (subr-arity (symbol-function function))) 'unevalled)) - (error "Function %s is a special form" function)) - (if (or (symbolp (symbol-function function)) + (when (and (subrp (symbol-function function)) + (eq (cdr (subr-arity (symbol-function function))) 'unevalled)) + (error "Function %s is a special form" function)) + (if (or (symbolp (symbol-function function)) (subrp (symbol-function function))) - ;; Create a wrapper in which we can then add the necessary debug call. + ;; The function is built-in or aliased to another function. + ;; Create a wrapper in which we can add the debug call. (fset function `(lambda (&rest debug-on-entry-args) ,(interactive-form (symbol-function function)) - (apply ',(symbol-function function) - debug-on-entry-args)))) - (or (consp (symbol-function function)) - (debug-convert-byte-code function)) - (or (consp (symbol-function function)) - (error "Definition of %s is not a list" function)) + (apply ',(symbol-function function) + debug-on-entry-args))) + (when (eq (car-safe (symbol-function function)) 'autoload) + ;; The function is autoloaded. Load its real definition. + (load (cadr (symbol-function function)) nil noninteractive nil t)) + (when (or (not (consp (symbol-function function))) + (and (eq (car (symbol-function function)) 'macro) + (not (consp (cdr (symbol-function function)))))) + ;; The function is byte-compiled. Create a wrapper in which + ;; we can add the debug call. + (debug-convert-byte-code function))) + (unless (consp (symbol-function function)) + (error "Definition of %s is not a list" function)) (fset function (debug-on-entry-1 function t)) - (or (memq function debug-function-list) - (push function debug-function-list)) + (unless (memq function debug-function-list) + (push function debug-function-list)) function) ;;;###autoload @@ -664,45 +671,52 @@ If argument is nil or an empty string, cancel for all functions." (if name (intern name))))) (if (and function (not (string= function ""))) (progn - (let ((f (debug-on-entry-1 function nil))) + (let ((defn (debug-on-entry-1 function nil))) (condition-case nil - (if (and (equal (nth 1 f) '(&rest debug-on-entry-args)) - (eq (car (nth 3 f)) 'apply)) - ;; `f' is a wrapper introduced in debug-on-entry. - ;; Get rid of it since we don't need it any more. - (setq f (nth 1 (nth 1 (nth 3 f))))) + (when (and (equal (nth 1 defn) '(&rest debug-on-entry-args)) + (eq (car (nth 3 defn)) 'apply)) + ;; `defn' is a wrapper introduced in debug-on-entry. + ;; Get rid of it since we don't need it any more. + (setq defn (nth 1 (nth 1 (nth 3 defn))))) (error nil)) - (fset function f)) + (fset function defn)) (setq debug-function-list (delq function debug-function-list)) function) (message "Cancelling debug-on-entry for all functions") (mapcar 'cancel-debug-on-entry debug-function-list))) (defun debug-convert-byte-code (function) - (let ((defn (symbol-function function))) - (if (not (consp defn)) - ;; Assume a compiled code object. - (let* ((contents (append defn nil)) - (body - (list (list 'byte-code (nth 1 contents) - (nth 2 contents) (nth 3 contents))))) - (if (nthcdr 5 contents) - (setq body (cons (list 'interactive (nth 5 contents)) body))) - (if (nth 4 contents) - ;; Use `documentation' here, to get the actual string, - ;; in case the compiled function has a reference - ;; to the .elc file. - (setq body (cons (documentation function) body))) - (fset function (cons 'lambda (cons (car contents) body))))))) + (let* ((defn (symbol-function function)) + (macro (eq (car-safe defn) 'macro))) + (when macro (setq defn (cdr defn))) + (unless (consp defn) + ;; Assume a compiled code object. + (let* ((contents (append defn nil)) + (body + (list (list 'byte-code (nth 1 contents) + (nth 2 contents) (nth 3 contents))))) + (if (nthcdr 5 contents) + (setq body (cons (list 'interactive (nth 5 contents)) body))) + (if (nth 4 contents) + ;; Use `documentation' here, to get the actual string, + ;; in case the compiled function has a reference + ;; to the .elc file. + (setq body (cons (documentation function) body))) + (setq defn (cons 'lambda (cons (car contents) body)))) + (when macro (setq defn (cons 'macro defn))) + (fset function defn)))) (defun debug-on-entry-1 (function flag) (let* ((defn (symbol-function function)) (tail defn)) - (if (subrp tail) - (error "%s is a built-in function" function) - (if (eq (car tail) 'macro) (setq tail (cdr tail))) - (if (eq (car tail) 'lambda) (setq tail (cdr tail)) - (error "%s not user-defined Lisp function" function)) + (when (eq (car-safe tail) 'macro) + (setq tail (cdr tail))) + (if (not (eq (car-safe tail) 'lambda)) + ;; Only signal an error when we try to set debug-on-entry. + ;; When we try to clear debug-on-entry, we are now done. + (when flag + (error "%s is not a user-defined Lisp function" function)) + (setq tail (cdr tail)) ;; Skip the docstring. (when (and (stringp (cadr tail)) (cddr tail)) (setq tail (cdr tail))) @@ -713,8 +727,8 @@ If argument is nil or an empty string, cancel for all functions." ;; Add/remove debug statement as needed. (if flag (setcdr tail (cons '(implement-debug-on-entry) (cdr tail))) - (setcdr tail (cddr tail)))) - defn))) + (setcdr tail (cddr tail))))) + defn)) (defun debugger-list-functions () "Display a list of all the functions now set to debug on entry." diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index b6b91710ed4..a96b1741139 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -1,6 +1,7 @@ ;;; easy-mmode.el --- easy definition for major and minor modes -;; Copyright (C) 1997,2000,01,02,03,2004 Free Software Foundation, Inc. +;; Copyright (C) 1997, 2000, 2001, 2002, 2003, 2004, 2005 +;; Free Software Foundation, Inc. ;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr> ;; Maintainer: Stefan Monnier <monnier@gnu.org> @@ -152,8 +153,8 @@ For example, you could write (unless group ;; We might as well provide a best-guess default group. (setq group - `(:group ',(or (custom-current-group) - (intern (replace-regexp-in-string + `(:group (or (custom-current-group) + ',(intern (replace-regexp-in-string "-mode\\'" "" mode-name)))))) `(progn @@ -253,8 +254,9 @@ With zero or negative ARG turn mode off. ;;; ;;;###autoload -(defmacro easy-mmode-define-global-mode (global-mode mode turn-on - &rest keys) +(defalias 'easy-mmode-define-global-mode 'define-global-minor-mode) +;;;###autoload +(defmacro define-global-minor-mode (global-mode mode turn-on &rest keys) "Make GLOBAL-MODE out of the buffer-local minor MODE. TURN-ON is a function that will be called with no args in every buffer and that should try to turn MODE on if applicable for that buffer. @@ -278,8 +280,8 @@ KEYS is a list of CL-style keyword arguments: (unless group ;; We might as well provide a best-guess default group. (setq group - `(:group ',(or (custom-current-group) - (intern (replace-regexp-in-string + `(:group (or (custom-current-group) + ',(intern (replace-regexp-in-string "-mode\\'" "" (symbol-name mode))))))) `(progn diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index bc868759d92..f31dafb7b11 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -1,6 +1,7 @@ ;;; eldoc.el --- show function arglist or variable docstring in echo area -;; Copyright (C) 1996, 97, 98, 99, 2000, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2003, 2005 +;; Free Software Foundation, Inc. ;; Author: Noah Friedman <friedman@splode.com> ;; Maintainer: friedman@splode.com @@ -150,7 +151,7 @@ If point is over a documented variable, print that variable's docstring instead. With prefix ARG, turn ElDoc mode on if and only if ARG is positive." - nil eldoc-minor-mode-string nil + :group 'eldoc :lighter eldoc-minor-mode-string (setq eldoc-last-message nil) (if eldoc-mode (progn diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index d72dc91ad2b..8852999db2d 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -1016,7 +1016,7 @@ If ARG is the atom `-', scroll upward by nearly full screen." (scroll-down arg) (beginning-of-buffer (goto-char (point-min))))))) -(put 'cua-scroll-up 'CUA 'move) +(put 'cua-scroll-down 'CUA 'move) ;;; Cursor indications @@ -1307,6 +1307,7 @@ highlight the region using `transient-mark-mode'), and typed text replaces the active selection. C-z, C-x, C-c, and C-v will undo, cut, copy, and paste (in addition to the normal emacs bindings)." :global t + :group 'cua :set-after '(cua-enable-modeline-indications cua-use-hyper-key) :require 'cua-base :link '(emacs-commentary-link "cua-base.el") diff --git a/lisp/files.el b/lisp/files.el index dbc43e4a5a9..4551e6ddb66 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -291,7 +291,7 @@ from `mode-require-final-newline'." :group 'editing-basics) (defcustom mode-require-final-newline t - "*Whether to add a newline at the end of the file, in certain major modes. + "*Whether to add a newline at end of file, in certain major modes. Those modes set `require-final-newline' to this value when you enable them. They do so because they are used for files that are supposed to end in newlines, and the question is how to arrange that. @@ -299,10 +299,16 @@ to end in newlines, and the question is how to arrange that. A value of t means do this only when the file is about to be saved. A value of `visit' means do this right after the file is visited. A value of `visit-save' means do it at both of those times. -Any other non-nil value means ask user whether to add a newline, when saving." +Any other non-nil value means ask user whether to add a newline, when saving. +nil means don't add newlines. + +You will have to be careful if you set this to nil: you will have +to remember to manually add a final newline whenever you finish a +file that really needs one." :type '(choice (const :tag "When visiting" visit) (const :tag "When saving" t) (const :tag "When visiting or saving" visit-save) + (const :tag "Never" nil) (other :tag "Ask" ask)) :group 'editing-basics :version "22.1") @@ -928,20 +934,31 @@ documentation for additional customization information." (defvar find-file-default nil "Used within `find-file-read-args'.") +(defmacro minibuffer-with-setup-hook (fun &rest body) + "Add FUN to `minibuffer-setup-hook' while executing BODY. +BODY should use the minibuffer at most once. +Recursive uses of the minibuffer will not be affected." + (declare (indent 1) (debug t)) + (let ((hook (make-symbol "setup-hook"))) + `(let ((,hook + (lambda () + ;; Clear out this hook so it does not interfere + ;; with any recursive minibuffer usage. + (remove-hook 'minibuffer-setup-hook ,hook) + (,fun)))) + (unwind-protect + (progn + (add-hook 'minibuffer-setup-hook ,hook) + ,@body) + (remove-hook 'minibuffer-setup-hook ,hook))))) + (defun find-file-read-args (prompt mustmatch) (list (let ((find-file-default (and buffer-file-name - (abbreviate-file-name buffer-file-name))) - (munge-default-fun - (lambda () - (setq minibuffer-default find-file-default) - ;; Clear out this hook so it does not interfere - ;; with any recursive minibuffer usage. - (pop minibuffer-setup-hook))) - (minibuffer-setup-hook - minibuffer-setup-hook)) - (add-hook 'minibuffer-setup-hook munge-default-fun) - (read-file-name prompt nil default-directory mustmatch)) + (abbreviate-file-name buffer-file-name)))) + (minibuffer-with-setup-hook + (lambda () (setq minibuffer-default find-file-default)) + (read-file-name prompt nil default-directory mustmatch))) t)) (defun find-file (filename &optional wildcards) diff --git a/lisp/filesets.el b/lisp/filesets.el index faba379db03..5a4dd7bda9a 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -1,6 +1,6 @@ ;;; filesets.el --- handle group of files -;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2005 Free Software Foundation, Inc. ;; Author: Thomas Link <t.link@gmx.at> ;; Maintainer: FSF @@ -250,8 +250,15 @@ key is supported." ; (customize-set-variable var val)) ; (filesets-build-menu)) +;; It seems this is a workaround for the XEmacs issue described in the +;; doc-string of filesets-menu-ensure-use-cached. Under Emacs this is +;; essentially just `set-default'. (defun filesets-set-default (sym val &optional init-flag) - "Set-default wrapper function used in conjunction with `defcustom'." + "Set-default wrapper function used in conjunction with `defcustom'. +If SYM is in the list `filesets-ignore-next-set-default', delete +it from that list, and return nil. Otherwise, set the value of +SYM to VAL and return t. If INIT-FLAG is non-nil, set with +`custom-initialize-set', otherwise with `set-default'." (let ((ignore-flag (member sym filesets-ignore-next-set-default))) (if ignore-flag (setq filesets-ignore-next-set-default @@ -304,31 +311,26 @@ key is supported." :type 'sexp :group 'filesets) -(if filesets-running-xemacs - (progn - (defcustom filesets-menu-path nil - "*The menu under which the filesets menu should be inserted. -XEmacs specific; see `add-submenu' for documentation." - :set (function filesets-set-default) - :type 'sexp - :group 'filesets) - - (defcustom filesets-menu-before "File" - "*The name of a menu before which this menu should be added. -XEmacs specific; see `add-submenu' for documentation." - :set (function filesets-set-default) - :type 'sexp - :group 'filesets) - - (defcustom filesets-menu-in-menu nil - "*Use that instead of `current-menubar' as the menu to change. -XEmacs specific; see `add-submenu' for documentation." - :set (function filesets-set-default) - :type 'sexp - :group 'filesets)) - (defvar filesets-menu-path nil) - (defvar filesets-menu-before nil) - (defvar filesets-menu-in-menu nil)) +(defcustom filesets-menu-path nil + "*The menu under which the filesets menu should be inserted. +See `add-submenu' for documentation." + :set (function filesets-set-default) + :type 'sexp + :group 'filesets) + +(defcustom filesets-menu-before "File" + "*The name of a menu before which this menu should be added. +See `add-submenu' for documentation." + :set (function filesets-set-default) + :type 'sexp + :group 'filesets) + +(defcustom filesets-menu-in-menu nil + "*Use that instead of `current-menubar' as the menu to change. +See `add-submenu' for documentation." + :set (function filesets-set-default) + :type 'sexp + :group 'filesets) (defcustom filesets-menu-shortcuts-flag t "*Non-nil means to prepend menus with hopefully unique shortcuts." @@ -351,7 +353,7 @@ XEmacs specific; see `add-submenu' for documentation." (defcustom filesets-menu-cache-file (if filesets-running-xemacs "~/.xemacs/filesets-cache.el" - "~/.filesets-cache.el") + "~/.emacs.d/filesets-cache.el") "*File to be used for saving the filesets menu between sessions. Set this to \"\", to disable caching of menus. Don't forget to check out `filesets-menu-ensure-use-cached'." @@ -1070,9 +1072,7 @@ defined in `filesets-ingroup-patterns'." ;;; Emacs compatibility (eval-and-compile (if filesets-running-xemacs - (progn - (fset 'filesets-error 'error) - (fset 'filesets-add-submenu 'add-submenu)) + (fset 'filesets-error 'error) (require 'easymenu) @@ -1080,12 +1080,6 @@ defined in `filesets-ingroup-patterns'." "`error' wrapper." (error (mapconcat 'identity args " "))) - ;; This should work for 21.1 Emacs - (defun filesets-add-submenu (menu-path submenu &optional - before in-menu) - "`easy-menu-define' wrapper." - (easy-menu-define - filesets-submenu global-map "Filesets menu" submenu)) )) (defun filesets-filter-dir-names (lst &optional negative) @@ -2339,7 +2333,7 @@ bottom up, set `filesets-submenus' to nil, first.)" (filesets-menu-cache-file-save-maybe))) (let ((cb (current-buffer))) (when (not (member cb filesets-updated-buffers)) - (filesets-add-submenu + (add-submenu filesets-menu-path `(,filesets-menu-name ("# Filesets" diff --git a/lisp/font-core.el b/lisp/font-core.el index ea1880baac7..5bf30d4d6c5 100644 --- a/lisp/font-core.el +++ b/lisp/font-core.el @@ -148,7 +148,7 @@ buffer local value for `font-lock-defaults', via its mode hook. The above is the default behavior of `font-lock-mode'; you may specify your own function which is called when `font-lock-mode' is toggled via `font-lock-function'. " - nil nil nil + :group 'font-lock ;; Don't turn on Font Lock mode if we don't have a display (we're running a ;; batch job) or if the buffer is invisible (the name starts with a space). (when (or noninteractive (eq (aref (buffer-name) 0) ?\ )) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 2cdda321092..38d3b94bccf 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1097,7 +1097,7 @@ delimit the region to fontify." ((error quit) (message "Fontifying block...%s" error-data))))))) (if (boundp 'facemenu-keymap) - (define-key facemenu-keymap "\M-g" 'font-lock-fontify-block)) + (define-key facemenu-keymap "\M-o" 'font-lock-fontify-block)) ;;; End of Fontification functions. diff --git a/lisp/generic-x.el b/lisp/generic-x.el index d39edbb7ef6..019456aae6b 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -170,7 +170,8 @@ generic-x to enable the specified modes." '((nil "^\\([-A-Za-z0-9_]+\\)" 1) ("*Directories*" "^\\s-*<Directory\\s-*\\([^>]+\\)>" 1) ("*Locations*" "^\\s-*<Location\\s-*\\([^>]+\\)>" 1)))))) - "Generic mode for Apache or HTTPD configuration files.")) + "Generic mode for Apache or HTTPD configuration files." + :group 'generic-x)) (when (memq 'apache-log-generic-mode generic-extras-enable-list) @@ -183,7 +184,8 @@ generic-x to enable the specified modes." (2 font-lock-variable-name-face))) '("access_log\\'") nil - "Mode for Apache log files")) + "Mode for Apache log files" + :group 'generic-x)) ;;; Samba (when (memq 'samba-generic-mode generic-extras-enable-list) @@ -197,7 +199,8 @@ generic-x to enable the specified modes." (2 font-lock-type-face))) '("smb\\.conf\\'") '(generic-bracket-support) - "Generic mode for Samba configuration files.")) + "Generic mode for Samba configuration files." + :group 'generic-x)) ;;; Fvwm ;; This is pretty basic. Also, modes for other window managers could @@ -222,7 +225,8 @@ generic-x to enable the specified modes." nil '("\\.fvwmrc\\'" "\\.fvwm2rc\\'") nil - "Generic mode for FVWM configuration files.")) + "Generic mode for FVWM configuration files." + :group 'generic-x)) ;;; X Resource ;; I'm pretty sure I've seen an actual mode to do this, but I don't @@ -235,7 +239,8 @@ generic-x to enable the specified modes." '(("^\\([^:\n]+:\\)" 1 font-lock-variable-name-face)) '("\\.Xdefaults\\'" "\\.Xresources\\'" "\\.Xenvironment\\'" "\\.ad\\'") nil - "Generic mode for X Resource configuration files.")) + "Generic mode for X Resource configuration files." + :group 'generic-x)) ;;; Hosts (when (memq 'hosts-generic-mode generic-extras-enable-list) @@ -246,7 +251,8 @@ generic-x to enable the specified modes." '(("\\([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+\\)" 1 font-lock-constant-face)) '("[hH][oO][sS][tT][sS]\\'") nil - "Generic mode for HOSTS files.")) + "Generic mode for HOSTS files." + :group 'generic-x)) ;;; Windows INF files (when (memq 'inf-generic-mode generic-extras-enable-list) @@ -257,7 +263,8 @@ generic-x to enable the specified modes." '(("^\\(\\[.*\\]\\)" 1 font-lock-constant-face)) '("\\.[iI][nN][fF]\\'") '(generic-bracket-support) - "Generic mode for MS-Windows INF files.")) + "Generic mode for MS-Windows INF files." + :group 'generic-x)) ;;; Windows INI files ;; Should define escape character as well! @@ -277,7 +284,8 @@ generic-x to enable the specified modes." (setq imenu-generic-expression '((nil "^\\[\\(.*\\)\\]" 1) ("*Variables*" "^\\s-*\\([^=]+\\)\\s-*=" 1)))))) - "Generic mode for MS-Windows INI files.")) + "Generic mode for MS-Windows INI files." + :group 'generic-x)) ;;; Windows REG files ;;; Unfortunately, Windows 95 and Windows NT have different REG file syntax! @@ -294,7 +302,8 @@ generic-x to enable the specified modes." (lambda () (setq imenu-generic-expression '((nil "^\\s-*\\(.*\\)\\s-*=" 1)))))) - "Generic mode for MS-Windows Registry files.")) + "Generic mode for MS-Windows Registry files." + :group 'generic-x)) ;;; DOS/Windows BAT files (when (memq 'bat-generic-mode generic-extras-enable-list) @@ -368,7 +377,8 @@ generic-x to enable the specified modes." "\\`[cC][oO][nN][fF][iI][gG]\\." "\\`[aA][uU][tT][oO][eE][xX][eE][cC]\\.") '(generic-bat-mode-setup-function) - "Generic mode for MS-Windows BAT files.") + "Generic mode for MS-Windows BAT files." + :group 'generic-x) (defvar bat-generic-mode-syntax-table nil "Syntax table in use in bat-generic-mode buffers.") @@ -446,7 +456,8 @@ generic-x to enable the specified modes." (lambda () (setq imenu-generic-expression '((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1)))))) - "Mode for Mailagent rules files.")) + "Mode for Mailagent rules files." + :group 'generic-x)) ;; Solaris/Sys V prototype files (when (memq 'prototype-generic-mode generic-extras-enable-list) @@ -469,7 +480,8 @@ generic-x to enable the specified modes." (2 font-lock-variable-name-face))) '("prototype\\'") nil - "Mode for Sys V prototype files.")) + "Mode for Sys V prototype files." + :group 'generic-x)) ;; Solaris/Sys V pkginfo files (when (memq 'pkginfo-generic-mode generic-extras-enable-list) @@ -482,7 +494,8 @@ generic-x to enable the specified modes." (2 font-lock-variable-name-face))) '("pkginfo\\'") nil - "Mode for Sys V pkginfo files.")) + "Mode for Sys V pkginfo files." + :group 'generic-x)) ;; Javascript mode ;; Includes extra keywords from Armando Singer [asinger@MAIL.COLGATE.EDU] @@ -559,7 +572,8 @@ generic-x to enable the specified modes." (setq imenu-generic-expression '((nil "^function\\s-+\\([A-Za-z0-9_]+\\)" 1) ("*Variables*" "^var\\s-+\\([A-Za-z0-9_]+\\)" 1)))))) - "Mode for JavaScript files.") + "Mode for JavaScript files." + :group 'generic-x) ;; VRML files (define-generic-mode vrml-generic-mode @@ -610,7 +624,8 @@ generic-x to enable the specified modes." ("*Definitions*" "DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{" 1)))))) - "Generic Mode for VRML files.") + "Generic Mode for VRML files." + :group 'generic-x) ;; Java Manifests (define-generic-mode java-manifest-generic-mode @@ -629,7 +644,8 @@ generic-x to enable the specified modes." (2 font-lock-constant-face))) '("[mM][aA][nN][iI][fF][eE][sS][tT]\\.[mM][fF]\\'") nil - "Mode for Java Manifest files") + "Mode for Java Manifest files" + :group 'generic-x) ;; Java properties files (define-generic-mode java-properties-generic-mode @@ -659,7 +675,8 @@ generic-x to enable the specified modes." (lambda () (setq imenu-generic-expression '((nil "^\\([^#! \t\n\r=:]+\\)" 1)))))) - "Mode for Java properties files.") + "Mode for Java properties files." + :group 'generic-x) ;; C shell alias definitions (when (memq 'alias-generic-mode generic-extras-enable-list) @@ -677,7 +694,8 @@ generic-x to enable the specified modes." (lambda () (setq imenu-generic-expression '((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2)))))) - "Mode for C Shell alias files.")) + "Mode for C Shell alias files." + :group 'generic-x)) ;;; Windows RC files ;; Contributed by ACorreir@pervasive-sw.com (Alfred Correira) @@ -769,7 +787,8 @@ generic-x to enable the specified modes." (2 font-lock-variable-name-face nil t)))) '("\\.[rR][cC]$") nil - "Generic mode for MS-Windows Resource files.")) + "Generic mode for MS-Windows Resource files." + :group 'generic-x)) ;; InstallShield RUL files ;; Contributed by Alfred.Correira@Pervasive.Com @@ -1389,7 +1408,8 @@ generic-x to enable the specified modes." font-lock-variable-name-face "[^_]" "[^_]"))) ; is this face the best choice? '("\\.[rR][uU][lL]$") '(generic-rul-mode-setup-function) - "Generic mode for InstallShield RUL files.") + "Generic mode for InstallShield RUL files." + :group 'generic-x) (define-skeleton rul-if "Insert an if statement." @@ -1437,7 +1457,8 @@ generic-x to enable the specified modes." (2 font-lock-variable-name-face))) '("\\.mailrc\\'") nil - "Mode for mailrc files.") + "Mode for mailrc files." + :group 'generic-x) ;; Inetd.conf (when (memq 'inetd-conf-generic-mode generic-extras-enable-list) @@ -1457,7 +1478,8 @@ generic-x to enable the specified modes." (function (lambda () (setq imenu-generic-expression - '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))) + '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))) + :group 'generic-x)) ;; Services (when (memq 'etc-services-generic-mode generic-extras-enable-list) @@ -1475,7 +1497,8 @@ generic-x to enable the specified modes." (function (lambda () (setq imenu-generic-expression - '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))) + '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))) + :group 'generic-x)) ;; Password and Group files (when (memq 'etc-passwd-generic-mode generic-extras-enable-list) @@ -1517,7 +1540,8 @@ generic-x to enable the specified modes." (function (lambda () (setq imenu-generic-expression - '((nil "^\\([-A-Za-z0-9_]+\\):" 1)))))))) + '((nil "^\\([-A-Za-z0-9_]+\\):" 1)))))) + :group 'generic-x)) ;; Fstab (when (memq 'etc-fstab-generic-mode generic-extras-enable-list) @@ -1567,7 +1591,8 @@ generic-x to enable the specified modes." (function (lambda () (setq imenu-generic-expression - '((nil "^\\([/-A-Za-z0-9_]+\\)\\s-+" 1)))))))) + '((nil "^\\([/-A-Za-z0-9_]+\\)\\s-+" 1)))))) + :group 'generic-x)) ;; From Jacques Duthen <jacques.duthen@sncf.fr> (eval-when-compile @@ -1609,7 +1634,8 @@ generic-x to enable the specified modes." nil ;; no auto-mode-alist ;; '(show-tabs-generic-mode-hook-fun) nil - "Generic mode to show tabs and trailing spaces") + "Generic mode to show tabs and trailing spaces" + :group 'generic-x) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; DNS modes @@ -1630,7 +1656,8 @@ generic-x to enable the specified modes." ;; List of additional automode-alist expressions '("/etc/named.boot\\'") ;; List of set up functions to call - nil) + nil + :group 'generic-x) (define-generic-mode named-database-generic-mode ;; List of comment characters @@ -1643,7 +1670,8 @@ generic-x to enable the specified modes." ;; List of additional automode-alist expressions nil ;; List of set up functions to call - nil) + nil + :group 'generic-x) (defvar named-database-time-string "%Y%m%d%H" "Timestring for named serial numbers.") @@ -1663,7 +1691,8 @@ generic-x to enable the specified modes." ;; List of additional automode-alist expressions '("/etc/resolv[e]?.conf\\'") ;; List of set up functions to call - nil) + nil + :group 'generic-x) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Modes for spice and common electrical engineering circuit netlist formats @@ -1705,7 +1734,8 @@ generic-x to enable the specified modes." (function (lambda() (setq font-lock-defaults '(generic-font-lock-keywords nil t))))) - "Generic mode for SPICE circuit netlist files.") + "Generic mode for SPICE circuit netlist files." + :group 'generic-x) (define-generic-mode ibis-generic-mode '(?|) @@ -1714,7 +1744,8 @@ generic-x to enable the specified modes." ("\\(\\(_\\|\\w\\)+\\)\\s-*=" 1 font-lock-variable-name-face)) '("\\.[iI][bB][sS]\\'") '(generic-bracket-support) - "Generic mode for IBIS circuit netlist files.") + "Generic mode for IBIS circuit netlist files." + :group 'generic-x) (define-generic-mode astap-generic-mode nil @@ -1749,7 +1780,8 @@ generic-x to enable the specified modes." (function (lambda() (setq font-lock-defaults '(generic-font-lock-keywords nil t))))) - "Generic mode for ASTAP circuit netlist files.") + "Generic mode for ASTAP circuit netlist files." + :group 'generic-x) (define-generic-mode etc-modules-conf-generic-mode ;; List of comment characters @@ -1791,7 +1823,8 @@ generic-x to enable the specified modes." ;; List of additional automode-alist expressions '("/etc/modules.conf" "/etc/conf.modules") ;; List of set up functions to call - nil) + nil + :group 'generic-x) (provide 'generic-x) diff --git a/lisp/generic.el b/lisp/generic.el index e20f73688c7..e170d05e0f3 100644 --- a/lisp/generic.el +++ b/lisp/generic.el @@ -185,7 +185,8 @@ the regexp in `generic-find-file-regexp'. If the value is nil, ;;;###autoload (defmacro define-generic-mode (mode comment-list keyword-list font-lock-list auto-mode-list - function-list &optional docstring) + function-list &optional docstring + &rest custom-keyword-args) "Create a new generic mode MODE. MODE is the name of the command for the generic mode; it need not @@ -216,59 +217,90 @@ as soon as `define-generic-mode' is called. FUNCTION-LIST is a list of functions to call to do some additional setup. +The optional CUSTOM-KEYWORD-ARGS are pairs of keywords and +values. They will be passed to the generated `defcustom' form of +the mode hook variable MODE-hook. You can specify keyword +arguments without specifying a docstring. + See the file generic-x.el for some examples of `define-generic-mode'." - (let* ((name-unquoted (if (eq (car-safe mode) 'quote) ; Backward compatibility. - (eval mode) - mode)) - (name-string (symbol-name name-unquoted)) + (declare (debug (sexp def-form def-form def-form form def-form + &optional stringp)) + (indent 1)) + + ;; Backward compatibility. + (when (eq (car-safe mode) 'quote) + (setq mode (eval mode))) + + (when (and docstring (not (stringp docstring))) + ;; DOCSTRING is not a string so we assume that it's actually the + ;; first keyword of CUSTOM-KEYWORD-ARGS. + (push docstring custom-keyword-args) + (setq docstring nil)) + + (let* ((mode-name (symbol-name mode)) (pretty-name (capitalize (replace-regexp-in-string - "-mode\\'" "" name-string)))) + "-mode\\'" "" mode-name))) + (mode-hook (intern (concat mode-name "-hook")))) + + (unless (plist-get custom-keyword-args :group) + (setq custom-keyword-args + (plist-put custom-keyword-args + :group `(or (custom-current-group) + ',(intern (replace-regexp-in-string + "-mode\\'" "" mode-name)))))) `(progn ;; Add a new entry. - (add-to-list 'generic-mode-list ,name-string) + (add-to-list 'generic-mode-list ,mode-name) ;; Add it to auto-mode-alist (dolist (re ,auto-mode-list) - (add-to-list 'auto-mode-alist (cons re ',name-unquoted))) + (add-to-list 'auto-mode-alist (cons re ',mode))) + + (defcustom ,mode-hook nil + ,(concat "Hook run when entering " pretty-name " mode.") + :type 'hook + ,@custom-keyword-args) - (defun ,name-unquoted () + (defun ,mode () ,(or docstring (concat pretty-name " mode.\n" "This a generic mode defined with `define-generic-mode'.")) (interactive) - (generic-mode-internal ',name-unquoted ,comment-list ,keyword-list + (generic-mode-internal ',mode ,comment-list ,keyword-list ,font-lock-list ,function-list))))) ;;;###autoload -(defun generic-mode-internal (mode comments keywords font-lock-list funs) +(defun generic-mode-internal (mode comment-list keyword-list + font-lock-list function-list) "Go into the generic mode MODE." - (let* ((modename (symbol-name mode)) - (generic-mode-hooks (intern (concat modename "-hook"))) + (let* ((mode-name (symbol-name mode)) (pretty-name (capitalize (replace-regexp-in-string - "-mode\\'" "" modename)))) + "-mode\\'" "" mode-name))) + (mode-hook (intern (concat mode-name "-hook")))) (kill-all-local-variables) (setq major-mode mode mode-name pretty-name) - (generic-mode-set-comments comments) + (generic-mode-set-comments comment-list) ;; Font-lock functionality. ;; Font-lock-defaults is always set even if there are no keywords ;; or font-lock expressions, so comments can be highlighted. (setq generic-font-lock-keywords (append - (when keywords - (list (generic-make-keywords-list keywords font-lock-keyword-face))) + (when keyword-list + (list (generic-make-keywords-list keyword-list + font-lock-keyword-face))) font-lock-list)) (setq font-lock-defaults '(generic-font-lock-keywords nil)) ;; Call a list of functions - (mapcar 'funcall funs) + (mapcar 'funcall function-list) - (run-hooks generic-mode-hooks))) + (run-mode-hooks mode-hook))) ;;;###autoload (defun generic-mode (mode) @@ -359,7 +391,7 @@ Some generic modes are defined in `generic-x.el'." imenu-case-fold-search t)) ;; This generic mode is always defined -(define-generic-mode default-generic-mode (list ?#) nil nil nil nil) +(define-generic-mode default-generic-mode (list ?#) nil nil nil nil :group 'generic) ;; A more general solution would allow us to enter generic-mode for ;; *any* comment character, but would require us to synthesize a new @@ -392,7 +424,7 @@ This hook will be installed if the variable (defun generic-mode-ini-file-find-file-hook () "Hook function to enter Default-Generic mode automatically for INI files. -Done if the first few lines of a file in Fundamental mode look like an +Done if the first few lines of a file in Fundamental mode look like an INI file. This hook is NOT installed by default." (and (eq major-mode 'fundamental-mode) (save-excursion diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 5d15a6f9646..b19598eb3ab 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,99 @@ +2005-04-03 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-sum.el (gnus-summary-make-menu-bar): Fix an + "unrecognised menu descriptor" error. + +2005-03-25 Katsumi Yamaoka <yamaoka@jpl.org> + + * message.el (message-resend): Bind rfc2047-encode-encoded-words. + + * mm-util.el (mm-replace-in-string): New function. + (mm-xemacs-find-mime-charset-1): Ignore errors while loading + latin-unity, which cannot be used with XEmacs 21.1. + + * rfc2047.el (rfc2047-encode-function-alist): Rename from + rfc2047-encoding-function-alist in order to avoid conflicting with + the old version. + (rfc2047-encode-message-header): Remove useless goto-char. + (rfc2047-encodable-p): Don't move point. + (rfc2047-syntax-table): Treat `(' and `)' as is. + (rfc2047-encode-region): Concatenate words containing non-ASCII + characters in structured fields; don't encode space-delimited + ASCII words even in unstructured fields; don't break words at + char-category boundaries; encode encoded words in structured + fields; treat text within parentheses as special; show the + original text when error has occurred; move point to the end of + the region after encoding, suggested by IRIE Tetsuya + <irie@t.email.ne.jp>; treat backslash-quoted characters as + non-special; check carefully whether to encode special characters; + fix some kind of misconfigured headers; signal a real error if + debug-on-quit or debug-on-error is non-nil; don't infloop, + suggested by Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp>; assume + the close parenthesis may be included in the encoded word; encode + bogus delimiters. + (rfc2047-encode-string): Use mm-with-multibyte-buffer. + (rfc2047-encode-max-chars): New variable. + (rfc2047-encode-1): New function. + (rfc2047-encode): Use it; encode text so that it occupies the + maximum width within 76-column; work correctly on Q encoding for + iso-2022-* charsets; fold the line before encoding; don't append a + space if the encoded word includes close parenthesis. + (rfc2047-fold-region): Use existing whitespace for LWSP; make it + sure not to break a line just after the header name. + (rfc2047-b-encode-region): Remove. + (rfc2047-b-encode-string): New function. + (rfc2047-q-encode-region): Remove. + (rfc2047-q-encode-string): New function. + (rfc2047-encode-parameter): New function. + (rfc2047-encoded-word-regexp): Don't use shy group. + (rfc2047-decode-region): Follow rfc2047-encoded-word-regexp change. + (rfc2047-parse-and-decode): Ditto. + (rfc2047-decode): Treat the ascii coding-system as raw-text by + default. + +2005-03-25 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * rfc2047.el (rfc2047-encode-encoded-words): New variable. + (rfc2047-field-value): Strip props. + (rfc2047-encode-message-header): Disabled header folding -- not + all headers can be folded, and this should be done by the message + composition mode. Probably. I think. + (rfc2047-encodable-p): Say that =? needs encoding. + (rfc2047-encode-region): Encode =? strings. + +2005-03-25 Jesper Harder <harder@ifa.au.dk> + + * rfc2047.el (rfc2047-encoded-word-regexp): Support RFC 2231 + language tags; remove unnecessary '+'. Reported by Stefan Wiens + <s.wi@gmx.net>. + (rfc2047-decode-string): Don't cons a string unnecessarily. + (rfc2047-parse-and-decode, rfc2047-decode): Use a character for + the encoding to avoid consing a string. + (rfc2047-decode): Use mm-subst-char-in-string instead of + mm-replace-chars-in-string. + +2005-03-25 TSUCHIYA Masatoshi <tsuchiya@namazu.org> + + * rfc2047.el (rfc2047-encode): Use uppercase letters to specify + encodings of MIME-encoded words, in order to improve + interoperability with several broken MUAs. + +2005-03-21 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-srvr.el (gnus-browse-select-group): Add NUMBER argument and + pass it to `gnus-browse-read-group'. + (gnus-browse-read-group): Add NUMBER argument and pass it to + `gnus-group-read-ephemeral-group'. + + * gnus-group.el (gnus-group-read-ephemeral-group): Add NUMBER + argument and pass it to `gnus-group-read-group'. + +2005-03-19 Aidan Kehoe <kehoea@parhasard.net> + + * mm-util.el (mm-xemacs-find-mime-charset): Only call + mm-xemacs-find-mime-charset-1 if we have the mule feature + available at runtime. + 2005-03-25 Werner Lemberg <wl@gnu.org> * nnmaildir.el: Replace `illegal' with `invalid'. @@ -618,7 +714,7 @@ unless plugged. Disable the agent so that an open failure causes an error. -2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Reiner Steib <Reiner.Steib@gmx.de> +2004-10-18 Reiner Steib <Reiner.Steib@gmx.de> * gnus-agent.el (gnus-agent-fetched-hook): Add :version. (gnus-agent-go-online): Change :version. @@ -660,21 +756,21 @@ (gnus-convert-mark-converter-prompt) (gnus-convert-converter-needs-prompt): Fix use of property list. -2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Katsumi Yamaoka <yamaoka@jpl.org> +2004-10-18 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-agent.el (gnus-agent-restore-gcc): Use ^ and regexp-quote. -2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Lars Magne Ingebrigtsen <larsi@gnus.org> +2004-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org> * gnus-start.el (gnus-get-unread-articles-in-group): Don't do stuff for non-living groups. -2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Lars Magne Ingebrigtsen <larsi@gnus.org> +2004-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org> * gnus-agent.el (gnus-agent-synchronize-flags): Default to nil. (gnus-agent-regenerate-group): Using nil messages aren't valid. -2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Lars Magne Ingebrigtsen <larsi@gnus.org> +2004-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org> * gnus-agent.el (gnus-agent-read-agentview): Inline gnus-uncompress-range. @@ -691,7 +787,7 @@ message-send-mail-function. The change makes the agent real-time responsive to user changes to message-send-mail-function. -2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Reiner Steib <Reiner.Steib@gmx.de> +2004-10-18 Reiner Steib <Reiner.Steib@gmx.de> * gnus-start.el (gnus-get-unread-articles): Fix last commit. @@ -732,12 +828,12 @@ * gnus-util.el (gnus-rename-file): New function. -2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Katsumi Yamaoka <yamaoka@jpl.org> +2004-10-18 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-agent.el (gnus-agent-regenerate-group): Activate the group when the group's active is not available. -2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Katsumi Yamaoka <yamaoka@jpl.org> +2004-10-18 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-agent.el (gnus-agent-read-agentview): Add a missing arg to error. diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 767bdacb78e..6d38626998c 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -1984,7 +1984,8 @@ confirmation is required." (defun gnus-group-read-ephemeral-group (group method &optional activate quit-config request-only select-articles - parameters) + parameters + number) "Read GROUP from METHOD as an ephemeral group. If ACTIVATE, request the group first. If QUIT-CONFIG, use that window configuration when exiting from the @@ -1992,6 +1993,7 @@ ephemeral group. If REQUEST-ONLY, don't actually read the group; just request it. If SELECT-ARTICLES, only select those articles. If PARAMETERS, use those as the group parameters. +If NUMBER, fetch this number of articles. Return the name of the group if selection was successful." (interactive @@ -2039,7 +2041,7 @@ Return the name of the group if selection was successful." (when (let ((gnus-large-newsgroup gnus-large-ephemeral-newsgroup) (gnus-fetch-old-headers gnus-fetch-old-ephemeral-headers)) - (gnus-group-read-group t t group select-articles)) + (gnus-group-read-group (or number t) t group select-articles)) group) ;;(error nil) (quit diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index e8c7d354145..7b3c033fddb 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -851,23 +851,26 @@ buffer. (setq buffer-read-only t) (gnus-run-hooks 'gnus-browse-mode-hook)) -(defun gnus-browse-read-group (&optional no-article) - "Enter the group at the current line." - (interactive) +(defun gnus-browse-read-group (&optional no-article number) + "Enter the group at the current line. +If NUMBER, fetch this number of articles." + (interactive "P") (let ((group (gnus-browse-group-name))) (if (or (not (gnus-get-info group)) (gnus-ephemeral-group-p group)) (unless (gnus-group-read-ephemeral-group group gnus-browse-current-method nil - (cons (current-buffer) 'browse)) + (cons (current-buffer) 'browse) + nil nil nil number) (error "Couldn't enter %s" group)) (unless (gnus-group-read-group nil no-article group) (error "Couldn't enter %s" group))))) -(defun gnus-browse-select-group () - "Select the current group." - (interactive) - (gnus-browse-read-group 'no)) +(defun gnus-browse-select-group (&optional number) + "Select the current group. +If NUMBER, fetch this number of articles." + (interactive "P") + (gnus-browse-read-group 'no number)) (defun gnus-browse-next-group (n) "Go to the next group." diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index ea8f7e063fe..8d6a5f951b5 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -2250,7 +2250,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ,@(if (featurep 'xemacs) '(t) '(:help "Generate and print a PostScript image"))]) ("Copy, move,... (Backend)" - ,@(if (featurep 'xemacs) '(t) + ,@(if (featurep 'xemacs) nil '(:help "Copying, moving, expiring articles...")) ["Respool article..." gnus-summary-respool-article t] ["Move article..." gnus-summary-move-article diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index de56fe2be96..9edbce2620e 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -6364,7 +6364,8 @@ Optional DIGEST will use digest to forward." (replace-match "X-From-Line: ")) ;; Send it. (let ((message-inhibit-body-encoding t) - message-required-mail-headers) + message-required-mail-headers + rfc2047-encode-encoded-words) (message-send-mail)) (kill-buffer (current-buffer))) (message "Resending message to %s...done" address))) diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 5b4200d6d52..3be6444f18f 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -86,6 +86,32 @@ (multibyte-char-to-unibyte . identity)))) (eval-and-compile + (cond + ((fboundp 'replace-in-string) + (defalias 'mm-replace-in-string 'replace-in-string)) + ((fboundp 'replace-regexp-in-string) + (defun mm-replace-in-string (string regexp newtext &optional literal) + "Replace all matches for REGEXP with NEWTEXT in STRING. +If LITERAL is non-nil, insert NEWTEXT literally. Return a new +string containing the replacements. + +This is a compatibility function for different Emacsen." + (replace-regexp-in-string regexp newtext string nil literal))) + (t + (defun mm-replace-in-string (string regexp newtext &optional literal) + "Replace all matches for REGEXP with NEWTEXT in STRING. +If LITERAL is non-nil, insert NEWTEXT literally. Return a new +string containing the replacements. + +This is a compatibility function for different Emacsen." + (let ((start 0) tail) + (while (string-match regexp string start) + (setq tail (- (length string) (match-end 0))) + (setq string (replace-match newtext nil literal string)) + (setq start (- (length string) tail)))) + string)))) + +(eval-and-compile (defalias 'mm-char-or-char-int-p (cond ((fboundp 'char-or-char-int-p) 'char-or-char-int-p) @@ -606,7 +632,7 @@ But this is very much a corner case, so don't worry about it." ;; Load the Latin Unity library, if available. (when (and (not (featurep 'latin-unity)) (locate-library "latin-unity")) - (require 'latin-unity)) + (ignore-errors (require 'latin-unity))) ;; Now, can we use it? (if (featurep 'latin-unity) @@ -651,7 +677,7 @@ But this is very much a corner case, so don't worry about it." (defmacro mm-xemacs-find-mime-charset (begin end) (when (featurep 'xemacs) - `(mm-xemacs-find-mime-charset-1 ,begin ,end))) + `(and (featurep 'mule) (mm-xemacs-find-mime-charset-1 ,begin ,end)))) (defun mm-find-mime-charset-region (b e &optional hack-charsets) "Return the MIME charsets needed to encode the region between B and E. diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el index 6086f422abd..538e22e0f88 100644 --- a/lisp/gnus/rfc2047.el +++ b/lisp/gnus/rfc2047.el @@ -119,12 +119,15 @@ The values can be: Valid encodings are nil, `Q' and `B'. These indicate binary (no) encoding, quoted-printable and base64 respectively.") -(defvar rfc2047-encoding-function-alist - '((Q . rfc2047-q-encode-region) - (B . rfc2047-b-encode-region) - (nil . ignore)) +(defvar rfc2047-encode-function-alist + '((Q . rfc2047-q-encode-string) + (B . rfc2047-b-encode-string) + (nil . identity)) "Alist of RFC2047 encodings to encoding functions.") +(defvar rfc2047-encode-encoded-words t + "Whether encoded words should be encoded again.") + ;;; ;;; Functions for encoding RFC2047 messages ;;; @@ -166,7 +169,7 @@ This is either `base64' or `quoted-printable'." (save-restriction (rfc2047-narrow-to-field) (re-search-forward ":[ \t\n]*" nil t) - (buffer-substring (point) (point-max))))) + (buffer-substring-no-properties (point) (point-max))))) (defvar rfc2047-encoding-type 'address-mime "The type of encoding done by `rfc2047-encode-region'. @@ -186,24 +189,25 @@ Should be called narrowed to the head of the message." (rfc2047-narrow-to-field) (if (not (rfc2047-encodable-p)) (prog1 - (if (and (eq (mm-body-7-or-8) '8bit) - (mm-multibyte-p) - (mm-coding-system-p - (car message-posting-charset))) - ;; 8 bit must be decoded. - (mm-encode-coding-region - (point-min) (point-max) - (mm-charset-to-coding-system - (car message-posting-charset)))) + (if (and (eq (mm-body-7-or-8) '8bit) + (mm-multibyte-p) + (mm-coding-system-p + (car message-posting-charset))) + ;; 8 bit must be decoded. + (mm-encode-coding-region + (point-min) (point-max) + (mm-charset-to-coding-system + (car message-posting-charset)))) ;; No encoding necessary, but folding is nice - (rfc2047-fold-region - (save-excursion - (goto-char (point-min)) - (skip-chars-forward "^:") - (when (looking-at ": ") - (forward-char 2)) - (point)) - (point-max))) + (when nil + (rfc2047-fold-region + (save-excursion + (goto-char (point-min)) + (skip-chars-forward "^:") + (when (looking-at ": ") + (forward-char 2)) + (point)) + (point-max)))) ;; We found something that may perhaps be encoded. (setq method nil alist rfc2047-header-encoding-alist) @@ -213,7 +217,6 @@ Should be called narrowed to the head of the message." (eq (car elem) t)) (setq alist nil method (cdr elem)))) - (goto-char (point-min)) (re-search-forward "^[^:]+: *" nil t) (cond ((eq method 'address-mime) @@ -267,8 +270,13 @@ The buffer may be narrowed." (require 'message) ; for message-posting-charset (let ((charsets (mm-find-mime-charset-region (point-min) (point-max)))) - (and charsets - (not (equal charsets (list (car message-posting-charset))))))) + (goto-char (point-min)) + (or (and rfc2047-encode-encoded-words + (prog1 + (search-forward "=?" nil t) + (goto-char (point-min)))) + (and charsets + (not (equal charsets (list (car message-posting-charset)))))))) ;; Use this syntax table when parsing into regions that may need ;; encoding. Double quotes are string delimiters, backslash is @@ -292,8 +300,8 @@ The buffer may be narrowed." table)))) (modify-syntax-entry ?\\ "\\" table) (modify-syntax-entry ?\" "\"" table) - (modify-syntax-entry ?\( "." table) - (modify-syntax-entry ?\) "." table) + (modify-syntax-entry ?\( "(" table) + (modify-syntax-entry ?\) ")" table) (modify-syntax-entry ?\< "." table) (modify-syntax-entry ?\> "." table) (modify-syntax-entry ?\[ "." table) @@ -310,183 +318,341 @@ By default, the region is treated as containing RFC2822 addresses. Dynamically bind `rfc2047-encoding-type' to change that." (save-restriction (narrow-to-region b e) - (if (eq 'mime rfc2047-encoding-type) - ;; Simple case. Treat as single word after any initial ASCII - ;; part and before any tailing ASCII part. The leading ASCII - ;; is relevant for instance in Subject headers with `Re:' for - ;; interoperability with non-MIME clients, and we might as - ;; well avoid the tail too. - (progn - (goto-char (point-min)) - ;; Does it need encoding? - (skip-chars-forward "\000-\177") - (unless (eobp) - (skip-chars-backward "^ \n") ; beginning of space-delimited word - (rfc2047-encode (point) (progn - (goto-char e) - (skip-chars-backward "\000-\177") - (skip-chars-forward "^ \n") - ;; end of space-delimited word - (point))))) - ;; `address-mime' case -- take care of quoted words, comments. - (with-syntax-table rfc2047-syntax-table - (let ((start) ; start of current token - end ; end of current token - ;; Whether there's an encoded word before the current - ;; token, either immediately or separated by space. - last-encoded) + (let ((encodable-regexp (if rfc2047-encode-encoded-words + "[^\000-\177]+\\|=\\?" + "[^\000-\177]+")) + start ; start of current token + end begin csyntax + ;; Whether there's an encoded word before the current token, + ;; either immediately or separated by space. + last-encoded + (orig-text (buffer-substring-no-properties b e))) + (if (eq 'mime rfc2047-encoding-type) + ;; Simple case. Continuous words in which all those contain + ;; non-ASCII characters are encoded collectively. Encoding + ;; ASCII words, including `Re:' used in Subject headers, is + ;; avoided for interoperability with non-MIME clients and + ;; for making it easy to find keywords. + (progn + (goto-char (point-min)) + (while (progn (skip-chars-forward " \t\n") + (not (eobp))) + (setq start (point)) + (while (and (looking-at "[ \t\n]*\\([^ \t\n]+\\)") + (progn + (setq end (match-end 0)) + (re-search-forward encodable-regexp end t))) + (goto-char end)) + (if (> (point) start) + (rfc2047-encode start (point)) + (goto-char end)))) + ;; `address-mime' case -- take care of quoted words, comments. + (with-syntax-table rfc2047-syntax-table (goto-char (point-min)) - (condition-case nil ; in case of unbalanced quotes + (condition-case err ; in case of unbalanced quotes ;; Look for rfc2822-style: sequences of atoms, quoted ;; strings, specials, whitespace. (Specials mustn't be ;; encoded.) (while (not (eobp)) - (setq start (point)) ;; Skip whitespace. - (unless (= 0 (skip-chars-forward " \t\n")) - (setq start (point))) + (skip-chars-forward " \t\n") + (setq start (point)) (cond ((not (char-after))) ; eob ;; else token start - ((eq ?\" (char-syntax (char-after))) + ((eq ?\" (setq csyntax (char-syntax (char-after)))) ;; Quoted word. (forward-sexp) (setq end (point)) ;; Does it need encoding? (goto-char start) - (skip-chars-forward "\000-\177" end) - (if (= end (point)) - (setq last-encoded nil) - ;; It needs encoding. Strip the quotes first, - ;; since encoded words can't occur in quotes. - (goto-char end) - (delete-backward-char 1) - (goto-char start) - (delete-char 1) - (when last-encoded - ;; There was a preceding quoted word. We need - ;; to include any separating whitespace in this - ;; word to avoid it getting lost. - (skip-chars-backward " \t") - ;; A space is needed between the encoded words. - (insert ? ) - (setq start (point) - end (1+ end))) - ;; Adjust the end position for the deleted quotes. - (rfc2047-encode start (- end 2)) - (setq last-encoded t))) ; record that it was encoded - ((eq ?. (char-syntax (char-after))) + (if (re-search-forward encodable-regexp end 'move) + ;; It needs encoding. Strip the quotes first, + ;; since encoded words can't occur in quotes. + (progn + (goto-char end) + (delete-backward-char 1) + (goto-char start) + (delete-char 1) + (when last-encoded + ;; There was a preceding quoted word. We need + ;; to include any separating whitespace in this + ;; word to avoid it getting lost. + (skip-chars-backward " \t") + ;; A space is needed between the encoded words. + (insert ? ) + (setq start (point) + end (1+ end))) + ;; Adjust the end position for the deleted quotes. + (rfc2047-encode start (- end 2)) + (setq last-encoded t)) ; record that it was encoded + (setq last-encoded nil))) + ((eq ?. csyntax) ;; Skip other delimiters, but record that they've ;; potentially separated quoted words. (forward-char) (setq last-encoded nil)) + ((eq ?\) csyntax) + (error "Unbalanced parentheses")) + ((eq ?\( csyntax) + ;; Look for the end of parentheses. + (forward-list) + ;; Encode text as an unstructured field. + (let ((rfc2047-encoding-type 'mime)) + (rfc2047-encode-region (1+ start) (1- (point)))) + (skip-chars-forward ")")) (t ; normal token/whitespace sequence ;; Find the end. - (forward-word 1) - (skip-chars-backward " \t") + ;; Skip one ASCII word, or encode continuous words + ;; in which all those contain non-ASCII characters. + (setq end nil) + (while (not (or end (eobp))) + (when (looking-at "[\000-\177]+") + (setq begin (point) + end (match-end 0)) + (when (progn + (while (and (or (re-search-forward + "[ \t\n]\\|\\Sw" end 'move) + (setq end nil)) + (eq ?\\ (char-syntax (char-before)))) + ;; Skip backslash-quoted characters. + (forward-char)) + end) + (setq end (match-beginning 0)) + (if rfc2047-encode-encoded-words + (progn + (goto-char begin) + (when (search-forward "=?" end 'move) + (goto-char (match-beginning 0)) + (setq end nil))) + (goto-char end)))) + ;; Where the value nil of `end' means there may be + ;; text to have to be encoded following the point. + ;; Otherwise, the point reached to the end of ASCII + ;; words separated by whitespace or a special char. + (unless end + (when (looking-at encodable-regexp) + (goto-char (setq begin (match-end 0))) + (while (and (looking-at "[ \t\n]+\\([^ \t\n]+\\)") + (setq end (match-end 0)) + (progn + (while (re-search-forward + encodable-regexp end t)) + (< begin (point))) + (goto-char begin) + (or (not (re-search-forward "\\Sw" end t)) + (progn + (goto-char (match-beginning 0)) + nil))) + (goto-char end)) + (when (looking-at "[^ \t\n]+") + (setq end (match-end 0)) + (if (re-search-forward "\\Sw+" end t) + ;; There are special characters better + ;; to be encoded so that MTAs may parse + ;; them safely. + (cond ((= end (point))) + ((looking-at (concat "\\sw*\\(" + encodable-regexp + "\\)")) + (setq end nil)) + (t + (goto-char (1- (match-end 0))) + (unless (= (point) (match-beginning 0)) + ;; Separate encodable text and + ;; delimiter. + (insert " ")))) + (goto-char end) + (skip-chars-forward " \t\n") + (if (and (looking-at "[^ \t\n]+") + (string-match encodable-regexp + (match-string 0))) + (setq end nil) + (goto-char end))))))) + (skip-chars-backward " \t\n") (setq end (point)) - ;; Deal with encoding and leading space as for - ;; quoted words. (goto-char start) - (skip-chars-forward "\000-\177" end) - (if (= end (point)) - (setq last-encoded nil) - (when last-encoded - (goto-char start) - (skip-chars-backward " \t") - (insert ? ) - (setq start (point) - end (1+ end))) - (rfc2047-encode start end) - (setq last-encoded t))))) + (if (re-search-forward encodable-regexp end 'move) + (progn + (unless (memq (char-before start) '(nil ?\t ? )) + (if (progn + (goto-char start) + (skip-chars-backward "^ \t\n") + (and (looking-at "\\Sw+") + (= (match-end 0) start))) + ;; Also encode bogus delimiters. + (setq start (point)) + ;; Separate encodable text and delimiter. + (goto-char start) + (insert " ") + (setq start (1+ start) + end (1+ end)))) + (rfc2047-encode start end) + (setq last-encoded t)) + (setq last-encoded nil))))) (error - (error "Invalid data for rfc2047 encoding: %s" - (buffer-substring b e))))))) - (rfc2047-fold-region b (point)))) + (if (or debug-on-quit debug-on-error) + (signal (car err) (cdr err)) + (error "Invalid data for rfc2047 encoding: %s" + (mm-replace-in-string orig-text "[ \t\n]+" " ")))))))) + (rfc2047-fold-region b (point)) + (goto-char (point-max)))) (defun rfc2047-encode-string (string) "Encode words in STRING. By default, the string is treated as containing addresses (see `rfc2047-encoding-type')." - (with-temp-buffer + (mm-with-multibyte-buffer (insert string) (rfc2047-encode-region (point-min) (point-max)) (buffer-string))) +(defvar rfc2047-encode-max-chars 76 + "Maximum characters of each header line that contain encoded-words. +If it is nil, encoded-words will not be folded. Too small value may +cause an error. Don't change this for no particular reason.") + +(defun rfc2047-encode-1 (column string cs encoder start crest tail + &optional eword) + "Subroutine used by `rfc2047-encode'." + (cond ((string-equal string "") + (or eword "")) + ((not rfc2047-encode-max-chars) + (concat start + (funcall encoder (if cs + (mm-encode-coding-string string cs) + string)) + "?=")) + ((>= column rfc2047-encode-max-chars) + (when eword + (cond ((string-match "\n[ \t]+\\'" eword) + ;; Reomove a superfluous empty line. + (setq eword (substring eword 0 (match-beginning 0)))) + ((string-match "(+\\'" eword) + ;; Break the line before the open parenthesis. + (setq crest (concat crest (match-string 0 eword)) + eword (substring eword 0 (match-beginning 0)))))) + (rfc2047-encode-1 (length crest) string cs encoder start " " tail + (concat eword "\n" crest))) + (t + (let ((index 0) + (limit (1- (length string))) + (prev "") + next len) + (while (and prev + (<= index limit)) + (setq next (concat start + (funcall encoder + (if cs + (mm-encode-coding-string + (substring string 0 (1+ index)) + cs) + (substring string 0 (1+ index)))) + "?=") + len (+ column (length next))) + (if (> len rfc2047-encode-max-chars) + (setq next prev + prev nil) + (if (or (< index limit) + (<= (+ len (or (string-match "\n" tail) + (length tail))) + rfc2047-encode-max-chars)) + (setq prev next + index (1+ index)) + (if (string-match "\\`)+" tail) + ;; Break the line after the close parenthesis. + (setq tail (concat (substring tail 0 (match-end 0)) + "\n " + (substring tail (match-end 0))) + prev next + index (1+ index)) + (setq next prev + prev nil))))) + (if (> index limit) + (concat eword next tail) + (if (= 0 index) + (if (and eword + (string-match "(+\\'" eword)) + (setq crest (concat crest (match-string 0 eword)) + eword (substring eword 0 (match-beginning 0))) + (setq eword (concat eword next))) + (setq crest " " + eword (concat eword next))) + (when (string-match "\n[ \t]+\\'" eword) + ;; Reomove a superfluous empty line. + (setq eword (substring eword 0 (match-beginning 0)))) + (rfc2047-encode-1 (length crest) (substring string index) + cs encoder start " " tail + (concat eword "\n" crest))))))) + (defun rfc2047-encode (b e) "Encode the word(s) in the region B to E. -By default, the region is treated as containing addresses (see -`rfc2047-encoding-type')." - (let* ((mime-charset (mm-find-mime-charset-region b e)) - (cs (if (> (length mime-charset) 1) - ;; Fixme: Instead of this, try to break region into - ;; parts that can be encoded separately. - (error "Can't rfc2047-encode `%s'" - (buffer-substring b e)) - (setq mime-charset (car mime-charset)) - (mm-charset-to-coding-system mime-charset))) - ;; Fixme: Better, calculate the number of non-ASCII - ;; characters, at least for 8-bit charsets. - (encoding (or (cdr (assq mime-charset +Point moves to the end of the region." + (let ((mime-charset (or (mm-find-mime-charset-region b e) (list 'us-ascii))) + cs encoding tail crest eword) + (cond ((> (length mime-charset) 1) + (error "Can't rfc2047-encode `%s'" + (buffer-substring-no-properties b e))) + ((= (length mime-charset) 1) + (setq mime-charset (car mime-charset) + cs (mm-charset-to-coding-system mime-charset)) + (unless (and (mm-multibyte-p) + (mm-coding-system-p cs)) + (setq cs nil)) + (save-restriction + (narrow-to-region b e) + (setq encoding + (or (cdr (assq mime-charset rfc2047-charset-encoding-alist)) ;; For the charsets that don't have a preferred ;; encoding, choose the one that's shorter. - (save-restriction - (narrow-to-region b e) - (if (eq (rfc2047-qp-or-base64) 'base64) - 'B - 'Q)))) - (start (concat - "=?" (downcase (symbol-name mime-charset)) "?" - (downcase (symbol-name encoding)) "?")) - (factor (case mime-charset - ((iso-8859-5 iso-8859-7 iso-8859-8 koi8-r) 1) - ((big5 gb2312 euc-kr) 2) - (utf-8 4) - (t 8))) - (pre (- b (save-restriction - (widen) - (rfc2047-point-at-bol)))) - ;; encoded-words must not be longer than 75 characters, - ;; including charset, encoding etc. This leaves us with - ;; 75 - (length start) - 2 - 2 characters. The last 2 is for - ;; possible base64 padding. In the worst case (iso-2022-*) - ;; each character expands to 8 bytes which is expanded by a - ;; factor of 4/3 by base64 encoding. - (length (floor (- 75 (length start) 4) (* factor (/ 4.0 3.0)))) - ;; Limit line length to 76 characters. - (length1 (max 1 (floor (- 76 (length start) 4 pre) - (* factor (/ 4.0 3.0))))) - (first t)) - (if mime-charset - (save-restriction - (narrow-to-region b e) - (when (eq encoding 'B) - ;; break into lines before encoding - (goto-char (point-min)) - (while (not (eobp)) - (if first - (progn - (goto-char (min (point-max) (+ length1 (point)))) - (setq first nil)) - (goto-char (min (point-max) (+ length (point))))) - (unless (eobp) - (insert ?\n))) - (setq first t)) - (if (and (mm-multibyte-p) - (mm-coding-system-p cs)) - (mm-encode-coding-region (point-min) (point-max) cs)) - (funcall (cdr (assq encoding rfc2047-encoding-function-alist)) - (point-min) (point-max)) - (goto-char (point-min)) - (while (not (eobp)) - (unless first - (insert ? )) - (setq first nil) - (insert start) - (end-of-line) - (insert "?=") - (forward-line 1)))))) + (if (eq (rfc2047-qp-or-base64) 'base64) + 'B + 'Q))) + (widen) + (goto-char e) + (skip-chars-forward "^ \t\n") + ;; `tail' may contain a close parenthesis. + (setq tail (buffer-substring-no-properties e (point))) + (goto-char b) + (setq b (point-marker) + e (set-marker (make-marker) e)) + (rfc2047-fold-region (rfc2047-point-at-bol) b) + (goto-char b) + (skip-chars-backward "^ \t\n") + (unless (= 0 (skip-chars-backward " \t")) + ;; `crest' may contain whitespace and an open parenthesis. + (setq crest (buffer-substring-no-properties (point) b))) + (setq eword (rfc2047-encode-1 + (- b (rfc2047-point-at-bol)) + (mm-replace-in-string + (buffer-substring-no-properties b e) + "\n\\([ \t]?\\)" "\\1") + cs + (or (cdr (assq encoding + rfc2047-encode-function-alist)) + 'identity) + (concat "=?" (downcase (symbol-name mime-charset)) + "?" (upcase (symbol-name encoding)) "?") + (or crest " ") + tail)) + (delete-region (if (eq (aref eword 0) ?\n) + (if (bolp) + ;; The line was folded before encoding. + (1- (point)) + (point)) + (goto-char b)) + (+ e (length tail))) + ;; `eword' contains `crest' and `tail'. + (insert eword) + (set-marker b nil) + (set-marker e nil) + (unless (or (/= 0 (length tail)) + (eobp) + (looking-at "[ \t\n)]")) + (insert " ")))) + (t + (goto-char e))))) (defun rfc2047-fold-field () "Fold the current header field." @@ -512,6 +678,7 @@ By default, the region is treated as containing addresses (see (goto-char (or break qword-break)) (setq break nil qword-break nil) + (skip-chars-backward " \t") (if (looking-at "[ \t]") (insert ?\n) (insert "\n ")) @@ -533,10 +700,8 @@ By default, the region is treated as containing addresses (see (forward-char 1)) ((memq (char-after) '(? ?\t)) (skip-chars-forward " \t") - (if first - ;; Don't break just after the header name. - (setq first nil) - (setq break (1- (point))))) + (unless first ;; Don't break just after the header name. + (setq break (point)))) ((not break) (if (not (looking-at "=\\?[^=]")) (if (eq (char-after) ?=) @@ -547,15 +712,17 @@ By default, the region is treated as containing addresses (see (setq qword-break (point))) (skip-chars-forward "^ \t\n\r"))) (t - (skip-chars-forward "^ \t\n\r")))) + (skip-chars-forward "^ \t\n\r"))) + (setq first nil)) (when (and (or break qword-break) (> (- (point) bol) 76)) (goto-char (or break qword-break)) (setq break nil qword-break nil) - (if (looking-at "[ \t]") - (insert ?\n) - (insert "\n ")) + (if (or (> 0 (skip-chars-backward " \t")) + (looking-at "[ \t]")) + (insert ?\n) + (insert "\n ")) (setq bol (1- (point))) ;; Don't break before the first non-LWSP characters. (skip-chars-forward " \t") @@ -590,48 +757,48 @@ By default, the region is treated as containing addresses (see (setq eol (rfc2047-point-at-eol)) (forward-line 1))))) -(defun rfc2047-b-encode-region (b e) - "Base64-encode the header contained in region B to E." - (save-restriction - (narrow-to-region (goto-char b) e) - (while (not (eobp)) - (base64-encode-region (point) (progn (end-of-line) (point)) t) - (if (and (bolp) (eolp)) - (delete-backward-char 1)) - (forward-line)))) - -(defun rfc2047-q-encode-region (b e) - "Quoted-printable-encode the header in region B to E." - (save-excursion - (save-restriction - (narrow-to-region (goto-char b) e) - (let ((bol (save-restriction - (widen) - (rfc2047-point-at-bol)))) - (quoted-printable-encode-region - b e nil - ;; = (\075), _ (\137), ? (\077) are used in the encoded word. - ;; Avoid using 8bit characters. - ;; This list excludes `especials' (see the RFC2047 syntax), - ;; meaning that some characters in non-structured fields will - ;; get encoded when they con't need to be. The following is - ;; what it used to be. -;;; ;; Equivalent to "^\000-\007\011\013\015-\037\200-\377=_?" -;;; "\010\012\014\040-\074\076\100-\136\140-\177") - "-\b\n\f !#-'*+0-9A-Z\\^`-~\d") - (subst-char-in-region (point-min) (point-max) ? ?_) - ;; The size of QP encapsulation is about 20, so set limit to - ;; 56=76-20. - (unless (< (- (point-max) (point-min)) 56) - ;; Don't break if it could fit in one line. - ;; Let rfc2047-encode-region break it later. - (goto-char (1+ (point-min))) - (while (and (not (bobp)) (not (eobp))) - (goto-char (min (point-max) (+ 56 bol))) - (search-backward "=" (- (point) 2) t) - (unless (or (bobp) (eobp)) - (insert ?\n) - (setq bol (point))))))))) +(defun rfc2047-b-encode-string (string) + "Base64-encode the header contained in STRING." + (base64-encode-string string t)) + +(defun rfc2047-q-encode-string (string) + "Quoted-printable-encode the header in STRING." + (mm-with-unibyte-buffer + (insert string) + (quoted-printable-encode-region + (point-min) (point-max) nil + ;; = (\075), _ (\137), ? (\077) are used in the encoded word. + ;; Avoid using 8bit characters. + ;; This list excludes `especials' (see the RFC2047 syntax), + ;; meaning that some characters in non-structured fields will + ;; get encoded when they con't need to be. The following is + ;; what it used to be. + ;;; ;; Equivalent to "^\000-\007\011\013\015-\037\200-\377=_?" + ;;; "\010\012\014\040-\074\076\100-\136\140-\177") + "-\b\n\f !#-'*+0-9A-Z\\^`-~\d") + (subst-char-in-region (point-min) (point-max) ? ?_) + (buffer-string))) + +(defun rfc2047-encode-parameter (param value) + "Return and PARAM=VALUE string encoded in the RFC2047-like style. +This is a replacement for the `rfc2231-encode-string' function. + +When attaching files as MIME parts, we should use the RFC2231 encoding +to specify the file names containing non-ASCII characters. However, +many mail softwares don't support it in practice and recipients won't +be able to extract files with correct names. Instead, the RFC2047-like +encoding is acceptable generally. This function provides the very +RFC2047-like encoding, resigning to such a regrettable trend. To use +it, put the following line in your ~/.gnus.el file: + +\(defalias 'mail-header-encode-parameter 'rfc2047-encode-parameter) +" + (let* ((rfc2047-encoding-type 'mime) + (rfc2047-encode-max-chars nil) + (string (rfc2047-encode-string value))) + (if (string-match (concat "[" ietf-drums-tspecials "]") string) + (format "%s=%S" param string) + (concat param "=" string)))) ;;; ;;; Functions for decoding RFC2047 messages @@ -639,8 +806,8 @@ By default, the region is treated as containing addresses (see (eval-and-compile (defconst rfc2047-encoded-word-regexp - "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\ -\\?\\([!->@-~ +]*\\)\\?=")) + "=\\?\\([^][\000-\040()<>@,\;:*\\\"/?.=]+\\)\\(\\*[^?]+\\)?\ +\\?\\(B\\|Q\\)\\?\\([!->@-~ ]*\\)\\?=")) (defvar rfc2047-quote-decoded-words-containing-tspecials nil "If non-nil, quote decoded words containing special characters.") @@ -671,7 +838,7 @@ By default, the region is treated as containing addresses (see "\\(\n?[ \t]\\)+" "\\(" rfc2047-encoded-word-regexp "\\)")) nil t) - (delete-region (goto-char (match-end 1)) (match-beginning 6))) + (delete-region (goto-char (match-end 1)) (match-beginning 7))) ;; Decode the encoded words. (setq b (goto-char (point-min))) (while (re-search-forward rfc2047-encoded-word-regexp nil t) @@ -774,7 +941,20 @@ By default, the region is treated as containing addresses (see mail-parse-charset (not (eq mail-parse-charset 'us-ascii)) (not (eq mail-parse-charset 'gnus-decoded))) - (mm-decode-coding-string string mail-parse-charset) + ;; `decode-coding-string' in Emacs offers a third optional + ;; arg NOCOPY to avoid consing a new string if the decoding + ;; is "trivial". Unfortunately it currently doesn't + ;; consider anything else than a `nil' coding system + ;; trivial. + ;; `rfc2047-decode-string' is called multiple times for each + ;; article during summary buffer generation, and we really + ;; want to avoid unnecessary consing. So we bypass + ;; `decode-coding-string' if the string is purely ASCII. + (if (and (fboundp 'detect-coding-string) + ;; string is purely ASCII + (eq (detect-coding-string string t) 'undecided)) + string + (mm-decode-coding-string string mail-parse-charset)) (mm-string-as-multibyte string))))) (defun rfc2047-parse-and-decode (word) @@ -787,8 +967,8 @@ decodable." (condition-case nil (rfc2047-decode (match-string 1 word) - (upcase (match-string 2 word)) - (match-string 3 word)) + (string-to-char (match-string 3 word)) + (match-string 4 word)) (error word)) word))) ; un-decodable @@ -809,7 +989,7 @@ decodable." (defun rfc2047-decode (charset encoding string) "Decode STRING from the given MIME CHARSET in the given ENCODING. -Valid ENCODINGs are \"B\" and \"Q\". +Valid ENCODINGs are the characters \"B\" and \"Q\". If your Emacs implementation can't decode CHARSET, return nil." (if (stringp charset) (setq charset (intern (downcase charset)))) @@ -824,18 +1004,17 @@ If your Emacs implementation can't decode CHARSET, return nil." (memq 'gnus-unknown mail-parse-ignored-charsets)) (setq cs (mm-charset-to-coding-system mail-parse-charset))) (when cs - (when (and (eq cs 'ascii) - mail-parse-charset) - (setq cs mail-parse-charset)) + (when (eq cs 'ascii) + (setq cs (or mail-parse-charset 'raw-text))) (mm-decode-coding-string (cond - ((equal "B" encoding) + ((char-equal ?B encoding) (base64-decode-string (rfc2047-pad-base64 string))) - ((equal "Q" encoding) + ((char-equal ?Q encoding) (quoted-printable-decode-string - (mm-replace-chars-in-string string ?_ ? ))) - (t (error "Invalid encoding: %s" encoding))) + (mm-subst-char-in-string ?_ ? string t))) + (t (error "Invalid encoding: %c" encoding))) cs)))) (provide 'rfc2047) diff --git a/lisp/hl-line.el b/lisp/hl-line.el index a3e786dd801..e553636674b 100644 --- a/lisp/hl-line.el +++ b/lisp/hl-line.el @@ -1,6 +1,6 @@ ;;; hl-line.el --- highlight the current line -;; Copyright (C) 1998, 2000, 2001, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1998, 2000, 2001, 2003, 2005 Free Software Foundation, Inc. ;; Author: Dave Love <fx@gnu.org> ;; Maintainer: FSF @@ -113,7 +113,7 @@ When `hl-line-sticky-flag' is nil, Hl-Line mode highlights the line about point in the selected window only. In this case, it uses the function `hl-line-unhighlight' on `pre-command-hook' in addition to `hl-line-highlight' on `post-command-hook'." - nil nil nil + :group 'hl-line (if hl-line-mode (progn ;; In case `kill-all-local-variables' is called. diff --git a/lisp/ido.el b/lisp/ido.el index 86a88d0d491..ddeecbb9b69 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -1935,19 +1935,21 @@ If INITIAL is non-nil, it specifies the initial input string." ;; Internal function for ido-find-file and friends (unless item (setq item 'file)) - (let* ((ido-current-directory (ido-expand-directory default)) - (ido-directory-nonreadable (ido-nonreadable-directory-p ido-current-directory)) - (ido-directory-too-big (and (not ido-directory-nonreadable) - (ido-directory-too-big-p ido-current-directory))) - (ido-context-switch-command switch-cmd) - filename) - - (cond - ((or (not ido-mode) (ido-is-slow-ftp-host)) - (setq filename t - ido-exit 'fallback)) - - ((and (eq item 'file) + (let ((ido-current-directory (ido-expand-directory default)) + (ido-context-switch-command switch-cmd) + ido-directory-nonreadable ido-directory-too-big + filename) + + (if (or (not ido-mode) (ido-is-slow-ftp-host)) + (setq filename t + ido-exit 'fallback) + (setq ido-directory-nonreadable + (ido-nonreadable-directory-p ido-current-directory) + ido-directory-too-big + (and (not ido-directory-nonreadable) + (ido-directory-too-big-p ido-current-directory)))) + + (when (and (eq item 'file) (or ido-use-url-at-point ido-use-filename-at-point)) (let (fn d) (require 'ffap) @@ -1966,7 +1968,7 @@ If INITIAL is non-nil, it specifies the initial input string." (setq d (file-name-directory fn)) (file-directory-p d)) (setq ido-current-directory d) - (setq initial (file-name-nondirectory fn))))))) + (setq initial (file-name-nondirectory fn)))))) (let (ido-saved-vc-hb (vc-handled-backends (and (boundp 'vc-handled-backends) vc-handled-backends)) diff --git a/lisp/iimage.el b/lisp/iimage.el index 9b183ebb01d..32f6aef9abd 100644 --- a/lisp/iimage.el +++ b/lisp/iimage.el @@ -1,6 +1,6 @@ ;;; iimage.el --- Inline image minor mode. -;; Copyright (C) 2004 Free Software Foundation +;; Copyright (C) 2004, 2005 Free Software Foundation ;; Author: KOSEKI Yoshinori <kose@meadowy.org> ;; Maintainer: KOSEKI Yoshinori <kose@meadowy.org> @@ -51,6 +51,11 @@ (eval-when-compile (require 'image-file)) +(defgroup iimage nil + "Support for inline images." + :version "22.1" + :group 'image) + (defconst iimage-version "1.1") (defvar iimage-mode nil) (defvar iimage-mode-map nil) @@ -137,7 +142,7 @@ With numeric ARG, display the images if and only if ARG is positive." ;;;###autoload (define-minor-mode iimage-mode "Toggle inline image minor mode." - nil " iImg" iimage-mode-map + :group 'iimage :lighter " iImg" :keymap iimage-mode-map (run-hooks 'iimage-mode-hook) (iimage-mode-buffer iimage-mode)) diff --git a/lisp/info.el b/lisp/info.el index 870e1ad89f6..cefe603a400 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -3026,12 +3026,12 @@ if point is in a menu item description, follow that menu item." :help "Go to menu of visited nodes"] ["Table of Contents" Info-toc :help "Go to table of contents"] - ("Index..." - ["Lookup a String" Info-index + ("Index" + ["Lookup a String..." Info-index :help "Look for a string in the index items"] - ["Next Matching Item" Info-index-next + ["Next Matching Item" Info-index-next :active Info-index-alternatives :help "Look for another occurrence of previous item"] - ["Lookup a string in all indices" info-apropos + ["Lookup a string in all indices..." info-apropos :help "Look for a string in the indices of all manuals"]) ["Edit" Info-edit :help "Edit contents of this node" :active Info-enable-edit] diff --git a/lisp/international/characters.el b/lisp/international/characters.el index 727c9e6b9ff..77eb49807c0 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -884,8 +884,8 @@ (set-case-syntax-pair (decode-char 'ucs (1- c)) (decode-char 'ucs c) tbl)) (setq c (1+ c))) - ;;(set-downcase-syntax ?$,1 P(B ?i tbl) - ;;(set-upcase-syntax ?I ?$,1 Q(B tbl) + (set-downcase-syntax ?$,1 P(B ?i tbl) + (set-upcase-syntax ?I ?$,1 Q(B tbl) (set-case-syntax-pair ?$,1 R(B ?$,1 S(B tbl) (set-case-syntax-pair ?$,1 T(B ?$,1 U(B tbl) (set-case-syntax-pair ?$,1 V(B ?$,1 W(B tbl) diff --git a/lisp/international/encoded-kb.el b/lisp/international/encoded-kb.el index aa6d35c340f..fdb35b34533 100644 --- a/lisp/international/encoded-kb.el +++ b/lisp/international/encoded-kb.el @@ -269,7 +269,7 @@ automatically. In Encoded-kbd mode, a text sent from keyboard is accepted as a multilingual text encoded in a coding system set by \\[set-keyboard-coding-system]." - :global t + :global t :group 'keyboard :group 'mule (if encoded-kbd-mode ;; We are turning on Encoded-kbd mode. diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 86665d31ba8..5e9f3014dc2 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -384,6 +384,7 @@ See also `coding-category-list' and `coding-system-category'." ;; CODING-SYSTEM is no-conversion or undecided. (error "Can't prefer the coding system `%s'" coding-system)) (set coding-category (or base coding-system)) + ;; Changing the binding of a coding category requires this call. (update-coding-systems-internal) (or (eq coding-category (car coding-category-list)) ;; We must change the order. @@ -1691,6 +1692,7 @@ The default status is as follows: coding-category-ccl coding-category-binary)) + ;; Changing the binding of a coding category requires this call. (update-coding-systems-internal) (set-default-coding-systems nil) @@ -1904,6 +1906,7 @@ of `buffer-file-coding-system' set by this function." (while priority (set (car categories) (car priority)) (setq priority (cdr priority) categories (cdr categories))) + ;; Changing the binding of a coding category requires this call. (update-coding-systems-internal))))) (defsubst princ-list (&rest args) diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el index 7c51409422b..8ac56b4bd65 100644 --- a/lisp/international/mule-util.el +++ b/lisp/international/mule-util.el @@ -327,6 +327,7 @@ coding systems ordered by priority." (mapc (function (lambda (x) (set (car x) (cdr x)))) prio-list) (set-coding-priority (mapcar #'car prio-list)) + ;; Changing the binding of a coding category requires this call. (update-coding-systems-internal) (detect-coding-region ,from ,to)) ;; We must restore the internal database. diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 1ec546e22fd..49635652bb2 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -1546,6 +1546,7 @@ text, and convert it in the temporary buffer. Otherwise, convert in-place." ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|[JEW]AR\\|XPI\\)\\'" . no-conversion) ("\\.\\(sx[dmicw]\\|tar\\|tgz\\)\\'" . no-conversion) ("\\.\\(gz\\|Z\\|bz\\|bz2\\|gpg\\)\\'" . no-conversion) + ("\\.\\(jpe?g\\|png\\|gif\\|tiff?\\|p[bpgn]m\\)\\'" . no-conversion) ("/#[^/]+#\\'" . emacs-mule)) "Alist of filename patterns vs corresponding coding systems. Each element looks like (REGEXP . CODING-SYSTEM). diff --git a/lisp/kmacro.el b/lisp/kmacro.el index c6a97bb3d34..20816fc7fea 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -614,10 +614,13 @@ With numeric arg, repeat macro now that many times, counting the definition just completed as the first repetition. An argument of zero means repeat until error." (interactive "P") - (end-kbd-macro arg #'kmacro-loop-setup-function) - (when (and last-kbd-macro (= (length last-kbd-macro) 0)) - (message "Ignore empty macro") - (kmacro-pop-ring))) + ;; Isearch may push the kmacro-end-macro key sequence onto the macro. + ;; Just ignore it when executing the macro. + (unless executing-kbd-macro + (end-kbd-macro arg #'kmacro-loop-setup-function) + (when (and last-kbd-macro (= (length last-kbd-macro) 0)) + (message "Ignore empty macro") + (kmacro-pop-ring)))) ;;;###autoload diff --git a/lisp/language/thai-util.el b/lisp/language/thai-util.el index 09f84d6fad6..dea05a4c948 100644 --- a/lisp/language/thai-util.el +++ b/lisp/language/thai-util.el @@ -1,10 +1,9 @@ ;;; thai-util.el --- utilities for Thai -*- coding: iso-2022-7bit; -*- -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. -;; Copyright (C) 2005 +;; Copyright (C) 1995, 1997, 1998, 1999, 2000, 2001, 2005 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H14PRO021 +;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. ;; Keywords: mule, multilingual, thai @@ -279,7 +278,7 @@ if necessary." (defun thai-compose-syllable (beg end &optional category-set string) (or category-set - (setq category-set + (setq category-set (char-category-set (if string (aref string beg) (char-after beg))))) (if (aref category-set ?c) ;; Starting with a consonant. We do relative composition. @@ -288,9 +287,9 @@ if necessary." (compose-region beg end)) ;; Vowel tone sequence. (if string - (compose-string string beg end (list (aref string beg) '(Bc . Bc) + (compose-string string beg end (list (aref string beg) '(Bc . Bc) (aref string (1+ beg)))) - (compose-region beg end (list (char-after beg) '(Bc . Bc) + (compose-region beg end (list (char-after beg) '(Bc . Bc) (char-after (1+ beg)))))) (- end beg)) @@ -348,7 +347,7 @@ The return value is number of composed characters." (if string (if (eq (string-match thai-composition-pattern string from) from) (thai-compose-syllable from (match-end 0) nil string)) - (if (save-excursion + (if (save-excursion (goto-char from) (and (looking-at thai-composition-pattern) (setq to (match-end 0)))) @@ -376,12 +375,48 @@ The return value is number of composed characters." ;;;###autoload (define-minor-mode thai-auto-composition-mode "Minor mode for automatically correct Thai character composition." - nil nil nil + :group 'mule (cond ((null thai-auto-composition-mode) (remove-hook 'after-change-functions 'thai-auto-composition)) (t (add-hook 'after-change-functions 'thai-auto-composition)))) +;; Thai-word-mode requires functions in the feature `thai-word'. +(require 'thai-word) + +(defvar thai-word-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [remap forward-word] 'thai-forward-word) + (define-key map [remap backward-word] 'thai-backward-word) + (define-key map [remap kill-word] 'thai-kill-word) + (define-key map [remap backward-kill-word] 'thai-backward-kill-word) + (define-key map [remap transpose-words] 'thai-transpose-words) + map) + "Keymap for `thai-word-mode'.") + +(define-minor-mode thai-word-mode + "Minor mode to make word-oriented commands aware of Thai words. +The commands affected are \\[forward-word], \\[backward-word], \\[kill-word], \\[backward-kill-word], \\[transpose-words], and \\[fill-paragraph]." + :global t :group 'mule + (cond (thai-word-mode + ;; This enables linebreak between Thai characters. + (modify-category-entry (make-char 'thai-tis620) ?|) + ;; This enables linebreak at a Thai word boundary. + (put-charset-property 'thai-tis620 'fill-find-break-point-function + 'thai-fill-find-break-point)) + (t + (modify-category-entry (make-char 'thai-tis620) ?| nil t) + (put-charset-property 'thai-tis620 'fill-find-break-point-function + nil)))) + +;; Function to call on entering the Thai language environment. +(defun setup-thai-language-environment-internal () + (thai-word-mode 1)) + +;; Function to call on exiting the Thai language environment. +(defun exit-thai-language-environment-internal () + (thai-word-mode -1)) + ;; (provide 'thai-util) diff --git a/lisp/language/thai-word.el b/lisp/language/thai-word.el index 82f6fcdea6a..2548a44ea80 100644 --- a/lisp/language/thai-word.el +++ b/lisp/language/thai-word.el @@ -1,7 +1,8 @@ ;;; thai-word.el -- find Thai word boundaries -;; Copyright (C) 2000, 2001, 2002, 2003, 2004 -;; Electrotechnical Laboratory, JAPAN. +;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 +;; National Institute of Advanced Industrial Science and Technology (AIST) +;; Registration Number H14PRO021 ;; Author: Kenichi HANDA <handa@etl.go.jp> @@ -72,13 +73,10 @@ ;; which means that you can easily index the list character by ;; character. -(defconst thai-word-table nil) - - -;; Set up `thai-word-table'. - -(let - ((l +(defvar thai-word-table + (let ((table (list 'thai-words))) + (dolist (elt + ;;; The following is indented as this to minimize this file size. '("¡¡" "¡¡Å" "¡¡Ø¸Àѳ±ì" @@ -10732,11 +10730,10 @@ "äÎâ¡ÃÁÔàµÍÃì" "äÎâ´Ã¤ÒÃìºÍ¹" "äÎâÅ" - ))) - (setq thai-word-table (list 'thai-words)) - (while l - (set-nested-alist (car l) 1 thai-word-table) - (setq l (cdr l)))) + )) + (set-nested-alist elt 1 table)) + table) + "Nested alist of Thai words.") (defun thai-update-word-table (file &optional append) @@ -10783,7 +10780,7 @@ the current word list." ;; character by character. (while this (setq pos (1+ pos) - char (char-after pos) + char (or (char-after pos) 0) category-set (char-category-set char)) ;; If the current sequence is recorded in `thai-word-table' ;; (i.e. (car THIS) is 1) and the following Thai character is @@ -11042,6 +11039,33 @@ If COUNT is negative, move point forward (- COUNT) words." (thai-forward-word (- count))) +(defun thai-kill-word (arg) + "Like kill-word but pay attention to Thai word boundaries. +With argument, do this that many times." + (interactive "p") + (kill-region (point) (progn (thai-forward-word arg) (point)))) + + +(defun thai-backward-kill-word (arg) + "Like backward-kill-word but pay attention to Thai word boundaries." + (interactive "p") + (thai-kill-word (- arg))) + + +(defun thai-transpose-words (arg) + "Like transpose-words but pay attention to Thai word boundaries." + (interactive "*p") + (transpose-subr 'thai-forward-word arg)) + +(defun thai-fill-find-break-point (linebeg) + "Go to a line breaking position near point considering Thai word boundaries." + (let ((pos (point))) + (thai-forward-word -1) + (when (<= (point) linebeg) + (goto-char pos) + (thai-forward-word 1)) + (kinsoku linebeg))) + (provide 'thai-word) diff --git a/lisp/language/thai.el b/lisp/language/thai.el index 6b5df5c08b6..c14d0005a72 100644 --- a/lisp/language/thai.el +++ b/lisp/language/thai.el @@ -1,10 +1,9 @@ ;;; thai.el --- support for Thai -*- coding: iso-2022-7bit; no-byte-compile: t -*- -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. -;; Copyright (C) 2005 +;; Copyright (C) 1995, 1997, 1998, 1999, 2000, 2002, 2005 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H14PRO021 +;; Copyright (C) 1997, 1998, 2000, 2001, 2002 Free Software Foundation, Inc. ;; Keywords: multilingual, Thai @@ -53,6 +52,8 @@ (input-method . "thai-kesmanee") (unibyte-display . thai-tis620) (features thai-util) + (setup-function . setup-thai-language-environment-internal) + (exit-function . exit-thai-language-environment-internal) (sample-text . (thai-compose-string (copy-sequence "Thai (,T@RIRd7B(B) ,TJ0GQ1J04U1$0CQ1:(B, ,TJ0GQ1J04U10$h1P(B"))) diff --git a/lisp/longlines.el b/lisp/longlines.el new file mode 100644 index 00000000000..ebfb7a660b0 --- /dev/null +++ b/lisp/longlines.el @@ -0,0 +1,393 @@ +;;; longlines.el --- automatically wrap long lines + +;; Copyright (C) 2000, 2001, 2004, 2005 by Free Software Foundation, Inc. + +;; Authors: Kai Grossjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> +;; Alex Schroeder <alex@gnu.org> +;; Chong Yidong <cyd@stupidchicken.com> +;; Maintainer: Chong Yidong <cyd@stupidchicken.com> +;; Keywords: convenience + +;; 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., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Some text editors save text files with long lines, and they +;; automatically break these lines at whitespace, without actually +;; inserting any newline characters. When doing `M-q' in Emacs, you +;; are inserting newline characters. Longlines mode provides a file +;; format which wraps the long lines when reading a file and unwraps +;; the lines when saving the file. It can also wrap and unwrap +;; automatically as editing takes place. + +;; Special thanks to Rod Smith for many useful bug reports. + +;;; Code: + +(require 'easy-mmode) + +(defgroup longlines nil + "Automatic wrapping of long lines when loading files." + :group 'fill) + +(defcustom longlines-auto-wrap t + "*Non-nil means long lines are automatically wrapped after each command. +Otherwise, you can perform filling using `fill-paragraph' or +`auto-fill-mode'. In any case, the soft newlines will be removed +when the file is saved to disk." + :group 'longlines + :type 'boolean) + +(defcustom longlines-wrap-follows-window-size nil + "*Non-nil means wrapping and filling happen at the edge of the window. +Otherwise, `fill-column' is used, regardless of the window size. This +does not work well when the buffer is displayed in multiple windows +with differing widths." + :group 'longlines + :type 'boolean) + +(defcustom longlines-show-hard-newlines nil + "*Non-nil means each hard newline is marked with a symbol. +You can also enable the display temporarily, using the command +`longlines-show-hard-newlines'" + :group 'longlines + :type 'boolean) + +(defcustom longlines-show-effect (propertize "|\n" 'face 'escape-glyph) + "*A string to display when showing hard newlines. +This is used when `longlines-show-hard-newlines' is on." + :group 'longlines + :type 'string) + +;; Internal variables + +(defvar longlines-wrap-beg nil) +(defvar longlines-wrap-end nil) +(defvar longlines-wrap-point nil) +(defvar longlines-showing nil) + +(make-variable-buffer-local 'longlines-wrap-beg) +(make-variable-buffer-local 'longlines-wrap-end) +(make-variable-buffer-local 'longlines-wrap-point) +(make-variable-buffer-local 'longlines-showing) + +;; Mode + +;;;###autoload +(define-minor-mode longlines-mode + "Toggle Long Lines mode. +In Long Lines mode, long lines are wrapped if they extend beyond +`fill-column'. The soft newlines used for line wrapping will not +show up when the text is yanked or saved to disk. + +If `longlines-auto-wrap' is non-nil, lines are automatically +wrapped whenever the buffer is changed. You can always call +`fill-paragraph' to fill individual paragraphs. + +If `longlines-show-hard-newlines' is non-nil, hard newlines will +be marked by a symbol." + :group 'longlines :lighter " ll" + (if longlines-mode + ;; Turn on longlines mode + (progn + (use-hard-newlines 1 'never) + (set (make-local-variable 'require-final-newline) nil) + (add-to-list 'buffer-file-format 'longlines) + (add-hook 'change-major-mode-hook 'longlines-mode-off nil t) + (make-local-variable 'buffer-substring-filters) + (add-to-list 'buffer-substring-filters 'longlines-encode-string) + (when longlines-wrap-follows-window-size + (set (make-local-variable 'fill-column) + (- (window-width) window-min-width)) + (add-hook 'window-configuration-change-hook + 'longlines-window-change-function nil t)) + (let ((buffer-undo-list t) + (mod (buffer-modified-p))) + ;; Turning off undo is OK since (spaces + newlines) is + ;; conserved, except for a corner case in + ;; longlines-wrap-lines that we'll never encounter from here + (longlines-decode-region (point-min) (point-max)) + (longlines-wrap-region (point-min) (point-max)) + (set-buffer-modified-p mod)) + (when (and longlines-show-hard-newlines + (not longlines-showing)) + (longlines-show-hard-newlines)) + (when longlines-auto-wrap + (auto-fill-mode 0) + (add-hook 'after-change-functions + 'longlines-after-change-function nil t) + (add-hook 'post-command-hook + 'longlines-post-command-function nil t))) + ;; Turn off longlines mode + (setq buffer-file-format (delete 'longlines buffer-file-format)) + (if longlines-showing + (longlines-unshow-hard-newlines)) + (let ((buffer-undo-list t)) + (longlines-encode-region (point-min) (point-max))) + (remove-hook 'change-major-mode-hook 'longlines-mode-off t) + (remove-hook 'before-kill-functions 'longlines-encode-region t) + (remove-hook 'after-change-functions 'longlines-after-change-function t) + (remove-hook 'post-command-hook 'longlines-post-command-function t) + (remove-hook 'window-configuration-change-hook + 'longlines-window-change-function t) + (kill-local-variable 'fill-column))) + +(defun longlines-mode-off () + "Turn off longlines mode. +This function exists to be called by `change-major-mode-hook' when the +major mode changes." + (longlines-mode 0)) + +;; Showing the effect of hard newlines in the buffer + +(defface longlines-visible-face + '((t (:background "red"))) + "Face used to make hard newlines visible in `longlines-mode'.") + +(defun longlines-show-hard-newlines (&optional arg) + "Make hard newlines visible by adding a face. +With optional argument ARG, make the hard newlines invisible again." + (interactive "P") + (let ((buffer-undo-list t) + (mod (buffer-modified-p))) + (if arg + (longlines-unshow-hard-newlines) + (setq longlines-showing t) + (longlines-show-region (point-min) (point-max))) + (set-buffer-modified-p mod))) + +(defun longlines-show-region (beg end) + "Make hard newlines between BEG and END visible." + (let* ((pmin (min beg end)) + (pmax (max beg end)) + (pos (text-property-any pmin pmax 'hard t))) + (while pos + (put-text-property pos (1+ pos) 'display + (copy-sequence longlines-show-effect)) + (setq pos (text-property-any (1+ pos) pmax 'hard t))))) + +(defun longlines-unshow-hard-newlines () + "Make hard newlines invisible again." + (interactive) + (setq longlines-showing nil) + (let ((pos (text-property-any (point-min) (point-max) 'hard t))) + (while pos + (remove-text-properties pos (1+ pos) '(display)) + (setq pos (text-property-any (1+ pos) (point-max) 'hard t))))) + +;; Wrapping the paragraphs. + +(defun longlines-wrap-region (beg end) + "Wrap each successive line, starting with the line before BEG. +Stop when we reach lines after END that don't need wrapping, or the +end of the buffer." + (setq longlines-wrap-point (point)) + (goto-char beg) + (forward-line -1) + ;; Two successful longlines-wrap-line's in a row mean successive + ;; lines don't need wrapping. + (while (null (and (longlines-wrap-line) + (or (eobp) + (and (>= (point) end) + (longlines-wrap-line)))))) + (goto-char longlines-wrap-point)) + +(defun longlines-wrap-line () + "If the current line needs to be wrapped, wrap it and return nil. +If wrapping is performed, point remains on the line. If the line does +not need to be wrapped, move point to the next line and return t." + (if (longlines-set-breakpoint) + (progn (backward-char 1) + (delete-char 1) + (insert-char ?\n 1) + nil) + (if (longlines-merge-lines-p) + (progn (end-of-line) + (delete-char 1) + ;; After certain commands (e.g. kill-line), there may be two + ;; successive soft newlines in the buffer. In this case, we + ;; replace these two newlines by a single space. Unfortunately, + ;; this breaks the conservation of (spaces + newlines), so we + ;; have to fiddle with longlines-wrap-point. + (if (or (bolp) (eolp)) + (if (> longlines-wrap-point (point)) + (setq longlines-wrap-point + (1- longlines-wrap-point))) + (insert-char ? 1)) + nil) + (forward-line 1) + t))) + +(defun longlines-set-breakpoint () + "Place point where we should break the current line, and return t. +If the line should not be broken, return nil; point remains on the +line." + (move-to-column fill-column) + (if (and (re-search-forward "[^ ]" (line-end-position) 1) + (> (current-column) fill-column)) + ;; This line is too long. Can we break it? + (or (longlines-find-break-backward) + (progn (move-to-column fill-column) + (longlines-find-break-forward))))) + +(defun longlines-find-break-backward () + "Move point backward to the first available breakpoint and return t. +If no breakpoint is found, return nil." + (and (search-backward " " (line-beginning-position) 1) + (save-excursion + (skip-chars-backward " " (line-beginning-position)) + (null (bolp))) + (progn (forward-char 1) + (if (and fill-nobreak-predicate + (run-hook-with-args-until-success + 'fill-nobreak-predicate)) + (progn (skip-chars-backward " " (line-beginning-position)) + (longlines-find-break-backward)) + t)))) + +(defun longlines-find-break-forward () + "Move point forward to the first available breakpoint and return t. +If no break point is found, return nil." + (and (search-forward " " (line-end-position) 1) + (progn (skip-chars-forward " " (line-end-position)) + (null (eolp))) + (if (and fill-nobreak-predicate + (run-hook-with-args-until-success + 'fill-nobreak-predicate)) + (longlines-find-break-forward) + t))) + +(defun longlines-merge-lines-p () + "Return t if part of the next line can fit onto the current line. +Otherwise, return nil. Text cannot be moved across hard newlines." + (save-excursion + (end-of-line) + (and (null (eobp)) + (null (get-text-property (point) 'hard)) + (let ((space (- fill-column (current-column)))) + (forward-line 1) + (if (eq (char-after) ? ) + t ; We can always merge some spaces + (<= (if (search-forward " " (line-end-position) 1) + (current-column) + (1+ (current-column))) + space)))))) + +(defun longlines-decode-region (beg end) + "Turn all newlines between BEG and END into hard newlines." + (save-excursion + (goto-char (min beg end)) + (while (search-forward "\n" (max beg end) t) + (set-hard-newline-properties + (match-beginning 0) (match-end 0))))) + +(defun longlines-encode-region (beg end &optional buffer) + "Replace each soft newline between BEG and END with exactly one space. +Hard newlines are left intact. The optional argument BUFFER exists for +compatibility with `format-alist', and is ignored." + (save-excursion + (let ((mod (buffer-modified-p))) + (goto-char (min beg end)) + (while (search-forward "\n" (max (max beg end)) t) + (unless (get-text-property (match-beginning 0) 'hard) + (replace-match " "))) + (set-buffer-modified-p mod) + end))) + +(defun longlines-encode-string (string) + "Return a copy of STRING with each soft newline replaced by a space. +Hard newlines are left intact." + (let* ((str (copy-sequence string)) + (pos (string-match "\n" str))) + (while pos + (if (null (get-text-property pos 'hard str)) + (aset str pos ? )) + (setq pos (string-match "\n" str (1+ pos)))) + str)) + +;; Auto wrap + +(defun longlines-auto-wrap (&optional arg) + "Turn on automatic line wrapping, and wrap the entire buffer. +With optional argument ARG, turn off line wrapping." + (interactive "P") + (remove-hook 'after-change-functions 'longlines-after-change-function t) + (remove-hook 'post-command-hook 'longlines-post-command-function t) + (if arg + (progn (setq longlines-auto-wrap nil) + (message "Auto wrap disabled.")) + (setq longlines-auto-wrap t) + (add-hook 'after-change-functions + 'longlines-after-change-function nil t) + (add-hook 'post-command-hook + 'longlines-post-command-function nil t) + (let ((mod (buffer-modified-p))) + (longlines-wrap-region (point-min) (point-max)) + (set-buffer-modified-p mod)) + (message "Auto wrap enabled."))) + +(defun longlines-after-change-function (beg end len) + "Update `longlines-wrap-beg' and `longlines-wrap-end'. +This is called by `after-change-functions' to keep track of the region +that has changed." + (unless undo-in-progress + (setq longlines-wrap-beg + (if longlines-wrap-beg (min longlines-wrap-beg beg) beg)) + (setq longlines-wrap-end + (if longlines-wrap-end (max longlines-wrap-end end) end)))) + +(defun longlines-post-command-function () + "Perform line wrapping on the parts of the buffer that have changed. +This is called by `post-command-hook' after each command." + (when longlines-wrap-beg + (cond ((or (eq this-command 'yank) + (eq this-command 'yank-pop)) + (longlines-decode-region (point) (mark t)) + (if longlines-showing + (longlines-show-region (point) (mark t)))) + ((and (eq this-command 'newline) longlines-showing) + (save-excursion + (if (search-backward "\n" nil t) + (longlines-show-region + (match-beginning 0) (match-end 0)))))) + (unless (or (eq this-command 'fill-paragraph) + (eq this-command 'fill-region)) + (longlines-wrap-region longlines-wrap-beg longlines-wrap-end)) + (setq longlines-wrap-beg nil) + (setq longlines-wrap-end nil))) + +(defun longlines-window-change-function () + "Re-wrap the buffer if the window width has changed. +This is called by `window-size-change-functions'." + (when (/= fill-column (- (window-width) window-min-width)) + (setq fill-column (- (window-width) window-min-width)) + (let ((mod (buffer-modified-p))) + (longlines-wrap-region (point-min) (point-max)) + (set-buffer-modified-p mod)))) + +;; Loading and saving + +(add-to-list + 'format-alist + (list 'longlines "Automatically wrap long lines." nil + 'longlines-decode-region 'longlines-encode-region t nil)) + +(provide 'longlines) + +;; arch-tag: 3489d225-5506-47b9-8659-d8807b77c624 +;;; longlines.el ends here diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 559963589a1..de88b37d91e 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -1622,13 +1622,15 @@ a remote mailbox, PASSWORD is the password if it should be supplied as a separate argument to `movemail' or nil otherwise, GOT-PASSWORD is non-nil if the user has supplied the password interactively. " - (if (string-match "^\\([^:]+\\)://\\(\\([^:@]+\\)\\(:\\([^@]+\\)\\)?@\\)?.*" file) + (cond + ((string-match "^\\([^:]+\\)://\\(\\([^:@]+\\)\\(:\\([^@]+\\)\\)?@\\)?.*" file) (let (got-password supplied-password (proto (match-string 1 file)) (user (match-string 3 file)) (pass (match-string 5 file)) (host (substring file (or (match-end 2) (+ 3 (match-end 1)))))) + (if (not pass) (when rmail-remote-password-required (setq got-password (not (rmail-have-password))) @@ -1645,8 +1647,22 @@ is non-nil if the user has supplied the password interactively. (list file (or (string-equal proto "pop") (string-equal proto "imap")) supplied-password - got-password))) - (list file nil nil nil))) + got-password)))) + + ((string-match "^po:\\([^:]+\\)\\(:\\(.*\\)\\)?" file) + (let (got-password supplied-password + (proto "pop") + (user (match-string 1 file)) + (host (match-string 3 file))) + + (when rmail-remote-password-required + (setq got-password (not (rmail-have-password))) + (setq supplied-password (rmail-get-remote-password nil))) + + (list file "pop" supplied-password got-password))) + + (t + (list file nil nil nil)))) (defun rmail-insert-inbox-text (files renamep) ;; Detect a locked file now, so that we avoid moving mail @@ -1686,15 +1702,7 @@ is non-nil if the user has supplied the password interactively. (expand-file-name buffer-file-name)))) ;; Always use movemail to rename the file, ;; since there can be mailboxes in various directories. - (setq movemail t) -;;; ;; If getting from mail spool directory, -;;; ;; use movemail to move rather than just renaming, -;;; ;; so as to interlock with the mailer. -;;; (setq movemail (string= file -;;; (file-truename -;;; (concat rmail-spool-directory -;;; (file-name-nondirectory file))))) - (if (and movemail (not popmail)) + (if (not popmail) (progn ;; On some systems, /usr/spool/mail/foo is a directory ;; and the actual inbox is /usr/spool/mail/foo/foo. @@ -1716,23 +1724,6 @@ is non-nil if the user has supplied the password interactively. ((or (file-exists-p tofile) (and (not popmail) (not (file-exists-p file)))) nil) - ((and (not movemail) (not popmail)) - ;; Try copying. If that fails (perhaps no space) and - ;; we're allowed to blow away the inbox, rename instead. - (if rmail-preserve-inbox - (copy-file file tofile nil) - (condition-case nil - (copy-file file tofile nil) - (error - ;; Third arg is t so we can replace existing file TOFILE. - (rename-file file tofile t)))) - ;; Make the real inbox file empty. - ;; Leaving it deleted could cause lossage - ;; because mailers often won't create the file. - (if (not rmail-preserve-inbox) - (condition-case () - (write-region (point) (point) file) - (file-error nil)))) (t (with-temp-buffer (let ((errors (current-buffer))) diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el index 3f24c952d89..6b769f53801 100644 --- a/lisp/mail/supercite.el +++ b/lisp/mail/supercite.el @@ -838,7 +838,7 @@ error occurs." "Return the mail header field value associated with FIELD. If there was no mail header with FIELD as its key, return the value of `sc-mumble'. FIELD is case insensitive." - (or (cdr (assoc (downcase field) sc-mail-info)) sc-mumble)) + (or (cdr (assoc-string field sc-mail-info 'case-fold)) sc-mumble)) (defun sc-mail-field-query (arg) "View the value of a mail field. @@ -916,8 +916,8 @@ Match addresses of the style ``<name[stuff]>.''" "Get the full email address path from FROM. AUTHOR is the author's name (which is removed from the address)." (let ((eos (length from))) - (if (string-match (concat "\\(^\\|^\"\\)" author - "\\(\\s +\\|\"\\s +\\)") from 0) + (if (string-match (concat "\\`\"?" (regexp-quote author) + "\"?\\s +") from 0) (let ((address (substring from (match-end 0) eos))) (if (and (= (aref address 0) ?<) (= (aref address (1- (length address))) ?>)) @@ -1866,10 +1866,11 @@ Note on function names in this list: all functions of the form (define-minor-mode sc-minor-mode "Supercite minor mode." - nil (" SC" (sc-auto-fill-region-p - (":f" (sc-fixup-whitespace-p "w")) - (sc-fixup-whitespace-p ":w"))) - `((,sc-mode-map-prefix . ,sc-mode-map))) + :group 'supercite + :lighter (" SC" (sc-auto-fill-region-p + (":f" (sc-fixup-whitespace-p "w")) + (sc-fixup-whitespace-p ":w"))) + :keymap `((,sc-mode-map-prefix . ,sc-mode-map))) ;;;###autoload (defun sc-cite-original () @@ -2054,5 +2055,5 @@ more information. Info node `(SC)Top'." (provide 'supercite) (run-hooks 'sc-load-hook) -;;; arch-tag: a5d5bfa6-3bd5-4414-8c65-0afc83e45cd3 +;; arch-tag: a5d5bfa6-3bd5-4414-8c65-0afc83e45cd3 ;;; supercite.el ends here diff --git a/lisp/master.el b/lisp/master.el index ce4144f087c..b9908e82b55 100644 --- a/lisp/master.el +++ b/lisp/master.el @@ -1,6 +1,6 @@ ;;; master.el --- make a buffer the master over another buffer -;; Copyright (C) 1999, 2000, 2001 Alexander Schroeder +;; Copyright (C) 1999, 2000, 2001, 2005 Alexander Schroeder ;; Author: Alex Schroeder <alex@gnu.org> ;; Maintainer: Alex Schroeder <alex@gnu.org> @@ -55,7 +55,10 @@ ;;; Code: -(require 'easy-mmode) +(defgroup master nil + "Support for master/slave relationships between buffers." + :version "22.1" + :group 'convenience) ;; Variables that don't need initialization. @@ -83,16 +86,13 @@ following commands: The slave buffer is stored in the buffer-local variable `master-of'. You can set this variable using `master-set-slave'. You can show yourself the value of `master-of' by calling `master-show-slave'." - ;; The initial value. - nil - ;; The indicator for the mode line. - nil - ;; The minor mode bindings. - '(("\C-c\C-n" . master-says-scroll-up) - ("\C-c\C-p" . master-says-scroll-down) - ("\C-c<" . master-says-beginning-of-buffer) - ("\C-c>" . master-says-end-of-buffer) - ("\C-c\C-l" . master-says-recenter))) + :group 'master + :keymap + '(("\C-c\C-n" . master-says-scroll-up) + ("\C-c\C-p" . master-says-scroll-down) + ("\C-c<" . master-says-beginning-of-buffer) + ("\C-c>" . master-says-end-of-buffer) + ("\C-c\C-l" . master-says-recenter))) ;; Initialize Master mode by setting a slave buffer. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index d988cae1260..273d4739b4d 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -136,7 +136,7 @@ A large number or nil slows down menu responsiveness." '(menu-item "--")) (define-key menu-bar-file-menu [recover-session] - '(menu-item "Recover Crashed Session..." recover-session + '(menu-item "Recover Crashed Session" recover-session :enable (and auto-save-list-file-prefix (file-directory-p (file-name-directory auto-save-list-file-prefix)) @@ -298,7 +298,7 @@ A large number or nil slows down menu responsiveness." '(menu-item "Continue Tags Search" tags-loop-continue :help "Continue last tags search operation")) (define-key menu-bar-search-menu [tags-srch] - '(menu-item "Search tagged files" tags-search + '(menu-item "Search tagged files..." tags-search :help "Search for a regexp in all tagged files")) (define-key menu-bar-search-menu [separator-tag-search] '(menu-item "--")) @@ -342,7 +342,7 @@ A large number or nil slows down menu responsiveness." '(menu-item "Continue Replace" tags-loop-continue :help "Continue last tags replace operation")) (define-key menu-bar-replace-menu [tags-repl] - '(menu-item "Replace in tagged files" tags-query-replace + '(menu-item "Replace in tagged files..." tags-query-replace :help "Interactively replace a regexp in all tagged files")) (define-key menu-bar-replace-menu [separator-replace-tags] '(menu-item "--")) @@ -377,14 +377,14 @@ A large number or nil slows down menu responsiveness." (defvar menu-bar-goto-menu (make-sparse-keymap "Go To")) (define-key menu-bar-goto-menu [set-tags-name] - '(menu-item "Set Tags File Name" visit-tags-table + '(menu-item "Set Tags File Name..." visit-tags-table :help "Tell Tags commands which tag table file to use")) (define-key menu-bar-goto-menu [separator-tag-file] '(menu-item "--")) (define-key menu-bar-goto-menu [apropos-tags] - '(menu-item "Tags Apropos" tags-apropos + '(menu-item "Tags Apropos..." tags-apropos :help "Find function/variables whose names match regexp")) (define-key menu-bar-goto-menu [next-tag-otherw] '(menu-item "Next Tag in Other Window" @@ -673,7 +673,7 @@ by \"Save Options\" in Custom buffers.") '("--")) (define-key menu-bar-options-menu [mouse-set-font] - '(menu-item "Set Font/Fontset" mouse-set-font + '(menu-item "Set Font/Fontset..." mouse-set-font :visible (display-multi-font-p) :help "Select a font from list of known fonts/fontsets")) @@ -1332,10 +1332,10 @@ key (or menu-item)")) (define-key menu-bar-manuals-menu [sep3] '("--")) (define-key menu-bar-manuals-menu [command] - '(menu-item "Find Command in Manual" Info-goto-emacs-command-node + '(menu-item "Find Command in Manual..." Info-goto-emacs-command-node :help "Display manual section that describes a command")) (define-key menu-bar-manuals-menu [key] - '(menu-item "Find Key in Manual" Info-goto-emacs-key-command-node + '(menu-item "Find Key in Manual..." Info-goto-emacs-key-command-node :help "Display manual section that describes a key")) (define-key menu-bar-help-menu [eliza] @@ -1369,7 +1369,7 @@ key (or menu-item)")) (define-key menu-bar-help-menu [sep2] '("--")) (define-key menu-bar-help-menu [finder-by-keyword] - '(menu-item "Find Emacs Packages..." finder-by-keyword + '(menu-item "Find Emacs Packages" finder-by-keyword :help "Find packages and features by keyword")) (define-key menu-bar-help-menu [manuals] (list 'menu-item "More Manuals" menu-bar-manuals-menu diff --git a/lisp/mouse.el b/lisp/mouse.el index fdc99205780..a409efadeca 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -49,7 +49,7 @@ :version "22.1" :group 'mouse) -(defcustom mouse-1-click-follows-link 350 +(defcustom mouse-1-click-follows-link 450 "Non-nil means that clicking Mouse-1 on a link follows the link. With the default setting, an ordinary Mouse-1 click on a link @@ -837,6 +837,29 @@ at the same position." (funcall action pos)) (t action))))))) +(defun mouse-fixup-help-message (msg) + "Fix help message MSG for `mouse-1-click-follows-link'." + (let (mp pos) + (if (and mouse-1-click-follows-link + (stringp msg) + (save-match-data + (string-match "^mouse-2" msg)) + (setq mp (mouse-pixel-position)) + (consp (setq pos (cdr mp))) + (car pos) (>= (car pos) 0) + (cdr pos) (>= (cdr pos) 0) + (setq pos (posn-at-x-y (car pos) (cdr pos) (car mp))) + (windowp (posn-window pos))) + (with-current-buffer (window-buffer (posn-window pos)) + (if (mouse-on-link-p pos) + (setq msg (concat + (cond + ((eq mouse-1-click-follows-link 'double) "double-") + ((and (integerp mouse-1-click-follows-link) + (< mouse-1-click-follows-link 0)) "Long ") + (t "")) + "mouse-1" (substring msg 7))))))) + msg) (defun mouse-drag-region-1 (start-event) (mouse-minibuffer-check start-event) @@ -886,6 +909,7 @@ at the same position." (track-mouse (while (progn (setq event (read-event)) + (setq mve (cons event (and (boundp 'mve) mve))) (or (mouse-movement-p event) (memq (car-safe event) '(switch-frame select-window)))) (if (memq (car-safe event) '(switch-frame select-window)) @@ -997,7 +1021,7 @@ at the same position." (= (window-start start-window) start-window-start))) (if (and on-link - (not end-point) + (or (not end-point) (= end-point start-point)) (consp event) (or remap-double-click (and diff --git a/lisp/msb.el b/lisp/msb.el index 2ab7fe5491d..0bcdad314a6 100644 --- a/lisp/msb.el +++ b/lisp/msb.el @@ -1,7 +1,7 @@ ;;; msb.el --- customizable buffer-selection with multiple menus -;; Copyright (C) 1993, 94, 95, 97, 98, 99, 2000, 2001, 2003 -;; Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2003, +;; 2005 Free Software Foundation, Inc. ;; Author: Lars Lindberg <lars.lindberg@home.se> ;; Maintainer: FSF @@ -1141,7 +1141,7 @@ variable `msb-menu-cond'." With arg, turn Msb mode on if and only if arg is positive. This mode overrides the binding(s) of `mouse-buffer-menu' to provide a different buffer menu using the function `msb'." - :global t + :global t :group 'msb (if msb-mode (progn (add-hook 'menu-bar-update-hook 'msb-menu-bar-update-buffers) diff --git a/lisp/international/iso-acc.el b/lisp/obsolete/iso-acc.el index 6c94f4aa562..740fa942c13 100644 --- a/lisp/international/iso-acc.el +++ b/lisp/obsolete/iso-acc.el @@ -1,6 +1,7 @@ ;;; iso-acc.el --- minor mode providing electric accent keys -;; Copyright (C) 1993, 1994, 1996, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1996, 2001, 2002, 2005 +;; Free Software Foundation, Inc. ;; Author: Johan Vromans ;; Maintainer: FSF @@ -487,5 +488,5 @@ Noninteractively, this operates on text from START to END." (add-hook 'minibuffer-setup-hook 'iso-acc-minibuf-setup) -;;; arch-tag: 149ff409-7c3e-4574-9b5d-ac038939c0a6 +;; arch-tag: 149ff409-7c3e-4574-9b5d-ac038939c0a6 ;;; iso-acc.el ends here diff --git a/lisp/pcvs.el b/lisp/pcvs.el index b00de07e50f..e7139d9cfba 100644 --- a/lisp/pcvs.el +++ b/lisp/pcvs.el @@ -358,7 +358,7 @@ from the current buffer." (dir default-directory) (buf (cond (name (cvs-get-buffer-create name)) - ((and (bufferp cvs-temp-buffer) (buffer-name cvs-temp-buffer)) + ((and (bufferp cvs-temp-buffer) (buffer-live-p cvs-temp-buffer)) cvs-temp-buffer) (t (set (make-local-variable 'cvs-temp-buffer) @@ -528,39 +528,49 @@ If non-nil, NEW means to create a new buffer no matter what." (files (nth 1 dir+files+rest)) (rest (nth 2 dir+files+rest))) - ;; setup the (current) process buffer - (set (make-local-variable 'cvs-postprocess) - (if (null rest) - ;; this is the last invocation - postprocess - ;; else, we have to register ourselves to be rerun on the rest - `(cvs-run-process ',args ',rest ',postprocess ',single-dir))) (add-hook 'kill-buffer-hook (lambda () (let ((proc (get-buffer-process (current-buffer)))) (when (processp proc) (set-process-filter proc nil) - (set-process-sentinel proc nil) - (delete-process proc)))) + ;; Abort postprocessing but leave the sentinel so it + ;; will update the list of running procs. + (process-put proc 'cvs-postprocess nil) + (interrupt-process proc)))) nil t) ;; create the new process and setup the procbuffer correspondingly - (let* ((args (append (cvs-flags-query 'cvs-cvs-flags nil 'noquery) + (let* ((msg (cvs-header-msg args fis)) + (args (append (cvs-flags-query 'cvs-cvs-flags nil 'noquery) (if cvs-cvsroot (list "-d" cvs-cvsroot)) args files)) ;; If process-connection-type is nil and the repository ;; is accessed via SSH, a bad interaction between libc, ;; CVS and SSH can lead to garbled output. - ;; It might be a glibc-specific problem (but it also happens + ;; It might be a glibc-specific problem (but it can also happens ;; under Mac OS X, it seems). - ;; Until the problem is cleared, we'll use a pty rather than - ;; a pipe. - ;; (process-connection-type nil) ; Use a pipe, not a pty. + ;; It seems that using a pty can help circumvent the problem, + ;; but at the cost of screwing up when the process thinks it + ;; can ask for user input (such as password or host-key + ;; confirmation). A better workaround is to set CVS_RSH to + ;; an appropriate script, or to use a later version of CVS. + (process-connection-type nil) ; Use a pipe, not a pty. (process ;; the process will be run in the selected dir (let ((default-directory (cvs-expand-dir-name dir))) (apply 'start-process "cvs" procbuf cvs-program args)))) + ;; setup the process. + (process-put process 'cvs-buffer cvs-buffer) + (with-current-buffer cvs-buffer (cvs-update-header msg 'add)) + (process-put process 'cvs-header msg) + (process-put + process 'cvs-postprocess + (if (null rest) + ;; this is the last invocation + postprocess + ;; else, we have to register ourselves to be rerun on the rest + `(cvs-run-process ',args ',rest ',postprocess ',single-dir))) (set-process-sentinel process 'cvs-sentinel) (set-process-filter process 'cvs-update-filter) (set-marker (process-mark process) (point-max)) @@ -636,33 +646,35 @@ If non-nil, NEW means to create a new buffer no matter what." This is responsible for parsing the output from the cvs update when it is finished." (when (memq (process-status proc) '(signal exit)) - (if (null (buffer-name (process-buffer proc))) - ;;(set-process-buffer proc nil) - (error "cvs' process buffer was killed") - (let* ((obuf (current-buffer)) - (procbuffer (process-buffer proc))) - (set-buffer (with-current-buffer procbuffer cvs-buffer)) - (setq cvs-mode-line-process (symbol-name (process-status proc))) - (force-mode-line-update) - (set-buffer procbuffer) - (let ((cvs-postproc cvs-postprocess)) - ;; Since the buffer and mode line will show that the - ;; process is dead, we can delete it now. Otherwise it - ;; will stay around until M-x list-processes. - (delete-process proc) - (setq cvs-postprocess nil) - ;; do the postprocessing like parsing and such - (save-excursion (eval cvs-postproc)) - ;; check whether something is left - (unless cvs-postprocess - ;; IIRC, we enable undo again once the process is finished - ;; for cases where the output was inserted in *vc-diff* or - ;; in a file-like buffer. -stef - (buffer-enable-undo) - (with-current-buffer cvs-buffer - (message "CVS process has completed in %s" (buffer-name))))) - ;; This might not even be necessary - (set-buffer obuf))))) + (let ((cvs-postproc (process-get proc 'cvs-postprocess)) + (cvs-buf (process-get proc 'cvs-buffer))) + ;; Since the buffer and mode line will show that the + ;; process is dead, we can delete it now. Otherwise it + ;; will stay around until M-x list-processes. + (process-put proc 'postprocess nil) + (delete-process proc) + ;; Don't do anything if the main buffer doesn't exist any more. + (when (buffer-live-p cvs-buf) + (with-current-buffer cvs-buf + (cvs-update-header (process-get proc 'cvs-header) nil) + (setq cvs-mode-line-process (symbol-name (process-status proc))) + (force-mode-line-update) + (when cvs-postproc + (if (null (buffer-live-p (process-buffer proc))) + ;;(set-process-buffer proc nil) + (error "cvs' process buffer was killed") + (with-current-buffer (process-buffer proc) + ;; do the postprocessing like parsing and such + (save-excursion (eval cvs-postproc)) + ;; check whether something is left + (unless (get-buffer-process (current-buffer)) + ;; IIRC, we enable undo again once the process is finished + ;; for cases where the output was inserted in *vc-diff* or + ;; in a file-like buffer. --Stef + (buffer-enable-undo) + (with-current-buffer cvs-buffer + (message "CVS process has completed in %s" + (buffer-name)))))))))))) (defun cvs-parse-process (dcd &optional subdir old-fis) "Parse the output of a cvs process. @@ -770,7 +782,7 @@ before calling the real function `" (symbol-name fun-1) "'.\n") (defun-cvs-mode cvs-mode-kill-process () "Kill the temporary buffer and associated process." (interactive) - (when (and (bufferp cvs-temp-buffer) (buffer-name cvs-temp-buffer)) + (when (and (bufferp cvs-temp-buffer) (buffer-live-p cvs-temp-buffer)) (let ((proc (get-buffer-process cvs-temp-buffer))) (when proc (delete-process proc))))) @@ -906,23 +918,28 @@ This usually doesn't really work but is a handy initval in a prompt." ;;;; ;;;###autoload -(defun cvs-checkout (modules dir flags) +(defun cvs-checkout (modules dir flags &optional root) "Run a 'cvs checkout MODULES' in DIR. Feed the output to a *cvs* buffer, display it in the current window, and run `cvs-mode' on it. With a prefix argument, prompt for cvs FLAGS to use." (interactive - (list (cvs-string->strings (read-string "Module(s): " (cvs-get-module))) - (read-directory-name "CVS Checkout Directory: " - nil default-directory nil) - (cvs-add-branch-prefix - (cvs-flags-query 'cvs-checkout-flags "cvs checkout flags")))) + (let ((root (cvs-get-cvsroot))) + (if (or (null root) current-prefix-arg) + (setq root (read-string "CVS Root: "))) + (list (cvs-string->strings (read-string "Module(s): " (cvs-get-module))) + (read-directory-name "CVS Checkout Directory: " + nil default-directory nil) + (cvs-add-branch-prefix + (cvs-flags-query 'cvs-checkout-flags "cvs checkout flags")) + root))) (when (eq flags t) (setf flags (cvs-flags-query 'cvs-checkout-flags nil 'noquery))) - (cvs-cmd-do "checkout" (or dir default-directory) - (append flags modules) nil 'new - :noexist t)) + (let ((cvs-cvsroot root)) + (cvs-cmd-do "checkout" (or dir default-directory) + (append flags modules) nil 'new + :noexist t))) (defun-cvs-mode (cvs-mode-checkout . NOARGS) (dir) "Run cvs checkout against the current branch. @@ -1133,7 +1150,7 @@ Full documentation is in the Texinfo file." (eq (ewoc-buffer cvs-cookies) buf) (setq check 'cvs-temp-buffer) (or (null cvs-temp-buffer) - (null (buffer-name cvs-temp-buffer)) + (null (buffer-live-p cvs-temp-buffer)) (and (eq (with-current-buffer cvs-temp-buffer cvs-buffer) buf) (equal (with-current-buffer cvs-temp-buffer default-directory) @@ -1822,11 +1839,6 @@ POSTPROC is a list of expressions to be evaluated at the very end (after ;; absence of `cvs update' output has a specific meaning. (or fis (list (cvs-create-fileinfo 'DIRCHANGE "" "." "")))))) (push `(cvs-parse-process ',dont-change-disc nil ',old-fis) postproc))) - (let ((msg (cvs-header-msg args fis))) - (cvs-update-header msg 'add) - (push `(with-current-buffer cvs-buffer - (cvs-update-header ',msg nil)) - postproc)) (setq postproc (if (cdr postproc) (cons 'progn postproc) (car postproc))) (with-current-buffer buf (let ((inhibit-read-only t)) (erase-buffer)) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 457177d7c4c..bafc901d3d1 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1613,6 +1613,8 @@ and overlay is highlighted between MK and END-MK." (compilation-set-window-height w) (when highlight-regexp + (if (timerp next-error-highlight-timer) + (cancel-timer next-error-highlight-timer)) (unless compilation-highlight-overlay (setq compilation-highlight-overlay (make-overlay (point-min) (point-min))) @@ -1632,8 +1634,11 @@ and overlay is highlighted between MK and END-MK." (move-overlay compilation-highlight-overlay (point) end (current-buffer))) (if (numberp next-error-highlight) - (sit-for next-error-highlight)) - (if (not (eq next-error-highlight t)) + (setq next-error-highlight-timer + (run-at-time next-error-highlight nil 'delete-overlay + compilation-highlight-overlay))) + (if (not (or (eq next-error-highlight t) + (numberp next-error-highlight))) (delete-overlay compilation-highlight-overlay)))))) (when (and (eq next-error-highlight 'fringe-arrow)) (set (make-local-variable 'overlay-arrow-position) diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el index b16381cd2c7..9dfd4dd9e26 100644 --- a/lisp/progmodes/cwarn.el +++ b/lisp/progmodes/cwarn.el @@ -1,6 +1,6 @@ ;;; cwarn.el --- highlight suspicious C and C++ constructions -;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2005 Free Software Foundation, Inc. ;; Author: Anders Lindgren <andersl@andersl.com> ;; Keywords: c, languages, faces @@ -193,7 +193,7 @@ be included in the variable `cwarn-configuration'. By default C and C++ modes are included. With ARG, turn CWarn mode on if and only if arg is positive." - nil cwarn-mode-text nil + :group 'cwarn :lighter cwarn-mode-text (cwarn-font-lock-keywords cwarn-mode) (if font-lock-mode (font-lock-fontify-buffer))) diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index fdb7fffac6c..4c8b847b7cd 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -597,41 +597,32 @@ characters long.") ;; Hideshow support. (defconst f90-end-block-re - (concat "^[ \t0-9]*\\<end\\>[ \t]*" + (concat "^[ \t0-9]*\\<end[ \t]*" (regexp-opt '("do" "if" "forall" "function" "interface" - "module" "program" "select" "subroutine" + "module" "program" "select" "subroutine" "type" "where" ) t) "[ \t]*\\sw*") - "Regexp matching the end of a \"block\" of F90 code. + "Regexp matching the end of an F90 \"block\", from the line start. Used in the F90 entry in `hs-special-modes-alist'.") ;; Ignore the fact that FUNCTION, SUBROUTINE, WHERE, FORALL have a -;; following "(". DO, CASE, IF can have labels; IF must be -;; accompanied by THEN. -;; A big problem is that many of these statements can be broken over -;; lines, even with embedded comments. We only try to handle this for -;; IF ... THEN statements, assuming and hoping it will be less common -;; for other constructs. We match up to one new-line, provided ") -;; THEN" appears on one line. Matching on just ") THEN" is no good, -;; since that includes ELSE branches. -;; For a fully accurate solution, hideshow would probably have to be -;; modified to allow functions as well as regexps to be used to -;; specify block start and end positions. +;; following "(". DO, CASE, IF can have labels. (defconst f90-start-block-re (concat "^[ \t0-9]*" ; statement number "\\(\\(" "\\(\\sw+[ \t]*:[ \t]*\\)?" ; structure label - "\\(do\\|select[ \t]*case\\|if[ \t]*(.*\n?.*)[ \t]*then\\|" + "\\(do\\|select[ \t]*case\\|" + ;; See comments in fortran-start-block-re for the problems of IF. + "if[ \t]*(\\(.*\\|" + ".*\n\\([^if]*\\([^i].\\|.[^f]\\|.\\>\\)\\)\\)\\<then\\|" ;; Distinguish WHERE block from isolated WHERE. "\\(where\\|forall\\)[ \t]*(.*)[ \t]*\\(!\\|$\\)\\)\\)" "\\|" "program\\|interface\\|module\\|type\\|function\\|subroutine" - ;; ") THEN" at line end. Problem - also does ELSE. -;;; "\\|.*)[ \t]*then[ \t]*\\($\\|!\\)" "\\)" "[ \t]*") - "Regexp matching the start of a \"block\" of F90 code. + "Regexp matching the start of an F90 \"block\", from the line start. A simple regexp cannot do this in fully correct fashion, so this tries to strike a compromise between complexity and flexibility. Used in the F90 entry in `hs-special-modes-alist'.") @@ -1305,12 +1296,12 @@ Checks for consistency of block types and labels (if present). Does not check the outermost block, because it may be incomplete. Interactively, pushes mark before moving point." (interactive "p") + (if (interactive-p) (push-mark (point) t)) (and num (< num 0) (f90-end-of-block (- num))) (let ((case-fold-search t) (count (or num 1)) end-list end-this end-type end-label start-this start-type start-label) - (if (interactive-p) (push-mark (point) t)) (beginning-of-line) ; probably want this (while (and (> count 0) (re-search-backward f90-blocks-re nil 'move)) (beginning-of-line) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 70150111a86..7067ddca21c 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -964,7 +964,7 @@ Convert it to flymake internal format." (if (consp file) (setq file (car file))) (if (consp line) (setq line (car line))) (if (consp col) (setq col (car col))) - + (when (not (functionp line)) (setq converted-list (cons (list regexp file line col) converted-list))))) converted-list)) @@ -1508,7 +1508,7 @@ Return first 'INCLUDE-DIRS/REL-FILE-NAME' that exists, or just REL-FILE-NAME if "Minor mode to do on-the-fly syntax checking. When called interactively, toggles the minor mode. With arg, turn Flymake mode on if and only if arg is positive." - :lighter flymake-mode-line + :group 'flymake :lighter flymake-mode-line (if flymake-mode (if (flymake-can-syntax-check-file (buffer-file-name)) (flymake-mode-on) diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index 768012c736c..30e1977d28d 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -1,7 +1,7 @@ ;;; fortran.el --- Fortran mode for GNU Emacs -;; Copyright (c) 1986, 93, 94, 95, 97, 98, 99, 2000, 01, 03, 04 -;; Free Software Foundation, Inc. +;; Copyright (C) 1986, 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001, +;; 2003, 2004, 2005 Free Software Foundation, Inc. ;; Author: Michael D. Prange <prange@erl.mit.edu> ;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk> @@ -95,7 +95,7 @@ with a character in column 6." :group 'fortran-indent) (defcustom fortran-if-indent 3 - "*Extra indentation applied to IF blocks." + "*Extra indentation applied to IF, SELECT CASE and WHERE blocks." :type 'integer :group 'fortran-indent) @@ -321,7 +321,8 @@ program\\|subroutine\\)\\>[ \t]*\\(\\sw+\\)?" "while" "inquire" "stop" "return" "include" "open" "close" "read" "write" "format" "print" "select" "case" - "cycle" "exit" "rewind" "backspace") + "cycle" "exit" "rewind" "backspace" + "where" "elsewhere") 'paren) "\\>") ;; Builtin operators. (concat "\\." (regexp-opt @@ -370,6 +371,29 @@ program\\|subroutine\\)\\>[ \t]*\\(\\sw+\\)?" fortran-font-lock-keywords-2))) "Gaudy level highlighting for Fortran mode.") +(defvar fortran-font-lock-keywords-4 + (append fortran-font-lock-keywords-3 + (list (list + (concat "\\<" + (regexp-opt + '("int" "ifix" "idint" "real" "float" "sngl" + "dble" "cmplx" "ichar" "char" "aint" "dint" + "anint" "dnint" "nint" "idnint" "iabs" "abs" + "dabs" "cabs" "mod" "amod" "dmod" "isign" + "sign" "dsign" "idim" "dim" "ddim" "dprod" + "max" "max0" "amax1" "dmax1" "amax0" "max1" + "min0" "amin1" "dmin1" "amin0" "min1" "len" + "index" "lge" "lgt" "lle" "llt" "aimag" + "conjg" "sqrt" "dsqrt" "csqrt" "exp" "dexp" + "cexp" "log" "alog" "dlog" "clog" "log10" + "alog10" "dlog10" "sin" "dsin" "csin" "cos" + "dcos" "ccos" "tan" "dtan" "asin" "dasin" + "acos" "dacos" "atan" "datan" "atan2" "datan2" + "sinh" "dsinh" "cosh" "dcosh" "tanh" "dtanh") + 'paren) "[ \t]*(") '(1 font-lock-builtin-face)))) + "Maximum highlighting for Fortran mode. +Consists of level 3 plus all other intrinsics not already highlighted.") + ;; Comments are real pain in Fortran because there is no way to ;; represent the standard comment syntax in an Emacs syntax table. ;; (We can do so for F90-style). Therefore an unmatched quote in a @@ -409,6 +433,64 @@ These get fixed-format comments fontified.") "Value for `imenu-generic-expression' in Fortran mode.") +;; Hideshow support. +(defconst fortran-blocks-re + (concat "block[ \t]*data\\|select[ \t]*case\\|" + (regexp-opt '("do" "if" "interface" "function" "map" "program" + "structure" "subroutine" "union" "where"))) + "Regexp potentially indicating the start or end of a Fortran \"block\". +Omits naked END statements, and DO-loops closed by anything other +than ENDDO.") + +(defconst fortran-end-block-re + ;; Do-loops terminated by things other than ENDDO cannot be handled + ;; with a regexp. This omission does not seem to matter to hideshow... + (concat "^[ \t0-9]*\\<end[ \t]*\\(" + fortran-blocks-re + ;; Naked END statement. + "\\|!\\|$\\)") + "Regexp matching the end of a Fortran \"block\", from the line start. +Note that only ENDDO is handled for the end of a DO-loop. Used +in the Fortran entry in `hs-special-modes-alist'.") + +(defconst fortran-start-block-re + (concat + "^[ \t0-9]*\\(" ; statement number + ;; Structure label for DO, IF, SELECT, WHERE. + "\\(\\(\\sw+[ \t]*:[ \t]*\\)?" + ;; IF blocks are a nuisance: + ;; IF ( ... ) foo is not a block, but a single statement. + ;; IF ( ... ) THEN can be split over multiple lines. + ;; [So can, eg, a DO WHILE (... ), but that is less common, I hope.] + ;; The regexp below allows for it to be split over at most 2 lines. + ;; That leads to the problem of not matching two consecutive IF + ;; statements as one, eg: + ;; IF ( ... ) foo + ;; IF ( ... ) THEN + ;; It simply is not possible to do this in a 100% correct fashion + ;; using a regexp - see the functions fortran-end-if, + ;; fortran-beginning-if for the hoops we have to go through. + ;; An alternative is to match on THEN at a line end, eg: + ;; ".*)[ \t]*then[ \t]*\\($\\|!\\)" + ;; This would also match ELSE branches, though. This does not seem + ;; right to me, because then one has neighbouring blocks that are + ;; not nested in each other. + "\\(if[ \t]*(\\(.*\\|" + ".*\n\\([^if]*\\([^i].\\|.[^f]\\|.\\>\\)\\)\\)\\<then\\|" + "do\\|select[ \t]*case\\|where\\)\\)\\|" + (regexp-opt '("interface" "function" "map" "program" + "structure" "subroutine" "union")) + "\\|block[ \t]*data\\)[ \t]*") + "Regexp matching the start of a Fortran \"block\", from the line start. +A simple regexp cannot do this in fully correct fashion, so this +tries to strike a compromise between complexity and flexibility. +Used in the Fortran entry in `hs-special-modes-alist'.") + +(add-to-list 'hs-special-modes-alist + `(fortran-mode ,fortran-start-block-re ,fortran-end-block-re + "^[cC*!]" fortran-end-of-block nil)) + + (defvar fortran-mode-syntax-table (let ((table (make-syntax-table))) ;; We might like `;' to be punctuation (g77 multi-statement @@ -422,7 +504,8 @@ These get fixed-format comments fontified.") (modify-syntax-entry ?/ "." table) (modify-syntax-entry ?\' "\"" table) (modify-syntax-entry ?\" "\"" table) - ;; Consistent with GNU Fortran -- see the manual. + ;; Consistent with GNU Fortran's default -- see the manual. + ;; The F77 standard imposes no rule on this issue. (modify-syntax-entry ?\\ "\\" table) ;; This might be better as punctuation, as for C, but this way you ;; can treat floating-point numbers as symbols. @@ -446,6 +529,8 @@ These get fixed-format comments fontified.") (define-key map "\C-c;" 'fortran-comment-region) (define-key map "\M-;" 'fortran-indent-comment) (define-key map "\M-\n" 'fortran-split-line) + (define-key map "\M-\C-n" 'fortran-end-of-block) + (define-key map "\M-\C-p" 'fortran-beginning-of-block) (define-key map "\M-\C-q" 'fortran-indent-subprogram) (define-key map "\C-c\C-w" 'fortran-window-create-momentarily) (define-key map "\C-c\C-r" 'fortran-column-ruler) @@ -606,7 +691,7 @@ Key definitions: Variables controlling indentation style and extra features: -`comment-start' +`fortran-comment-line-start' To use comments starting with `!', set this to the string \"!\". `fortran-do-indent' Extra indentation within DO blocks (default 3). @@ -696,7 +781,8 @@ with no args, if that value is non-nil." '((fortran-font-lock-keywords fortran-font-lock-keywords-1 fortran-font-lock-keywords-2 - fortran-font-lock-keywords-3) + fortran-font-lock-keywords-3 + fortran-font-lock-keywords-4) nil t ((?/ . "$/") ("_$" . "w")) fortran-beginning-of-subprogram)) (set (make-local-variable 'font-lock-syntactic-keywords) @@ -1059,6 +1145,84 @@ Directive lines are treated as comments." (if (not not-last-statement) 'last-statement))) +(defun fortran-looking-at-if-then () + "Return non-nil if at the start of a line with an IF ... THEN statement." + ;; cf f90-looking-at-if-then. + (let ((p (point)) + (i (fortran-beginning-if))) + (if i + (save-excursion + (goto-char i) + (beginning-of-line) + (= (point) p))))) + +;; Used in hs-special-modes-alist. +(defun fortran-end-of-block (&optional num) + "Move point forward to the end of the current code block. +With optional argument NUM, go forward that many balanced blocks. +If NUM is negative, go backward to the start of a block. Does +not check for consistency of block types. Interactively, pushes +mark before moving point." + (interactive "p") + (if (interactive-p) (push-mark (point) t)) + (and num (< num 0) (fortran-beginning-of-block (- num))) + (let ((case-fold-search t) + (count (or num 1))) + (end-of-line) + (while (and (> count 0) + (re-search-forward + (concat "\\(" fortran-blocks-re + (if fortran-check-all-num-for-matching-do + "\\|^[ \t]*[0-9]+" "") + "\\|continue\\|end\\)\\>") + nil 'move)) + (beginning-of-line) + (if (if (looking-at (concat "^[0-9 \t]*" fortran-if-start-re)) + (fortran-looking-at-if-then) + (looking-at fortran-start-block-re)) + (setq count (1+ count)) + (if (or (looking-at fortran-end-block-re) + (and (or (looking-at "^[0-9 \t]*continue") + (and fortran-check-all-num-for-matching-do + (looking-at "[ \t]*[0-9]+"))) + (fortran-check-for-matching-do))) + (setq count (1- count)))) + (end-of-line)) + (if (> count 0) (error "Missing block end")))) + +(defun fortran-beginning-of-block (&optional num) + "Move point backwards to the start of the current code block. +With optional argument NUM, go backward that many balanced +blocks. If NUM is negative, go forward to the end of a block. +Does not check for consistency of block types. Interactively, +pushes mark before moving point." + (interactive "p") + (if (interactive-p) (push-mark (point) t)) + (and num (< num 0) (fortran-end-of-block (- num))) + (let ((case-fold-search t) + (count (or num 1))) + (beginning-of-line) + (while (and (> count 0) + (re-search-backward + (concat "\\(" fortran-blocks-re + (if fortran-check-all-num-for-matching-do + "\\|^[ \t]*[0-9]+" "") + "\\|continue\\|end\\)\\>") + nil 'move)) + (beginning-of-line) + (if (if (looking-at (concat "^[0-9 \t]*" fortran-if-start-re)) + (fortran-looking-at-if-then) + (looking-at fortran-start-block-re)) + (setq count (1- count)) + (if (or (looking-at fortran-end-block-re) + (and (or (looking-at "^[0-9 \t]*continue") + (and fortran-check-all-num-for-matching-do + (looking-at "[ \t]*[0-9]+"))) + (fortran-check-for-matching-do))) + (setq count (1+ count))))) + ;; Includes an un-named main program block. + (if (> count 0) (error "Missing block start")))) + (defun fortran-blink-match (regex keyword find-begin) "From a line matching REGEX, blink matching KEYWORD statement line. @@ -1679,8 +1843,9 @@ If ALL is nil, only match comments that start in column > 0." (1+ (point))))) (if (re-search-forward "\\S\"\\s\"\\S\"" eol t) (backward-char 2)) - ;; If the current string is longer than 72 - 6 chars, - ;; break it at the fill column (else infinite loop). + ;; If the current string is longer than (fill-column + ;; - 6) chars, break it at the fill column (else + ;; infinite loop). (if (> (- (point) start) (- fill-column 6 fortran-continuation-indent)) fcpoint diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el index dea40b8db19..7aff14ec608 100644 --- a/lisp/progmodes/glasses.el +++ b/lisp/progmodes/glasses.el @@ -1,6 +1,6 @@ ;;; glasses.el --- make cantReadThis readable -;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2005 Free Software Foundation, Inc. ;; Author: Milan Zamazal <pdm@zamazal.org> ;; Maintainer: Milan Zamazal <pdm@zamazal.org> @@ -251,7 +251,7 @@ recognized according to the current value of the variable `glasses-separator'." "Minor mode for making identifiers likeThis readable. When this mode is active, it tries to add virtual separators (like underscores) at places they belong to." - nil " o^o" nil + :group 'glasses :lighter " o^o" (save-excursion (save-restriction (widen) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 0988599ed54..1f9284db9cb 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -531,6 +531,9 @@ off the specialized speedbar mode." (defvar gdb-first-prompt t) +(defvar gud-filter-pending-text nil + "Non-nil means this is text that has been saved for later in `gud-filter'.") + ;;;###autoload (defun gdb (command-line) "Run gdb on program FILE in buffer *gud-FILE*. @@ -562,6 +565,7 @@ and source-file directory for your debugger." (setq comint-prompt-regexp "^(.*gdb[+]?) *") (setq paragraph-start comint-prompt-regexp) (setq gdb-first-prompt t) + (setq gud-filter-pending-text nil) (run-hooks 'gdb-mode-hook)) ;; One of the nice features of GDB is its impressive support for @@ -2445,9 +2449,6 @@ comint mode, which see." "Non-nil means don't process anything from the debugger right now. It is saved for when this flag is not set.") -(defvar gud-filter-pending-text nil - "Non-nil means this is text that has been saved for later in `gud-filter'.") - ;; These functions are responsible for inserting output from your debugger ;; into the buffer. The hard work is done by the method that is ;; the value of gud-marker-filter. @@ -2516,19 +2517,22 @@ It is saved for when this flag is not set.") (gud-filter proc "")))))) (defvar gud-minor-mode-type nil) +(defvar gud-overlay-arrow-position nil) +(put 'gud-overlay-arrow-position 'overlay-arrow-string "=>") +(add-to-list 'overlay-arrow-variable-list 'gud-overlay-arrow-position) (defun gud-sentinel (proc msg) (cond ((null (buffer-name (process-buffer proc))) ;; buffer killed ;; Stop displaying an arrow in a source file. - (setq overlay-arrow-position nil) + (setq gud-overlay-arrow-position nil) (set-process-buffer proc nil) (if (memq gud-minor-mode-type '(gdbmi gdba)) (gdb-reset) (gud-reset))) ((memq (process-status proc) '(signal exit)) ;; Stop displaying an arrow in a source file. - (setq overlay-arrow-position nil) + (setq gud-overlay-arrow-position nil) (with-current-buffer gud-comint-buffer (if (memq gud-minor-mode-type '(gdbmi gdba)) (gdb-reset) @@ -2611,13 +2615,13 @@ Obeying it means displaying in another window the specified file and line." (goto-line line) (setq pos (point)) (setq overlay-arrow-string "=>") - (or overlay-arrow-position - (setq overlay-arrow-position (make-marker))) - (set-marker overlay-arrow-position (point) (current-buffer))) + (or gud-overlay-arrow-position + (setq gud-overlay-arrow-position (make-marker))) + (set-marker gud-overlay-arrow-position (point) (current-buffer))) (cond ((or (< pos (point-min)) (> pos (point-max))) (widen) (goto-char pos)))) - (if window (set-window-point window overlay-arrow-position)))))) + (if window (set-window-point window gud-overlay-arrow-position)))))) ;; The gud-call function must do the right thing whether its invoking ;; keystroke is from the GUD buffer itself (via major-mode binding) diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index da6b6f772b6..23031c5bcda 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -1,6 +1,6 @@ ;;; hideif.el --- hides selected code within ifdef -;; Copyright (C) 1988,1994,2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 1988, 1994, 2001, 2002, 2005 Free Software Foundation, Inc. ;; Author: Daniel LaLiberte <liberte@holonexus.org> ;; Maintainer: FSF @@ -197,7 +197,7 @@ how the hiding is done: After `show-ifdefs', read-only status is restored to previous value. \\{hide-ifdef-mode-map}" - nil " Ifdef" nil + :group 'hide-ifdef :lighter " Ifdef" (if hide-ifdef-mode (progn ;; inherit global values diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 20af0aaf96e..5073f2bc23a 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1098,28 +1098,40 @@ Don't save anything for STR matching `inferior-python-filter-regexp'." (defvar python-preoutput-continuation nil "If non-nil, funcall this when `python-preoutput-filter' sees `_emacs_ok'.") +(defvar python-preoutput-leftover nil) + ;; Using this stops us getting lines in the buffer like ;; >>> ... ... >>> ;; Also look for (and delete) an `_emacs_ok' string and call ;; `python-preoutput-continuation' if we get it. (defun python-preoutput-filter (s) "`comint-preoutput-filter-functions' function: ignore prompts not at bol." + (when python-preoutput-leftover + (setq s (concat python-preoutput-leftover s)) + (setq python-preoutput-leftover nil)) (cond ((and (string-match (rx (and string-start (repeat 3 (any ".>")) - " " string-end)) - s) - (/= (let ((inhibit-field-text-motion t)) - (line-beginning-position)) - (point))) - "") - ((string= s "_emacs_ok\n") - (when python-preoutput-continuation - (funcall python-preoutput-continuation) - (setq python-preoutput-continuation nil)) - "") - ((string-match "_emacs_out \\(.*\\)\n" s) - (setq python-preoutput-result (match-string 1 s)) + " " string-end)) + s) + (/= (let ((inhibit-field-text-motion t)) + (line-beginning-position)) + (point))) + "") + ((string= s "_emacs_ok\n") + (when python-preoutput-continuation + (funcall python-preoutput-continuation) + (setq python-preoutput-continuation nil)) + "") + ((string-match "_emacs_out \\(.*\\)\n" s) + (setq python-preoutput-result (match-string 1 s)) + "") + ((string-match ".*\n" s) + s) + ((or (eq t (compare-strings s nil nil "_emacs_ok\n" nil (length s))) + (let ((end (min (length "_emacs_out ") (length s)))) + (eq t (compare-strings s nil end "_emacs_out " nil end)))) + (setq python-preoutput-leftover s) "") - (t s))) + (t s))) ;;;###autoload (defun run-python (&optional cmd noshow) @@ -1359,7 +1371,9 @@ The result is what follows `_emacs_out' in the output (or nil)." (let ((proc (python-proc))) (python-send-string string) (setq python-preoutput-result nil) - (accept-process-output proc 5) + (while (progn + (accept-process-output proc 5) + python-preoutput-leftover)) python-preoutput-result)) ;; Fixme: try to make it work with point in the arglist. Also, is diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index d9ffea852d1..c792b59ad87 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -90,7 +90,7 @@ (modify-syntax-entry ?\] ")[ " st) (modify-syntax-entry ?{ "(} " st) (modify-syntax-entry ?} "){ " st) - (modify-syntax-entry ?\| " 23" st) + (modify-syntax-entry ?\| "\" 23b" st) ;; Other atom delimiters (modify-syntax-entry ?\( "() " st) @@ -103,7 +103,7 @@ ;; Special characters (modify-syntax-entry ?, "' " st) (modify-syntax-entry ?@ "' " st) - (modify-syntax-entry ?# "' 14" st) + (modify-syntax-entry ?# "' 14bn" st) (modify-syntax-entry ?\\ "\\ " st) st)) diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index 4dba6b61a56..24ae19b0ad4 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -1,6 +1,7 @@ ;;; tcl.el --- Tcl code editing commands for Emacs -;; Copyright (C) 1994,98,1999,2000,01,02,2003,2004 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 +;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Author: Tom Tromey <tromey@redhat.com> @@ -469,10 +470,7 @@ Uses variables `tcl-proc-regexp' and `tcl-keyword-list'." ;; Keywords. Only recognized if surrounded by whitespace. ;; FIXME consider using "not word or symbol", not ;; "whitespace". - (cons (concat "\\(\\s-\\|^\\)" - ;; FIXME Use regexp-quote? - (regexp-opt tcl-keyword-list t) - "\\(\\s-\\|$\\)") + (cons (concat "\\_<" (regexp-opt tcl-keyword-list t) "\\_>") 2)))) (if tcl-proc-regexp @@ -1507,5 +1505,5 @@ The first line is assumed to look like \"#!.../program ...\"." (provide 'tcl) -;;; arch-tag: 8a032554-c3ef-422e-b84c-acec0522179d +;; arch-tag: 8a032554-c3ef-422e-b84c-acec0522179d ;;; tcl.el ends here diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index dae5722d430..d329e234025 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -1,6 +1,7 @@ ;;; which-func.el --- print current function in mode line -;; Copyright (C) 1994, 1997, 1998, 2001, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1997, 1998, 2001, 2003, 2005 +;; Free Software Foundation, Inc. ;; Author: Alex Rezinsky <alexr@msil.sps.mot.com> ;; (doesn't seem to be responsive any more) @@ -251,7 +252,7 @@ If no function name is found, return nil." (when (and (null name) (boundp 'imenu--index-alist) (null imenu--index-alist) (null which-function-imenu-failed)) - (imenu--make-index-alist) + (imenu--make-index-alist t) (unless imenu--index-alist (make-local-variable 'which-function-imenu-failed) (setq which-function-imenu-failed t))) @@ -291,5 +292,5 @@ If no function name is found, return nil." (provide 'which-func) -;;; arch-tag: fa8a55c7-bfe3-4ffc-95ab-01bf21796827 +;; arch-tag: fa8a55c7-bfe3-4ffc-95ab-01bf21796827 ;;; which-func.el ends here diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el index 6f14538ff4d..ba858959cc3 100644 --- a/lisp/ps-mule.el +++ b/lisp/ps-mule.el @@ -511,7 +511,10 @@ element of the list." (defsubst ps-mule-printable-p (charset) "Non-nil if characters in CHARSET is printable." - (ps-mule-get-font-spec charset 'normal)) + ;; ASCII and Latin-1 are always printable. + (or (eq charset 'ascii) + (eq charset 'latin-iso8859-1) + (ps-mule-get-font-spec charset 'normal))) (defconst ps-mule-external-libraries '((builtin nil nil @@ -824,7 +827,9 @@ Returns the value: Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of the sequence." - (setq ps-mule-current-charset (charset-after from)) + (let ((ch (char-after from))) + (setq ps-mule-current-charset + (char-charset (or (aref ps-print-translation-table ch) ch)))) (let* ((wrappoint (ps-mule-find-wrappoint from to (ps-avg-char-width 'ps-font-for-text))) (to (car wrappoint)) @@ -832,6 +837,10 @@ the sequence." (ps-font-alist 'ps-font-for-text)))) (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type)) (string (buffer-substring-no-properties from to))) + (dotimes (i (length string)) + (let ((ch (aref ps-print-translation-table (aref string i)))) + (if ch + (aset string i ch)))) (cond ((= from to) ;; We can't print any more characters in the current line. @@ -1393,6 +1402,7 @@ FONTTAG should be a string \"/h0\" or \"/h1\"." (defun ps-mule-show-warning (charsets from to header-footer-list) (let ((table (make-category-table)) (buf (current-buffer)) + (max-unprintable-chars 15) char-pos-list) (define-category ?u "Unprintable charset" table) (dolist (cs charsets) @@ -1400,19 +1410,22 @@ FONTTAG should be a string \"/h0\" or \"/h1\"." (with-category-table table (save-excursion (goto-char from) - (while (and (< (length char-pos-list) 20) + (while (and (<= (length char-pos-list) max-unprintable-chars) (re-search-forward "\\cu" to t)) - (push (cons (preceding-char) (1- (point))) char-pos-list)) - (setq char-pos-list (nreverse char-pos-list)))) + (push (cons (preceding-char) (1- (point))) char-pos-list)))) (with-output-to-temp-buffer "*Warning*" (with-current-buffer standard-output (when char-pos-list (let ((func #'(lambda (buf pos) (when (buffer-live-p buf) (pop-to-buffer buf) - (goto-char pos))))) + (goto-char pos)))) + (more nil)) + (if (>= (length char-pos-list) max-unprintable-chars) + (setq char-pos-list (cdr char-pos-list) + more t)) (insert "These characters in the buffer can't be printed:\n") - (dolist (elt char-pos-list) + (dolist (elt (nreverse char-pos-list)) (insert " ") (insert-text-button (string (car elt)) :type 'help-xref @@ -1421,8 +1434,10 @@ FONTTAG should be a string \"/h0\" or \"/h1\"." 'help-function func 'help-args (list buf (cdr elt))) (insert ",")) - ;; Delete the last comma. - (delete-char -1) + (if more + (insert " and more...") + ;; Delete the last comma. + (delete-char -1)) (insert "\nClick them to jump to the buffer position,\n" (substitute-command-keys "\ or \\[universal-argument] \\[what-cursor-position] will give information about them.\n")))) @@ -1469,13 +1484,15 @@ This checks if all multi-byte characters in the region are printable or not." (setq ps-mule-charset-list (delq 'ascii (delq 'eight-bit-control (delq 'eight-bit-graphic - (find-charset-region from to)))) + (find-charset-region + from to ps-print-translation-table)))) ps-mule-header-charsets (delq 'ascii (delq 'eight-bit-control (delq 'eight-bit-graphic (find-charset-string (mapconcat - 'identity header-footer-list "")))))) + 'identity header-footer-list "") + ps-print-translation-table))))) (dolist (cs ps-mule-charset-list) (or (ps-mule-printable-p cs) (push cs unprintable-charsets))) diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 726b0e4402c..b47ea3d4f89 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -6150,6 +6150,19 @@ XSTART YSTART are the relative position for the first page in a sheet.") (defvar ps-current-effect 0) +(defvar ps-print-translation-table + (let ((tbl (make-char-table 'translation-table nil))) + (if (and (boundp 'ucs-mule-8859-to-mule-unicode) + (char-table-p ucs-mule-8859-to-mule-unicode)) + (map-char-table + #'(lambda (k v) + (if (and v (eq (char-charset v) 'latin-iso8859-1) (/= k v)) + (aset tbl k v))) + ucs-mule-8859-to-mule-unicode)) + tbl) + "Translation table for PostScript printing. +The default value is a table that translates non-Latin-1 Latin characters +to the equivalent Latin-1 characters.") (defun ps-plot-region (from to font &optional fg-color bg-color effects) (or (equal font ps-current-font) @@ -6240,11 +6253,17 @@ XSTART YSTART are the relative position for the first page in a sheet.") (ps-plot 'ps-mule-plot-composition match-point (point) bg-color)) ((> match 255) ; a multi-byte character + (setq match (or (aref ps-print-translation-table match) match)) (let* ((charset (char-charset match)) (composition (ps-e-find-composition match-point to)) (stop (if (nth 2 composition) (car composition) to))) (or (eq charset 'composition) - (while (and (< (point) stop) (eq (charset-after) charset)) + (while (and (< (point) stop) + (let ((ch (following-char))) + (setq ch + (or (aref ps-print-translation-table ch) + ch)) + (eq (char-charset ch) charset))) (forward-char 1))) (ps-plot 'ps-mule-plot-string match-point (point) bg-color))) ; characters from ^@ to ^_ and diff --git a/lisp/register.el b/lisp/register.el index 253207c3140..eaa53446c56 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -277,7 +277,7 @@ Interactively, second arg is non-nil if prefix arg is supplied." Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions indicating what to copy." (interactive "cCopy to register: \nr\nP") - (set-register register (buffer-substring start end)) + (set-register register (filter-buffer-substring start end)) (if delete-flag (delete-region start end))) (defun append-to-register (register start end &optional delete-flag) @@ -289,7 +289,7 @@ START and END are buffer positions indicating what to append." (or (stringp (get-register register)) (error "Register does not contain text")) (set-register register (concat (get-register register) - (buffer-substring start end))) + (filter-buffer-substring start end))) (if delete-flag (delete-region start end))) (defun prepend-to-register (register start end &optional delete-flag) @@ -300,7 +300,7 @@ START and END are buffer positions indicating what to prepend." (interactive "cPrepend to register: \nr\nP") (or (stringp (get-register register)) (error "Register does not contain text")) - (set-register register (concat (buffer-substring start end) + (set-register register (concat (filter-buffer-substring start end) (get-register register))) (if delete-flag (delete-region start end))) diff --git a/lisp/reveal.el b/lisp/reveal.el index eb6b4519f38..97411fc1669 100644 --- a/lisp/reveal.el +++ b/lisp/reveal.el @@ -163,8 +163,8 @@ (let ((map (make-sparse-keymap))) ;; Override the default move-beginning-of-line and move-end-of-line ;; which skips valuable invisible text. - (define-key map [?\C-a] 'beginning-of-line) - (define-key map [?\C-e] 'end-of-line) + (define-key map [remap move-beginning-of-line] 'beginning-of-line) + (define-key map [remap move-end-of-line] 'end-of-line) map)) ;;;###autoload @@ -175,6 +175,7 @@ Reveal mode renders invisible text around point visible again. Interactively, with no prefix argument, toggle the mode. With universal prefix ARG (or if ARG is nil) turn mode on. With zero or negative ARG turn mode off." + :group 'reveal :lighter (global-reveal-mode nil " Reveal") :keymap reveal-mode-map (if reveal-mode diff --git a/lisp/simple.el b/lisp/simple.el index 20563dc5433..22716a819f4 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -35,6 +35,13 @@ (autoload 'widget-convert "wid-edit") (autoload 'shell-mode "shell")) +(defcustom idle-update-delay 0.5 + "*Idle time delay before updating various things on the screen. +Various Emacs features that update auxiliary information when point moves +wait this many seconds after Emacs becomes idle before doing an update." + :type 'number + :group 'display + :version "22.1") (defgroup killing nil "Killing and yanking commands." @@ -105,6 +112,8 @@ If `fringe-arrow', indicate the locus by the fringe arrow." :group 'next-error :version "22.1") +(defvar next-error-highlight-timer nil) + (defvar next-error-last-buffer nil "The most recent next-error buffer. A buffer becomes most recent when its compilation, grep, or @@ -293,7 +302,7 @@ select the source buffer." When turned on, cursor motion in the compilation, grep, occur or diff buffer causes automatic display of the corresponding source code location." - nil " Fol" nil + :group 'next-error :init-value " Fol" (if (not next-error-follow-minor-mode) (remove-hook 'post-command-hook 'next-error-follow-mode-post-command-hook t) (add-hook 'post-command-hook 'next-error-follow-mode-post-command-hook nil t) @@ -2216,6 +2225,42 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]." (reset-this-command-lengths) (restore-overriding-map)) +(defvar buffer-substring-filters nil + "List of filter functions for `filter-buffer-substring'. +Each function must accept a single argument, a string, and return +a string. The buffer substring is passed to the first function +in the list, and the return value of each function is passed to +the next. The return value of the last function is used as the +return value of `filter-buffer-substring'. + +If this variable is nil, no filtering is performed.") + +(defun filter-buffer-substring (beg end &optional delete) + "Return the buffer substring between BEG and END, after filtering. +The buffer substring is passed through each of the filter +functions in `buffer-substring-filters', and the value from the +last filter function is returned. If `buffer-substring-filters' +is nil, the buffer substring is returned unaltered. + +If DELETE is non-nil, the text between BEG and END is deleted +from the buffer. + +Point is temporarily set to BEG before caling +`buffer-substring-filters', in case the functions need to know +where the text came from. + +This function should be used instead of `buffer-substring' or +`delete-and-extract-region' when you want to allow filtering to +take place. For example, major or minor modes can use +`buffer-substring-filters' to extract characters that are special +to a buffer, and should not be copied into other buffers." + (save-excursion + (goto-char beg) + (let ((string (if delete (delete-and-extract-region beg end) + (buffer-substring beg end)))) + (dolist (filter buffer-substring-filters string) + (setq string (funcall filter string)))))) + ;;;; Window system cut and paste hooks. (defvar interprogram-cut-function nil @@ -2396,7 +2441,7 @@ specifies the yank-handler text property to be set on the killed text. See `insert-for-yank'." (interactive "r") (condition-case nil - (let ((string (delete-and-extract-region beg end))) + (let ((string (filter-buffer-substring beg end t))) (when string ;STRING is nil if BEG = END ;; Add that string to the kill ring, one way or another. (if (eq last-command 'kill-region) @@ -2432,8 +2477,8 @@ If `interprogram-cut-function' is non-nil, also save the text for a window system cut and paste." (interactive "r") (if (eq last-command 'kill-region) - (kill-append (buffer-substring beg end) (< end beg)) - (kill-new (buffer-substring beg end))) + (kill-append (filter-buffer-substring beg end) (< end beg)) + (kill-new (filter-buffer-substring beg end))) (if transient-mark-mode (setq deactivate-mark t)) nil) @@ -2958,7 +3003,7 @@ the user to see that the mark has moved, and you want the previous mark position to be lost. Normally, when a new mark is set, the old one should go on the stack. -This is why most applications should use push-mark, not set-mark. +This is why most applications should use `push-mark', not `set-mark'. Novice Emacs Lisp programmers often try to use the mark for the wrong purposes. The mark saves a location for the user's convenience. @@ -5186,14 +5231,6 @@ See also `normal-erase-is-backspace'." (message "Delete key deletes %s" (if normal-erase-is-backspace "forward" "backward")))) -(defcustom idle-update-delay 0.5 - "*Idle time delay before updating various things on the screen. -Various Emacs features that update auxiliary information when point moves -wait this many seconds after Emacs becomes idle before doing an update." - :type 'number - :group 'display - :version "22.1") - (defvar vis-mode-saved-buffer-invisibility-spec nil "Saved value of `buffer-invisibility-spec' when Visible mode is on.") @@ -5205,6 +5242,7 @@ Enabling Visible mode makes all invisible text temporarily visible. Disabling Visible mode turns off that effect. Visible mode works by saving the value of `buffer-invisibility-spec' and setting it to nil." :lighter " Vis" + :group 'editing-basics (when (local-variable-p 'vis-mode-saved-buffer-invisibility-spec) (setq buffer-invisibility-spec vis-mode-saved-buffer-invisibility-spec) (kill-local-variable 'vis-mode-saved-buffer-invisibility-spec)) diff --git a/lisp/smerge-mode.el b/lisp/smerge-mode.el index 35903dcf749..d6a93a935d6 100644 --- a/lisp/smerge-mode.el +++ b/lisp/smerge-mode.el @@ -1,6 +1,6 @@ ;;; smerge-mode.el --- Minor mode to resolve diff3 conflicts -;; Copyright (C) 1999, 2000, 01, 03, 2004 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2003, 2004, 2005 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@cs.yale.edu> ;; Keywords: revision-control merge diff3 cvs conflict @@ -667,7 +667,7 @@ buffer names." (define-minor-mode smerge-mode "Minor mode to simplify editing output from the diff3 program. \\{smerge-mode-map}" - nil " SMerge" nil + :group 'smerge :lighter " SMerge" (when (and (boundp 'font-lock-mode) font-lock-mode) (set (make-local-variable 'font-lock-multiline) t) (save-excursion diff --git a/lisp/startup.el b/lisp/startup.el index aa7a16d1356..e3c2617c420 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1008,8 +1008,27 @@ If this is nil, no message will be displayed." using the mouse.\n\n" :face (variable-pitch :weight bold) "Important Help menu items:\n" - :face variable-pitch "\ -Emacs Tutorial\tLearn-by-doing tutorial for using Emacs efficiently + :face variable-pitch + (lambda () + (let* ((en "TUTORIAL") + (tut (or (get-language-info current-language-environment + 'tutorial) + en)) + (title (with-temp-buffer + (insert-file-contents + (expand-file-name tut data-directory) + nil 0 256) + (search-forward ".") + (buffer-substring (point-min) (1- (point)))))) + ;; If there is a specific tutorial for the current language + ;; environment and it is not English, append its title. + (concat + "Emacs Tutorial\tLearn how to use Emacs efficiently" + (if (string= en tut) + "" + (concat " (" title ")")) + "\n"))) + :face variable-pitch "\ Emacs FAQ\tFrequently asked questions and answers Read the Emacs Manual\tView the Emacs manual using Info \(Non)Warranty\tGNU Emacs comes with " @@ -1073,14 +1092,18 @@ Values less than 60 seconds are ignored." (defun fancy-splash-insert (&rest args) "Insert text into the current buffer, with faces. -Arguments from ARGS should be either strings or pairs `:face FACE', +Arguments from ARGS should be either strings, functions called +with no args that return a string, or pairs `:face FACE', where FACE is a valid face specification, as it can be used with `put-text-properties'." (let ((current-face nil)) (while args (if (eq (car args) :face) (setq args (cdr args) current-face (car args)) - (insert (propertize (car args) + (insert (propertize (let ((it (car args))) + (if (functionp it) + (funcall it) + it)) 'face current-face 'help-echo fancy-splash-help-echo))) (setq args (cdr args))))) diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index fc677b3de44..3e5b77d8baa 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -1,6 +1,6 @@ ;;; bibtex.el --- BibTeX mode for GNU Emacs -;; Copyright (C) 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2003, 2004 +;; Copyright (C) 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2003, 2004, 2005 ;; Free Software Foundation, Inc. ;; Author: Stefan Schoef <schoef@offis.uni-oldenburg.de> @@ -784,41 +784,56 @@ Used by `bibtex-complete-crossref-cleanup' and `bibtex-copy-summary-as-kill'." (function :tag "Personalized function"))) (defcustom bibtex-generate-url-list - '((("url" . ".*:.*")) - ;; Example of a complex setup. - (("journal" . "\\<\\(PR[ABCDEL]?\\|RMP\\)\\>") - "http://link.aps.org/abstract/" - ("journal" ".*" downcase) - "/v" - ("volume" ".*" 0) - "/p" - ("pages" "\\`\\([0-9]+\\)" 1))) + '((("url" . ".*:.*"))) "List of schemes for generating the URL of a BibTeX entry. These schemes are used by `bibtex-url'. -Each scheme is of the form ((FIELD . REGEXP) STEP...). +Each scheme should have one of these forms: -FIELD is a field name as returned by `bibtex-parse-entry'. -REGEXP is matched against the text of FIELD. If the match succeeds, then -this scheme is used. If no STEPs are specified the matched text is used -as the URL, otherwise the URL is built by concatenating the STEPs. - -A STEP can be a string or a list (FIELD REGEXP REPLACE) in which case -the text of FIELD is matched against REGEXP, and is replaced with REPLACE. -REPLACE can be a string, or a number (which selects the corresponding submatch) -or a function called with the field's text as argument and with the -`match-data' properly set. + ((FIELD . REGEXP)) + ((FIELD . REGEXP) STEP...) + ((FIELD . REGEXP) STRING STEP...) -Case is always ignored. Always remove the field delimiters." +FIELD is a field name as returned by `bibtex-parse-entry'. +REGEXP is matched against the text of FIELD. If the match succeeds, +then this scheme is used. If no STRING and STEPs are specified +the matched text is used as the URL, otherwise the URL is built +by evaluating STEPs. If no STRING is specified the STEPs must result +in strings which are concatenated. Otherwise the resulting objects +are passed through `format' using STRING as format control string. + +A STEP is a list (FIELD REGEXP REPLACE). The text of FIELD +is matched against REGEXP, and is replaced with REPLACE. +REPLACE can be a string, or a number (which selects the corresponding +submatch), or a function called with the field's text as argument +and with the `match-data' properly set. + +Case is always ignored. Always remove the field delimiters. + +The following is a complex example, see http://link.aps.org/linkfaq.html. + + (((\"journal\" . \"\\\\=<\\(PR[ABCDEL]?\\|RMP\\)\\\\=>\") + \"http://link.aps.org/abstract/%s/v%s/p%s\" + (\"journal\" \".*\" downcase) + (\"volume\" \".*\" 0) + (\"pages\" \"\\`[A-Z]?[0-9]+\" 0)))" :group 'bibtex :type '(repeat - (list :tag "Scheme" + (cons :tag "Scheme" (cons :tag "Matcher" :extra-offset 4 (string :tag "BibTeX field") (regexp :tag "Regexp")) - (repeat :tag "Steps to generate URL" :inline t - (choice - (string :tag "Literal text") + (choice + (const :tag "Take match as is" nil) + (cons :tag "Formatted" + (string :tag "Format control string") + (repeat :tag "Steps to generate URL" + (list (string :tag "BibTeX field") + (regexp :tag "Regexp") + (choice (string :tag "Replacement") + (integer :tag "Sub-match") + (function :tag "Filter"))))) + (repeat :tag "Concatenated" (list (string :tag "BibTeX field") (regexp :tag "Regexp") (choice (string :tag "Replacement") @@ -2662,11 +2677,10 @@ begins at the beginning of a line. We use this function for font-locking." (let ((lst bibtex-generate-url-list) url) (goto-char start) (while (and (not found) - (setq url (caar lst))) + (setq url (car (pop lst)))) (setq found (and (bibtex-string= field (car url)) (re-search-forward (cdr url) end t) - (>= (match-beginning 0) pnt)) - lst (cdr lst)))) + (>= (match-beginning 0) pnt))))) (goto-char end)) (if found (bibtex-button (match-beginning 0) (match-end 0) 'bibtex-url (match-beginning 0))) @@ -4283,39 +4297,36 @@ The URL is generated using the schemes defined in `bibtex-generate-url-list' ;; Always ignore case, (case-fold-search t) (lst bibtex-generate-url-list) - field url scheme) + field url scheme obj fmt) (while (setq scheme (pop lst)) (when (and (setq field (cdr (assoc-string (caar scheme) fields-alist t))) ;; Always remove field delimiters (progn (setq field (bibtex-remove-delimiters-string field)) (string-match (cdar scheme) field))) - (setq lst nil) - (if (null (cdr scheme)) - (setq url (match-string 0 field))) - (dolist (step (cdr scheme)) - (cond ((stringp step) - (setq url (concat url step))) - ((setq field (cdr (assoc-string (car step) fields-alist t))) - ;; Always remove field delimiters - (setq field (bibtex-remove-delimiters-string field)) - (if (string-match (nth 1 step) field) - (setq field (cond - ((functionp (nth 2 step)) - (funcall (nth 2 step) field)) - ((numberp (nth 2 step)) - (match-string (nth 2 step) field)) - (t - (replace-match (nth 2 step) t nil field)))) - ;; If the scheme is set up correctly, - ;; we should never reach this point - (error "Match failed: %s" field)) - (setq url (concat url field))) - ;; If the scheme is set up correctly, - ;; we should never reach this point - (t (error "Step failed: %s" step)))) - (message "%s" url) - (browse-url url))) + (setq lst nil + scheme (cdr scheme) + url (if (null scheme) (match-string 0 field) + (if (stringp (car scheme)) + (setq fmt (pop scheme))) + (dolist (step scheme) + ;; Always remove field delimiters + (setq field (bibtex-remove-delimiters-string + (cdr (assoc-string (car step) fields-alist t)))) + (if (string-match (nth 1 step) field) + (setq field (cond ((functionp (nth 2 step)) + (funcall (nth 2 step) field)) + ((numberp (nth 2 step)) + (match-string (nth 2 step) field)) + (t + (replace-match (nth 2 step) t nil field)))) + ;; If the scheme is set up correctly, + ;; we should never reach this point + (error "Match failed: %s" field)) + (push field obj)) + (if fmt (apply 'format fmt (nreverse obj)) + (apply 'concat (nreverse obj))))) + (browse-url (message "%s" url)))) (unless url (message "No URL known."))))) diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index 71bb6cf137d..b1b5abc488f 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -1,6 +1,6 @@ ;;; enriched.el --- read and save files in text/enriched format -;; Copyright (c) 1994, 1995, 1996, 2002, 2004 Free Software Foundation, Inc. +;; Copyright (c) 1994, 1995, 1996, 2002, 2004, 2005 Free Software Foundation, Inc. ;; Author: Boris Goldowsky <boris@gnu.org> ;; Keywords: wp, faces @@ -183,7 +183,7 @@ etc/enriched.doc in the Emacs distribution directory. Commands: \\{enriched-mode-map}" - nil " Enriched" nil + :group 'enriched :lighter " Enriched" (cond ((null enriched-mode) ;; Turn mode off (setq buffer-file-format (delq 'text/enriched buffer-file-format)) diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index ccd7f21f502..c41145befc8 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -539,6 +539,17 @@ The break position will be always after LINEBEG and generally before point." ;; Make sure we take SOMETHING after the fill prefix if any. (fill-find-break-point linebeg))))) +;; Like text-properties-at but don't include `composition' property. +(defun fill-text-properties-at (pos) + (let ((l (text-properties-at pos)) + prop-list) + (while l + (unless (eq (car l) 'composition) + (setq prop-list + (cons (car l) (cons (cadr l) prop-list)))) + (setq l (cddr l))) + prop-list)) + (defun fill-newline () ;; Replace whitespace here with one newline, then ;; indent to left margin. @@ -546,7 +557,7 @@ The break position will be always after LINEBEG and generally before point." (insert ?\n) ;; Give newline the properties of the space(s) it replaces (set-text-properties (1- (point)) (point) - (text-properties-at (point))) + (fill-text-properties-at (point))) (and (looking-at "\\( [ \t]*\\)\\(\\c|\\)?") (or (aref (char-category-set (or (char-before (1- (point))) ?\000)) ?|) (match-end 2)) diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el index ab45434526a..86406d37475 100644 --- a/lisp/textmodes/org.el +++ b/lisp/textmodes/org.el @@ -1,14 +1,14 @@ ;; org.el --- Outline-based notes management and organizer ;; Carstens outline-mode for keeping track of everything. -;; Copyright (c) 2003, 2004, 2005 Free Software Foundation - +;; Copyright (c) 2004, 2005 Free Software Foundation +;; ;; Author: Carsten Dominik <dominik at science dot uva dot nl> ;; Keywords: outlines, hypermedia, calendar ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ -;; Version: 3.04 - +;; Version: 3.05 +;; ;; 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) @@ -75,10 +75,18 @@ ;; ------------- ;; The documentation of Org-mode can be found in the TeXInfo file. ;; This distribution also contains a PDF version of it. At the homepage -;; of Org-mode, you can find and read online the same text as HTML. +;; of Org-mode, you can read online the same text online as HTML. ;; ;; Changes: ;; ------- +;; Version 3.05 +;; - Agenda entries from the diary are linked to the diary file, so +;; adding and editing diary entries can be done directly from the agenda. +;; - Many calendar/diary commands available directly from agenda. +;; - Field copying in tables with S-RET does increment. +;; - C-c C-x C-v extracts the visible part of the buffer for printing. +;; - Moving subtrees up and down preserves the whitespace at the tree end. +;; ;; Version 3.04 ;; - Table editor optimized to need fewer realignments, and to keep ;; table shape when typing in fields. @@ -213,7 +221,7 @@ ;;; Customization variables -(defvar org-version "3.04" +(defvar org-version "3.05" "The version number of the file org.el.") (defun org-version () (interactive) @@ -241,7 +249,13 @@ :group 'org) (defcustom org-startup-folded t - "Non-nil means, entering Org-mode will switch to OVERVIEW." + "Non-nil means, entering Org-mode will switch to OVERVIEW. +This can also be configured on a per-file basis by adding one of +the following lines anywhere in the buffer: + + #+STARTUP: fold + #+STARTUP: nofold +" :group 'org-startup :type 'boolean) @@ -255,7 +269,13 @@ uninteresting. Also tables look terrible when wrapped." (defcustom org-startup-with-deadline-check nil "Non-nil means, entering Org-mode will run the deadline check. This means, if you start editing an org file, you will get an -immediate reminder of any due deadlines." +immediate reminder of any due deadlines. +This can also be configured on a per-file basis by adding one of +the following lines anywhere in the buffer: + + #+STARTUP: dlcheck + #+STARTUP: nodlcheck +" :group 'org-startup :type 'boolean) @@ -534,6 +554,11 @@ When nil, cursor will remain in the current window." :group 'org-agenda :type 'boolean) +(defcustom org-fit-agenda-window t + "Non-nil means, change windo size of agenda to fit content." + :group 'org-agenda + :type 'boolean) + (defcustom org-agenda-show-all-dates t "Non-nil means, `org-agenda' shows every day in the selected range. When nil, only the days which actually have entries are shown." @@ -892,7 +917,7 @@ slight (in fact: unnoticable) speed impact for normal typing. Org-mode is very good at guessing when a re-align will be necessary, but you can always force one with `C-c C-c'. -I you would like to use the optimized version in Org-mode, but the un-optimized +If you would like to use the optimized version in Org-mode, but the un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'. This variable can be used to turn on and off the table editor during a session, @@ -971,6 +996,11 @@ line will be formatted with <th> tags." :group 'org-table :type 'boolean) +(defcustom org-table-copy-increment t + "Non-nil means, increment when copying current field with \\[org-table-copy-down]." + :group 'org-table + :type 'boolean) + (defcustom org-table-tab-recognizes-table.el t "Non-nil means, TAB will automatically notice a table.el table. When it sees such a table, it moves point into it and - if necessary - @@ -1260,7 +1290,7 @@ Otherwise, the buffer will just be saved to a file and stay hidden." "Face used for level 7 headlines." :group 'org-faces) -(defface org-level-8-face ;;font-lock-string-face +(defface org-level-8-face ;; font-lock-string-face '((((type tty) (class color)) (:foreground "green")) (((class color) (background light)) (:foreground "RosyBrown")) (((class color) (background dark)) (:foreground "LightSalmon")) @@ -1276,8 +1306,24 @@ Otherwise, the buffer will just be saved to a file and stay hidden." "Face for deadlines and TODO keyords." :group 'org-faces) -;; Inheritance does not work for xemacs, unfortunately. -;; We just copy the definitions and waste some space.... +(defcustom org-fontify-done-headline nil + "Non-nil means, change the face of a headline if it is marked DONE. +Normally, only the TODO/DONE keyword indicates the state of a headline. +When this is non-nil, the headline after the keyword is set to the +`org-headline-done-face' as an additional indication." + :group 'org-faces + :type 'boolean) + +(defface org-headline-done-face ;; font-lock-string-face + '((((type tty) (class color)) (:foreground "green")) + (((class color) (background light)) (:foreground "RosyBrown")) + (((class color) (background dark)) (:foreground "LightSalmon")) + (t (:italic t))) + "Face used to indicate that a headline is DONE. See also the variable +`org-fontify-done-headline'." + :group 'org-faces) + +;; Inheritance does not yet work for xemacs. So we just copy... (defface org-deadline-announce-face '((((type tty) (class color)) (:foreground "blue" :weight bold)) @@ -1341,11 +1387,11 @@ Otherwise, the buffer will just be saved to a file and stay hidden." )) (defvar org-n-levels (length org-level-faces)) - ;; Tell the compiler about dynamically scoped variables, ;; and variables from other packages (eval-when-compile (defvar zmacs-regions) + (defvar original-date) (defvar org-transient-mark-mode) (defvar org-old-auto-fill-inhibit-regexp) (defvar orgtbl-mode-menu) @@ -1521,8 +1567,11 @@ The following commands are available: (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>") '(1 'org-warning-face t)) '("^#.*" (0 'font-lock-comment-face t)) - (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>") - '(1 'org-done-face t)) + (if org-fontify-done-headline + (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>") + '(1 'org-done-face t) '(2 'org-headline-done-face t)) + (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>") + '(1 'org-done-face t))) '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" (1 'org-table-face t)) '("^[ \t]*\\(:.*\\)" (1 'org-table-face t))))) @@ -1563,7 +1612,7 @@ The following commands are available: (defvar org-cycle-global-status nil) (defvar org-cycle-subtree-status nil) (defun org-cycle (&optional arg) - "Visibility cycling for org-mode. + "Visibility cycling for Org-mode. - When this function is called with a prefix argument, rotate the entire buffer through 3 states (global cycling) @@ -1579,6 +1628,9 @@ The following commands are available: zoom in further. 3. SUBTREE: Show the entire subtree, including body text. +- When there is a numeric prefix, go ARG levels up and do a `show-subtree', + keeping cursor position. + - When point is not at the beginning of a headline, execute `indent-relative', like TAB normally does. See the option `org-cycle-emulate-tab' for details. @@ -1587,8 +1639,9 @@ The following commands are available: no headline in line 1, this function will act as if called with prefix arg." (interactive "P") - (if (and (bobp) (not (looking-at outline-regexp))) - ; special case: use global cycling + (if (or (and (bobp) (not (looking-at outline-regexp))) + (equal arg '(4))) + ;; special case: use global cycling (setq arg t)) (cond @@ -1600,7 +1653,7 @@ The following commands are available: (org-table-justify-field-maybe) (org-table-next-field)))) - (arg ;; Global cycling + ((eq arg t) ;; Global cycling (cond ((and (eq last-command this-command) @@ -1621,18 +1674,27 @@ The following commands are available: (if (bobp) (throw 'exit nil)))) (message "CONTENTS...done")) (setq org-cycle-global-status 'contents)) + ((and (eq last-command this-command) (eq org-cycle-global-status 'contents)) ;; We just showed the table of contents - now show everything (show-all) (message "SHOW ALL") (setq org-cycle-global-status 'all)) + (t ;; Default action: go to overview (hide-sublevels 1) (message "OVERVIEW") (setq org-cycle-global-status 'overview)))) + ((integerp arg) + ;; Show-subtree, ARG levels up from here. + (save-excursion + (org-back-to-heading) + (outline-up-heading arg) + (show-subtree))) + ((save-excursion (beginning-of-line 1) (looking-at outline-regexp)) ;; At a heading: rotate between three different views (org-back-to-heading) @@ -1970,7 +2032,7 @@ is changed at all." (save-excursion (outline-end-of-heading) (setq folded (org-invisible-p))) (outline-end-of-subtree)) - (if (equal (char-after) ?\n) (forward-char 1)) + (outline-next-heading) (setq end (point)) ;; Find insertion point, with error handling (goto-char beg) @@ -1982,7 +2044,10 @@ is changed at all." (if (> arg 0) ;; Moving forward - still need to move over subtree (progn (outline-end-of-subtree) - (if (equal (char-after) ?\n) (forward-char 1)))) + (outline-next-heading) + (if (not (or (looking-at (concat "^" outline-regexp)) + (bolp))) + (newline)))) (move-marker ins-point (point)) (setq txt (buffer-substring beg end)) (delete-region beg end) @@ -1993,7 +2058,7 @@ is changed at all." (defvar org-subtree-clip "" "Clipboard for cut and paste of subtrees. -This is actually only a cpoy of the kill, because we use the normal kill +This is actually only a copy of the kill, because we use the normal kill ring. We need it to check if the kill was created by `org-copy-subtree'.") (defvar org-subtree-clip-folded nil @@ -2906,6 +2971,14 @@ The following commands are available: (define-key org-agenda-mode-map "p" 'org-agenda-priority) (define-key org-agenda-mode-map "," 'org-agenda-priority) (define-key org-agenda-mode-map "i" 'org-agenda-diary-entry) +(define-key org-agenda-mode-map "c" 'org-agenda-goto-calendar) +(define-key org-agenda-mode-map "C" 'org-agenda-convert-date) +(define-key org-agenda-mode-map "m" 'org-agenda-phases-of-moon) +(define-key org-agenda-mode-map "M" 'org-agenda-phases-of-moon) +(define-key org-agenda-mode-map "s" 'org-agenda-sunrise-sunset) +(define-key org-agenda-mode-map "S" 'org-agenda-sunrise-sunset) +(define-key org-agenda-mode-map "h" 'org-agenda-holidays) +(define-key org-agenda-mode-map "H" 'org-agenda-holidays) (define-key org-agenda-mode-map "+" 'org-agenda-priority-up) (define-key org-agenda-mode-map "-" 'org-agenda-priority-down) (define-key org-agenda-mode-map [(right)] 'org-agenda-later) @@ -2951,6 +3024,12 @@ The following commands are available: :style toggle :selected org-agenda-include-diary :active t] "--" ["New Diary Entry" org-agenda-diary-entry t] + ("Calendar commands" + ["Goto calendar" org-agenda-goto-calendar t] + ["Phases of the Moon" org-agenda-phases-of-moon t] + ["Sunrise/Sunset" org-agenda-sunrise-sunset t] + ["Holidays" org-agenda-holidays t] + ["Convert" org-agenda-convert-date t]) "--" ["Quit" org-agenda-quit t] ["Exit and Release Buffers" org-agenda-exit t] @@ -3110,7 +3189,7 @@ NDAYS defaults to `org-agenda-ndays'." (d (- nt n1))) (- sd (+ (if (< d 0) 7 0) d))))) (day-numbers (list start)) - s e rtn rtnall file date d start-pos) + s e rtn rtnall file date d start-pos end-pos) (setq org-agenda-redo-command (list 'org-agenda include-all start-day ndays)) ;; Make the list of days @@ -3146,7 +3225,9 @@ NDAYS defaults to `org-agenda-ndays'." s (point)) (if (or (= d today) (and (not start-pos) (= d sd))) - (setq start-pos (point))) + (setq start-pos (point)) + (if (and start-pos (not end-pos)) + (setq end-pos (point)))) (setq files org-agenda-files rtnall nil) (while (setq file (pop files)) @@ -3173,6 +3254,17 @@ NDAYS defaults to `org-agenda-ndays'." (put-text-property s (1- (point)) 'day d)))) (goto-char (point-min)) (setq buffer-read-only t) + (if org-fit-agenda-window + (fit-window-to-buffer nil (/ (* (frame-height) 3) 4) + (/ (frame-height) 2))) + (unless (and (pos-visible-in-window-p (point-min)) + (pos-visible-in-window-p (point-max))) + (goto-char (1- (point-max))) + (recenter -1) + (if (not (pos-visible-in-window-p (or start-pos 1))) + (progn + (goto-char (or start-pos 1)) + (recenter 1)))) (goto-char (or start-pos 1)) (if (not org-select-agenda-window) (select-window win)) (message ""))) @@ -3285,10 +3377,10 @@ With prefix ARG, go back that many times `org-agenda-ndays'." "Set the mode name to indicate all the small mode seetings." (setq mode-name (concat "Org-Agenda" - (if (equal org-agenda-ndays 1) " Day" "") - (if (equal org-agenda-ndays 7) " Week" "") - (if org-agenda-follow-mode " Follow" "") - (if org-agenda-include-diary " Diary" ""))) + (if (equal org-agenda-ndays 1) " Day" "") + (if (equal org-agenda-ndays 7) " Week" "") + (if org-agenda-follow-mode " Follow" "") + (if org-agenda-include-diary " Diary" ""))) (force-mode-line-update)) (defun org-agenda-post-command-hook () @@ -3299,26 +3391,33 @@ With prefix ARG, go back that many times `org-agenda-ndays'." (defun org-get-entries-from-diary (date) "Get the (emacs calendar) diary entries for DATE." (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*") - (diary-display-hook '(sort-diary-entries fancy-diary-display)) + (diary-display-hook '(fancy-diary-display)) + (list-diary-entries-hook + (cons 'org-diary-default-entry list-diary-entries-hook)) entries - (disable-org-agenda t)) + (disable-org-diary t)) (save-excursion (save-window-excursion (list-diary-entries date 1))) (if (not (get-buffer fancy-diary-buffer)) (setq entries nil) (save-excursion - (set-buffer fancy-diary-buffer) + (switch-to-buffer fancy-diary-buffer) (setq buffer-read-only nil) (if (= (point-max) 1) ;; No entries (setq entries nil) - ;; Omit the date - (beginning-of-line 3) - (delete-region (point-min) (point)) + ;; Omit the date and other unnecessary stuff + (org-agenda-cleanup-fancy-diary) + ;; Add prefix to each line and extend the text properties + (goto-char (point-min)) (while (and (re-search-forward "^" nil t) (not (eobp))) - (replace-match " Diary: ")) - (setq entries (buffer-substring (point-min) (- (point-max) 1)))) + (replace-match " Diary: ") + (add-text-properties (point-at-bol) (point) + (text-properties-at (point)))) + (if (= (point-max) 1) + (setq entries nil) + (setq entries (buffer-substring (point-min) (- (point-max) 1))))) (set-buffer-modified-p nil) (kill-buffer fancy-diary-buffer))) (when entries @@ -3337,6 +3436,49 @@ With prefix ARG, go back that many times `org-agenda-ndays'." x) entries))))) +(defun org-agenda-cleanup-fancy-diary () + "Remove unwanted stuff in buffer created by fancy-diary-display. +This gets rid of the date, the underline under the date, and +the dummy entry installed by org-mode to ensure non-empty diary for each +date." + (goto-char (point-min)) + (if (looking-at ".*?:[ \t]*") + (progn + (replace-match "") + (re-search-forward "\n=+$" nil t) + (replace-match "") + (while (re-search-backward "^ +" nil t) (replace-match ""))) + (re-search-forward "\n=+$" nil t) + (delete-region (point-min) (min (point-max) (1+ (match-end 0))))) + (if (re-search-forward "^Org-mode dummy\n?" nil t) + (replace-match ""))) + +;; Advise the add-to-diary-list function to allow org to jump to +;; diary entires. Wrapped into eval-after-load to avoid loading +;; advice unnecessarily +(eval-after-load "diary-lib" + '(defadvice add-to-diary-list (before org-mark-diary-entry activate) + "Make the position visible." + (if (and (boundp 'disable-org-diary) ;; called from org-agenda + (stringp string) + (buffer-file-name)) + (add-text-properties + 0 (length string) + (list 'mouse-face 'highlight + 'keymap org-agenda-keymap + 'help-echo + (format + "mouse-2 or RET jump to diary file %s" + (abbreviate-file-name (buffer-file-name))) + 'org-agenda-diary-link t + 'org-marker (org-agenda-new-marker (point-at-bol))) + string)))) + +(defun org-diary-default-entry () + "Add a dummy entry to the diary. +Needed to avoid empty dates which mess up holiday display." + (add-to-diary-list original-date "Org-mode dummy" "")) + (defun org-add-file (&optional file) "Add current file to the list of files in variable `org-agenda-files'. These are the files which are being checked for agenda entries. @@ -3468,7 +3610,7 @@ function from a program - use `org-agenda-get-day-entries' instead." file rtn results) ;; If this is called during org-agenda, don't return any entries to ;; the calendar. Org Agenda will list these entries itself. - (if (boundp 'disable-org-agenda) (setq files nil)) + (if (boundp 'disable-org-diary) (setq files nil)) (while (setq file (pop files)) (setq rtn (apply 'org-agenda-get-day-entries file date args)) (setq results (append results rtn))) @@ -3864,7 +4006,6 @@ and by additional input from the age of a schedules or deadline entry." (let* ((pri (get-text-property (point-at-bol) 'priority))) (message "Priority is %d" (if pri pri -1000)))) - (defun org-agenda-goto () "Go to the Org-mode file which contains the item at point." (interactive) @@ -3875,10 +4016,11 @@ and by additional input from the age of a schedules or deadline entry." (switch-to-buffer-other-window buffer) (widen) (goto-char pos) - (org-show-hidden-entry) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))))) ; show the next heading + (when (eq major-mode 'org-mode) + (org-show-hidden-entry) + (save-excursion + (and (outline-next-heading) + (org-flag-heading nil)))))) ; show the next heading (defun org-agenda-switch-to () "Go to the Org-mode file which contains the item at point." @@ -3891,10 +4033,11 @@ and by additional input from the age of a schedules or deadline entry." (delete-other-windows) (widen) (goto-char pos) - (org-show-hidden-entry) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))))) ; show the next heading + (when (eq major-mode 'org-mode) + (org-show-hidden-entry) + (save-excursion + (and (outline-next-heading) + (org-flag-heading nil)))))) ; show the next heading (defun org-agenda-goto-mouse (ev) "Go to the Org-mode file which contains the deadline at the mouse click." @@ -3923,12 +4066,18 @@ and by additional input from the age of a schedules or deadline entry." (mouse-set-point ev) (org-agenda-show)) +(defun org-agenda-check-no-diary () + "Check if the entry is a diary link and abort if yes." + (if (get-text-property (point) 'org-agenda-diary-link) + (org-agenda-error))) + (defun org-agenda-error () (error "Command not allowed in this line.")) (defun org-agenda-todo () "Cycle TODO state of line at point, also in Org-mode file." (interactive) + (org-agenda-check-no-diary) (let* ((props (text-properties-at (point))) (col (current-column)) (marker (or (get-text-property (point) 'org-marker) @@ -3971,6 +4120,7 @@ and by additional input from the age of a schedules or deadline entry." (defun org-agenda-priority (&optional force-direction) "Set the priority of line at point, also in Org-mode file." (interactive) + (org-agenda-check-no-diary) (let* ((props (text-properties-at (point))) (col (current-column)) (marker (or (get-text-property (point) 'org-marker) @@ -4003,6 +4153,7 @@ and by additional input from the age of a schedules or deadline entry." (defun org-agenda-date-later (arg &optional what) "Change the date of this item to one day later." (interactive "p") + (org-agenda-check-no-diary) (let* ((marker (or (get-text-property (point) 'org-marker) (org-agenda-error))) (buffer (marker-buffer marker)) @@ -4022,8 +4173,9 @@ and by additional input from the age of a schedules or deadline entry." (org-agenda-date-later (- arg) what)) (defun org-agenda-date-today (arg) - "Change the date of this item to one day later." + "Change the date of this item to today." (interactive "p") + (org-agenda-check-no-diary) (let* ((marker (or (get-text-property (point) 'org-marker) (org-agenda-error))) (buffer (marker-buffer marker)) @@ -4084,7 +4236,91 @@ All the standard commands work: block, weekly etc" (get-text-property point 'day)))) (call-interactively cmd)) (fset 'calendar-cursor-to-date oldf))))) - + + +(defun org-agenda-execute-calendar-command (cmd) + "Execute a calendar command from the agenda, with the date associated to +the cursor position." + (require 'diary-lib) + (unless (get-text-property (point) 'day) + (error "Don't know which date to use for calendar command")) + (let* ((oldf (symbol-function 'calendar-cursor-to-date)) + (point (point)) + (mark (or (mark t) (point))) + (date (calendar-gregorian-from-absolute + (get-text-property point 'day))) + (displayed-day (extract-calendar-day date)) + (displayed-month (extract-calendar-month date)) + (displayed-year (extract-calendar-year date))) + (unwind-protect + (progn + (fset 'calendar-cursor-to-date + (lambda (&optional error) + (calendar-gregorian-from-absolute + (get-text-property point 'day)))) + (call-interactively cmd)) + (fset 'calendar-cursor-to-date oldf)))) + +(defun org-agenda-phases-of-moon () + "Display the phases of the moon for 3 month around cursor date." + (interactive) + (org-agenda-execute-calendar-command 'calendar-phases-of-moon)) + +(defun org-agenda-holidays () + "Display the holidays for 3 month around cursor date." + (interactive) + (org-agenda-execute-calendar-command 'list-calendar-holidays)) + +(defun org-agenda-sunrise-sunset (arg) + "Display sunrise and sunset for the cursor date. +Latitude and longitude can be specified with the variables +`calendar-latitude' and `calendar-longitude'. When called with prefix +argument, location will be prompted for." + (interactive "P") + (let ((calendar-longitude (if arg nil calendar-longitude)) + (calendar-latitude (if arg nil calendar-latitude)) + (calendar-location-name nil)) + (org-agenda-execute-calendar-command 'calendar-sunrise-sunset))) + +(defun org-agenda-goto-calendar () + "Open the Emacs calendar with the date at the cursor." + (interactive) + (let* ((day (or (get-text-property (point) 'day) + (error "Don't know which date to open in calendar"))) + (date (calendar-gregorian-from-absolute day))) + (calendar) + (calendar-goto-date date))) + +(defun org-agenda-convert-date () + (interactive) + (let ((day (get-text-property (point) 'day)) + date s) + (unless day + (error "Don't know which date to convert")) + (setq date (calendar-gregorian-from-absolute day)) + (require 'cal-julian) + (require 'cal-hebrew) + (require 'cal-islam) + (require 'cal-french) + (require 'cal-mayan) + (require 'cal-coptic) + (require 'cal-persia) + (require 'cal-china) + (setq s (concat + "Gregorian: " (calendar-date-string date) "\n" + "Julian: " (calendar-julian-date-string date) "\n" + "Astronomic: " (calendar-astro-date-string date) " (at noon UTC)\n" + "Hebrew: " (calendar-hebrew-date-string date) "\n" + "Islamic: " (calendar-islamic-date-string date) "\n" + "French: " (calendar-french-date-string date) "\n" + "Maya: " (calendar-mayan-date-string date) "\n" + "Coptic: " (calendar-coptic-date-string date) "\n" + "Persian: " (calendar-persian-date-string date) "\n" + "Chineese: " (calendar-chinese-date-string date) "\n")) + (with-output-to-temp-buffer "*Dates*" + (princ s)) + (fit-window-to-buffer (get-buffer-window "*Dates*")))) + ;;; Link Stuff (defun org-find-file-at-mouse (ev) @@ -5087,14 +5323,23 @@ Before doing so, re-align the table if necessary." (skip-chars-backward "^|\n\r") (if (looking-at " ") (forward-char 1))))) -(defun org-table-copy-from-above (n) - "Copy into the current column the nearest non-empty field from above. -With prefix argument N, take the Nth non-empty field." +(defun org-table-copy-down (n) + "Copy a field down in the current column. +If the field at the cursor is empty, copy into it the content of the nearest +non-empty field above. With argument N, use the Nth non-empty field. +If the current fields is not empty, it is copied down to the next row, and +the cursor is moved with it. Therefore, repeating this command causes the +column to be filled row-by-row. +If the variable `org-table-copy-increment' is non-nil and the field is an +integer, it will be incremented while copying." (interactive "p") - (let ((colpos (org-table-current-column)) - (beg (org-table-begin)) - txt) + (let* ((colpos (org-table-current-column)) + (field (org-table-get-field)) + (non-empty (string-match "[^ \t]" field)) + (beg (org-table-begin)) + txt) (org-table-check-inside-data-field) + (if non-empty (progn (org-table-next-row) (org-table-blank-field))) (if (save-excursion (setq txt (catch 'exit @@ -5103,10 +5348,13 @@ With prefix argument N, take the Nth non-empty field." beg t)) (org-table-goto-column colpos t) (if (and (looking-at - "|[ \t]*\\([^| \t][^|]*[^| \t]\\)[ \t]*|") + "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") (= (setq n (1- n)) 0)) (throw 'exit (match-string 1))))))) (progn + (if (and org-table-copy-increment + (string-match "^[0-9]+$" txt)) + (setq txt (format "%d" (+ (string-to-int txt) 1)))) (insert txt) (org-table-align)) (error "No non-empty field found")))) @@ -6039,7 +6287,7 @@ table editor iin arbitrary modes.") ([(shift tab)] org-table-previous-field) ("\C-c\C-c" org-table-align) ([(return)] org-table-next-row) - ([(shift return)] org-table-copy-from-above) + ([(shift return)] org-table-copy-down) ([(meta return)] org-table-wrap-region) ("\C-c\C-q" org-table-wrap-region) ("\C-c?" org-table-current-column) @@ -6157,7 +6405,7 @@ a reduced column width." "--" ["Blank field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"] ["Copy field from above" - org-table-copy-from-above :active (org-at-table-p) :keys "S-RET"] + org-table-copy-down :active (org-at-table-p) :keys "S-RET"] "--" ("Column" ["Move column left" org-metaleft :active (org-at-table-p) :keys "M-<left>"] @@ -6678,7 +6926,57 @@ underlined headlines. The default is 3." (setq char (nth (- umax level) (reverse org-ascii-underline))) (if org-export-with-section-numbers (setq title (concat (org-section-number level) " " title))) - (insert title "\n" (make-string (length title) char) "\n")))) + (insert title "\n" (make-string (string-width title) char) "\n")))) + +(defun org-export-copy-visible (&optional arg) + "Copy the visible part of the buffer to another buffer, for printing. +Also removes the first line of the buffer it is specifies a mode, +and all options lines." + (interactive "P") + (let* ((filename (concat (file-name-sans-extension (buffer-file-name)) + ".txt")) + (buffer (find-file-noselect filename)) + (ore (concat + (org-make-options-regexp + '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" "STARTUP" + "TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE")) + (if org-noutline-p "\\(\n\\|$\\)" ""))) + s e) + (save-excursion + (set-buffer buffer) + (erase-buffer) + (text-mode)) + (save-excursion + (setq s (goto-char (point-min))) + (while (not (= (point) (point-max))) + (goto-char (org-find-invisible)) + (append-to-buffer buffer s (point)) + (setq s (goto-char (org-find-visible))))) + (switch-to-buffer-other-window buffer) + (newline) + (goto-char (point-min)) + (if (looking-at ".*-\\*- mode:.*\n") + (replace-match "")) + (while (re-search-forward ore nil t) + (replace-match "")) + (goto-char (point-min)))) + +(defun org-find-visible () + (if (featurep 'noutline) + (let ((s (point))) + (while (and (not (= (point-max) (setq s (next-overlay-change s)))) + (get-char-property s 'invisible))) + s) + (skip-chars-forward "^\n") + (point))) +(defun org-find-invisible () + (if (featurep 'noutline) + (let ((s (point))) + (while (and (not (= (point-max) (setq s (next-overlay-change s)))) + (not (get-char-property s 'invisible)))) + s) + (skip-chars-forward "^\r") + (point))) ;; HTML @@ -7423,7 +7721,7 @@ When LEVEL is non-nil, increase section numbers on that level." (define-key org-mode-map [(shift tab)] 'org-shifttab) (define-key org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) (define-key org-mode-map [(return)] 'org-return) -(define-key org-mode-map [(shift return)] 'org-table-copy-from-above) +(define-key org-mode-map [(shift return)] 'org-table-copy-down) (define-key org-mode-map [(meta return)] 'org-meta-return) (define-key org-mode-map [(control up)] 'org-move-line-up) (define-key org-mode-map [(control down)] 'org-move-line-down) @@ -7436,6 +7734,10 @@ When LEVEL is non-nil, increase section numbers on that level." (define-key org-mode-map "\C-c\C-q" 'org-table-wrap-region) (define-key org-mode-map "\C-c\C-xa" 'org-export-as-ascii) (define-key org-mode-map "\C-c\C-x\C-a" 'org-export-as-ascii) +(define-key org-mode-map "\C-c\C-xv" 'org-export-copy-visible) +(define-key org-mode-map "\C-c\C-x\C-v" 'org-export-copy-visible) +(define-key org-mode-map "\C-c\C-xo" 'org-export-as-opml) +(define-key org-mode-map "\C-c\C-x\C-o" 'org-export-as-opml) (define-key org-mode-map "\C-c\C-xt" 'org-insert-export-options-template) (define-key org-mode-map "\C-c:" 'org-toggle-fixed-width-section) (define-key org-mode-map "\C-c\C-xh" 'org-export-as-html) @@ -7444,7 +7746,7 @@ When LEVEL is non-nil, increase section numbers on that level." ;; FIXME: Do we really need to save match data in these commands? ;; I would like to remove it in order to minimize impact. -;; Self-insert already does not preserve it. How much resources does this take??? +;; Self-insert already does not preserve it. How much resources used by this??? (defsubst org-table-p () (if (and (eq major-mode 'org-mode) font-lock-mode) @@ -7469,28 +7771,7 @@ overwritten, and the table is not marked as requiring realignment." ;; FIXME: ;; The following two functions might still be optimized to trigger -;; re-alignment less frequently. Right now they raise the flag each time -;; (through before-change-functions). Here is how this could be minimized: -;; Basically, check if the non-white field width before deletion is -;; equal to the column width. If yes, the delete should trigger a -;; re-align. I have not implemented this so far because it is not so -;; easy, requires grabbing the field etc. So it may finally have some -;; impact on typing performance which we don't want. - -;; The defsubst is only a draft, untested... - -;; Maybe it is not so important to get rid of realigns - maybe the most -;; important aspect is to keep the table look noce as long as possible, -;; which is already achieved... - -;(defsubst org-check-delete-triggers-realign () -; (let ((pos (point))) -; (skip-chars-backward "^|\n") -; (and (looking-at " *\\(.*?\\) *|") -; (= (nth (1- (org-table-current-column)) -; org-table-last-column-widths) -; (- (match-end 1) (match-beginning 1))) -; (setq org-table-may-need-update t)))) +;; re-alignment less frequently. (defun org-delete-backward-char (N) "Like `delete-backward-char', insert whitespace at field end in tables. @@ -7769,7 +8050,7 @@ the automatic table editor has been turned off." ["Next row" org-return (org-at-table-p)] "--" ["Blank field" org-table-blank-field (org-at-table-p)] - ["Copy field from above" org-table-copy-from-above (org-at-table-p)] + ["Copy field from above" org-table-copy-down (org-at-table-p)] "--" ("Column" ["Move column left" org-metaleft (org-at-table-p)] @@ -7807,8 +8088,10 @@ the automatic table editor has been turned off." "--" ("Export" ["ASCII" org-export-as-ascii t] + ["Extract visible text" org-export-copy-visible t] ["HTML" org-export-as-html t] ["HTML, and open" org-export-as-html-and-open t] + ["OPML" org-export-as-opml nil] "--" ["Option template" org-insert-export-options-template t] ["Toggle fixed width" org-toggle-fixed-width-section t]) @@ -8098,3 +8381,5 @@ When ENTRY is non-nil, show the entire entry." ;;; org.el ends here + + diff --git a/lisp/textmodes/refill.el b/lisp/textmodes/refill.el index 9979f4a3e27..d5f3b19cc9c 100644 --- a/lisp/textmodes/refill.el +++ b/lisp/textmodes/refill.el @@ -221,7 +221,9 @@ With prefix arg, turn Refill mode on iff arg is positive. When Refill mode is on, the current paragraph will be formatted when changes are made within it. Self-inserting characters only cause refilling if they would cause auto-filling." - nil " Refill" '(("\177" . backward-delete-char-untabify)) + :group 'refill + :lighter " Refill" + :keymap '(("\177" . backward-delete-char-untabify)) ;; Remove old state if necessary (when refill-ignorable-overlay (delete-overlay refill-ignorable-overlay) diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 6fcf5869143..c4019d39fe5 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -1804,7 +1804,7 @@ have <h1>Very Major Headlines</h1> through <h6>Very Minor Headlines</h6> <p>Paragraphs only need an opening tag. Line breaks and multiple spaces are ignored unless the text is <pre>preformatted.</pre> Text can be marked as -<b>bold</b>, <i>italic</i> or <u>underlined</u> using the normal M-g or +<b>bold</b>, <i>italic</i> or <u>underlined</u> using the normal M-o or Edit/Text Properties/Face commands. Pages can have <a name=\"SOMENAME\">named points</a> and can link other points diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 7e5d9fee78b..cc9ed23c6be 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -1562,8 +1562,9 @@ Return the process in which TeX is running." (concat (if file (if star (concat (substring cmd 0 star) - file (substring cmd (1+ star))) - (concat cmd " " file)) + (shell-quote-argument file) + (substring cmd (1+ star))) + (concat cmd " " (shell-quote-argument file))) cmd) (if background "&" "")))) ;; Switch to buffer before checking for subproc output in it. @@ -1886,8 +1887,8 @@ FILE is typically the output DVI or PDF file." (prog1 (file-name-directory (expand-file-name file)) (setq file (file-name-nondirectory file)))) (root (file-name-sans-extension file)) - (fspec (list (cons ?r (comint-quote-filename root)) - (cons ?f (comint-quote-filename file)))) + (fspec (list (cons ?r (shell-quote-argument root)) + (cons ?f (shell-quote-argument file)))) (default (tex-compile-default fspec))) (list default-directory (completing-read @@ -1908,14 +1909,14 @@ FILE is typically the output DVI or PDF file." (compile-command (if star (concat (substring command 0 star) - (comint-quote-filename file) + (shell-quote-argument file) (substring command (1+ star))) (concat command " " tex-start-options (if (< 0 (length tex-start-commands)) (concat (shell-quote-argument tex-start-commands) " ")) - (comint-quote-filename file))))) + (shell-quote-argument file))))) (tex-send-tex-command compile-command dir))) (defun tex-send-tex-command (cmd &optional dir) diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 6ed93a0e99e..59f82c12e31 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -130,7 +130,7 @@ position to pop up the tooltip." (defcustom tooltip-gud-display '((eq (tooltip-event-buffer tooltip-gud-event) - (marker-buffer overlay-arrow-position))) + (marker-buffer gud-overlay-arrow-position))) "List of forms determining where GUD tooltips are displayed. Forms in the list are combined with AND. The default is to display @@ -469,27 +469,7 @@ This function must return nil if it doesn't handle EVENT." (defun tooltip-show-help-function (msg) "Function installed as `show-help-function'. MSG is either a help string to display, or nil to cancel the display." - (let ((previous-help tooltip-help-message) - mp pos) - (if (and mouse-1-click-follows-link - (stringp msg) - (save-match-data - (string-match "^mouse-2" msg)) - (setq mp (mouse-pixel-position)) - (consp (setq pos (cdr mp))) - (car pos) (>= (car pos) 0) - (cdr pos) (>= (cdr pos) 0) - (setq pos (posn-at-x-y (car pos) (cdr pos) (car mp))) - (windowp (posn-window pos))) - (with-current-buffer (window-buffer (posn-window pos)) - (if (mouse-on-link-p pos) - (setq msg (concat - (cond - ((eq mouse-1-click-follows-link 'double) "double-") - ((and (integerp mouse-1-click-follows-link) - (< mouse-1-click-follows-link 0)) "Long ") - (t "")) - "mouse-1" (substring msg 7)))))) + (let ((previous-help tooltip-help-message)) (setq tooltip-help-message msg) (cond ((null msg) ;; Cancel display. This also cancels a delayed tip, if diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 5a3bf23529c..82b7f64dc01 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,7 @@ +2005-04-04 Lute Kamstra <lute@gnu.org> + + * url-handlers.el (url-handler-mode): Specify :group. + 2005-02-26 James Cloos <cloos@jhcloos.com> (tiny change) * url-history.el (url-have-visited-url): Don't barf if diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index f90f21a3dbe..68bf0ec7ab5 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -1,6 +1,6 @@ ;;; url-handlers.el --- file-name-handler stuff for URL loading -;; Copyright (c) 1996, 1997, 1998, 1999, 2004 Free Software Foundation, Inc. +;; Copyright (c) 1996, 1997, 1998, 1999, 2004, 2005 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -106,7 +106,7 @@ particularly bad at this\).") ;;;###autoload (define-minor-mode url-handler-mode "Use URL to handle URL-like file names." - :global t + :global t :group 'url (if (not (boundp 'file-name-handler-alist)) ;; Can't be turned ON anyway. (setq url-handler-mode nil) diff --git a/lisp/url/vc-dav.el b/lisp/url/vc-dav.el index e0e32f5da1a..3bf03165564 100644 --- a/lisp/url/vc-dav.el +++ b/lisp/url/vc-dav.el @@ -21,6 +21,11 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Code: + (require 'url) (require 'url-dav) @@ -175,4 +180,5 @@ It should return a status of either 0 (no differences found), or (provide 'vc-dav) -;;; arch-tag: 0a0fb9fe-8190-4c0a-a179-5c291d3a467e +;; arch-tag: 0a0fb9fe-8190-4c0a-a179-5c291d3a467e +;;; vc-dav.el ends here diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el index 81a18eadd87..52b4659cec6 100644 --- a/lisp/vc-hooks.el +++ b/lisp/vc-hooks.el @@ -481,7 +481,9 @@ and does not employ any heuristic at all." "Return non-nil if FILE has not changed since the last checkout." (let ((checkout-time (vc-file-getprop file 'vc-checkout-time)) (lastmod (nth 5 (file-attributes file)))) - (if checkout-time + (if (and checkout-time + ;; Tramp and Ange-FTP return this when they don't know the time. + (not (equal lastmod '(0 0)))) (equal checkout-time lastmod) (let ((unchanged (vc-call workfile-unchanged-p file))) (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0)) diff --git a/lisp/vc.el b/lisp/vc.el index 2e241e67f48..ce4cb2d36c8 100644 --- a/lisp/vc.el +++ b/lisp/vc.el @@ -1,7 +1,7 @@ ;;; vc.el --- drive a version-control system from within Emacs ;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, -;; 2000, 2001, 2003, 2004 Free Software Foundation, Inc. +;; 2000, 2001, 2003, 2004, 2005 Free Software Foundation, Inc. ;; Author: FSF (see below for full credits) ;; Maintainer: Andre Spiegel <spiegel@gnu.org> @@ -962,8 +962,10 @@ that is inserted into the command line before the filename." ;; start-process does not support remote execution (setq okstatus nil)) (if (eq okstatus 'async) - (let ((proc (apply 'start-process command (current-buffer) command - squeezed))) + (let ((proc + (let ((process-connection-type nil)) + (apply 'start-process command (current-buffer) command + squeezed)))) (unless (active-minibuffer-window) (message "Running %s in the background..." command)) ;;(set-process-sentinel proc (lambda (p msg) (delete-process p))) diff --git a/lisp/wdired.el b/lisp/wdired.el index 92d7a81627a..a4119343600 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -330,7 +330,8 @@ See `wdired-mode'." (set-buffer-modified-p nil) (setq buffer-undo-list nil) (run-hooks 'wdired-mode-hook) - (message (substitute-command-keys "Press \\[wdired-finish-edit] when finished"))) + (message (substitute-command-keys "Press \\[wdired-finish-edit] when finished \ +or \\[wdired-abort-changes] to abort changes"))) ;; Protect the buffer so only the filenames can be changed, and put diff --git a/lisp/window.el b/lisp/window.el index 5768436eaae..b4fd664a43c 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -397,20 +397,13 @@ lines than are actually needed in the case where some error may be present." (defun window-buffer-height (window) "Return the height (in screen lines) of the buffer that WINDOW is displaying." - (save-excursion - (set-buffer (window-buffer window)) - (goto-char (point-min)) - (let ((ignore-final-newline - ;; If buffer ends with a newline, ignore it when counting height - ;; unless point is after it. - (and (not (eobp)) (eq ?\n (char-after (1- (point-max))))))) - (+ 1 (nth 2 (compute-motion (point-min) - '(0 . 0) - (- (point-max) (if ignore-final-newline 1 0)) - (cons 0 100000000) - nil - nil - window)))))) + (with-current-buffer (window-buffer window) + (max 1 + (count-screen-lines (point-min) (point-max) + ;; If buffer ends with a newline, ignore it when + ;; counting height unless point is after it. + (eobp) + window)))) (defun count-screen-lines (&optional beg end count-final-newline window) "Return the number of screen lines in the region. diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 131f95db7d0..4f7e19623fe 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -155,8 +155,11 @@ "Toggle XTerm mouse mode. With prefix arg, turn XTerm mouse mode on iff arg is positive. -Turn it on to use emacs mouse commands, and off to use xterm mouse commands." - nil " Mouse" nil :global t +Turn it on to use Emacs mouse commands, and off to use xterm mouse commands. +This works in terminal emulators compatible with xterm. Only single clicks +are supported. When turned on, the normal xterm mouse functionality is still +available by holding down the SHIFT key while pressing the mouse button." + nil " Mouse" nil :global t :group 'mouse (if xterm-mouse-mode ;; Turn it on (unless window-system |