Mercurial > emacs
changeset 83653:2a69b973fae2
Merge from emacs--devo--0
Patches applied:
* emacs--devo--0 (patch 852-856)
- Update from CVS
- Merge from emacs--rel--22
* emacs--rel--22 (patch 93-96)
- Update from CVS
- Merge from gnus--rel--5.10
* gnus--rel--5.10 (patch 245)
- Update from CVS
Revision: emacs@sv.gnu.org/emacs--multi-tty--0--patch-32
| author | Miles Bader <miles@gnu.org> |
|---|---|
| date | Tue, 21 Aug 2007 04:55:30 +0000 |
| parents | 5b644ae74c91 (current diff) 962fb740e73f (diff) |
| children | e9a88d9f47fb |
| files | lisp/ChangeLog lisp/emulation/cua-base.el lisp/gnus/ChangeLog lisp/mail/emacsbug.el lisp/menu-bar.el lisp/simple.el lisp/startup.el lisp/term/mac-win.el src/ChangeLog src/alloc.c src/emacs.c src/eval.c src/minibuf.c src/term.c src/xterm.c |
| diffstat | 75 files changed, 2355 insertions(+), 1303 deletions(-) [+] |
line wrap: on
line diff
--- a/admin/FOR-RELEASE Mon Aug 13 13:51:08 2007 +0000 +++ b/admin/FOR-RELEASE Tue Aug 21 04:55:30 2007 +0000 @@ -44,34 +44,21 @@ EMACS_22_BASE branch. Any entries below are automatically copied from that branch. Do not make manual changes to this file on the trunk. -** michael.ewe@arcor.de, Apr 24: 22.0.98 not starting on Solaris 10/I386 -http://lists.gnu.org/archive/html/emacs-devel/2007-04/msg01113.html - -** davby@ida.liu.se, 6 July: Bug in pos-visible-in-window-p -** dak@gnu.org, 30 May: Redraw problem with overlapping frames - -** bojohan+news@dd.chalmers.se, 1 Aug: n_schumacher@web.de: modification hooks called only once in +** ams@gnu.org, 9 July: eshell and external commands +http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00385.html -** ams@gnu.org, 9 July: eshell and external commands - -** timh@insightful.com, 25 June: undigestify-rmail-message in emacs 22.1 doesn't split a digest +** Check all non-file-scope static vars to make sure they +won't lose on USG or HPUX systems. -** andreas.roehler@online.de, 24 Jul: CVS build on Suse 10.0 failed - -** Gtk+ tool bar looses focus when pressing next tool bar button in GUD. -http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-08/msg00008.html - -* FIXES FOR EMACS 22.2 +* FIXES FOR EMACS 22.3 Here we list small fixes that arrived too late for Emacs 22.2, but that should be installed on the release branch after 22.2 is released. -** Changes to six pbm icons in etc/images. -Sync change from trunk 2007-05-19. +** bojohan+news@dd.chalmers.se, 1 Aug: n_schumacher@web.de: modification hooks called only once in +Fix is on the trunk: 2007-08-13 change to insdel.c by Stefan Monnier. +http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00457.html -** viper should not load cl at run time. - -** yamaoka@jpl.org's patch for mail-extract-address-components problem. * DOCUMENTATION
--- a/etc/ChangeLog Mon Aug 13 13:51:08 2007 +0000 +++ b/etc/ChangeLog Tue Aug 21 04:55:30 2007 +0000 @@ -1,3 +1,7 @@ +2007-08-14 Glenn Morris <rgm@gnu.org> + + * NEWS: Mention `bad-packages-alist'. + 2007-08-08 Glenn Morris <rgm@gnu.org> * TODO: `iff' item is dealt with.
--- a/etc/NEWS Mon Aug 13 13:51:08 2007 +0000 +++ b/etc/NEWS Tue Aug 21 04:55:30 2007 +0000 @@ -56,6 +56,10 @@ * Startup Changes in Emacs 23.1 +** New user option `initial-buffer-choice' specifies what to display +after starting Emacs: startup screen, *scratch* buffer, visiting a +file or directory. + * Incompatible Editing Changes in Emacs 23.1 @@ -171,6 +175,11 @@ * Lisp Changes in Emacs 23.1 ++++ +** inhibit-modification-hooks is bound to t while running modification hooks. +As a happy consequence, after-change-functions and before-change-functions +are not bound to nil any more while running an (after|before)-change-function. + ** Non-breaking space now acts as whitespace. +++
--- a/etc/NEWS.22 Mon Aug 13 13:51:08 2007 +0000 +++ b/etc/NEWS.22 Tue Aug 21 04:55:30 2007 +0000 @@ -28,7 +28,8 @@ version is used. You can use M-x list-load-path-shadows to find such older packages. -Some specific packages that are known to cause problems are: +Some specific packages that are known to cause problems are given +below. Emacs tries to warn you about these through `bad-packages-alist'. ** Semantic (used by CEDET, ECB, JDEE): upgrade to latest version. @@ -40,6 +41,9 @@ * Changes in Emacs 22.2 +** `bad-packages-alist' will warn about external packages that are known +to cause problems in this version of Emacs. + ** The values of `dired-recursive-deletes' and `dired-recursive-copies' have been changed to `top'. This means that the user is asked once, before deleting/copying the indicated directory recursively.
--- a/lisp/ChangeLog Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/ChangeLog Tue Aug 21 04:55:30 2007 +0000 @@ -1,3 +1,318 @@ +2007-08-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * smerge-mode.el (smerge-resolve): New arg `safe'. + (smerge-resolve-all, smerge-batch-resolve): New function. + (smerge-refine): Make sure `diff' returns the expected result. + (smerge-parsep-re): New const. + (smerge-mode): Use it to adjust paragraph-separate. + + * progmodes/perl-mode.el (perl-font-lock-syntactic-keywords): + Correctly match / regexp matchers as first char on a line when + fontifying only that line. + + * emacs-lisp/cl-macs.el (cl-transform-lambda): Preserve the match-data. + +2007-08-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc-bzr.el: Don't fiddle with vc-handled-backend. + (vc-bzr-registered): Don't redundantly protect against + file-error. Actually use the format-specific code. + (vc-bzr-buffer-nonblank-p): Remove. + (vc-bzr-status): Change `kindchange' -> `kindchanged'. + +2007-08-20 Juri Linkov <juri@jurta.org> + + * startup.el (fancy-splash-text): Change multiple tabs into one + tab. Remove "Useful File menu items" section (with "Exit Emacs" + and "Recover Crashed Session"). + (fancy-splash-screens): Set tab-width to 22. + (normal-splash-screen): Replace literal tabs with \t and + fix whitespace. Remove "Useful File menu items" section (with + "Exit Emacs" and "Recover Crashed Session"). + +2007-08-20 Johannes Weiner <hannes@saeurebad.de> (tiny change) + + * emacs-lisp/lisp-mode.el (preceding-sexp): New fun, the code was + extracted from `eval-last-sexp-1'. + (eval-last-sexp-1): Call `preceding-sexp'. + +2007-08-20 Thien-Thi Nguyen <ttn@gnuvola.org> + + * vc-rcs.el (vc-rcs-annotate-command): + Fix bug introduced 2007-07-18 (revision 1.51): + Add back :vc-annotate-prefix propertization. + +2007-08-20 Andreas Schwab <schwab@suse.de> + + * mail/rmail.el (rmail-autodetect): Doc fix. + +2007-08-19 Juri Linkov <juri@jurta.org> + + * startup.el (normal-splash-screen): Add more links. + +2007-08-19 Juri Linkov <juri@jurta.org> + + * startup.el (splash-screen-keymap): Rename from `fancy-splash-keymap' + because it's common to both types of splash screen: fancy and normal. + Bind SPC to scroll-up, DEL to scroll-down and `q' to exit-splash-screen. + (exit-splash-screen): Rename from `fancy-splash-quit'. + Use `quit-window' instead of `kill-buffer'. + (fancy-splash-head): Use make-button to insert GNU image link. + (fancy-splash-screens, normal-splash-screen): Rename " About GNU + Emacs" to "*About GNU Emacs*", and " GNU Emacs" to "*GNU Emacs*". + (normal-splash-screen): Put "Browse manuals" on the same line with + "Emacs manual". Remove descriptions from "Useful tasks" and put + all links in two columns on two lines. + +2007-08-19 Michael Kifer <kifer@cs.stonybrook.edu> + + * viper.el (viper-remove-hooks): remove some additional viper hooks + when the user calls viper-go-away. + (viper-go-away): restore the default of default-major-mode. + Save the value of default-major-mode before vaperization. + + * viper-cmd.el: Replace error "" with "Viper bell". + + * viper-ex.el: Replace error "" with "Viper bell". + + * ediff-util.el (ediff-make-temp-file): use the coding system of the + buffer for which file is created. + +2007-08-19 Glenn Morris <rgm@gnu.org> + + * Makefile.in (custom-deps, finder-data, autoloads, recompile) + (progmodes/cc-mode.elc, mh-e/mh-loaddefs.el): Use $(emacs) rather + than $(EMACS), so that EMACSLOADPATH is set. Prevents any system + shadow files messing up the compilation. + +2007-08-18 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/eldoc.el (eldoc-get-fnsym-args-string): Add doc + string. Also apply eldoc-argument-case in the help-split-fundoc + case. Adapt for changed behavior of eldoc-function-argstring, + eldoc-function-argstring-format, and + eldoc-highlight-function-argument. + (eldoc-highlight-function-argument): Handle nil INDEX argument, + just call eldoc-docstring-format-sym-doc in that case. + (eldoc-function-argstring): Change the behavior. Now it converts + an argument list to a string. + (eldoc-function-argstring-format): Change the behavior. Now it + applies `eldoc-argument-case' to a string. + + * progmodes/scheme.el (scheme-mode-variables): Set + font-lock-comment-start-skip. + +2007-08-18 Martin Rudalics <rudalics@gmx.at> + + * progmodes/ada-mode.el (ada-create-syntax-table): Move + set-syntax-table from here to ... + (ada-mode): ... here. Do not change global value of + comment-multi-line. Call new function + ada-initialize-syntax-table-properties and add new function + ada-handle-syntax-table-properties to font-lock-mode-hook. + (ada-deactivate-properties, ada-initialize-properties): Replace + by new functions ... + (ada-handle-syntax-table-properties) + (ada-initialize-syntax-table-properties) + (ada-set-syntax-table-properties): ... to set up syntax-table + properties uniformly, independently from whether font-lock-mode + is enabled or not. Handle read-only buffers and do not change + undo-list when setting syntax-table properties. + (ada-after-change-function): Use + ada-set-syntax-table-properties. + +2007-08-18 Micha,Ak(Bl Cadilhac <michael@cadilhac.name> + + * progmodes/meta-mode.el (meta-indent-calculate-last): Remove. + (meta-indent-current-nesting): Use a computation of the nesting + instead. + (meta-indent-current-indentation): Indentation is given according + to nesting and if the previous line was finished or not. + (meta-indent-unfinished-line): Tell if the current line ends with + a finished expression. + (meta-indent-looking-at-code): Like `looking-at', but checks if + the point is in a string before. + (meta-indent-level-count): Use it. Don't count parenthesis as it's + done in the nesting function. + (meta-indent-in-string-p): Tell if the current point is in a + string. + (meta-indent-calculate): Treat b-o-b as a special case. Use the + previous functions. + +2007-08-17 Thien-Thi Nguyen <ttn@gnuvola.org> + + * emacs-lisp/copyright.el (copyright-limit): New defsubst. + (copyright-update-year, copyright-update) + (copyright-fix-years): Use it. + +2007-08-17 Kimit Yada <kimitto@gmail.com> (tiny change) + + * emacs-lisp/copyright.el (copyright-update-year): + Fix bug: Handle nil copyright-limit. + +2007-08-17 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-units.el (math-standard-units): Give exact + conversion for tsp. + + * calc/calc.el (math-bignum-digit-length): Compute the + appropriate value. + + * calc/calc-bin.el (math-bignum-logb-digit-size) + (math-bignum-digit-power-of-two): + * calc/calc-comb.el (math-small-factorial-table): + * calc/calc-ext.el (math-approx-pi,math-approx-sqrt-e) + (math-approx-gamma-const): + * calc/calc-funcs.el (math-besJ0, math-besJ1, math-besY0) + (math-besY1, math-bernoulli-b-cache): + * calc/calc-math.el (math-approx-ln-10, math-approx-ln-2): + Remove `eval-when-compile's. + +2007-08-17 Bob Rogers <rogers-emacs@rgrjr.dyndns.org> (tiny change) + + * progmode/cperl-mode.el (cperl-look-at-leading-count) + (cperl-find-pods-heres): Fix an error when typing expressions like + `s{a}{b}'. + +2007-08-17 Micha,Ak(Bl Cadilhac <michael@cadilhac.name> + + * mail/emacsbug.el (report-emacs-bug): Remove the last number of + `emacs-version', use the topic prefix ``version; ''. Make MS-DOS + a special case (there's no build number). + +2007-08-17 T. V. Raman <raman@users.sf.net> (tiny change) + + * completion.el (symbol-under-point, symbol-before-point) + (symbol-before-point-for-complete): Use + buffer-substring-no-properties. + +2007-08-17 Glenn Morris <rgm@gnu.org> + + * progmodes/compile.el (compilation-get-file-structure): Make use + of the directory part when checking for an existing entry, to + handle files with same basename in different directories. + +2007-08-17 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc.el (calc-language-alist): Add texinfo-mode. + +2007-08-16 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * ps-print.el (ps-header-font-size, ps-header-title-font-size) + (ps-footer-font-size, ps-line-number-font-size, ps-line-spacing) + (ps-paragraph-spacing): Docstring fix. + +2007-08-16 Glenn Morris <rgm@gnu.org> + + * ps-print.el (ps-font-size): Doc fix. + +2007-08-16 Richard Stallman <rms@gnu.org> + + * emacs-lisp/copyright.el (copyright-names-regexp): Add custom group. + +2007-08-15 Juri Linkov <juri@jurta.org> + + * startup.el (initialization): Change parent group from `internal' + to `environment'. + (initial-buffer-choice): New variable. + (command-line): Revert 2007-07-02 change that sets + buffer-offer-save in *scratch* and enables auto-save in it. + (fancy-splash-text): Add links to existing items. Add new items + with links for useful tasks. Move information about Control-g to + fancy-splash-head. Move "Emacs Guided Tour" to the end. + (fancy-splash-keymap): New variable. + (fancy-splash-last-input-event): Remove variable. + (fancy-splash-insert): Add processing of `:link' element. + (fancy-splash-head): Replace "Type Control-l to begin editing" + with "Type `q' to exit". + (fancy-splash-screens-1): Let-bind inhibit-read-only to t. + (fancy-splash-default-action, fancy-splash-special-event-action): + Remove functions. + (fancy-splash-quit): New function. + (fancy-splash-screens): Rename input arg from `hide-on-input' to + `static' and reverse the condition of its usage. Don't preserve + original values of `minor-mode-map-alist', + `emulation-mode-map-alists', `special-event-map'. + Rename startup-buffer from "*About GNU Emacs*" to " GNU Emacs". + Rename about-buffer from " GNU Emacs" to " About GNU Emacs". + Remove processing of special events. Use local key map + `fancy-splash-keymap'. Set buffer to read-only. + (normal-splash-screen): Rename input arg from `hide-on-input' to + `static' and reverse the condition of its usage. + Rename startup-buffer from "*About GNU Emacs*" to " GNU Emacs". + Rename about-buffer from " GNU Emacs" to " About GNU Emacs". + Add links to existing items. Add new items with links for useful + tasks. Use local key map `fancy-splash-keymap'. + (display-splash-screen): Rename input arg from `hide-on-input' to + `static'. + (about-emacs): Add alias to display-splash-screen. + (command-line-1): Use `initial-buffer-choice'. + + * menu-bar.el (menu-bar-help-menu): + * term/mac-win.el (mac-apple-event-map): Bind About Emacs menu + item to about-emacs instead of display-splash-screen. + +2007-08-15 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-units.el (math-standard-units): Update values. + Put in exact, rational values when possible. + (math-unit-prefixes): Replace floats with powers of ten. + (math-standard-units-systems): Replace floats with integers. + (math-make-unit-string): Remove extra spaces in output. + +2007-08-15 Glenn Morris <rgm@gnu.org> + + * mail/undigest.el (rmail-digest-parse-rfc1153sloppy): Be even + sloppier, for the sake of GNU Mailman. + (rmail-digest-rfc1153): Initialize `result' correctly. + +2007-08-15 Micha,Ak(Bl Cadilhac <michael@cadilhac.name> + + * mail/emacsbug.el (report-emacs-bug): Put `Bug: emacs-version; ' + in the mail title. Suggested by Reiner Steib. + +2007-08-14 Chris Hecker <checker@d6.com> (tiny change) + + * calc/calc-aent.el (calc-do-quick-calc): Add binary + representation of integers to the list of outputs. + +2007-08-14 Glenn Morris <rgm@gnu.org> + + * simple.el (bad-packages-alist): New constant. + (bad-package-check): New function. Together, these two add + elements to `after-load-alist' to check for problematic external + packages. + * emulation/cua-base.el: Move CUA-mode check to `bad-packages-alist'. + +2007-08-14 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-units.el (math-get-standard-units) + (math-get-units,math-make-unit-string) + (math-get-default-units,math-put-default-units): New functions. + (math-default-units-table): New variable. + (calc-convert-units, calc-convert-temperature): Add machinery + to supply default values. + +2007-08-14 Stefan Monnier <monnier@iro.umontreal.ca> + + * emulation/tpu-edt.el: Add tpu-extras's autoloads. + (tpu-gold-map, tpu-global-map): Comment-out the bindings to nil. + (tpu-gold-map): Bind F to tpu-cursor-free-mode. + (minibuffer-local-map): Use funkey symbols rather than esc-sequence. + + * emulation/tpu-extras.el: Remove spurious * in docstrings. + Put its autoloads into tpu-edt.el rather than loaddefs.el. + (tpu-cursor-free-mode): Rename from tpu-cursor-free. + Make into a proper minor-mode. + (tpu-backward-char, tpu-next-line, tpu-previous-line) + (tpu-next-end-of-line, tpu-current-end-of-line): Use new name. + (tpu-trim-line-ends-if-needed): Rename from tpu-before-save-hook. + (tpu-set-cursor-free, tpu-set-cursor-bound): + Delegate to tpu-cursor-free-mode. + (tpu-next-line, tpu-previous-line, tpu-forward-line) + (tpu-backward-line, tpu-scroll-window-down, tpu-scroll-window-up): + Use line-move or forward-line instead of next-line-internal. + 2007-08-13 Nick Roberts <nickrob@snap.net.nz> * progmodes/gdb-ui.el (gdb-send): Handle CTRL-D more carefully. @@ -19,8 +334,8 @@ * pcvs-util.el (cvs-qtypedesc-strings): Use new names combine-and-quote-strings and split-string-and-unquote. - * subr.el (combine-and-quote-strings): Renamed from strings->string. - (split-string-and-unquote): Renamed from string->strings. + * subr.el (combine-and-quote-strings): Rename from strings->string. + (split-string-and-unquote): Rename from string->strings. 2007-08-10 Stefan Monnier <monnier@iro.umontreal.ca> @@ -156,6 +471,24 @@ * help.el (resize-temp-buffer-window): Use window-full-width-p instead of comparing frame-width and window-width. +2007-08-13 Stephen Leake <stephen_leake@stephe-leake.org> + + * pcvs-parse.el (cvs-parse-table): Handle additional instance of + optional quotes around files in NEED-UPDATE . REMOVED case. + + * progmodes/ada-xref.el (ada-gnatls-args): Fix docstring. + (ada-treat-cmd-string): Improve error message. + (ada-do-file-completion): Call `ada-require-project-file', so + project variables are set properly. + (ada-prj-find-prj-file): Delete Emacs 20.2 support. + (ada-gnatfind-buffer-name): New constant. + (ada-find-any-references): Use new constant. Set buffer name + properly in compilation-start. Toggle read-only properly. + (ada-find-in-src-path): Fix spelling error in docstring. + + * progmodes/vhdl-mode.el (vhdl-update-progress-info): Avoid divide + by zero error. + 2007-08-13 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/autoload.el (autoload-print-form): Use print-quoted. @@ -184,7 +517,7 @@ (tex-font-script-display, tex-font-lock-suscript): Change from a cons cell to a list of 2 elements to simplify the unfontify code. -2007-08-09 Edward O'Connor <hober0@gmail.com> (tiny change) +2007-08-09 Edward O'Connor <hober0@gmail.com> (tiny change) * url/url-auth.el (url-basic-auth): When prompting for username and password, default to the username and password in the URL. @@ -265,15 +598,6 @@ It calls comment-line-break-function if there are comments. (do-auto-fill): Use that. -2007-08-07 Ivan Kanis <apple@kanis.eu> - - * time.el (display-time-world-mode, display-time-world-display) - (display-time-world, display-time-world-list) - (display-time-world-time-format, display-time-world-buffer-name) - (display-time-world-timer-enable) - (display-time-world-timer-second, display-time-world-mode-map): - New. - 2007-08-07 Sean O'Rourke <sorourke@cs.ucsd.edu> * complete.el (PC-lisp-complete-symbol): Complete symbol around point. @@ -328,10 +652,9 @@ term-default-fg/bg-color instead of ansi-term-color-vector when the index (term-ansi-current-color or term-ansi-current-bg-color) is zero. -2007-08-05 Jay Belanger <belanger@localhost.localdomain> - - * calc/calc-nlfit.el (math-nlfit-curve): - Remove unnecessary variables. +2007-08-05 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-nlfit.el (math-nlfit-curve): Remove unnecessary variables. (math-nlfit-givens): Let bind free variables. 2007-08-05 Vinicius Jose Latorre <viniciusig@ig.com.br> @@ -344,7 +667,7 @@ * files.el (set-auto-mode): Handle also remote files wrt `auto-mode-alist'. -2007-08-04 Jay Belanger <belanger@localhost.localdomain> +2007-08-04 Jay Belanger <jay.p.belanger@gmail.com> * calc/calcalg3.el (calc-curve-fit): Add support for nonlinear curves and plotting. @@ -382,7 +705,7 @@ 2007-08-03 Jay Belanger <jay.p.belanger@gmail.com> - * calc/calc-ext.el (math-get-value,math-get-sdev) + * calc/calc-ext.el (math-get-value, math-get-sdev) (math-contains-sdev): New functions. * calc/calc-graph.el (calc-graph-format-data) @@ -437,8 +760,8 @@ * net/telnet.el (telnet-mode): Set comint-use-prompt-regexp to t. - * progmodes/fortran.el (fortran-font-lock-syntactic-keywords): Fix - off-by-one error in previous change. + * progmodes/fortran.el (fortran-font-lock-syntactic-keywords): + Fix off-by-one error in previous change. 2007-08-03 Drew Adams <drew.adams@oracle.com> @@ -447,8 +770,8 @@ 2007-08-01 Jay Belanger <jay.p.belanger@gmail.com> - * calc/calc-math.el (math-sqrt-raw,math-sin-raw-2) - (math-cos-raw-2,math-arctan-raw,math-ln-raw): + * calc/calc-math.el (math-sqrt-raw, math-sin-raw-2) + (math-cos-raw-2, math-arctan-raw, math-ln-raw): Use native Emacs functions, when appropriate. 2007-08-01 Dan Nicolaescu <dann@ics.uci.edu> @@ -586,7 +909,7 @@ 2007-07-28 Masatake YAMATO <jet@gyve.org> * vc.el (vc-dired-mode): Add a menu for VC related operation. - Use backend name as the menu label Suggested by David Kastrup. + Use backend name as the menu label. Suggested by David Kastrup. 2007-07-28 Alan Mackenzie <acm@muc.de>
--- a/lisp/Makefile.in Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/Makefile.in Tue Aug 21 04:55:30 2007 +0000 @@ -90,12 +90,12 @@ custom-deps: $(lisp)/subdirs.el $(lisp)/loaddefs.el $(lisp)/cus-load.el doit wd=$(lisp); $(setwins_almost); \ echo Directories: $$wins; \ - $(EMACS) $(EMACSOPT) -l cus-dep --eval '(setq generated-custom-dependencies-file "$(lisp)/cus-load.el")' -f custom-make-dependencies $$wins + $(emacs) -l cus-dep --eval '(setq generated-custom-dependencies-file "$(lisp)/cus-load.el")' -f custom-make-dependencies $$wins finder-data: $(lisp)/subdirs.el $(lisp)/loaddefs.el doit wd=$(lisp); $(setwins_almost); \ echo Directories: $$wins; \ - $(EMACS) $(EMACSOPT) -l finder --eval '(setq generated-finder-keywords-file "$(lisp)/finder-inf.el")' -f finder-compile-keywords-make-dist $$wins + $(emacs) -l finder --eval '(setq generated-finder-keywords-file "$(lisp)/finder-inf.el")' -f finder-compile-keywords-make-dist $$wins $(lisp)/loaddefs.el: echo ";;; loaddefs.el --- automatically extracted autoloads" >> $@ @@ -110,7 +110,7 @@ autoloads: $(lisp)/subdirs.el $(lisp)/loaddefs.el doit wd=$(lisp); $(setwins_almost); \ echo Directories: $$wins; \ - $(EMACS) $(EMACSOPT) -l autoload --eval '(setq generated-autoload-file "$(lisp)/loaddefs.el")' -f batch-update-autoloads $$wins + $(emacs) -l autoload --eval '(setq generated-autoload-file "$(lisp)/loaddefs.el")' -f batch-update-autoloads $$wins $(lisp)/subdirs.el: $(MAKE) $(MFLAGS) update-subdirs @@ -210,7 +210,7 @@ # new ones. recompile: doit mh-autoloads $(lisp)/progmodes/cc-mode.elc - $(EMACS) $(EMACSOPT) --eval "(batch-byte-recompile-directory 0)" $(lisp) + $(emacs) --eval "(batch-byte-recompile-directory 0)" $(lisp) # CC Mode uses a compile time macro system which causes a compile time # dependency in cc-mode.elc on the macros in cc-langs.el and the @@ -219,7 +219,7 @@ $(lisp)/progmodes/cc-mode.el \ $(lisp)/progmodes/cc-langs.el \ $(lisp)/progmodes/cc-defs.el - $(EMACS) $(EMACSOPT) -f batch-byte-compile $(lisp)/progmodes/cc-mode.el + $(emacs) -f batch-byte-compile $(lisp)/progmodes/cc-mode.el # Update MH-E internal autoloads. These are not to be confused with # the autoloads for the MH-E entry points, which are already in @@ -256,7 +256,7 @@ echo ";; no-update-autoloads: t" >> $@ echo ";; End:" >> $@ echo ";;; mh-loaddefs.el ends here" >> $@ - $(EMACS) $(EMACSOPT) \ + $(emacs) \ -l autoload \ --eval "(setq generate-autoload-cookie \";;;###mh-autoload\")" \ --eval "(setq generated-autoload-file \"$(lisp)/mh-e/mh-loaddefs.el\")" \
--- a/lisp/calc/calc-aent.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/calc/calc-aent.el Tue Aug 21 04:55:30 2007 +0000 @@ -74,6 +74,9 @@ ", " (let ((calc-number-radix 8)) (math-format-value (car alg-exp) 1000)) + ", " + (let ((calc-number-radix 2)) + (math-format-value (car alg-exp) 1000)) (if (and (integerp (car alg-exp)) (> (car alg-exp) 0) (< (car alg-exp) 127))
--- a/lisp/calc/calc-bin.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/calc/calc-bin.el Tue Aug 21 04:55:30 2007 +0000 @@ -34,13 +34,13 @@ ;;; Some useful numbers (defconst math-bignum-logb-digit-size - (eval-when-compile (logb math-bignum-digit-size)) + (logb math-bignum-digit-size) "The logb of the size of a bignum digit. This is the largest value of B such that 2^B is less than the size of a Calc bignum digit.") (defconst math-bignum-digit-power-of-two - (eval-when-compile (expt 2 (logb math-bignum-digit-size))) + (expt 2 (logb math-bignum-digit-size)) "The largest power of 2 less than the size of a Calc bignum digit.") ;;; b-prefix binary commands.
--- a/lisp/calc/calc-comb.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/calc/calc-comb.el Tue Aug 21 04:55:30 2007 +0000 @@ -295,17 +295,16 @@ ;;; Factorial and related functions. (defconst math-small-factorial-table - (eval-when-compile - (vector 1 1 2 6 24 120 720 5040 40320 362880 3628800 39916800 - (math-read-number-simple "479001600") - (math-read-number-simple "6227020800") - (math-read-number-simple "87178291200") - (math-read-number-simple "1307674368000") - (math-read-number-simple "20922789888000") - (math-read-number-simple "355687428096000") - (math-read-number-simple "6402373705728000") - (math-read-number-simple "121645100408832000") - (math-read-number-simple "2432902008176640000")))) + (vector 1 1 2 6 24 120 720 5040 40320 362880 3628800 39916800 + (math-read-number-simple "479001600") + (math-read-number-simple "6227020800") + (math-read-number-simple "87178291200") + (math-read-number-simple "1307674368000") + (math-read-number-simple "20922789888000") + (math-read-number-simple "355687428096000") + (math-read-number-simple "6402373705728000") + (math-read-number-simple "121645100408832000") + (math-read-number-simple "2432902008176640000"))) (defun calcFunc-fact (n) ; [I I] [F F] [Public] (let (temp)
--- a/lisp/calc/calc-ext.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/calc/calc-ext.el Tue Aug 21 04:55:30 2007 +0000 @@ -1926,8 +1926,7 @@ ;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239). [F] [Public] (defconst math-approx-pi - (eval-when-compile - (math-read-number-simple "3.141592653589793238463")) + (math-read-number-simple "3.141592653589793238463") "An approximation for pi.") (math-defcache math-pi math-approx-pi @@ -1962,7 +1961,7 @@ (math-sqrt-float (math-two-pi))) (defconst math-approx-sqrt-e - (eval-when-compile (math-read-number-simple "1.648721270700128146849")) + (math-read-number-simple "1.648721270700128146849") "An approximation for sqrt(3).") (math-defcache math-sqrt-e math-approx-sqrt-e @@ -1976,9 +1975,8 @@ '(float 5 -1))) (defconst math-approx-gamma-const - (eval-when-compile - (math-read-number-simple - "0.5772156649015328606065120900824024310421593359399235988057672348848677267776646709369470632917467495")) + (math-read-number-simple + "0.5772156649015328606065120900824024310421593359399235988057672348848677267776646709369470632917467495") "An approximation for gamma.") (math-defcache math-gamma-const nil
--- a/lisp/calc/calc-funcs.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/calc/calc-funcs.el Tue Aug 21 04:55:30 2007 +0000 @@ -569,53 +569,47 @@ (let* ((z (math-div '(float 8 0) x)) (y (math-sqr z)) (xx (math-add x - (eval-when-compile - (math-read-number-simple "-0.785398164")))) + (math-read-number-simple "-0.785398164"))) (a1 (math-poly-eval y - (eval-when-compile (list (math-read-number-simple "0.0000002093887211") (math-read-number-simple "-0.000002073370639") (math-read-number-simple "0.00002734510407") (math-read-number-simple "-0.001098628627") - '(float 1 0))))) + '(float 1 0)))) (a2 (math-poly-eval y - (eval-when-compile - (list - (math-read-number-simple "-0.0000000934935152") - (math-read-number-simple "0.0000007621095161") - (math-read-number-simple "-0.000006911147651") - (math-read-number-simple "0.0001430488765") - (math-read-number-simple "-0.01562499995"))))) + (list + (math-read-number-simple "-0.0000000934935152") + (math-read-number-simple "0.0000007621095161") + (math-read-number-simple "-0.000006911147651") + (math-read-number-simple "0.0001430488765") + (math-read-number-simple "-0.01562499995")))) (sc (math-sin-cos-raw xx))) (if yflag (setq sc (cons (math-neg (cdr sc)) (car sc)))) (math-mul (math-sqrt - (math-div (eval-when-compile - (math-read-number-simple "0.636619722")) - x)) + (math-div (math-read-number-simple "0.636619722") + x)) (math-sub (math-mul (cdr sc) a1) (math-mul (car sc) (math-mul z a2)))))) (t (let ((y (math-sqr x))) (math-div (math-poly-eval y - (eval-when-compile - (list - (math-read-number-simple "-184.9052456") - (math-read-number-simple "77392.33017") - (math-read-number-simple "-11214424.18") - (math-read-number-simple "651619640.7") - (math-read-number-simple "-13362590354.0") - (math-read-number-simple "57568490574.0")))) + (list + (math-read-number-simple "-184.9052456") + (math-read-number-simple "77392.33017") + (math-read-number-simple "-11214424.18") + (math-read-number-simple "651619640.7") + (math-read-number-simple "-13362590354.0") + (math-read-number-simple "57568490574.0"))) (math-poly-eval y - (eval-when-compile - (list - '(float 1 0) - (math-read-number-simple "267.8532712") - (math-read-number-simple "59272.64853") - (math-read-number-simple "9494680.718") - (math-read-number-simple "1029532985.0") - (math-read-number-simple "57568490411.0"))))))))) + (list + '(float 1 0) + (math-read-number-simple "267.8532712") + (math-read-number-simple "59272.64853") + (math-read-number-simple "9494680.718") + (math-read-number-simple "1029532985.0") + (math-read-number-simple "57568490411.0")))))))) (defun math-besJ1 (x &optional yflag) (cond ((and (math-negp (calcFunc-re x)) (not yflag)) @@ -623,32 +617,28 @@ ((Math-lessp '(float 8 0) (math-abs-approx x)) (let* ((z (math-div '(float 8 0) x)) (y (math-sqr z)) - (xx (math-add x (eval-when-compile - (math-read-number-simple "-2.356194491")))) + (xx (math-add x (math-read-number-simple "-2.356194491"))) (a1 (math-poly-eval y - (eval-when-compile - (list - (math-read-number-simple "-0.000000240337019") - (math-read-number-simple "0.000002457520174") - (math-read-number-simple "-0.00003516396496") - '(float 183105 -8) - '(float 1 0))))) + (list + (math-read-number-simple "-0.000000240337019") + (math-read-number-simple "0.000002457520174") + (math-read-number-simple "-0.00003516396496") + '(float 183105 -8) + '(float 1 0)))) (a2 (math-poly-eval y - (eval-when-compile - (list - (math-read-number-simple "0.000000105787412") - (math-read-number-simple "-0.00000088228987") - (math-read-number-simple "0.000008449199096") - (math-read-number-simple "-0.0002002690873") - (math-read-number-simple "0.04687499995"))))) + (list + (math-read-number-simple "0.000000105787412") + (math-read-number-simple "-0.00000088228987") + (math-read-number-simple "0.000008449199096") + (math-read-number-simple "-0.0002002690873") + (math-read-number-simple "0.04687499995")))) (sc (math-sin-cos-raw xx))) (if yflag (setq sc (cons (math-neg (cdr sc)) (car sc))) (if (math-negp x) (setq sc (cons (math-neg (car sc)) (math-neg (cdr sc)))))) (math-mul (math-sqrt (math-div - (eval-when-compile - (math-read-number-simple "0.636619722")) + (math-read-number-simple "0.636619722") x)) (math-sub (math-mul (cdr sc) a1) (math-mul (car sc) (math-mul z a2)))))) @@ -657,23 +647,21 @@ (math-mul x (math-div (math-poly-eval y - (eval-when-compile - (list - (math-read-number-simple "-30.16036606") - (math-read-number-simple "15704.4826") - (math-read-number-simple "-2972611.439") - (math-read-number-simple "242396853.1") - (math-read-number-simple "-7895059235.0") - (math-read-number-simple "72362614232.0")))) + (list + (math-read-number-simple "-30.16036606") + (math-read-number-simple "15704.4826") + (math-read-number-simple "-2972611.439") + (math-read-number-simple "242396853.1") + (math-read-number-simple "-7895059235.0") + (math-read-number-simple "72362614232.0"))) (math-poly-eval y - (eval-when-compile - (list - '(float 1 0) - (math-read-number-simple "376.9991397") - (math-read-number-simple "99447.43394") - (math-read-number-simple "18583304.74") - (math-read-number-simple "2300535178.0") - (math-read-number-simple "144725228442.0")))))))))) + (list + '(float 1 0) + (math-read-number-simple "376.9991397") + (math-read-number-simple "99447.43394") + (math-read-number-simple "18583304.74") + (math-read-number-simple "2300535178.0") + (math-read-number-simple "144725228442.0"))))))))) (defun calcFunc-besY (v x) (math-inexact-result) @@ -712,27 +700,24 @@ (defun math-besY0 (x) (cond ((Math-lessp (math-abs-approx x) '(float 8 0)) (let ((y (math-sqr x))) - (math-add + (math-add (math-div (math-poly-eval y - (eval-when-compile - (list - (math-read-number-simple "228.4622733") - (math-read-number-simple "-86327.92757") - (math-read-number-simple "10879881.29") - (math-read-number-simple "-512359803.6") - (math-read-number-simple "7062834065.0") - (math-read-number-simple "-2957821389.0")))) + (list + (math-read-number-simple "228.4622733") + (math-read-number-simple "-86327.92757") + (math-read-number-simple "10879881.29") + (math-read-number-simple "-512359803.6") + (math-read-number-simple "7062834065.0") + (math-read-number-simple "-2957821389.0"))) (math-poly-eval y - (eval-when-compile - (list - '(float 1 0) - (math-read-number-simple "226.1030244") - (math-read-number-simple "47447.2647") - (math-read-number-simple "7189466.438") - (math-read-number-simple "745249964.8") - (math-read-number-simple "40076544269.0"))))) - (math-mul (eval-when-compile - (math-read-number-simple "0.636619772")) + (list + '(float 1 0) + (math-read-number-simple "226.1030244") + (math-read-number-simple "47447.2647") + (math-read-number-simple "7189466.438") + (math-read-number-simple "745249964.8") + (math-read-number-simple "40076544269.0")))) + (math-mul (math-read-number-simple "0.636619772") (math-mul (math-besJ0 x) (math-ln-raw x)))))) ((math-negp (calcFunc-re x)) (math-add (math-besJ0 (math-neg x) t) @@ -748,25 +733,23 @@ (math-mul x (math-div (math-poly-eval y - (eval-when-compile - (list - (math-read-number-simple "8511.937935") - (math-read-number-simple "-4237922.726") - (math-read-number-simple "734926455.1") - (math-read-number-simple "-51534381390.0") - (math-read-number-simple "1275274390000.0") - (math-read-number-simple "-4900604943000.0")))) + (list + (math-read-number-simple "8511.937935") + (math-read-number-simple "-4237922.726") + (math-read-number-simple "734926455.1") + (math-read-number-simple "-51534381390.0") + (math-read-number-simple "1275274390000.0") + (math-read-number-simple "-4900604943000.0"))) (math-poly-eval y - (eval-when-compile - (list - '(float 1 0) - (math-read-number-simple "354.9632885") - (math-read-number-simple "102042.605") - (math-read-number-simple "22459040.02") - (math-read-number-simple "3733650367.0") - (math-read-number-simple "424441966400.0") - (math-read-number-simple "24995805700000.0")))))) - (math-mul (eval-when-compile (math-read-number-simple "0.636619772")) + (list + '(float 1 0) + (math-read-number-simple "354.9632885") + (math-read-number-simple "102042.605") + (math-read-number-simple "22459040.02") + (math-read-number-simple "3733650367.0") + (math-read-number-simple "424441966400.0") + (math-read-number-simple "24995805700000.0"))))) + (math-mul (math-read-number-simple "0.636619772") (math-sub (math-mul (math-besJ1 x) (math-ln-raw x)) (math-div 1 x)))))) ((math-negp (calcFunc-re x)) @@ -832,45 +815,45 @@ (calcFunc-euler n '(float 5 -1))) (calcFunc-euler n '(frac 1 2)))))) -(defvar math-bernoulli-b-cache - (eval-when-compile - (list - (list 'frac - -174611 - (math-read-number-simple "802857662698291200000")) - (list 'frac - 43867 - (math-read-number-simple "5109094217170944000")) - (list 'frac - -3617 - (math-read-number-simple "10670622842880000")) - (list 'frac - 1 - (math-read-number-simple "74724249600")) - (list 'frac - -691 - (math-read-number-simple "1307674368000")) - (list 'frac - 1 - (math-read-number-simple "47900160")) - (list 'frac - -1 - (math-read-number-simple "1209600")) - (list 'frac - 1 - 30240) - (list 'frac - -1 - 720) - (list 'frac - 1 - 12) - 1 ))) +(defvar math-bernoulli-b-cache + (list + (list 'frac + -174611 + (math-read-number-simple "802857662698291200000")) + (list 'frac + 43867 + (math-read-number-simple "5109094217170944000")) + (list 'frac + -3617 + (math-read-number-simple "10670622842880000")) + (list 'frac + 1 + (math-read-number-simple "74724249600")) + (list 'frac + -691 + (math-read-number-simple "1307674368000")) + (list 'frac + 1 + (math-read-number-simple "47900160")) + (list 'frac + -1 + (math-read-number-simple "1209600")) + (list 'frac + 1 + 30240) + (list 'frac + -1 + 720) + (list 'frac + 1 + 12) + 1 )) -(defvar math-bernoulli-B-cache '((frac -174611 330) (frac 43867 798) - (frac -3617 510) (frac 7 6) (frac -691 2730) - (frac 5 66) (frac -1 30) (frac 1 42) - (frac -1 30) (frac 1 6) 1 )) +(defvar math-bernoulli-B-cache + '((frac -174611 330) (frac 43867 798) + (frac -3617 510) (frac 7 6) (frac -691 2730) + (frac 5 66) (frac -1 30) (frac 1 42) + (frac -1 30) (frac 1 6) 1 )) (defvar math-bernoulli-cache-size 11) (defun math-bernoulli-coefs (n)
--- a/lisp/calc/calc-math.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/calc/calc-math.el Tue Aug 21 04:55:30 2007 +0000 @@ -1794,16 +1794,14 @@ (math-lnp1-series nextsum (1+ n) nextx x)))) (defconst math-approx-ln-10 - (eval-when-compile - (math-read-number-simple "2.302585092994045684018")) + (math-read-number-simple "2.302585092994045684018") "An approximation for ln(10).") (math-defcache math-ln-10 math-approx-ln-10 (math-ln-raw-2 '(float 1 1))) (defconst math-approx-ln-2 - (eval-when-compile - (math-read-number-simple "0.693147180559945309417")) + (math-read-number-simple "0.693147180559945309417") "An approximation for ln(2).") (math-defcache math-ln-2 math-approx-ln-2
--- a/lisp/calc/calc-units.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/calc/calc-units.el Tue Aug 21 04:55:30 2007 +0000 @@ -40,45 +40,47 @@ ;;; with some additions by Przemek Klosowski (przemek@rrdstrad.nist.gov) ;;; Updated April 2002 by Jochen Küpper -;;; for CODATA 1998 see one of -;;; - Journal of Physical and Chemical Reference Data, 28(6), 1713-1852, 1999. -;;; - Reviews of Modern Physics, 72(2), 351-495, 2000. -;;; for CODATA 2005 see -;;; - http://physics.nist.gov/cuu/Constants/index.html +;;; Updated August 2007, using +;;; CODATA (http://physics.nist.gov/cuu/Constants/index.html) +;;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html) +;;; ESUWM (Encyclopaedia of Scientific Units, Weights and +;;; Measures, by François Cardarelli) +;;; All conversions are exact unless otherwise noted. (defvar math-standard-units '( ;; Length ( m nil "*Meter" ) - ( in "2.54 cm" "Inch" ) + ( in "254*10^(-2) cm" "Inch" ) ( ft "12 in" "Foot" ) ( yd "3 ft" "Yard" ) ( mi "5280 ft" "Mile" ) - ( au "149597870691 m" "Astronomical Unit" ) ;; NASA JPL (http://neo.jpl.nasa.gov/glossary/au.html) - ( lyr "9460536207068016 m" "Light Year" ) - ( pc "206264.80625 au" "Parsec" ) + ( au "149597870691. m" "Astronomical Unit" ) + ;; (approx) NASA JPL (http://neo.jpl.nasa.gov/glossary/au.html) + ( lyr "c yr" "Light Year" ) + ( pc "3.0856775854e16 m" "Parsec" ) ;; (approx) ESUWM ( nmi "1852 m" "Nautical Mile" ) ( fath "6 ft" "Fathom" ) ( mu "1 um" "Micron" ) ( mil "in/1000" "Mil" ) ( point "in/72" "Point (1/72 inch)" ) - ( Ang "1e-10 m" "Angstrom" ) + ( Ang "10^(-10) m" "Angstrom" ) ( mfi "mi+ft+in" "Miles + feet + inches" ) ;; TeX lengths - ( texpt "in/72.27" "Point (TeX conventions)" ) + ( texpt "(100/7227) in" "Point (TeX conventions)" ) ( texpc "12 texpt" "Pica" ) ( texbp "point" "Big point (TeX conventions)" ) - ( texdd "1238/1157 texpt" "Didot point" ) + ( texdd "(1238/1157) texpt" "Didot point" ) ( texcc "12 texdd" "Cicero" ) - ( texsp "1/66536 texpt" "Scaled TeX point" ) + ( texsp "(1/65536) texpt" "Scaled TeX point" ) ;; Area ( hect "10000 m^2" "*Hectare" ) ( a "100 m^2" "Are") ( acre "mi^2 / 640" "Acre" ) - ( b "1e-28 m^2" "Barn" ) + ( b "10^(-28) m^2" "Barn" ) ;; Volume - ( L "1e-3 m^3" "*Liter" ) + ( L "10^(-3) m^3" "*Liter" ) ( l "L" "Liter" ) ( gal "4 qt" "US Gallon" ) ( qt "2 pt" "Quart" ) @@ -87,10 +89,12 @@ ( ozfl "2 tbsp" "Fluid Ounce" ) ( floz "2 tbsp" "Fluid Ounce" ) ( tbsp "3 tsp" "Tablespoon" ) - ( tsp "4.92892159375 ml" "Teaspoon" ) + ;; ESUWM defines a US gallon as 231 in^3. + ;; That gives the following exact value for tsp. + ( tsp "492892159375*10^(-11) ml" "Teaspoon" ) ( vol "tsp+tbsp+ozfl+cup+pt+qt+gal" "Gallons + ... + teaspoons" ) - ( galC "4.54609 L" "Canadian Gallon" ) - ( galUK "4.546092 L" "UK Gallon" ) + ( galC "galUK" "Canadian Gallon" ) + ( galUK "454609*10^(-5) L" "UK Gallon" ) ;; NIST ;; Time ( s nil "*Second" ) @@ -100,44 +104,44 @@ ( day "24 hr" "Day" ) ( wk "7 day" "Week" ) ( hms "wk+day+hr+min+s" "Hours, minutes, seconds" ) - ( yr "365.25 day" "Year" ) + ( yr "365.25 day" "Year" ) ;; (approx, but keep) ( Hz "1/s" "Hertz" ) ;; Speed ( mph "mi/hr" "*Miles per hour" ) ( kph "km/hr" "Kilometers per hour" ) ( knot "nmi/hr" "Knot" ) - ( c "299792458 m/s" "Speed of light" ) ;;; CODATA 2005 + ( c "299792458 m/s" "Speed of light" ) ;;; CODATA ;; Acceleration - ( ga "9.80665 m/s^2" "*\"g\" acceleration" ) ;; CODATA 2005 + ( ga "980665*10^(-5) m/s^2" "*\"g\" acceleration" ) ;; CODATA ;; Mass ( g nil "*Gram" ) ( lb "16 oz" "Pound (mass)" ) - ( oz "28.349523125 g" "Ounce (mass)" ) + ( oz "28349523125*10^(-9) g" "Ounce (mass)" ) ;; ESUWM ( ton "2000 lb" "Ton" ) ( tpo "ton+lb+oz" "Tons + pounds + ounces (mass)" ) ( t "1000 kg" "Metric ton" ) - ( tonUK "1016.0469088 kg" "UK ton" ) + ( tonUK "10160469088*10^(-7) kg" "UK ton" ) ;; ESUWM ( lbt "12 ozt" "Troy pound" ) - ( ozt "31.103475 g" "Troy ounce" ) - ( ct ".2 g" "Carat" ) - ( u "1.66053886e-27 kg" "Unified atomic mass" ) ;; CODATA 2005 + ( ozt "31.10347680 g" "Troy ounce" ) ;; (approx) ESUWM + ( ct "(2/10) g" "Carat" ) ;; ESUWM + ( u "1.660538782e-27 kg" "Unified atomic mass" );;(approx) CODATA ;; Force ( N "m kg/s^2" "*Newton" ) - ( dyn "1e-5 N" "Dyne" ) + ( dyn "10^(-5) N" "Dyne" ) ( gf "ga g" "Gram (force)" ) - ( lbf "4.44822161526 N" "Pound (force)" ) + ( lbf "ga lb" "Pound (force)" ) ( kip "1000 lbf" "Kilopound (force)" ) - ( pdl "0.138255 N" "Poundal" ) + ( pdl "138254954376*10^(-12) N" "Poundal" ) ;; ESUWM ;; Energy ( J "N m" "*Joule" ) - ( erg "1e-7 J" "Erg" ) - ( cal "4.1868 J" "International Table Calorie" ) - ( Btu "1055.05585262 J" "International Table Btu" ) + ( erg "10^(-7) J" "Erg" ) + ( cal "4.18674 J" "International Table Calorie" );;(approx) ESUWM + ( Btu "105505585262*10^(-8) J" "International Table Btu" ) ;; ESUWM ( eV "ech V" "Electron volt" ) ( ev "eV" "Electron volt" ) ( therm "105506000 J" "EEC therm" ) @@ -151,7 +155,7 @@ ;; Power ( W "J/s" "*Watt" ) - ( hp "745.7 W" "Horsepower" ) + ( hp "745.699871581 W" "Horsepower" ) ;;(approx) ESUWM ;; Temperature ( K nil "*Degree Kelvin" K ) @@ -164,24 +168,24 @@ ;; Pressure ( Pa "N/m^2" "*Pascal" ) - ( bar "1e5 Pa" "Bar" ) - ( atm "101325 Pa" "Standard atmosphere" ) ;; CODATA 2005 - ( Torr " 1.333224e2 Pa" "Torr" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html) + ( bar "10^5 Pa" "Bar" ) + ( atm "101325 Pa" "Standard atmosphere" ) ;; CODATA + ( Torr "1.333224e2 Pa" "Torr" ) ;;(approx) NIST ( mHg "1000 Torr" "Meter of mercury" ) - ( inHg "25.4 mmHg" "Inch of mercury" ) - ( inH2O "2.490889e2 Pa" "Inch of water" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html) - ( psi "6894.75729317 Pa" "Pound per square inch" ) + ( inHg "254*10^(-1) mmHg" "Inch of mercury" ) + ( inH2O "2.490889e2 Pa" "Inch of water" ) ;;(approx) NIST + ( psi "lbf/in^2" "Pounds per square inch" ) ;; Viscosity - ( P "0.1 Pa s" "*Poise" ) - ( St "1e-4 m^2/s" "Stokes" ) + ( P "(1/10) Pa s" "*Poise" ) + ( St "10^(-4) m^2/s" "Stokes" ) ;; Electromagnetism ( A nil "*Ampere" ) ( C "A s" "Coulomb" ) ( Fdy "ech Nav" "Faraday" ) - ( e "1.60217653e-19 C" "Elementary charge" ) ;; CODATA 2005 - ( ech "1.60217653e-19 C" "Elementary charge" ) ;; CODATA 2005 + ( e "ech" "Elementary charge" ) + ( ech "1.602176487e-19 C" "Elementary charge" ) ;;(approx) CODATA ( V "W/A" "Volt" ) ( ohm "V/A" "Ohm" ) ( mho "A/V" "Mho" ) @@ -189,26 +193,26 @@ ( F "C/V" "Farad" ) ( H "Wb/A" "Henry" ) ( T "Wb/m^2" "Tesla" ) - ( Gs "1e-4 T" "Gauss" ) + ( Gs "10^(-4) T" "Gauss" ) ( Wb "V s" "Weber" ) ;; Luminous intensity ( cd nil "*Candela" ) - ( sb "1e4 cd/m^2" "Stilb" ) + ( sb "10000 cd/m^2" "Stilb" ) ( lm "cd sr" "Lumen" ) ( lx "lm/m^2" "Lux" ) - ( ph "1e4 lx" "Phot" ) - ( fc "10.76391 lx" "Footcandle" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html) - ( lam "1e4 lm/m^2" "Lambert" ) - ( flam "3.426259 cd/m^2" "Footlambert" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html) + ( ph "10000 lx" "Phot" ) + ( fc "10.76391 lx" "Footcandle" ) ;;(approx) NIST + ( lam "10000 lm/m^2" "Lambert" ) + ( flam "3.426259 cd/m^2" "Footlambert" ) ;;(approx) NIST ;; Radioactivity ( Bq "1/s" "*Becquerel" ) - ( Ci "3.7e10 Bq" "Curie" ) + ( Ci "37*10^9 Bq" "Curie" ) ;; ESUWM ( Gy "J/kg" "Gray" ) ( Sv "Gy" "Sievert" ) - ( R "2.58e-4 C/kg" "Roentgen" ) - ( rd ".01 Gy" "Rad" ) + ( R "258*10^(-6) C/kg" "Roentgen" ) ;; NIST + ( rd "(1/100) Gy" "Rad" ) ( rem "rd" "Rem" ) ;; Amount of substance @@ -228,23 +232,24 @@ ( sr nil "*Steradian" ) ;; Other physical quantities - ( h "6.6260693e-34 J s" "*Planck's constant" ) ;; CODATA 2005 - ( hbar "h / 2 pi" "Planck's constant" ) - ( mu0 "4 pi 1e-7 H/m" "Permeability of vacuum" ) - ( G "6.6742e-11 m^3/kg^1/s^2" "Gravitational constant" ) ;; CODATA 2005 - ( Nav "6.02214115e23 / mol" "Avagadro's constant" ) ;; CODATA 2005 - ( me "9.1093826e-31 kg" "Electron rest mass" ) ;; CODATA 2005 - ( mp "1.67262171e-27 kg" "Proton rest mass" ) ;; CODATA 2005 - ( mn "1.67492728e-27 kg" "Neutron rest mass" ) ;; CODATA 2005 - ( mmu "1.88353140e-28 kg" "Muon rest mass" ) ;; CODATA 2005 - ( Ryd "10973731.568525 /m" "Rydberg's constant" ) ;; CODATA 2005 - ( k "1.3806505e-23 J/K" "Boltzmann's constant" ) ;; CODATA 2005 - ( alpha "7.297352568e-3" "Fine structure constant" ) ;; CODATA 2005 - ( muB "927.400949e-26 J/T" "Bohr magneton" ) ;; CODATA 2005 - ( muN "5.05078343e-27 J/T" "Nuclear magneton" ) ;; CODATA 2005 - ( mue "-928.476412e-26 J/T" "Electron magnetic moment" ) ;; CODATA 2005 - ( mup "1.41060671e-26 J/T" "Proton magnetic moment" ) ;; CODATA 2005 - ( R0 "8.314472 J/mol/K" "Molar gas constant" ) ;; CODATA 2005 + ;; The values are from CODATA, and are approximate. + ( h "6.62606896e-34 J s" "*Planck's constant" ) + ( hbar "h / (2 pi)" "Planck's constant" ) + ( mu0 "4 pi 10^(-7) H/m" "Permeability of vacuum" ) + ( G "6.67428e-11 m^3/(kg s^2)" "Gravitational constant" ) + ( Nav "6.02214179e23 / mol" "Avagadro's constant" ) + ( me "9.10938215e-31 kg" "Electron rest mass" ) + ( mp "1.672621637e-27 kg" "Proton rest mass" ) + ( mn "1.674927211e-27 kg" "Neutron rest mass" ) + ( mmu "1.88353130e-28 kg" "Muon rest mass" ) + ( Ryd "10973731.568527 /m" "Rydberg's constant" ) + ( k "1.3806504e-23 J/K" "Boltzmann's constant" ) + ( alpha "7.2973525376e-3" "Fine structure constant" ) + ( muB "927.400915e-26 J/T" "Bohr magneton" ) + ( muN "5.05078324e-27 J/T" "Nuclear magneton" ) + ( mue "-928.476377e-26 J/T" "Electron magnetic moment" ) + ( mup "1.410606662e-26 J/T" "Proton magnetic moment" ) + ( R0 "8.314472 J/(mol K)" "Molar gas constant" ) ( V0 "22.710981e-3 m^3/mol" "Standard volume of ideal gas" ))) @@ -255,35 +260,35 @@ that the combined units table will be rebuilt.") (defvar math-unit-prefixes - '( ( ?Y (float 1 24) "Yotta" ) - ( ?Z (float 1 21) "Zetta" ) - ( ?E (float 1 18) "Exa" ) - ( ?P (float 1 15) "Peta" ) - ( ?T (float 1 12) "Tera" ) - ( ?G (float 1 9) "Giga" ) - ( ?M (float 1 6) "Mega" ) - ( ?k (float 1 3) "Kilo" ) - ( ?K (float 1 3) "Kilo" ) - ( ?h (float 1 2) "Hecto" ) - ( ?H (float 1 2) "Hecto" ) - ( ?D (float 1 1) "Deka" ) - ( 0 (float 1 0) nil ) - ( ?d (float 1 -1) "Deci" ) - ( ?c (float 1 -2) "Centi" ) - ( ?m (float 1 -3) "Milli" ) - ( ?u (float 1 -6) "Micro" ) - ( ?n (float 1 -9) "Nano" ) - ( ?p (float 1 -12) "Pico" ) - ( ?f (float 1 -15) "Femto" ) - ( ?a (float 1 -18) "Atto" ) - ( ?z (float 1 -21) "zepto" ) - ( ?y (float 1 -24) "yocto" ))) + '( ( ?Y (^ 10 24) "Yotta" ) + ( ?Z (^ 10 21) "Zetta" ) + ( ?E (^ 10 18) "Exa" ) + ( ?P (^ 10 15) "Peta" ) + ( ?T (^ 10 12) "Tera" ) + ( ?G (^ 10 9) "Giga" ) + ( ?M (^ 10 6) "Mega" ) + ( ?k (^ 10 3) "Kilo" ) + ( ?K (^ 10 3) "Kilo" ) + ( ?h (^ 10 2) "Hecto" ) + ( ?H (^ 10 2) "Hecto" ) + ( ?D (^ 10 1) "Deka" ) + ( 0 (^ 10 0) nil ) + ( ?d (^ 10 -1) "Deci" ) + ( ?c (^ 10 -2) "Centi" ) + ( ?m (^ 10 -3) "Milli" ) + ( ?u (^ 10 -6) "Micro" ) + ( ?n (^ 10 -9) "Nano" ) + ( ?p (^ 10 -12) "Pico" ) + ( ?f (^ 10 -15) "Femto" ) + ( ?a (^ 10 -18) "Atto" ) + ( ?z (^ 10 -21) "zepto" ) + ( ?y (^ 10 -24) "yocto" ))) (defvar math-standard-units-systems '( ( base nil ) - ( si ( ( g '(* (var kg var-kg) (float 1 -3)) ) ) ) - ( mks ( ( g '(* (var kg var-kg) (float 1 -3)) ) ) ) - ( cgs ( ( m '(* (var cm var-cm) 100 ) ) ) ))) + ( si ( ( g '(/ (var kg var-kg) 1000) ) ) ) + ( mks ( ( g '(/ (var kg var-kg) 1000) ) ) ) + ( cgs ( ( m '(* (var cm var-cm) 100 ) ) ) ))) (defvar math-units-table nil "Internal units table derived from math-defined-units. @@ -321,13 +326,67 @@ (math-simplify-units (math-mul expr (nth pos units)))))))) +(defun math-get-standard-units (expr) + "Return the standard units in EXPR." + (math-simplify-units + (math-extract-units + (math-to-standard-units expr nil)))) + +(defun math-get-units (expr) + "Return the units in EXPR." + (math-simplify-units + (math-extract-units expr))) + +(defun math-make-unit-string (expr) + "Return EXPR in string form. +If EXPR is nil, return nil." + (if expr + (let ((cexpr (math-compose-expr expr 0))) + (replace-regexp-in-string + " / " "/" + (if (stringp cexpr) + cexpr + (math-composition-to-string cexpr)))))) + +(defvar math-default-units-table + (make-hash-table :test 'equal) + "A table storing previously converted units.") + +(defun math-get-default-units (expr) + "Get default units to use when converting the units in EXPR." + (let* ((units (math-get-units expr)) + (standard-units (math-get-standard-units expr)) + (default-units (gethash + standard-units + math-default-units-table))) + (if (equal units (car default-units)) + (math-make-unit-string (cadr default-units)) + (math-make-unit-string (car default-units))))) + +(defun math-put-default-units (expr) + "Put the units in EXPR in the default units table." + (let* ((units (math-get-units expr)) + (standard-units (math-get-standard-units expr)) + (default-units (gethash + standard-units + math-default-units-table))) + (cond + ((not default-units) + (puthash standard-units (list units) math-default-units-table)) + ((not (equal units (car default-units))) + (puthash standard-units + (list units (car default-units)) + math-default-units-table))))) + + (defun calc-convert-units (&optional old-units new-units) (interactive) (calc-slow-wrapper (let ((expr (calc-top-n 1)) (uoldname nil) unew - units) + units + defunits) (unless (math-units-in-expr-p expr t) (let ((uold (or old-units (progn @@ -343,16 +402,31 @@ (error "Bad format in units expression: %s" (nth 1 uold))) (setq expr (math-mul expr uold)))) (unless new-units - (setq new-units (read-string (if uoldname - (concat "Old units: " - uoldname - ", new units: ") - "New units: ")))) + (setq defunits (math-get-default-units expr)) + (setq new-units + (read-string (concat + (if uoldname + (concat "Old units: " + uoldname + ", new units") + "New units") + (if defunits + (concat + " (default: " + defunits + "): ") + ": ")))) + + (if (and + (string= new-units "") + defunits) + (setq new-units defunits))) (when (string-match "\\` */" new-units) (setq new-units (concat "1" new-units))) (setq units (math-read-expr new-units)) (when (eq (car-safe units) 'error) (error "Bad format in units expression: %s" (nth 2 units))) + (math-put-default-units units) (let ((unew (math-units-in-expr-p units t)) (std (and (eq (car-safe units) 'var) (assq (nth 1 units) math-standard-units-systems)))) @@ -381,7 +455,8 @@ (let ((expr (calc-top-n 1)) (uold nil) (uoldname nil) - unew) + unew + defunits) (setq uold (or old-units (let ((units (math-single-units-in-expr-p expr))) (if units @@ -398,15 +473,24 @@ (error "Bad format in units expression: %s" (nth 2 uold))) (or (math-units-in-expr-p expr nil) (setq expr (math-mul expr uold))) + (setq defunits (math-get-default-units expr)) (setq unew (or new-units (math-read-expr - (read-string (if uoldname - (concat "Old temperature units: " - uoldname - ", new units: ") - "New temperature units: "))))) + (read-string + (concat + (if uoldname + (concat "Old temperature units: " + uoldname + ", new units") + "New temperature units") + (if defunits + (concat " (default: " + defunits + "): ") + ": ")))))) (when (eq (car-safe unew) 'error) (error "Bad format in units expression: %s" (nth 2 unew))) + (math-put-default-units unew) (calc-enter-result 1 "cvtm" (math-simplify-units (math-convert-temperature expr uold unew uoldname))))))
--- a/lisp/calc/calc.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/calc/calc.el Tue Aug 21 04:55:30 2007 +0000 @@ -229,7 +229,8 @@ (c-mode . c) (c++-mode . c) (fortran-mode . fortran) - (f90-mode . fortran)) + (f90-mode . fortran) + (texinfo-mode . calc-normal-language)) "*Alist of major modes with appropriate Calc languages." :group 'calc :type '(alist :key-type (symbol :tag "Major mode") @@ -2283,8 +2284,8 @@ -(defconst math-bignum-digit-length 4 -; (truncate (/ (log10 (/ most-positive-fixnum 2)) 2)) +(defconst math-bignum-digit-length + (truncate (/ (log10 (/ most-positive-fixnum 2)) 2)) "The length of a \"digit\" in Calc bignums. If a big integer is of the form (bigpos N0 N1 ...), this is the length of the allowable Emacs integers N0, N1,...
--- a/lisp/completion.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/completion.el Tue Aug 21 04:55:30 2007 +0000 @@ -568,7 +568,8 @@ (- cmpl-symbol-end cmpl-symbol-start)) (<= (- cmpl-symbol-end cmpl-symbol-start) completion-max-length)) - (buffer-substring cmpl-symbol-start cmpl-symbol-end)))))) + (buffer-substring-no-properties + cmpl-symbol-start cmpl-symbol-end)))))) ;; tests for symbol-under-point ;; `^' indicates cursor pos. where value is returned @@ -601,7 +602,8 @@ ;; Return value if long enough. (if (>= cmpl-symbol-end (+ cmpl-symbol-start completion-min-length)) - (buffer-substring cmpl-symbol-start cmpl-symbol-end))) + (buffer-substring-no-properties + cmpl-symbol-start cmpl-symbol-end))) ((= cmpl-preceding-syntax ?w) ;; chars to ignore at end (let ((saved-point (point))) @@ -621,7 +623,8 @@ (- cmpl-symbol-end cmpl-symbol-start)) (<= (- cmpl-symbol-end cmpl-symbol-start) completion-max-length)) - (buffer-substring cmpl-symbol-start cmpl-symbol-end))))))) + (buffer-substring-no-properties + cmpl-symbol-start cmpl-symbol-end))))))) ;; tests for symbol-before-point ;; `^' indicates cursor pos. where value is returned @@ -670,7 +673,8 @@ (- cmpl-symbol-end cmpl-symbol-start)) (<= (- cmpl-symbol-end cmpl-symbol-start) completion-max-length)) - (buffer-substring cmpl-symbol-start cmpl-symbol-end)))))) + (buffer-substring-no-properties + cmpl-symbol-start cmpl-symbol-end)))))) ;; tests for symbol-before-point-for-complete ;; `^' indicates cursor pos. where value is returned
--- a/lisp/ediff-util.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/ediff-util.el Tue Aug 21 04:55:30 2007 +0000 @@ -3164,7 +3164,11 @@ (defun ediff-make-temp-file (buff &optional prefix given-file start end) (let* ((p (ediff-convert-standard-filename (or prefix "ediff"))) (short-p p) - (coding-system-for-write ediff-coding-system-for-write) + (coding-system-for-write + (ediff-with-current-buffer buff + (if (boundp 'buffer-file-coding-system) + buffer-file-coding-system + ediff-coding-system-for-write))) f short-f) (if (and (fboundp 'msdos-long-file-names) (not (msdos-long-file-names))
--- a/lisp/ediff.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/ediff.el Tue Aug 21 04:55:30 2007 +0000 @@ -8,7 +8,7 @@ ;; Keywords: comparing, merging, patching, tools, unix (defconst ediff-version "2.81.2" "The current version of Ediff") -(defconst ediff-date "June 13, 2007" "Date of last update") +(defconst ediff-date "August 18, 2007" "Date of last update") ;; This file is part of GNU Emacs.
--- a/lisp/emacs-lisp/cl-macs.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/emacs-lisp/cl-macs.el Tue Aug 21 04:55:30 2007 +0000 @@ -272,15 +272,19 @@ (nconc (nreverse simple-args) (list '&rest (car (pop bind-lets)))) (nconc (let ((hdr (nreverse header))) - (require 'help-fns) - (cons (help-add-fundoc-usage - (if (stringp (car hdr)) (pop hdr)) - ;; orig-args can contain &cl-defs (an internal CL - ;; thingy that I do not understand), so remove it. - (let ((x (memq '&cl-defs orig-args))) - (if (null x) orig-args - (delq (car x) (remq (cadr x) orig-args))))) - hdr)) + ;; Macro expansion can take place in the middle of + ;; apparently harmless computation, so it should not + ;; touch the match-data. + (save-match-data + (require 'help-fns) + (cons (help-add-fundoc-usage + (if (stringp (car hdr)) (pop hdr)) + ;; orig-args can contain &cl-defs (an internal + ;; CL thingy I don't understand), so remove it. + (let ((x (memq '&cl-defs orig-args))) + (if (null x) orig-args + (delq (car x) (remq (cadr x) orig-args))))) + hdr))) (list (nconc (list 'let* bind-lets) (nreverse bind-forms) body)))))))
--- a/lisp/emacs-lisp/copyright.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/emacs-lisp/copyright.el Tue Aug 21 04:55:30 2007 +0000 @@ -59,6 +59,7 @@ Only copyright lines where the name matches this regexp will be updated. This allows you to avoid adding yars to a copyright notice belonging to someone else or to a group for which you do not work." + :group 'copyright :type 'regexp) (defcustom copyright-years-regexp @@ -89,13 +90,16 @@ (defvar copyright-current-year (substring (current-time-string) -4) "String representing the current year.") +(defsubst copyright-limit () ; re-search-forward BOUND + (and copyright-limit (+ (point) copyright-limit))) + (defun copyright-update-year (replace noquery) (when (condition-case err (re-search-forward (concat "\\(" copyright-regexp "\\)\\([ \t]*\n\\)?.*\\(?:" copyright-names-regexp "\\)") - (if copyright-limit (+ (point) copyright-limit)) + (copyright-limit) t) ;; In case the regexp is rejected. This is useful because ;; copyright-update is typically called from before-save-hook where @@ -181,7 +185,7 @@ "\\(the Free Software Foundation;\ either \\|; a\\^u eldono \\([0-9]+\\)a, ? a\\^u (la\\^u via \\)\ version \\([0-9]+\\), or (at" - (if copyright-limit (+ (point) copyright-limit)) t) + (copyright-limit) t) (not (string= (match-string 3) copyright-current-gpl-version)) (or noquery (y-or-n-p (concat "Replace GPL version by " @@ -203,8 +207,7 @@ (interactive) (widen) (goto-char (point-min)) - (if (re-search-forward copyright-regexp - (if copyright-limit (+ (point) copyright-limit)) t) + (if (re-search-forward copyright-regexp (copyright-limit) t) (let ((s (match-beginning 2)) (e (copy-marker (1+ (match-end 2)))) (p (make-marker))
--- a/lisp/emacs-lisp/eldoc.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/emacs-lisp/eldoc.el Tue Aug 21 04:55:30 2007 +0000 @@ -264,30 +264,43 @@ ;; so we need to be careful that errors aren't ignored. (error (message "eldoc error: %s" err)))) -;; Return a string containing the function parameter list, or 1-line -;; docstring if function is a subr and no arglist is obtainable from the -;; docstring or elsewhere. -(defun eldoc-get-fnsym-args-string (sym &optional argument-index) - (let ((args nil) - (doc nil)) +(defun eldoc-get-fnsym-args-string (sym &optional index) + "Return a string containing the parameter list of the function SYM. +If SYM is a subr and no arglist is obtainable from the docstring +or elsewhere, return a 1-line docstring. Calls the functions +`eldoc-function-argstring-format' and +`eldoc-highlight-function-argument' to format the result. The +former calls `eldoc-argument-case'; the latter gives the +function name `font-lock-function-name-face', and optionally +highlights argument number INDEX. " + (let (args doc) (cond ((not (and sym (symbolp sym) (fboundp sym)))) - ((and (eq sym (aref eldoc-last-data 0)) - (eq 'function (aref eldoc-last-data 2))) - (setq doc (aref eldoc-last-data 1))) + ((and (eq sym (aref eldoc-last-data 0)) + (eq 'function (aref eldoc-last-data 2))) + (setq doc (aref eldoc-last-data 1))) ((setq doc (help-split-fundoc (documentation sym t) sym)) (setq args (car doc)) + ;; Remove any enclosing (), since e-function-argstring adds them. (string-match "\\`[^ )]* ?" args) - (setq args (concat "(" (substring args (match-end 0)))) - (eldoc-last-data-store sym args 'function)) - (t - (setq args (eldoc-function-argstring sym)))) - (and args - argument-index - (setq doc (eldoc-highlight-function-argument sym args argument-index))) - doc)) + (setq args (substring args (match-end 0))) + (if (string-match ")\\'" args) + (setq args (substring args 0 -1)))) + (t + (setq args (help-function-arglist sym)))) + (if args + ;; Stringify, and store before highlighting, downcasing, etc. + ;; FIXME should truncate before storing. + (eldoc-last-data-store sym (setq args (eldoc-function-argstring args)) + 'function) + (setq args doc)) ; use stored value + ;; Change case, highlight, truncate. + (if args + (eldoc-highlight-function-argument + sym (eldoc-function-argstring-format args) index)))) -;; Highlight argument INDEX in ARGS list for SYM. (defun eldoc-highlight-function-argument (sym args index) + "Highlight argument INDEX in ARGS list for function SYM. +In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." (let ((start nil) (end 0) (argument-face 'bold)) @@ -298,7 +311,7 @@ ;; (defun NAME ARGLIST [DOCSTRING] BODY...) case? ;; The problem is there is no robust way to determine if ;; the current argument is indeed a docstring. - (while (>= index 1) + (while (and index (>= index 1)) (if (string-match "[^ ()]+" args end) (progn (setq start (match-beginning 0) @@ -438,29 +451,31 @@ (error (setq defn nil)))) defn)) -(defun eldoc-function-argstring (fn) - (eldoc-function-argstring-format (help-function-arglist fn))) +(defun eldoc-function-argstring (arglist) + "Return ARGLIST as a string enclosed by (). +ARGLIST is either a string, or a list of strings or symbols." + (cond ((stringp arglist)) + ((not (listp arglist)) + (setq arglist nil)) + ((symbolp (car arglist)) + (setq arglist + (mapconcat (lambda (s) (symbol-name s)) + arglist " "))) + ((stringp (car arglist)) + (setq arglist + (mapconcat (lambda (s) s) + arglist " ")))) + (if arglist + (format "(%s)" arglist))) -(defun eldoc-function-argstring-format (arglist) - (cond ((not (listp arglist)) - (setq arglist nil)) - ((symbolp (car arglist)) - (setq arglist - (mapcar (function (lambda (s) - (if (memq s '(&optional &rest)) - (symbol-name s) - (funcall eldoc-argument-case - (symbol-name s))))) - arglist))) - ((stringp (car arglist)) - (setq arglist - (mapcar (function (lambda (s) - (if (member s '("&optional" "&rest")) - s - (funcall eldoc-argument-case s)))) - arglist)))) - (concat "(" (mapconcat 'identity arglist " ") ")")) - +(defun eldoc-function-argstring-format (argstring) + "Apply `eldoc-argument-case' to each word in argstring. +The words \"&rest\", \"&optional\" are returned unchanged." + (mapconcat (lambda (s) + (if (member s '("&optional" "&rest")) + s + (funcall eldoc-argument-case s))) + (split-string argstring) " ")) ;; When point is in a sexp, the function args are not reprinted in the echo ;; area after every possible interactive command because some of them print
--- a/lisp/emacs-lisp/lisp-mode.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/emacs-lisp/lisp-mode.el Tue Aug 21 04:55:30 2007 +0000 @@ -539,62 +539,65 @@ string)))) +(defun preceding-sexp () + "Return sexp before the point." + (let ((opoint (point)) + ignore-quotes + expr) + (save-excursion + (with-syntax-table emacs-lisp-mode-syntax-table + ;; If this sexp appears to be enclosed in `...' + ;; then ignore the surrounding quotes. + (setq ignore-quotes + (or (eq (following-char) ?\') + (eq (preceding-char) ?\'))) + (forward-sexp -1) + ;; If we were after `?\e' (or similar case), + ;; use the whole thing, not just the `e'. + (when (eq (preceding-char) ?\\) + (forward-char -1) + (when (eq (preceding-char) ??) + (forward-char -1))) + + ;; Skip over `#N='s. + (when (eq (preceding-char) ?=) + (let (labeled-p) + (save-excursion + (skip-chars-backward "0-9#=") + (setq labeled-p (looking-at "\\(#[0-9]+=\\)+"))) + (when labeled-p + (forward-sexp -1)))) + + (save-restriction + ;; vladimir@cs.ualberta.ca 30-Jul-1997: skip ` in + ;; `variable' so that the value is returned, not the + ;; name + (if (and ignore-quotes + (eq (following-char) ?`)) + (forward-char)) + (narrow-to-region (point-min) opoint) + (setq expr (read (current-buffer))) + ;; If it's an (interactive ...) form, it's more + ;; useful to show how an interactive call would + ;; use it. + (and (consp expr) + (eq (car expr) 'interactive) + (setq expr + (list 'call-interactively + (list 'quote + (list 'lambda + '(&rest args) + expr + 'args))))) + expr))))) + + (defun eval-last-sexp-1 (eval-last-sexp-arg-internal) "Evaluate sexp before point; print value in minibuffer. With argument, print output into current buffer." (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t))) - (let ((value - (eval (let ((stab (syntax-table)) - (opoint (point)) - ignore-quotes - expr) - (save-excursion - (with-syntax-table emacs-lisp-mode-syntax-table - ;; If this sexp appears to be enclosed in `...' - ;; then ignore the surrounding quotes. - (setq ignore-quotes - (or (eq (following-char) ?\') - (eq (preceding-char) ?\'))) - (forward-sexp -1) - ;; If we were after `?\e' (or similar case), - ;; use the whole thing, not just the `e'. - (when (eq (preceding-char) ?\\) - (forward-char -1) - (when (eq (preceding-char) ??) - (forward-char -1))) + (eval-last-sexp-print-value (eval (preceding-sexp))))) - ;; Skip over `#N='s. - (when (eq (preceding-char) ?=) - (let (labeled-p) - (save-excursion - (skip-chars-backward "0-9#=") - (setq labeled-p (looking-at "\\(#[0-9]+=\\)+"))) - (when labeled-p - (forward-sexp -1)))) - - (save-restriction - ;; vladimir@cs.ualberta.ca 30-Jul-1997: skip ` in - ;; `variable' so that the value is returned, not the - ;; name - (if (and ignore-quotes - (eq (following-char) ?`)) - (forward-char)) - (narrow-to-region (point-min) opoint) - (setq expr (read (current-buffer))) - ;; If it's an (interactive ...) form, it's more - ;; useful to show how an interactive call would - ;; use it. - (and (consp expr) - (eq (car expr) 'interactive) - (setq expr - (list 'call-interactively - (list 'quote - (list 'lambda - '(&rest args) - expr - 'args))))) - expr))))))) - (eval-last-sexp-print-value value)))) (defun eval-last-sexp-print-value (value) (let ((unabbreviated (let ((print-length nil) (print-level nil))
--- a/lisp/emulation/cua-base.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/emulation/cua-base.el Tue Aug 21 04:55:30 2007 +0000 @@ -1601,22 +1601,6 @@ (interactive) (setq cua--debug (not cua--debug))) -;; Install run-time check for older versions of CUA-mode which does not -;; work with GNU Emacs version 22.1 and newer. -;; -;; Except for version 1.2, all of the 1.x and 2.x version of cua-mode -;; provided the `CUA-mode' feature. Since this is no longer true, -;; we can warn the user if the `CUA-mode' feature is ever provided. - -;;;###autoload (eval-after-load 'CUA-mode -;;;###autoload '(error (concat "\n\n" -;;;###autoload "CUA-mode is now part of the standard GNU Emacs distribution, so you may\n" -;;;###autoload "now enable CUA via the Options menu or by customizing option `cua-mode'.\n\n" -;;;###autoload "You have loaded an older version of CUA-mode which does\n" -;;;###autoload "not work correctly with this version of GNU Emacs.\n\n" -;;;###autoload (if user-init-file (concat -;;;###autoload "To correct this, remove the loading and customization of the\n" -;;;###autoload "old version from the " user-init-file " file.\n\n"))))) (provide 'cua)
--- a/lisp/emulation/tpu-edt.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/emulation/tpu-edt.el Tue Aug 21 04:55:30 2007 +0000 @@ -322,176 +322,176 @@ ;; that term/*.el does its job to map the escape sequence to the right ;; key-symbol. - (define-key map [up] 'tpu-move-to-beginning) ; up-arrow - (define-key map [down] 'tpu-move-to-end) ; down-arrow - (define-key map [right] 'end-of-line) ; right-arrow - (define-key map [left] 'beginning-of-line) ; left-arrow + (define-key map [up] 'tpu-move-to-beginning) ; up-arrow + (define-key map [down] 'tpu-move-to-end) ; down-arrow + (define-key map [right] 'end-of-line) ; right-arrow + (define-key map [left] 'beginning-of-line) ; left-arrow - (define-key map [find] 'nil) ; Find - (define-key map [insert] 'nil) ; Insert Here - (define-key map [delete] 'tpu-store-text) ; Remove - (define-key map [select] 'tpu-unselect) ; Select - (define-key map [prior] 'tpu-previous-window) ; Prev Screen - (define-key map [next] 'tpu-next-window) ; Next Screen + ;; (define-key map [find] nil) ; Find + ;; (define-key map [insert] nil) ; Insert Here + (define-key map [delete] 'tpu-store-text) ; Remove + (define-key map [select] 'tpu-unselect) ; Select + (define-key map [prior] 'tpu-previous-window) ; Prev Screen + (define-key map [next] 'tpu-next-window) ; Next Screen - (define-key map [f1] 'nil) ; F1 - (define-key map [f2] 'nil) ; F2 - (define-key map [f3] 'nil) ; F3 - (define-key map [f4] 'nil) ; F4 - (define-key map [f5] 'nil) ; F5 - (define-key map [f6] 'nil) ; F6 - (define-key map [f7] 'nil) ; F7 - (define-key map [f8] 'nil) ; F8 - (define-key map [f9] 'nil) ; F9 - (define-key map [f10] 'nil) ; F10 - (define-key map [f11] 'nil) ; F11 - (define-key map [f12] 'nil) ; F12 - (define-key map [f13] 'nil) ; F13 - (define-key map [f14] 'nil) ; F14 - (define-key map [help] 'describe-bindings) ; HELP - (define-key map [menu] 'nil) ; DO - (define-key map [f17] 'tpu-drop-breadcrumb) ; F17 - (define-key map [f18] 'nil) ; F18 - (define-key map [f19] 'nil) ; F19 - (define-key map [f20] 'nil) ; F20 + ;; (define-key map [f1] nil) ; F1 + ;; (define-key map [f2] nil) ; F2 + ;; (define-key map [f3] nil) ; F3 + ;; (define-key map [f4] nil) ; F4 + ;; (define-key map [f5] nil) ; F5 + ;; (define-key map [f6] nil) ; F6 + ;; (define-key map [f7] nil) ; F7 + ;; (define-key map [f8] nil) ; F8 + ;; (define-key map [f9] nil) ; F9 + ;; (define-key map [f10] nil) ; F10 + ;; (define-key map [f11] nil) ; F11 + ;; (define-key map [f12] nil) ; F12 + ;; (define-key map [f13] nil) ; F13 + ;; (define-key map [f14] nil) ; F14 + (define-key map [help] 'describe-bindings) ; HELP + ;; (define-key map [menu] nil) ; DO + (define-key map [f17] 'tpu-drop-breadcrumb) ; F17 + ;; (define-key map [f18] nil) ; F18 + ;; (define-key map [f19] nil) ; F19 + ;; (define-key map [f20] nil) ; F20 - (define-key map [kp-f1] 'keyboard-quit) ; PF1 - (define-key map [kp-f2] 'help-for-help) ; PF2 - (define-key map [kp-f3] 'tpu-search) ; PF3 - (define-key map [kp-f4] 'tpu-undelete-lines) ; PF4 - (define-key map [kp-0] 'open-line) ; KP0 - (define-key map [kp-1] 'tpu-change-case) ; KP1 - (define-key map [kp-2] 'tpu-delete-to-eol) ; KP2 - (define-key map [kp-3] 'tpu-special-insert) ; KP3 - (define-key map [kp-4] 'tpu-move-to-end) ; KP4 - (define-key map [kp-5] 'tpu-move-to-beginning) ; KP5 - (define-key map [kp-6] 'tpu-paste) ; KP6 - (define-key map [kp-7] 'execute-extended-command) ; KP7 - (define-key map [kp-8] 'tpu-fill) ; KP8 - (define-key map [kp-9] 'tpu-replace) ; KP9 - (define-key map [kp-subtract] 'tpu-undelete-words) ; KP- - (define-key map [kp-separator] 'tpu-undelete-char) ; KP, - (define-key map [kp-decimal] 'tpu-unselect) ; KP. - (define-key map [kp-enter] 'tpu-substitute) ; KPenter + (define-key map [kp-f1] 'keyboard-quit) ; PF1 + (define-key map [kp-f2] 'help-for-help) ; PF2 + (define-key map [kp-f3] 'tpu-search) ; PF3 + (define-key map [kp-f4] 'tpu-undelete-lines) ; PF4 + (define-key map [kp-0] 'open-line) ; KP0 + (define-key map [kp-1] 'tpu-change-case) ; KP1 + (define-key map [kp-2] 'tpu-delete-to-eol) ; KP2 + (define-key map [kp-3] 'tpu-special-insert) ; KP3 + (define-key map [kp-4] 'tpu-move-to-end) ; KP4 + (define-key map [kp-5] 'tpu-move-to-beginning) ; KP5 + (define-key map [kp-6] 'tpu-paste) ; KP6 + (define-key map [kp-7] 'execute-extended-command) ; KP7 + (define-key map [kp-8] 'tpu-fill) ; KP8 + (define-key map [kp-9] 'tpu-replace) ; KP9 + (define-key map [kp-subtract] 'tpu-undelete-words) ; KP- + (define-key map [kp-separator] 'tpu-undelete-char) ; KP, + (define-key map [kp-decimal] 'tpu-unselect) ; KP. + (define-key map [kp-enter] 'tpu-substitute) ; KPenter ;; - (define-key map "\C-A" 'tpu-toggle-overwrite-mode) ; ^A - (define-key map "\C-B" 'nil) ; ^B - (define-key map "\C-C" 'nil) ; ^C - (define-key map "\C-D" 'nil) ; ^D - (define-key map "\C-E" 'nil) ; ^E - (define-key map "\C-F" 'set-visited-file-name) ; ^F - (define-key map "\C-g" 'keyboard-quit) ; safety first - (define-key map "\C-h" 'delete-other-windows) ; BS - (define-key map "\C-i" 'other-window) ; TAB - (define-key map "\C-J" 'nil) ; ^J - (define-key map "\C-K" 'tpu-define-macro-key) ; ^K - (define-key map "\C-l" 'downcase-region) ; ^L - (define-key map "\C-M" 'nil) ; ^M - (define-key map "\C-N" 'nil) ; ^N - (define-key map "\C-O" 'nil) ; ^O - (define-key map "\C-P" 'nil) ; ^P - (define-key map "\C-Q" 'nil) ; ^Q - (define-key map "\C-R" 'nil) ; ^R - (define-key map "\C-S" 'nil) ; ^S - (define-key map "\C-T" 'tpu-toggle-control-keys) ; ^T - (define-key map "\C-u" 'upcase-region) ; ^U - (define-key map "\C-V" 'nil) ; ^V - (define-key map "\C-w" 'tpu-write-current-buffers) ; ^W - (define-key map "\C-X" 'nil) ; ^X - (define-key map "\C-Y" 'nil) ; ^Y - (define-key map "\C-Z" 'nil) ; ^Z - (define-key map " " 'undo) ; SPC - (define-key map "!" 'nil) ; ! - (define-key map "#" 'nil) ; # - (define-key map "$" 'tpu-add-at-eol) ; $ - (define-key map "%" 'tpu-goto-percent) ; % - (define-key map "&" 'nil) ; & - (define-key map "(" 'nil) ; ( - (define-key map ")" 'nil) ; ) - (define-key map "*" 'tpu-toggle-regexp) ; * - (define-key map "+" 'nil) ; + - (define-key map "," 'tpu-goto-breadcrumb) ; , - (define-key map "-" 'negative-argument) ; - - (define-key map "." 'tpu-drop-breadcrumb) ; . - (define-key map "/" 'tpu-emacs-replace) ; / - (define-key map "0" 'digit-argument) ; 0 - (define-key map "1" 'digit-argument) ; 1 - (define-key map "2" 'digit-argument) ; 2 - (define-key map "3" 'digit-argument) ; 3 - (define-key map "4" 'digit-argument) ; 4 - (define-key map "5" 'digit-argument) ; 5 - (define-key map "6" 'digit-argument) ; 6 - (define-key map "7" 'digit-argument) ; 7 - (define-key map "8" 'digit-argument) ; 8 - (define-key map "9" 'digit-argument) ; 9 - (define-key map ":" 'nil) ; : - (define-key map ";" 'tpu-trim-line-ends) ; ; - (define-key map "<" 'nil) ; < - (define-key map "=" 'nil) ; = - (define-key map ">" 'nil) ; > - (define-key map "?" 'tpu-spell-check) ; ? - (define-key map "A" 'tpu-toggle-newline-and-indent) ; A - (define-key map "B" 'tpu-next-buffer) ; B - (define-key map "C" 'repeat-complex-command) ; C - (define-key map "D" 'shell-command) ; D - (define-key map "E" 'tpu-exit) ; E - (define-key map "F" 'tpu-set-cursor-free) ; F - (define-key map "G" 'tpu-get) ; G - (define-key map "H" 'nil) ; H - (define-key map "I" 'tpu-include) ; I - (define-key map "K" 'tpu-kill-buffer) ; K - (define-key map "L" 'tpu-what-line) ; L - (define-key map "M" 'buffer-menu) ; M - (define-key map "N" 'tpu-next-file-buffer) ; N - (define-key map "O" 'occur) ; O - (define-key map "P" 'lpr-buffer) ; P - (define-key map "Q" 'tpu-quit) ; Q - (define-key map "R" 'tpu-toggle-rectangle) ; R - (define-key map "S" 'replace) ; S - (define-key map "T" 'tpu-line-to-top-of-window) ; T - (define-key map "U" 'undo) ; U - (define-key map "V" 'tpu-version) ; V - (define-key map "W" 'save-buffer) ; W - (define-key map "X" 'tpu-save-all-buffers-kill-emacs) ; X - (define-key map "Y" 'copy-region-as-kill) ; Y - (define-key map "Z" 'suspend-emacs) ; Z - (define-key map "[" 'blink-matching-open) ; [ - (define-key map "\\" 'nil) ; \ - (define-key map "]" 'blink-matching-open) ; ] - (define-key map "^" 'tpu-add-at-bol) ; ^ - (define-key map "_" 'split-window-vertically) ; - - (define-key map "`" 'what-line) ; ` - (define-key map "a" 'tpu-toggle-newline-and-indent) ; a - (define-key map "b" 'tpu-next-buffer) ; b - (define-key map "c" 'repeat-complex-command) ; c - (define-key map "d" 'shell-command) ; d - (define-key map "e" 'tpu-exit) ; e - (define-key map "f" 'tpu-set-cursor-free) ; f - (define-key map "g" 'tpu-get) ; g - (define-key map "h" 'nil) ; h - (define-key map "i" 'tpu-include) ; i - (define-key map "k" 'tpu-kill-buffer) ; k - (define-key map "l" 'goto-line) ; l - (define-key map "m" 'buffer-menu) ; m - (define-key map "n" 'tpu-next-file-buffer) ; n - (define-key map "o" 'occur) ; o - (define-key map "p" 'lpr-region) ; p - (define-key map "q" 'tpu-quit) ; q - (define-key map "r" 'tpu-toggle-rectangle) ; r - (define-key map "s" 'replace) ; s - (define-key map "t" 'tpu-line-to-top-of-window) ; t - (define-key map "u" 'undo) ; u - (define-key map "v" 'tpu-version) ; v - (define-key map "w" 'save-buffer) ; w + (define-key map "\C-A" 'tpu-toggle-overwrite-mode) ; ^A + ;; (define-key map "\C-B" nil) ; ^B + ;; (define-key map "\C-C" nil) ; ^C + ;; (define-key map "\C-D" nil) ; ^D + ;; (define-key map "\C-E" nil) ; ^E + (define-key map "\C-F" 'set-visited-file-name) ; ^F + (define-key map "\C-g" 'keyboard-quit) ; safety first + (define-key map "\C-h" 'delete-other-windows) ; BS + (define-key map "\C-i" 'other-window) ; TAB + ;; (define-key map "\C-J" nil) ; ^J + (define-key map "\C-K" 'tpu-define-macro-key) ; ^K + (define-key map "\C-l" 'downcase-region) ; ^L + ;; (define-key map "\C-M" nil) ; ^M + ;; (define-key map "\C-N" nil) ; ^N + ;; (define-key map "\C-O" nil) ; ^O + ;; (define-key map "\C-P" nil) ; ^P + ;; (define-key map "\C-Q" nil) ; ^Q + ;; (define-key map "\C-R" nil) ; ^R + ;; (define-key map "\C-S" nil) ; ^S + (define-key map "\C-T" 'tpu-toggle-control-keys) ; ^T + (define-key map "\C-u" 'upcase-region) ; ^U + ;; (define-key map "\C-V" nil) ; ^V + (define-key map "\C-w" 'tpu-write-current-buffers) ; ^W + ;; (define-key map "\C-X" nil) ; ^X + ;; (define-key map "\C-Y" nil) ; ^Y + ;; (define-key map "\C-Z" nil) ; ^Z + (define-key map " " 'undo) ; SPC + ;; (define-key map "!" nil) ; ! + ;; (define-key map "#" nil) ; # + (define-key map "$" 'tpu-add-at-eol) ; $ + (define-key map "%" 'tpu-goto-percent) ; % + ;; (define-key map "&" nil) ; & + ;; (define-key map "(" nil) ; ( + ;; (define-key map ")" nil) ; ) + (define-key map "*" 'tpu-toggle-regexp) ; * + ;; (define-key map "+" nil) ; + + (define-key map "," 'tpu-goto-breadcrumb) ; , + (define-key map "-" 'negative-argument) ; - + (define-key map "." 'tpu-drop-breadcrumb) ; . + (define-key map "/" 'tpu-emacs-replace) ; / + (define-key map "0" 'digit-argument) ; 0 + (define-key map "1" 'digit-argument) ; 1 + (define-key map "2" 'digit-argument) ; 2 + (define-key map "3" 'digit-argument) ; 3 + (define-key map "4" 'digit-argument) ; 4 + (define-key map "5" 'digit-argument) ; 5 + (define-key map "6" 'digit-argument) ; 6 + (define-key map "7" 'digit-argument) ; 7 + (define-key map "8" 'digit-argument) ; 8 + (define-key map "9" 'digit-argument) ; 9 + ;; (define-key map ":" nil) ; : + (define-key map ";" 'tpu-trim-line-ends) ; ; + ;; (define-key map "<" nil) ; < + ;; (define-key map "=" nil) ; = + ;; (define-key map ">" nil) ; > + (define-key map "?" 'tpu-spell-check) ; ? + ;; (define-key map "A" 'tpu-toggle-newline-and-indent) ; A + ;; (define-key map "B" 'tpu-next-buffer) ; B + ;; (define-key map "C" 'repeat-complex-command) ; C + ;; (define-key map "D" 'shell-command) ; D + ;; (define-key map "E" 'tpu-exit) ; E + ;; (define-key map "F" 'tpu-cursor-free-mode) ; F + ;; (define-key map "G" 'tpu-get) ; G + ;; (define-key map "H" nil) ; H + ;; (define-key map "I" 'tpu-include) ; I + ;; (define-key map "K" 'tpu-kill-buffer) ; K + (define-key map "L" 'tpu-what-line) ; L + ;; (define-key map "M" 'buffer-menu) ; M + ;; (define-key map "N" 'tpu-next-file-buffer) ; N + ;; (define-key map "O" 'occur) ; O + (define-key map "P" 'lpr-buffer) ; P + ;; (define-key map "Q" 'tpu-quit) ; Q + ;; (define-key map "R" 'tpu-toggle-rectangle) ; R + ;; (define-key map "S" 'replace) ; S + ;; (define-key map "T" 'tpu-line-to-top-of-window) ; T + ;; (define-key map "U" 'undo) ; U + ;; (define-key map "V" 'tpu-version) ; V + ;; (define-key map "W" 'save-buffer) ; W + ;; (define-key map "X" 'tpu-save-all-buffers-kill-emacs) ; X + ;; (define-key map "Y" 'copy-region-as-kill) ; Y + ;; (define-key map "Z" 'suspend-emacs) ; Z + (define-key map "[" 'blink-matching-open) ; [ + ;; (define-key map "\\" nil) ; \ + (define-key map "]" 'blink-matching-open) ; ] + (define-key map "^" 'tpu-add-at-bol) ; ^ + (define-key map "_" 'split-window-vertically) ; - + (define-key map "`" 'what-line) ; ` + (define-key map "a" 'tpu-toggle-newline-and-indent) ; a + (define-key map "b" 'tpu-next-buffer) ; b + (define-key map "c" 'repeat-complex-command) ; c + (define-key map "d" 'shell-command) ; d + (define-key map "e" 'tpu-exit) ; e + (define-key map "f" 'tpu-cursor-free-mode) ; f + (define-key map "g" 'tpu-get) ; g + ;; (define-key map "h" nil) ; h + (define-key map "i" 'tpu-include) ; i + (define-key map "k" 'tpu-kill-buffer) ; k + (define-key map "l" 'goto-line) ; l + (define-key map "m" 'buffer-menu) ; m + (define-key map "n" 'tpu-next-file-buffer) ; n + (define-key map "o" 'occur) ; o + (define-key map "p" 'lpr-region) ; p + (define-key map "q" 'tpu-quit) ; q + (define-key map "r" 'tpu-toggle-rectangle) ; r + (define-key map "s" 'replace) ; s + (define-key map "t" 'tpu-line-to-top-of-window) ; t + (define-key map "u" 'undo) ; u + (define-key map "v" 'tpu-version) ; v + (define-key map "w" 'save-buffer) ; w (define-key map "x" 'tpu-save-all-buffers-kill-emacs) ; x - (define-key map "y" 'copy-region-as-kill) ; y - (define-key map "z" 'suspend-emacs) ; z - (define-key map "{" 'nil) ; { - (define-key map "|" 'split-window-horizontally) ; | - (define-key map "}" 'nil) ; } - (define-key map "~" 'exchange-point-and-mark) ; ~ - (define-key map "\177" 'delete-window) ; <X] + (define-key map "y" 'copy-region-as-kill) ; y + (define-key map "z" 'suspend-emacs) ; z + ;; (define-key map "{" nil) ; { + (define-key map "|" 'split-window-horizontally) ; | + ;; (define-key map "}" nil) ; } + (define-key map "~" 'exchange-point-and-mark) ; ~ + (define-key map "\177" 'delete-window) ; <X] map) "Maps the function keys on the VT100 keyboard preceded by PF1. GOLD is the ASCII 7-bit escape sequence <ESC>OP.") @@ -502,61 +502,61 @@ ;; Previously defined in CSI-map. We now presume that term/*.el does ;; its job to map the escape sequence to the right key-symbol. - (define-key map [find] 'tpu-search) ; Find - (define-key map [insert] 'tpu-paste) ; Insert Here - (define-key map [delete] 'tpu-cut) ; Remove - (define-key map [select] 'tpu-select) ; Select - (define-key map [prior] 'tpu-scroll-window-down) ; Prev Screen - (define-key map [next] 'tpu-scroll-window-up) ; Next Screen + (define-key map [find] 'tpu-search) ; Find + (define-key map [insert] 'tpu-paste) ; Insert Here + (define-key map [delete] 'tpu-cut) ; Remove + (define-key map [select] 'tpu-select) ; Select + (define-key map [prior] 'tpu-scroll-window-down) ; Prev Screen + (define-key map [next] 'tpu-scroll-window-up) ; Next Screen - (define-key map [f1] 'nil) ; F1 - (define-key map [f2] 'nil) ; F2 - (define-key map [f3] 'nil) ; F3 - (define-key map [f4] 'nil) ; F4 - (define-key map [f5] 'nil) ; F5 - (define-key map [f6] 'nil) ; F6 - (define-key map [f7] 'nil) ; F7 - (define-key map [f8] 'nil) ; F8 - (define-key map [f9] 'nil) ; F9 - (define-key map [f10] 'tpu-exit) ; F10 - (define-key map [f11] 'tpu-insert-escape) ; F11 (ESC) - (define-key map [f12] 'tpu-next-beginning-of-line) ; F12 (BS) - (define-key map [f13] 'tpu-delete-previous-word) ; F13 (LF) - (define-key map [f14] 'tpu-toggle-overwrite-mode) ; F14 - (define-key map [help] 'tpu-help) ; HELP - (define-key map [menu] 'execute-extended-command) ; DO - (define-key map [f17] 'tpu-goto-breadcrumb) ; F17 - (define-key map [f18] 'nil) ; F18 - (define-key map [f19] 'nil) ; F19 - (define-key map [f20] 'nil) ; F20 + ;; (define-key map [f1] nil) ; F1 + ;; (define-key map [f2] nil) ; F2 + ;; (define-key map [f3] nil) ; F3 + ;; (define-key map [f4] nil) ; F4 + ;; (define-key map [f5] nil) ; F5 + ;; (define-key map [f6] nil) ; F6 + ;; (define-key map [f7] nil) ; F7 + ;; (define-key map [f8] nil) ; F8 + ;; (define-key map [f9] nil) ; F9 + (define-key map [f10] 'tpu-exit) ; F10 + (define-key map [f11] 'tpu-insert-escape) ; F11 (ESC) + (define-key map [f12] 'tpu-next-beginning-of-line) ; F12 (BS) + (define-key map [f13] 'tpu-delete-previous-word) ; F13 (LF) + (define-key map [f14] 'tpu-toggle-overwrite-mode) ; F14 + (define-key map [help] 'tpu-help) ; HELP + (define-key map [menu] 'execute-extended-command) ; DO + (define-key map [f17] 'tpu-goto-breadcrumb) ; F17 + ;; (define-key map [f18] nil) ; F18 + ;; (define-key map [f19] nil) ; F19 + ;; (define-key map [f20] nil) ; F20 ;; Previously defined in SS3-map. We now presume that term/*.el does ;; its job to map the escape sequence to the right key-symbol. - (define-key map [kp-f1] tpu-gold-map) ; GOLD map + (define-key map [kp-f1] tpu-gold-map) ; GOLD map ;; - (define-key map [up] 'tpu-previous-line) ; up - (define-key map [down] 'tpu-next-line) ; down - (define-key map [right] 'tpu-forward-char) ; right - (define-key map [left] 'tpu-backward-char) ; left + (define-key map [up] 'tpu-previous-line) ; up + (define-key map [down] 'tpu-next-line) ; down + (define-key map [right] 'tpu-forward-char) ; right + (define-key map [left] 'tpu-backward-char) ; left - (define-key map [kp-f2] 'tpu-help) ; PF2 - (define-key map [kp-f3] 'tpu-search-again) ; PF3 - (define-key map [kp-f4] 'tpu-delete-current-line) ; PF4 - (define-key map [kp-0] 'tpu-line) ; KP0 - (define-key map [kp-1] 'tpu-word) ; KP1 - (define-key map [kp-2] 'tpu-end-of-line) ; KP2 - (define-key map [kp-3] 'tpu-char) ; KP3 - (define-key map [kp-4] 'tpu-advance-direction) ; KP4 - (define-key map [kp-5] 'tpu-backup-direction) ; KP5 - (define-key map [kp-6] 'tpu-cut) ; KP6 - (define-key map [kp-7] 'tpu-page) ; KP7 - (define-key map [kp-8] 'tpu-scroll-window) ; KP8 - (define-key map [kp-9] 'tpu-append-region) ; KP9 + (define-key map [kp-f2] 'tpu-help) ; PF2 + (define-key map [kp-f3] 'tpu-search-again) ; PF3 + (define-key map [kp-f4] 'tpu-delete-current-line) ; PF4 + (define-key map [kp-0] 'tpu-line) ; KP0 + (define-key map [kp-1] 'tpu-word) ; KP1 + (define-key map [kp-2] 'tpu-end-of-line) ; KP2 + (define-key map [kp-3] 'tpu-char) ; KP3 + (define-key map [kp-4] 'tpu-advance-direction) ; KP4 + (define-key map [kp-5] 'tpu-backup-direction) ; KP5 + (define-key map [kp-6] 'tpu-cut) ; KP6 + (define-key map [kp-7] 'tpu-page) ; KP7 + (define-key map [kp-8] 'tpu-scroll-window) ; KP8 + (define-key map [kp-9] 'tpu-append-region) ; KP9 (define-key map [kp-subtract] 'tpu-delete-current-word) ; KP- (define-key map [kp-separator] 'tpu-delete-current-char) ; KP, - (define-key map [kp-decimal] 'tpu-select) ; KP. - (define-key map [kp-enter] 'newline) ; KPenter + (define-key map [kp-decimal] 'tpu-select) ; KP. + (define-key map [kp-enter] 'newline) ; KPenter map) "TPU-edt global keymap.") @@ -2225,8 +2225,8 @@ ;;; ;;; Minibuffer map additions to set search direction ;;; -(define-key minibuffer-local-map "\eOt" 'tpu-search-forward-exit) ;KP4 -(define-key minibuffer-local-map "\eOu" 'tpu-search-backward-exit) ;KP5 +(define-key minibuffer-local-map [kp-4] 'tpu-search-forward-exit) ;KP4 +(define-key minibuffer-local-map [kp-5] 'tpu-search-backward-exit) ;KP5 ;;; @@ -2428,6 +2428,33 @@ (ad-disable-regexp "\\`tpu-") (setq tpu-edt-mode nil)) + +;;;### (autoloads (tpu-set-cursor-bound tpu-set-cursor-free tpu-set-scroll-margins +;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "e0629234f1abe076917a303456b48329") +;;; Generated autoloads from tpu-extras.el + +(autoload 'tpu-cursor-free-mode "tpu-extras" "\ +Minor mode to allow the cursor to move freely about the screen. + +\(fn &optional ARG)" t nil) + +(autoload 'tpu-set-scroll-margins "tpu-extras" "\ +Set scroll margins. + +\(fn TOP BOTTOM)" t nil) + +(autoload 'tpu-set-cursor-free "tpu-extras" "\ +Allow the cursor to move freely about the screen. + +\(fn)" t nil) + +(autoload 'tpu-set-cursor-bound "tpu-extras" "\ +Constrain the cursor to the flow of the text. + +\(fn)" t nil) + +;;;*** + (provide 'tpu-edt) ;; arch-tag: f3dfe61c-2cbd-4f73-b9cc-eb215020b857
--- a/lisp/emulation/tpu-extras.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/emulation/tpu-extras.el Tue Aug 21 04:55:30 2007 +0000 @@ -112,18 +112,18 @@ ;;; Customization variables (defcustom tpu-top-scroll-margin 0 - "*Scroll margin at the top of the screen. + "Scroll margin at the top of the screen. Interpreted as a percent of the current window size." :type 'integer :group 'tpu) (defcustom tpu-bottom-scroll-margin 0 - "*Scroll margin at the bottom of the screen. + "Scroll margin at the bottom of the screen. Interpreted as a percent of the current window size." :type 'integer :group 'tpu) (defcustom tpu-backward-char-like-tpu t - "*If non-nil, in free cursor mode backward-char (left-arrow) works + "If non-nil, in free cursor mode backward-char (left-arrow) works just like TPU/edt. Otherwise, backward-char will move to the end of the previous line when starting from a line beginning." :type 'boolean @@ -132,8 +132,12 @@ ;;; Global variables -(defvar tpu-cursor-free nil - "If non-nil, let the cursor roam free.") +;;;###autoload +(define-minor-mode tpu-cursor-free-mode + "Minor mode to allow the cursor to move freely about the screen." + :init-value nil + (if (not tpu-cursor-free-mode) + (tpu-trim-line-ends))) ;;; Hooks -- Set cursor free in picture mode. @@ -141,11 +145,10 @@ (add-hook 'picture-mode-hook 'tpu-set-cursor-free) -(defun tpu-before-save-hook () +(defun tpu-trim-line-ends-if-needed () "Eliminate whitespace at ends of lines, if the cursor is free." - (if (and (buffer-modified-p) tpu-cursor-free) (tpu-trim-line-ends))) - -(add-hook 'before-save-hook 'tpu-before-save-hook) + (if (and (buffer-modified-p) tpu-cursor-free-mode) (tpu-trim-line-ends))) +(add-hook 'before-save-hook 'tpu-trim-line-ends-if-needed) ;;; Utility routines for implementing scroll margins @@ -171,12 +174,12 @@ (defun tpu-forward-char (num) "Move right ARG characters (left if ARG is negative)." (interactive "p") - (if tpu-cursor-free (picture-forward-column num) (forward-char num))) + (if tpu-cursor-free-mode (picture-forward-column num) (forward-char num))) (defun tpu-backward-char (num) "Move left ARG characters (right if ARG is negative)." (interactive "p") - (cond ((not tpu-cursor-free) + (cond ((not tpu-cursor-free-mode) (backward-char num)) (tpu-backward-char-like-tpu (picture-backward-column num)) @@ -195,8 +198,8 @@ Prefix argument serves as a repeat count." (interactive "p") (let ((beg (tpu-current-line))) - (if tpu-cursor-free (or (eobp) (picture-move-down num)) - (next-line-internal num)) + (if tpu-cursor-free-mode (or (eobp) (picture-move-down num)) + (line-move num)) (tpu-bottom-check beg num) (setq this-command 'next-line))) @@ -205,7 +208,7 @@ Prefix argument serves as a repeat count." (interactive "p") (let ((beg (tpu-current-line))) - (if tpu-cursor-free (picture-move-up num) (next-line-internal (- num))) + (if tpu-cursor-free-mode (picture-move-up num) (line-move (- num))) (tpu-top-check beg num) (setq this-command 'previous-line))) @@ -223,7 +226,7 @@ Accepts a prefix argument for the number of lines to move." (interactive "p") (let ((beg (tpu-current-line))) - (cond (tpu-cursor-free + (cond (tpu-cursor-free-mode (let ((beg (point))) (if (< 1 num) (forward-line num)) (picture-end-of-line) @@ -238,7 +241,7 @@ Accepts a prefix argument for the number of lines to move." (interactive "p") (let ((beg (tpu-current-line))) - (cond (tpu-cursor-free + (cond (tpu-cursor-free-mode (picture-end-of-line (- 1 num))) (t (end-of-line (- 1 num)))) @@ -248,7 +251,7 @@ "Move point to end of current line." (interactive) (let ((beg (point))) - (if tpu-cursor-free (picture-end-of-line) (end-of-line)) + (if tpu-cursor-free-mode (picture-end-of-line) (end-of-line)) (if (= beg (point)) (message "You are already at the end of a line.")))) (defun tpu-forward-line (num) @@ -256,9 +259,8 @@ Prefix argument serves as a repeat count." (interactive "p") (let ((beg (tpu-current-line))) - (next-line-internal num) - (tpu-bottom-check beg num) - (beginning-of-line))) + (forward-line num) + (tpu-bottom-check beg num))) (defun tpu-backward-line (num) "Move to beginning of previous line. @@ -266,9 +268,8 @@ (interactive "p") (let ((beg (tpu-current-line))) (or (bolp) (>= 0 num) (setq num (- num 1))) - (next-line-internal (- num)) - (tpu-top-check beg num) - (beginning-of-line))) + (forward-line (- num)) + (tpu-top-check beg num))) ;;; Movement by paragraph @@ -346,7 +347,7 @@ (let* ((beg (tpu-current-line)) (height (1- (window-height))) (lines (* num (/ (* height tpu-percent-scroll) 100)))) - (next-line-internal (- lines)) + (line-move (- lines)) (tpu-top-check beg lines))) (defun tpu-scroll-window-up (num) @@ -356,7 +357,7 @@ (let* ((beg (tpu-current-line)) (height (1- (window-height))) (lines (* num (/ (* height tpu-percent-scroll) 100)))) - (next-line-internal lines) + (line-move lines) (tpu-bottom-check beg lines))) @@ -448,22 +449,19 @@ (defun tpu-set-cursor-free () "Allow the cursor to move freely about the screen." (interactive) - (setq tpu-cursor-free t) - (substitute-key-definition 'tpu-set-cursor-free - 'tpu-set-cursor-bound - GOLD-map) + (tpu-cursor-free-mode 1) (message "The cursor will now move freely about the screen.")) ;;;###autoload (defun tpu-set-cursor-bound () "Constrain the cursor to the flow of the text." (interactive) - (tpu-trim-line-ends) - (setq tpu-cursor-free nil) - (substitute-key-definition 'tpu-set-cursor-bound - 'tpu-set-cursor-free - GOLD-map) + (tpu-cursor-free-mode -1) (message "The cursor is now bound to the flow of your text.")) +;; Local Variables: +;; generated-autoload-file: "tpu-edt.el" +;; End: + ;; arch-tag: 89676fa4-33ec-48cb-9135-6f3bf230ab1a ;;; tpu-extras.el ends here
--- a/lisp/emulation/viper-cmd.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/emulation/viper-cmd.el Tue Aug 21 04:55:30 2007 +0000 @@ -1116,7 +1116,7 @@ "Function that implements ESC key in Viper emulation of Vi." (interactive) (let ((cmd (or (key-binding (viper-envelop-ESC-key)) - '(lambda () (interactive) (error ""))))) + '(lambda () (interactive) (error "Viper bell"))))) ;; call the actual function to execute ESC (if no other symbols followed) ;; or the key bound to the ESC sequence (if the sequence was issued @@ -1238,7 +1238,7 @@ ;; it is an error. (progn ;; new com is (CHAR . OLDCOM) - (if (viper-memq-char char '(?# ?\")) (error "")) + (if (viper-memq-char char '(?# ?\")) (error "Viper bell")) (setq com (cons char com)) (setq cont nil)) ;; If com is nil we set com as char, and read more. Again, if char is @@ -1257,7 +1257,7 @@ (let ((reg (read-char))) (if (viper-valid-register reg) (setq viper-use-register reg) - (error "")) + (error "Viper bell")) (setq char (read-char)))) (t (setq com char) @@ -1279,7 +1279,7 @@ (viper-regsuffix-command-p char) (viper= char ?!) ; bang command (viper= char ?g) ; the gg command (like G0) - (error "")) + (error "Viper bell")) (setq cmd-to-exec-at-end (viper-exec-form-in-vi `(key-binding (char-to-string ,char))))) @@ -1313,7 +1313,7 @@ ((equal com '(?= . ?=)) (viper-line (cons value ?=))) ;; gg acts as G0 ((equal (car com) ?g) (viper-goto-line 0)) - (t (error ""))))) + (t (error "Viper bell"))))) (if cmd-to-exec-at-end (progn @@ -2738,9 +2738,9 @@ ;; the forward motion before the 'viper-execute-com', but, of ;; course, 'dl' doesn't work on an empty line, so we have to ;; catch that condition before 'viper-execute-com' - (if (and (eolp) (bolp)) (error "") (forward-char val)) + (if (and (eolp) (bolp)) (error "Viper bell") (forward-char val)) (if com (viper-execute-com 'viper-forward-char val com)) - (if (eolp) (progn (backward-char 1) (error "")))) + (if (eolp) (progn (backward-char 1) (error "Viper bell")))) (forward-char val) (if com (viper-execute-com 'viper-forward-char val com))))) @@ -2755,7 +2755,7 @@ (if com (viper-move-marker-locally 'viper-com-point (point))) (if viper-ex-style-motion (progn - (if (bolp) (error "") (backward-char val)) + (if (bolp) (error "Viper bell") (backward-char val)) (if com (viper-execute-com 'viper-backward-char val com))) (backward-char val) (if com (viper-execute-com 'viper-backward-char val com))))) @@ -3078,7 +3078,7 @@ (if com (viper-execute-com 'viper-goto-col val com)) (save-excursion (end-of-line) - (if (> val (current-column)) (error ""))) + (if (> val (current-column)) (error "Viper bell"))) )) @@ -3198,7 +3198,7 @@ ;; If FORWARD then search is forward, otherwise backward. OFFSET is used to ;; adjust point after search. (defun viper-find-char (arg char forward offset) - (or (char-or-string-p char) (error "")) + (or (char-or-string-p char) (error "Viper bell")) (let ((arg (if forward arg (- arg))) (cmd (if (eq viper-intermediate-command 'viper-repeat) (nth 5 viper-d-com) @@ -3544,7 +3544,7 @@ (if com (viper-move-marker-locally 'viper-com-point (point))) (backward-sexp 1) (if com (viper-execute-com 'viper-paren-match nil com))) - (t (error "")))))) + (t (error "Viper bell")))))) (defun viper-toggle-parse-sexp-ignore-comments () (interactive) @@ -4107,7 +4107,7 @@ (let ((reg viper-use-register)) (setq viper-use-register nil) (error viper-EmptyRegister reg)) - (error ""))) + (error "Viper bell"))) (setq viper-use-register nil) (if (viper-end-with-a-newline-p text) (progn @@ -4157,7 +4157,7 @@ (let ((reg viper-use-register)) (setq viper-use-register nil) (error viper-EmptyRegister reg)) - (error ""))) + (error "Viper bell"))) (setq viper-use-register nil) (if (viper-end-with-a-newline-p text) (beginning-of-line)) (viper-set-destructive-command @@ -4202,7 +4202,7 @@ (> val (viper-chars-in-region (point) (viper-line-pos 'end)))) (setq val (viper-chars-in-region (point) (viper-line-pos 'end)))) (if (and viper-ex-style-motion (eolp)) - (if (bolp) (error "") (setq val 0))) ; not bol---simply back 1 ch + (if (bolp) (error "Viper bell") (setq val 0))) ; not bol---simply back 1 ch (save-excursion (viper-forward-char-carefully val) (setq end-del-pos (point))) @@ -4467,7 +4467,7 @@ ((viper= char ?,) (viper-cycle-through-mark-ring)) ((viper= char ?^) (push-mark viper-saved-mark t t)) ((viper= char ?D) (mark-defun)) - (t (error "")) + (t (error "Viper bell")) ))) ;; Algorithm: If first invocation of this command save mark on ring, goto @@ -4566,7 +4566,7 @@ (switch-to-buffer buff) (goto-char viper-com-point) (viper-change-state-to-vi) - (error ""))))) + (error "Viper bell"))))) ((and (not skip-white) (viper= char ?`)) (if com (viper-move-marker-locally 'viper-com-point (point))) (if (and (viper-same-line (point) viper-last-jump)
--- a/lisp/emulation/viper-ex.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/emulation/viper-ex.el Tue Aug 21 04:55:30 2007 +0000 @@ -1236,7 +1236,7 @@ (read-string "[Hit return to confirm] ") (quit (save-excursion (kill-buffer " *delete text*")) - (error ""))) + (error "Viper bell"))) (save-excursion (kill-buffer " *delete text*"))) (if ex-buffer (cond ((viper-valid-register ex-buffer '(Letter))
--- a/lisp/emulation/viper.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/emulation/viper.el Tue Aug 21 04:55:30 2007 +0000 @@ -9,7 +9,7 @@ ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> ;; Keywords: emulations -(defconst viper-version "3.14 of June 14, 2007" +(defconst viper-version "3.14 of August 18, 2007" "The current version of Viper") ;; This file is part of GNU Emacs. @@ -646,6 +646,11 @@ (remove-hook symbol 'viper-change-state-to-emacs) (remove-hook symbol 'viper-change-state-to-insert) (remove-hook symbol 'viper-change-state-to-vi) + (remove-hook symbol 'viper-minibuffer-post-command-hook) + (remove-hook symbol 'viper-minibuffer-setup-sentinel) + (remove-hook symbol 'viper-major-mode-change-sentinel) + (remove-hook symbol 'set-viper-state-in-major-mode) + (remove-hook symbol 'viper-post-command-sentinel) ))) ;; Remove local value in all existing buffers @@ -682,6 +687,9 @@ global-mode-string (delq 'viper-mode-string global-mode-string)) + (setq default-major-mode + (viper-standard-value 'default-major-mode viper-saved-non-viper-variables)) + (if viper-emacs-p (setq-default mark-even-if-inactive @@ -772,9 +780,7 @@ (mapatoms 'viper-remove-hooks) (remove-hook 'comint-mode-hook 'viper-comint-mode-hook) (remove-hook 'erc-mode-hook 'viper-comint-mode-hook) - (remove-hook 'minibuffer-setup-hook 'viper-minibuffer-setup-sentinel) (remove-hook 'change-major-mode-hook 'viper-major-mode-change-sentinel) - (remove-hook 'post-command-hook 'viper-minibuffer-post-command-hook) ;; unbind Viper mouse bindings (viper-unbind-mouse-search-key) @@ -1214,6 +1220,7 @@ (if (null viper-saved-non-viper-variables) (setq viper-saved-non-viper-variables (list + (cons 'default-major-mode (list default-major-mode)) (cons 'next-line-add-newlines (list next-line-add-newlines)) (cons 'require-final-newline (list require-final-newline)) (cons 'scroll-step (list scroll-step))
--- a/lisp/gnus/ChangeLog Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/gnus/ChangeLog Tue Aug 21 04:55:30 2007 +0000 @@ -1,3 +1,19 @@ +2007-08-17 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-summary-command-nosave) + (gnus-article-read-summary-keys): Don't use 3rd arg of pop-to-buffer. + +2007-08-14 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus.el (gnus-maximum-newsgroup): New variable. + + * gnus-agent.el (gnus-agent-fetch-headers): Limit the range of articles + according to gnus-maximum-newsgroup. + + * gnus-sum.el (gnus-articles-to-read, gnus-list-of-unread-articles) + (gnus-list-of-read-articles, gnus-sequence-of-unread-articles): Limit + the range of articles according to gnus-maximum-newsgroup. + 2007-08-10 Katsumi Yamaoka <yamaoka@jpl.org> * nntp.el (nntp-xref-number-is-evil): New server variable.
--- a/lisp/gnus/gnus-agent.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/gnus/gnus-agent.el Tue Aug 21 04:55:30 2007 +0000 @@ -1765,7 +1765,14 @@ (gnus-agent-find-parameter group 'agent-predicate))))) (articles (if fetch-all - (gnus-uncompress-range (gnus-active group)) + (if gnus-maximum-newsgroup + (let ((active (gnus-active group))) + (gnus-uncompress-range + (cons (max (car active) + (- (cdr active) + gnus-maximum-newsgroup -1)) + (cdr active)))) + (gnus-uncompress-range (gnus-active group))) (gnus-list-of-unread-articles group))) (gnus-decode-encoded-word-function 'identity) (gnus-decode-encoded-address-function 'identity)
--- a/lisp/gnus/gnus-art.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/gnus/gnus-art.el Tue Aug 21 04:55:30 2007 +0000 @@ -5607,7 +5607,7 @@ "Execute the last keystroke in the summary buffer." (interactive) (let (func) - (pop-to-buffer gnus-article-current-summary nil (not (featurep 'xemacs))) + (pop-to-buffer gnus-article-current-summary) (setq func (lookup-key (current-local-map) (this-command-keys))) (call-interactively func))) @@ -5646,8 +5646,7 @@ (member keys nosave-in-article)) (let (func) (save-window-excursion - (pop-to-buffer gnus-article-current-summary - nil (not (featurep 'xemacs))) + (pop-to-buffer gnus-article-current-summary) ;; We disable the pick minor mode commands. (let (gnus-pick-mode) (setq func (lookup-key (current-local-map) keys)))) @@ -5659,16 +5658,14 @@ (call-interactively func) (setq new-sum-point (point))) (when (member keys nosave-but-article) - (pop-to-buffer gnus-article-buffer - nil (not (featurep 'xemacs))))) + (pop-to-buffer gnus-article-buffer))) ;; These commands should restore window configuration. (let ((obuf (current-buffer)) (owin (current-window-configuration)) (opoint (point)) win func in-buffer selected new-sum-start new-sum-hscroll) (cond (not-restore-window - (pop-to-buffer gnus-article-current-summary - nil (not (featurep 'xemacs)))) + (pop-to-buffer gnus-article-current-summary)) ((setq win (get-buffer-window gnus-article-current-summary)) (select-window win)) (t
--- a/lisp/gnus/gnus-sum.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/gnus/gnus-sum.el Tue Aug 21 04:55:30 2007 +0000 @@ -5472,7 +5472,13 @@ ;; articles in the group, or (if that's nil), the ;; articles in the cache. (or - (gnus-uncompress-range (gnus-active group)) + (if gnus-maximum-newsgroup + (let ((active (gnus-active group))) + (gnus-uncompress-range + (cons (max (car active) + (- (cdr active) gnus-maximum-newsgroup -1)) + (cdr active)))) + (gnus-uncompress-range (gnus-active group))) (gnus-cache-articles-in-group group)) ;; Select only the "normal" subset of articles. (gnus-sorted-nunion @@ -6534,23 +6540,26 @@ (let* ((read (gnus-info-read (gnus-get-info group))) (active (or (gnus-active group) (gnus-activate-group group))) (last (cdr active)) + (bottom (if gnus-maximum-newsgroup + (max (car active) (- last gnus-maximum-newsgroup -1)) + (car active))) first nlast unread) ;; If none are read, then all are unread. (if (not read) - (setq first (car active)) + (setq first bottom) ;; If the range of read articles is a single range, then the ;; first unread article is the article after the last read ;; article. Sounds logical, doesn't it? (if (and (not (listp (cdr read))) - (or (< (car read) (car active)) + (or (< (car read) bottom) (progn (setq read (list read)) nil))) - (setq first (max (car active) (1+ (cdr read)))) + (setq first (max bottom (1+ (cdr read)))) ;; `read' is a list of ranges. (when (/= (setq nlast (or (and (numberp (car read)) (car read)) (caar read))) 1) - (setq first (car active))) + (setq first bottom)) (while read (when first (while (< first nlast) @@ -6575,7 +6584,12 @@ (gnus-list-range-difference (gnus-list-range-difference (gnus-sorted-complement - (gnus-uncompress-range active) + (gnus-uncompress-range + (if gnus-maximum-newsgroup + (cons (max (car active) + (- (cdr active) gnus-maximum-newsgroup -1)) + (cdr active)) + active)) (gnus-list-of-unread-articles group)) (cdr (assq 'dormant marked))) (cdr (assq 'tick marked)))))) @@ -6587,23 +6601,26 @@ (let* ((read (gnus-info-read (gnus-get-info group))) (active (or (gnus-active group) (gnus-activate-group group))) (last (cdr active)) + (bottom (if gnus-maximum-newsgroup + (max (car active) (- last gnus-maximum-newsgroup -1)) + (car active))) first nlast unread) ;; If none are read, then all are unread. (if (not read) - (setq first (car active)) + (setq first bottom) ;; If the range of read articles is a single range, then the ;; first unread article is the article after the last read ;; article. Sounds logical, doesn't it? (if (and (not (listp (cdr read))) - (or (< (car read) (car active)) + (or (< (car read) bottom) (progn (setq read (list read)) nil))) - (setq first (max (car active) (1+ (cdr read)))) + (setq first (max bottom (1+ (cdr read)))) ;; `read' is a list of ranges. (when (/= (setq nlast (or (and (numberp (car read)) (car read)) (caar read))) 1) - (setq first (car active))) + (setq first bottom)) (while read (when first (push (cons first nlast) unread))
--- a/lisp/gnus/gnus.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/gnus/gnus.el Tue Aug 21 04:55:30 2007 +0000 @@ -1501,6 +1501,17 @@ :type '(choice (const :tag "No limit" nil) integer)) +(defcustom gnus-maximum-newsgroup nil + "The maximum number of articles a newsgroup. +If this is a number, old articles in a newsgroup exceeding this number +are silently ignored. If it is nil, no article is ignored. Note that +setting this variable to a number might prevent you from reading very +old articles." + :group 'gnus-group-select + :version "22.2" + :type '(choice (const :tag "No limit" nil) + integer)) + (defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix))) "*Non-nil means that the default name of a file to save articles in is the group name. If it's nil, the directory form of the group name is used instead.
--- a/lisp/mail/emacsbug.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/mail/emacsbug.el Tue Aug 21 04:55:30 2007 +0000 @@ -73,18 +73,27 @@ ;; This strange form ensures that (recent-keys) is the value before ;; the bug subject string is read. (interactive (reverse (list (recent-keys) (read-string "Bug Subject: ")))) - ;; If there are four numbers in emacs-version, this is a pretest - ;; version. - (let* ((pretest-p (string-match "\\..*\\..*\\." emacs-version)) - (from-buffer (current-buffer)) - (reporting-address (if pretest-p - report-emacs-bug-pretest-address - report-emacs-bug-address)) - ;; Put these properties on semantically-void text. - (prompt-properties '(field emacsbug-prompt - intangible but-helpful - rear-nonsticky t)) - user-point message-end-point) + ;; The syntax `version;' is preferred to `[version]' because the + ;; latter could be mistakenly stripped by mailing software. + (if (eq system-type 'ms-dos) + (setq topic (concat emacs-version "; " topic)) + (when (string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version) + (setq topic (concat (match-string 1 emacs-version) "; " topic)))) + ;; If there are four numbers in emacs-version (three for MS-DOS), + ;; this is a pretest version. + (let* ((pretest-p (string-match (if (eq system-type 'ms-dos) + "\\..*\\." + "\\..*\\..*\\.") + emacs-version)) + (from-buffer (current-buffer)) + (reporting-address (if pretest-p + report-emacs-bug-pretest-address + report-emacs-bug-address)) + ;; Put these properties on semantically-void text. + (prompt-properties '(field emacsbug-prompt + intangible but-helpful + rear-nonsticky t)) + user-point message-end-point) (setq message-end-point (with-current-buffer (get-buffer-create "*Messages*") (point-max-marker))) @@ -106,7 +115,7 @@ (let ((pos (point))) (insert "not to your local site managers!") (put-text-property pos (point) 'face 'highlight))) - (insert "\nPlease write in ") + (insert "\nPlease write in ") (let ((pos (point))) (insert "English") (put-text-property pos (point) 'face 'highlight)) @@ -132,8 +141,8 @@ (let ((debug-file (expand-file-name "DEBUG" data-directory))) (if (file-readable-p debug-file) - (insert "If you would like to further debug the crash, please read the file\n" - debug-file " for instructions.\n"))) + (insert "If you would like to further debug the crash, please read the file\n" + debug-file " for instructions.\n"))) (add-text-properties (1+ user-point) (point) prompt-properties) (insert "\n\nIn " (emacs-version) "\n")
--- a/lisp/mail/rmail.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/mail/rmail.el Tue Aug 21 04:55:30 2007 +0000 @@ -204,7 +204,7 @@ 'emacs)))))) (defun rmail-autodetect () - "Determine and return the file name of the `movemail' program. + "Determine the file name of the `movemail' program and return its flavor. If `rmail-movemail-program' is non-nil, use it. Otherwise, look for `movemail' in the directories in `rmail-movemail-search-path', those in `exec-path', and `exec-directory'."
--- a/lisp/mail/undigest.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/mail/undigest.el Tue Aug 21 04:55:30 2007 +0000 @@ -93,7 +93,15 @@ (rmail-digest-rfc1153 "^-\\{55,\\}\n\n" "^\n-\\{27,\\}\n\n" - "^\n-\\{27,\\}\n\nEnd of")) + ;; GNU Mailman knowingly (see comment at line 353 of ToDigest.py in + ;; Mailman source) produces non-conformant rfc 1153 digests, in that + ;; the trailer contains a "digest footer" like this: + ;; _______________________________________________ + ;; <one or more lines of list blurb> + ;; + ;; End of Foo Digest... + ;; ************************************** + "^\nEnd of")) (defun rmail-digest-rfc1153 (prolog-sep message-sep trailer-sep) (goto-char (point-min)) @@ -104,7 +112,7 @@ separator result) (move-marker start (match-beginning 0)) (move-marker end (match-end 0)) - (setq result (cons (copy-marker start) (copy-marker end t))) + (setq result (list (cons (copy-marker start) (copy-marker end t)))) (when (re-search-forward message-sep nil t) ;; Ok, at least one message separator found (setq separator (match-string 0))
--- a/lisp/menu-bar.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/menu-bar.el Tue Aug 21 04:55:30 2007 +0000 @@ -1381,7 +1381,7 @@ data-directory)) (goto-address))) (define-key menu-bar-help-menu [about] - '(menu-item "About Emacs" display-splash-screen + '(menu-item "About Emacs" about-emacs :help "Display version number, copyright info, and basic help")) (define-key menu-bar-help-menu [sep2] '("--"))
--- a/lisp/mh-e/ChangeLog Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/mh-e/ChangeLog Tue Aug 21 04:55:30 2007 +0000 @@ -1,3 +1,29 @@ +2007-08-20 Jeffrey C Honig <jch@honig.net> + + * mh-mime.el (message-options-set): Add missing autoloads from my + last change. + + * mh-comp.el (mh-forward): Address SF 1730393. When forwarding + with mml, messages were included in reverse order. + + * mh-mime.el (mh-mml-forward-message): Address SF 1378993 and + forward messages as inline attatchments. + +2007-08-19 Jeffrey C Honig <jch@honig.net> + + * mh-e.el (mh-invisible-header-fields-internal): We want to show + Comments: and hide Comment:, not the other way around. + + * mh-mime.el (mh-mml-to-mime): GPG requires e-mail addresses, not + aliases. So resolve aliases before passing addresses to GPG/PGP. + Closes SF #649226. + + * mh-e.el (mh-invisible-header-fields-internal): Update with all + the entries from + http://people.dsv.su.se/~jpalme/ietf/mail-headers, plus some of my + own. I added attributions to entries we already had that did not + list an RFC. + 2007-08-08 Glenn Morris <rgm@gnu.org> * mh-folder.el, mh-letter.el, mh-show.el: Replace `iff' in
--- a/lisp/mh-e/mh-comp.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/mh-e/mh-comp.el Tue Aug 21 04:55:30 2007 +0000 @@ -497,7 +497,9 @@ (dolist (msg msgs) (setq i (1+ i)) (mh-mml-forward-message (format description i) - folder msg)))))) + folder msg) + ;; Was inserted before us, move to end of file to preserve order + (goto-char (point-max))))))) ;; Postition just before forwarded message (if (re-search-forward "^------- Forwarded Message" nil t) (forward-line -1)
--- a/lisp/mh-e/mh-e.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/mh-e/mh-e.el Tue Aug 21 04:55:30 2007 +0000 @@ -2383,130 +2383,189 @@ ;; Keep fields alphabetized. Mention source, if known. (defvar mh-invisible-header-fields-internal - '("Approved:" - "Autoforwarded:" + '("Abuse-Reports-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Also-Control:" ; H. Spencer: News Article Format and Transmission, June 1994 + "Alternate-recipient:" ; RFC 2156 + "Approved-By:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Approved:" ; RFC 1036 + "Article-Names:" ; H. Spencer: News Article Format and Transmission, June 1994 + "Article-Updates:" ; H. Spencer: News Article Format and Transmission, June 1994 + "Authentication-Results:" + "Auto-forwarded:" ; RFC 2156 + "Autoforwarded:" ; RFC 2156 "Bestservhost:" + "Cancel-Key:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Cancel-Lock:" ; NNTP posts - "Content-" ; RFC 2045 - "Delivered-To:" ; Egroups/yahoogroups mailing list manager - "Delivery-Date:" ; MH + "Comment:" ; Shows up with DomainKeys +;; "Comments:" ; RFC 2822 - show this one + "Content-" ; RFC 2045, 1123, 1766, 1864, 2045, 2110, 2156, 2183, 2912 + "Control:" ; RFC 1036 + "Conversion-With-Loss:" ; RFC 2156 + "Conversion:" ; RFC 2156 + "DKIM-" ; http://antispam.yahoo.com/domainkeys + "DL-Expansion-History:" ; RFC 2156 + "Delivered-To:" ; Egroups/yahoogroups mailing list manager + "Delivery-Date:" ; RFC 2156 "Delivery:" - "DomainKey-Signature:" ;http://antispam.yahoo.com/domainkeys - "Encoding:" + "Discarded-X400-" ; RFC 2156 + "Disclose-Recipients:" ; RFC 2156 + "Disposition-Notification-Options:" ; RFC 2298 + "Disposition-Notification-To:" ; RFC 2298 + "Distribution:" ; RFC 1036 + "DomainKey-" ; http://antispam.yahoo.com/domainkeys + "Encoding:" ; RFC 1505 "Envelope-to:" - "Errors-To:" + "Errors-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Expires:" ; RFC 1036 + "Expiry-Date:" ; RFC 2156 "Face:" ; Gnus Face header + "Fax:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Followup-To:" ; RFC 1036 + "For-Approval:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "For-Comment:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "For-Handdling:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Forwarded:" ; MH "From " ; sendmail - "Importance:" ; MS Outlook - "In-Reply-To:" ; MH - "Lines:" - "List-" ; Mailman mailing list manager - "List-" ; Unknown mailing list managers - "List-Subscribe:" ; Unknown mailing list managers - "List-Unsubscribe:" ; Unknown mailing list managers + "Generate-Delivery-Report:" ; RFC 2156 + "Importance:" ; RFC 2156, 2421 + "In-Reply-To:" ; RFC 2822 + "Incomplete-Copy:" ; RFC 2156 + "Keywords:" ; RFC 2822 + "Language:" ; RFC 2156 + "Lines:" ; RFC 1036 + "List-" ; RFC 2369, 2919 + "Mail-Copies-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Mail-Followup-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Mail-Reply-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Mail-from:" ; MH - "Mailing-List:" ; Egroups/yahoogroups mailing list manager + "Mailing-List:" ; Egroups/yahoogroups mailing list manager + "Message-Content:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Message-Id:" ; RFC 822 + "Message-Type:" ; RFC 2156 "Mime-Version" ; RFC 2045 "NNTP-" ; News + "Newsgroups:" ; RFC 1036 + "Obsoletes:" ; RFC 2156 "Old-Return-Path:" - "Original-Encoded-Information-Types:" ; X400 + "OpenPGP:" + "Original-Encoded-Information-Types:" ; RFC 2156 "Original-Lines:" ; mail to news "Original-NNTP-" ; mail to news "Original-Newsgroups:" ; mail to news "Original-Path:" ; mail to news "Original-Received:" ; mail to news + "Original-Recipt:" ; RFC 2298 "Original-To:" ; mail to news "Original-X-" ; mail to news - "Originator:" + "Origination-Client:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Originator:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "P1-Content-Type:" ; X400 "P1-Message-Id:" ; X400 "P1-Recipient:" ; X400 - "Path:" - "Precedence:" + "Path:" ; RFC 1036 + "Phone:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Pics-Label:" ; W3C + "Posted-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Precedence:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Prev-Resent" ; MH - "Priority:" - "Received:" ; RFC 822 + "Prevent-NonDelivery-Report:" ; RFC 2156 + "Priority:" ; RFC 2156 + "Read-Receipt-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Received-SPF:" ; Gmail - "References:" + "Received:" ; RFC 822 + "References:" ; RFC 2822 + "Registered-Mail-Reply-Requested-By:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Remailed-" ; MH + "Replaces:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Replied:" ; MH - "Resent" ; MH + "Resent-" ; RFC 2822 "Return-Path:" ; RFC 822 - "Sensitivity:" ; MS Outlook + "Return-Receipt-Requested:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Return-Receipt-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "See-Also:" ; H. Spencer: News Article Format and Transmission, June 1994 + "Sensitivity:" ; RFC 2156, 2421 + "Speach-Act:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Status:" ; sendmail + "Supersedes:" ; H. Spencer: News Article Format and Transmission, June 1994 + "Telefax:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Thread-" + "Translated-By:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "Translation-Of:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Ua-Content-Id:" ; X400 -;; "User-Agent:" ; Similar to X-Mailer, so display it. "Via:" ; MH + "X-AMAZON" ; Amazon.com "X-AOL-IP:" ; AOL WebMail "X-Abuse-Info:" "X-Abuse-and-DMCA-" "X-Accept-Language:" "X-Accept-Language:" ; Netscape/Mozilla "X-Ack:" + "X-Admin:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Administrivia-To:" "X-AntiAbuse:" ; cPanel "X-Apparently-From:" ; MS Outlook "X-Apparently-To:" ; Egroups/yahoogroups mailing list manager + "X-AuditID:" "X-Authenticated-Sender:" ; AT&T Message Center (webmail) "X-Authentication-Warning:" ; sendmail "X-Barracuda-" ; Barracuda spam scores "X-Beenthere:" ; Mailman mailing list manager + "X-Bigfish:" "X-Bogosity:" ; bogofilter - "X-BrightmailFiltered:" ; Brightmail "X-Brightmail-Tracker:" ; Brightmail + "X-BrightmailFiltered:" ; Brightmail "X-Bugzilla-" ; Bugzilla - "X-Complaints-To:" + "X-Complaints-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-Confirm-Reading-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-ContentStamp:" ; NetZero "X-Cron-Env:" "X-DMCA" "X-Delivered" "X-EFL-Spamscore:" ; MIT alumni spam filtering "X-ELNK-Trace:" ; Earthlink mailer + "X-Enigmail-Version:" "X-Envelope-Date:" ; GNU mailutils - "X-Envelope-From:" + "X-Envelope-From:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Envelope-Sender:" - "X-Envelope-To:" + "X-Envelope-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Evolution:" ; Evolution mail client - "X-Face:" + "X-ExtLoop" + "X-Face:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Folder:" ; Spam "X-From-Line" "X-Gmail-" ; Gmail "X-Gnus-Mail-Source:" ; gnus + "X-Google-" ; Google mail "X-Greylist:" ; milter-greylist-1.2.1 - "X-Habeas-SWE-1:" ; Spam - "X-Habeas-SWE-2:" ; Spam - "X-Habeas-SWE-3:" ; Spam - "X-Habeas-SWE-4:" ; Spam - "X-Habeas-SWE-5:" ; Spam - "X-Habeas-SWE-6:" ; Spam - "X-Habeas-SWE-7:" ; Spam - "X-Habeas-SWE-8:" ; Spam - "X-Habeas-SWE-9:" ; Spam + "X-HTTP-UserAgent:" + "X-Habeas-SWE-" ; Spam "X-Hashcash:" ; hashcash + "X-IMAP:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-Image-URL:" "X-Info:" ; NTMail - "X-IronPort-AV:" ; IronPort AV + "X-IronPort-" ; IronPort AV "X-Juno-" ; Juno - "X-List-Host:" ; Unknown mailing list managers + "X-List-Host:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-List-Subscribe:" ; Unknown mailing list managers "X-List-Unsubscribe:" ; Unknown mailing list managers "X-Listprocessor-" ; ListProc(tm) by CREN - "X-Listserver:" ; Unknown mailing list managers - "X-Loop:" ; Unknown mailing list managers + "X-Listserver:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-Loop:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Lumos-SenderID:" ; Roving ConstantContact "X-MAIL-INFO:" ; NetZero "X-MB-Message-" ; AOL WebMail "X-MHE-Checksum:" ; Checksum added during index search "X-MIME-Autoconverted:" ; sendmail + "X-MIMEOLE:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/sendmail "X-MIMETrack:" "X-MS-" ; MS Outlook + "X-MSMail-Priority" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Mail-from:" ; fastmail.fm "X-MailScanner" ; ListProc(tm) by CREN "X-Mailing-List:" ; Unknown mailing list managers "X-Mailman-Approved-At:" ; Mailman mailing list manager "X-Mailman-Version:" ; Mailman mailing list manager + "X-Mailutils-Message-Id" ; GNU Mailutils "X-Majordomo:" ; Majordomo mailing list manager "X-Message-Id" "X-MessageWall-Score:" ; Unknown mailing list manager, AUC TeX @@ -2516,24 +2575,29 @@ "X-Msmail-" ; MS Outlook "X-NAI-Spam-" ; Network Associates Inc. SpamKiller "X-News:" ; News - "X-No-Archive:" + "X-Newsreader:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-No-Archive:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Notes-Item:" ; Lotus Notes Domino structured header "X-OperatingSystem:" - ;;"X-Operator:" ; Similar to X-Mailer, so display it "X-Orcl-Content-Type:" + "X-Original-Arrival-Type:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Original-Complaints-To:" "X-Original-Date:" ; SourceForge mailing list manager "X-Original-To:" "X-Original-Trace:" "X-OriginalArrivalTime:" ; Hotmail + "X-Originating-Email:" ; Hotmail "X-Originating-IP:" ; Hotmail + "X-PMG-" "X-Postfilter:" "X-Priority:" ; MS Outlook "X-Provags-ID:" "X-Qotd-" ; User added + "X-RCPT-TO:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-RM" "X-Received-Date:" "X-Received:" + "X-Report-Abuse-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Request-" "X-Resolved-to:" ; fastmail.fm "X-Return-Path-Hint:" ; Roving ConstantContact @@ -2546,7 +2610,7 @@ "X-SMTP-" "X-Sasl-enc:" ; Apple Mail "X-Scanned-By:" - "X-Sender:" + "X-Sender:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Server-Date:" "X-Server-Uuid:" "X-Sieve:" ; Sieve filtering @@ -2558,21 +2622,33 @@ "X-Telecom-Digest" "X-Trace:" "X-UID" - "X-UIDL:" + "X-UIDL:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-UNTD-" ; NetZero + "X-URI:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-URL:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-USANET-" ; usa.net + "X-Unity" "X-UserInfo1:" "X-VSMLoop:" ; NTMail "X-Virus-Scanned" ; amavisd-new "X-Vms-To:" "X-WebTV-Signature:" "X-Wss-Id:" ; Worldtalk gateways + "X-X-Sender:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-YMail-" "X-Yahoo" "X-eGroups-" ; Egroups/yahoogroups mailing list manager "X-pgp:" "X-submission-address:" "X400-" ; X400 - "Xref:") + ;;"X-Operator:" ; Similar to X-Mailer, so display it +;; "Mail-System-Version:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ +;; "Mailer:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ +;; "Reply-By:" ; RFC 2156 +;; "Reply-To:" ; RFC 2822 +;; "User-Agent:" ; Similar to X-Mailer, so display it. + "Xref:" ; RFC 1036 + ) "List of default header fields that are not to be shown. Do not alter this variable directly. Instead, add entries from
--- a/lisp/mh-e/mh-mime.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/mh-e/mh-mime.el Tue Aug 21 04:55:30 2007 +0000 @@ -60,7 +60,10 @@ (autoload 'mail-decode-encoded-word-string "mail-parse") (autoload 'mail-header-parse-content-type "mail-parse") (autoload 'mail-header-strip "mail-parse") +(autoload 'message-options-get "message") +(autoload 'message-options-set "message") (autoload 'message-options-set-recipient "message") +(autoload 'mh-alias-expand "mh-alias") (autoload 'mm-decode-body "mm-bodies") (autoload 'mm-uu-dissect "mm-uu") (autoload 'mml-unsecure-message "mml-sec") @@ -1220,16 +1223,11 @@ mh-sent-from-msg (string-to-number message)))) (cond ((integerp msg) - (if (string= "" description) - ;; Rationale: mml-attach-file constructs a malformed composition - ;; if the description string is empty. This fixes SF #625168. - (mml-attach-file (format "%s%s/%d" - mh-user-path (substring folder 1) msg) - "message/rfc822") - (mml-attach-file (format "%s%s/%d" - mh-user-path (substring folder 1) msg) - "message/rfc822" - description))) + (mml-attach-file (format "%s%s/%d" + mh-user-path (substring folder 1) msg) + "message/rfc822" + (if (string= "" description) nil description) + "inline")) (t (error "The message number, %s, is not a integer" msg))))) (defun mh-mh-forward-message (&optional description folder messages) @@ -1621,8 +1619,22 @@ This action can be undone by running \\[undo]." (interactive) (require 'message) - (when mh-pgp-support-flag ;; This is only needed for PGP - (message-options-set-recipient)) + (when mh-pgp-support-flag + ;; PGP requires actual e-mail addresses, not aliases. + ;; Parse the recipients and sender from the message + (message-options-set-recipient) + ;; Do an alias lookup on sender + (message-options-set 'message-sender + (mail-strip-quoted-names + (mh-alias-expand + (message-options-get 'message-sender)))) + ;; Do an alias lookup on recipients + (message-options-set 'message-recipients + (mapconcat + '(lambda (ali) + (mail-strip-quoted-names (mh-alias-expand ali))) + (split-string (message-options-get 'message-recipients) "[, ]+") + ", "))) (let ((saved-text (buffer-string)) (buffer (current-buffer)) (modified-flag (buffer-modified-p)))
--- a/lisp/pcvs-parse.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/pcvs-parse.el Tue Aug 21 04:55:30 2007 +0000 @@ -284,6 +284,8 @@ ;; File removed, since it is removed (by third party) in repository. (and (cvs-or + ;; some cvs versions output quotes around these files + (cvs-match "warning: `\\(.*\\)' is not (any longer) pertinent$" (file 1)) (cvs-match "warning: \\(.*\\) is not (any longer) pertinent$" (file 1)) (cvs-match "`\\(.*\\)' is no longer in the repository$" (file 1)) (cvs-match "\\(.*\\) is no longer in the repository$" (file 1)))
--- a/lisp/progmodes/ada-mode.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/progmodes/ada-mode.el Tue Aug 21 04:55:30 2007 +0000 @@ -829,13 +829,12 @@ ;; Thus their syntax property is changed automatically, and we can still use ;; the standard Emacs functions for sexp (see `ada-in-string-p') ;; -;; On Emacs, this is done through the `syntax-table' text property. The -;; modification is done automatically each time the user as typed a new -;; character. This is already done in `font-lock-mode' (in -;; `font-lock-syntactic-keywords', so we take advantage of the existing -;; mechanism. If font-lock-mode is not activated, we do it by hand in -;; `ada-after-change-function', thanks to `ada-deactivate-properties' and -;; `ada-initialize-properties'. +;; On Emacs, this is done through the `syntax-table' text property. The +;; corresponding action is applied automatically each time the buffer +;; changes. If `font-lock-mode' is enabled (the default) the action is +;; set up by `font-lock-syntactic-keywords'. Otherwise, we do it +;; manually in `ada-after-change-function'. The proper method is +;; installed by `ada-handle-syntax-table-properties'. ;; ;; on XEmacs, the `syntax-table' property does not exist and we have to use a ;; slow advice to `parse-partial-sexp' to do the same thing. @@ -852,7 +851,6 @@ declares it as a word constituent." (interactive) (setq ada-mode-syntax-table (make-syntax-table)) - (set-syntax-table ada-mode-syntax-table) ;; define string brackets (`%' is alternative string bracket, but ;; almost never used as such and throws font-lock and indentation @@ -936,50 +934,59 @@ (insert (caddar change)) (setq change (cdr change))))))) -(defun ada-deactivate-properties () - "Deactivate Ada mode's properties handling. -This would be a duplicate of font-lock if both are used at the same time." - (remove-hook 'after-change-functions 'ada-after-change-function t)) - -(defun ada-initialize-properties () - "Initialize some special text properties in the whole buffer. -In particular, character constants are said to be strings, #...# are treated -as numbers instead of gnatprep comments." - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward "'.'" nil t) - (add-text-properties (match-beginning 0) (match-end 0) - '(syntax-table ("'" . ?\")))) - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*#" nil t) - (add-text-properties (match-beginning 0) (match-end 0) - '(syntax-table (11 . 10)))) - (set-buffer-modified-p nil) - - ;; Setting this only if font-lock is not set won't work - ;; if the user activates or deactivates font-lock-mode, - ;; but will make things faster most of the time - (add-hook 'after-change-functions 'ada-after-change-function nil t) - ))) +(defun ada-set-syntax-table-properties () + "Assign `syntax-table' properties in accessible part of buffer. +In particular, character constants are said to be strings, #...# +are treated as numbers instead of gnatprep comments." + (let ((modified (buffer-modified-p)) + (buffer-undo-list t) + (inhibit-read-only t) + (inhibit-point-motion-hooks t) + (inhibit-modification-hooks t)) + (remove-text-properties (point-min) (point-max) '(syntax-table nil)) + (goto-char (point-min)) + (while (re-search-forward + ;; The following regexp was adapted from + ;; `ada-font-lock-syntactic-keywords'. + "^[ \t]*\\(#\\(?:if\\|else\\|elsif\\|end\\)\\)\\|[^a-zA-Z0-9)]\\('\\)[^'\n]\\('\\)" + nil t) + (if (match-beginning 1) + (put-text-property + (match-beginning 1) (match-end 1) 'syntax-table '(11 . ?\n)) + (put-text-property + (match-beginning 2) (match-end 2) 'syntax-table '(7 . ?')) + (put-text-property + (match-beginning 3) (match-end 3) 'syntax-table '(7 . ?')))) + (unless modified + (restore-buffer-modified-p nil)))) (defun ada-after-change-function (beg end old-len) "Called when the region between BEG and END was changed in the buffer. OLD-LEN indicates what the length of the replaced text was." - (let ((inhibit-point-motion-hooks t) - (eol (point))) + (save-excursion + (save-restriction + (let ((from (progn (goto-char beg) (line-beginning-position))) + (to (progn (goto-char end) (line-end-position)))) + (narrow-to-region from to) + (save-match-data + (ada-set-syntax-table-properties)))))) + +(defun ada-initialize-syntax-table-properties () + "Assign `syntax-table' properties in current buffer." (save-excursion - (save-match-data - (beginning-of-line) - (remove-text-properties (point) eol '(syntax-table nil)) - (while (re-search-forward "'.'" eol t) - (add-text-properties (match-beginning 0) (match-end 0) - '(syntax-table ("'" . ?\")))) - (beginning-of-line) - (if (looking-at "^[ \t]*#") - (add-text-properties (match-beginning 0) (match-end 0) - '(syntax-table (11 . 10)))))))) + (save-restriction + (widen) + (save-match-data + (ada-set-syntax-table-properties)))) + (add-hook 'after-change-functions 'ada-after-change-function nil t)) + +(defun ada-handle-syntax-table-properties () + "Handle `syntax-table' properties." + (if font-lock-mode + ;; `font-lock-mode' will take care of `syntax-table' properties. + (remove-hook 'after-change-functions 'ada-after-change-function t) + ;; Take care of `syntax-table' properties manually. + (ada-initialize-syntax-table-properties))) ;;------------------------------------------------------------------ ;; Testing the grammatical context @@ -1150,6 +1157,8 @@ (interactive) (kill-all-local-variables) + + (set-syntax-table ada-mode-syntax-table) (set (make-local-variable 'require-final-newline) mode-require-final-newline) @@ -1340,7 +1349,7 @@ (setq which-func-functions '(ada-which-function)) ;; Support for indent-new-comment-line (Especially for XEmacs) - (setq comment-multi-line nil) + (set (make-local-variable 'comment-multi-line) nil) (setq major-mode 'ada-mode mode-name "Ada") @@ -1377,9 +1386,8 @@ ;; font-lock-mode (unless (featurep 'xemacs) - (progn - (ada-initialize-properties) - (add-hook 'font-lock-mode-hook 'ada-deactivate-properties nil t))) + (ada-initialize-syntax-table-properties) + (add-hook 'font-lock-mode-hook 'ada-handle-syntax-table-properties nil t)) ;; the following has to be done after running the ada-mode-hook ;; because users might want to set the values of these variable @@ -5200,8 +5208,7 @@ ;; This sets the properties of the characters, so that ada-in-string-p ;; correctly handles '"' too... '(("[^a-zA-Z0-9)]\\('\\)[^'\n]\\('\\)" (1 (7 . ?')) (2 (7 . ?'))) - ("^[ \t]*\\(#\\(if\\|else\\|elsif\\|end\\)\\)" (1 (11 . ?\n))) - )) + ("^[ \t]*\\(#\\(if\\|else\\|elsif\\|end\\)\\)" (1 (11 . ?\n))))) (defvar ada-font-lock-keywords (eval-when-compile
--- a/lisp/progmodes/ada-xref.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/progmodes/ada-xref.el Tue Aug 21 04:55:30 2007 +0000 @@ -71,7 +71,7 @@ :type 'string :group 'ada) (defcustom ada-gnatls-args '("-v") - "*Arguments to pass to `gnatfind' to find location of the runtime. + "*Arguments to pass to `gnatls' to find location of the runtime. Typical use is to pass `--RTS=soft-floats' on some systems that support it. You can also add `-I-' if you do not want the current directory to be included. @@ -322,7 +322,6 @@ (reverse ada-xref-runtime-library-ali-path)) )) - (defun ada-treat-cmd-string (cmd-string) "Replace meta-sequences like ${...} in CMD-STRING with the appropriate value. Assumes project exists. @@ -345,7 +344,7 @@ ;; Check if there is an environment variable with the same name (if (null value) (if (not (setq value (getenv name))) - (message "%s" (concat "No environment variable " name " found")))) + (message "%s" (concat "No project or environment variable " name " found")))) (cond ((null value) @@ -535,6 +534,11 @@ Completion is attempted in all the directories in the source path, as defined in the project file." ;; FIXME: doc arguments + + ;; This function is not itself interactive, but it is called as part + ;; of the prompt of interactive functions, so we require a project + ;; file. + (ada-require-project-file) (let (list (dirs (ada-xref-get-src-dir-field))) @@ -663,9 +667,6 @@ ada-prj-file-extension)) (dir (file-name-directory current-file)) - ;; on Emacs 20.2, directory-files does not work if - ;; parse-sexp-lookup-properties is set - (parse-sexp-lookup-properties nil) (prj-files (directory-files dir t (concat ".*" (regexp-quote @@ -905,6 +906,8 @@ (interactive "d\nP") (ada-find-references pos arg t)) +(defconst ada-gnatfind-buffer-name "*gnatfind*") + (defun ada-find-any-references (entity &optional file line column local-only append) "Search for references to any entity whose name is ENTITY. @@ -943,23 +946,25 @@ (setq command (concat command " -P" ada-prj-default-project-file)) (setq command (concat command " -p" ada-prj-default-project-file)))) - (if (and append (get-buffer "*gnatfind*")) + (if (and append (get-buffer ada-gnatfind-buffer-name)) (save-excursion (set-buffer "*gnatfind*") (setq old-contents (buffer-string)))) (let ((compilation-error "reference")) - (compilation-start command)) + (compilation-start command 'compilation-mode (lambda (mode) ada-gnatfind-buffer-name))) ;; Hide the "Compilation" menu (save-excursion - (set-buffer "*gnatfind*") + (set-buffer ada-gnatfind-buffer-name) (local-unset-key [menu-bar compilation-menu]) (if old-contents (progn (goto-char 1) + (set 'buffer-read-only nil) (insert old-contents) + (set 'buffer-read-only t) (goto-char (point-max))))) ) ) @@ -1940,7 +1945,7 @@ anywhere in the object path. This command requires the external `egrep' program to be available. -This works well when one is using an external librarie and wants to find +This works well when one is using an external library and wants to find the declaration and documentation of the subprograms one is using." ;; FIXME: what does this function do? (let (list
--- a/lisp/progmodes/compile.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/progmodes/compile.el Tue Aug 21 04:55:30 2007 +0000 @@ -1972,7 +1972,13 @@ ;; Store it for the possibly unnormalized name (puthash file ;; Retrieve or create file-structure for normalized name - (or (gethash (list filename) compilation-locs) + ;; The gethash used to not use spec-directory, but + ;; this leads to errors when files in different + ;; directories have the same name: + ;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00463.html + (or (gethash (cons filename spec-directory) compilation-locs) + ;; TODO should this, without spec-directory, be + ;; done at all? (puthash (list filename) (list (list filename spec-directory) fmt) compilation-locs))
--- a/lisp/progmodes/cperl-mode.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/progmodes/cperl-mode.el Tue Aug 21 04:55:30 2007 +0000 @@ -3736,8 +3736,12 @@ (set-syntax-table reset-st)))) (defsubst cperl-look-at-leading-count (is-x-REx e) - (if (re-search-forward (concat "\\=" (if is-x-REx "[ \t\n]*" "") "[{?+*]") - (1- e) t) ; return nil on failure, no moving + (if (and (> (point) e) + ;; return nil on failure, no moving + (re-search-forward (concat "\\=" + (if is-x-REx "[ \t\n]*" "") + "[{?+*]") + (1- e) t)) (if (eq ?\{ (preceding-char)) nil (cperl-postpone-fontification (1- (point)) (point) @@ -3750,7 +3754,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', `cperl-here-face'." (interactive) - (or min (setq min (point-min) + (or min (setq min (point-min) cperl-syntax-state nil cperl-syntax-done-to min)) (or max (setq max (point-max))) @@ -4785,7 +4789,8 @@ (progn (cperl-postpone-fontification (1- e1) e1 'face my-cperl-delimiters-face) - (if (assoc (char-after b) cperl-starters) + (if (and (not (eobp)) + (assoc (char-after b) cperl-starters)) (progn (cperl-postpone-fontification b1 (1+ b1) 'face my-cperl-delimiters-face)
--- a/lisp/progmodes/gdb-ui.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/progmodes/gdb-ui.el Tue Aug 21 04:55:30 2007 +0000 @@ -1132,10 +1132,10 @@ (let ((item (concat string "\n"))) (if gdb-enable-debug (push (cons 'send item) gdb-debug-log)) (process-send-string proc item))) - (if (and (string-match "\\\\$" string) - (not comint-input-sender-no-newline)) ;;Try to catch C-d. + (if (string-match "\\\\\\'" string) (setq gdb-continuation (concat gdb-continuation string "\n")) - (let ((item (concat gdb-continuation string "\n"))) + (let ((item (concat gdb-continuation string + (if (not comint-input-sender-no-newline) "\n")))) (gdb-enqueue-input item) (setq gdb-continuation nil)))))
--- a/lisp/progmodes/grep.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/progmodes/grep.el Tue Aug 21 04:55:30 2007 +0000 @@ -770,7 +770,8 @@ ;; even when async processes aren't supported. (compilation-start (if (and grep-use-null-device null-device) (concat command " " null-device) - command) 'grep-mode)) + command) + 'grep-mode)) (if (eq next-error-last-buffer (current-buffer)) (setq default-directory dir))))))
--- a/lisp/progmodes/meta-mode.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/progmodes/meta-mode.el Tue Aug 21 04:55:30 2007 +0000 @@ -51,7 +51,7 @@ ;; these lines to your startup file: ;; ;; (add-hook 'meta-mode-load-hook -;; '(lambda () (require 'meta-buf))) +;; (lambda () (require 'meta-buf))) ;; ;; The add-on package loaded this way may in turn make use of the ;; mode-hooks provided in this package to activate additional features @@ -605,14 +605,16 @@ (defun meta-indent-calculate () "Return the indentation of current line of Metafont or MetaPost source." + ;; Indentation within strings is not considered as Meta* don't allow multi + ;; line strings. (save-excursion (back-to-indentation) (cond - ;; Comments to the left margin. + ;; Comments to the left margin. ((and meta-left-comment-regexp (looking-at meta-left-comment-regexp)) 0) - ;; Comments to the right margin. + ;; Comments to the right margin. ((and meta-right-comment-regexp (looking-at meta-right-comment-regexp)) comment-column) @@ -620,42 +622,113 @@ ((and meta-ignore-comment-regexp (looking-at meta-ignore-comment-regexp)) (current-indentation)) + ;; Beginning of buffer. + ((eq (point-at-bol) (point-min)) + 0) ;; Backindent at end of environments. - ((looking-at + ((meta-indent-looking-at-code (concat "\\<" meta-end-environment-regexp "\\>")) - (- (meta-indent-calculate-last) meta-indent-level)) + (- (meta-indent-current-indentation) meta-indent-level)) ;; Backindent at keywords within environments. - ((looking-at + ((meta-indent-looking-at-code (concat "\\<" meta-within-environment-regexp "\\>")) - (- (meta-indent-calculate-last) meta-indent-level)) - (t (meta-indent-calculate-last))))) + (- (meta-indent-current-indentation) meta-indent-level)) + (t (meta-indent-current-indentation))))) + +(defun meta-indent-in-string-p () + "Tell if the point is in a string." + (or (nth 3 (syntax-ppss)) + (eq (get-text-property (point) 'face) font-lock-string-face))) -(defun meta-indent-calculate-last () - "Return the indentation of previous line of Metafont or MetaPost source." - (save-restriction - (widen) +(defun meta-indent-looking-at-code (regexp) + "Same as `looking-at' but checks that the point is not in a string." + (unless (meta-indent-in-string-p) + (looking-at regexp))) + +(defun meta-indent-previous-line () + "Go to the previous line of code, skipping comments." + (skip-chars-backward "\n\t ") + (move-to-column (current-indentation)) + ;; Ignore comments. + (while (and (looking-at comment-start) (not (bobp))) (skip-chars-backward "\n\t ") - (move-to-column (current-indentation)) - ;; Ignore comments. - (while (and (looking-at comment-start) (not (bobp))) - (skip-chars-backward "\n\t ") - (if (not (bobp)) - (move-to-column (current-indentation)))) - (cond - ((bobp) 0) - (t (+ (current-indentation) - (meta-indent-level-count) - (cond - ;; Compensate for backindent at end of environments. - ((looking-at - (concat "\\<"meta-end-environment-regexp "\\>")) - meta-indent-level) - ;; Compensate for backindent within environments. - ((looking-at - (concat "\\<" meta-within-environment-regexp "\\>")) - meta-indent-level) - (t 0))))) - )) + (if (not (bobp)) + (move-to-column (current-indentation))))) + +(defun meta-indent-unfinished-line () + "Tell if the current line of code ends with an unfinished expression." + (save-excursion + (end-of-line) + ;; Skip backward the comments. + (while (search-backward comment-start (point-at-bol) t)) + ;; Search for the end of the previous expression. + (if (search-backward ";" (point-at-bol) t) + (progn (while (and (meta-indent-in-string-p) + (search-backward ";" (point-at-bol) t))) + (if (= (char-after) ?\;) + (forward-char) + (beginning-of-line))) + (beginning-of-line)) + ;; See if the last statement of the line is environment-related, + ;; or exists at all. + (if (meta-indent-looking-at-code + (concat "[ \t]*\\($\\|" (regexp-quote comment-start) + "\\|\\<" meta-end-environment-regexp "\\>" + "\\|\\<" meta-begin-environment-regexp "\\>" + "\\|\\<" meta-within-environment-regexp "\\>\\)")) + nil + t))) + +(defun meta-indent-current-indentation () + "Return the indentation wanted for the current line of code." + (+ (meta-indent-current-nesting) + (if (save-excursion + (back-to-indentation) + (and (not (looking-at (concat "\\<" meta-end-environment-regexp "\\>" + "\\|\\<" meta-within-environment-regexp "\\>"))) + (progn (meta-indent-previous-line) + (meta-indent-unfinished-line)))) + meta-indent-level + 0))) + +(defun meta-indent-current-nesting () + "Return the indentation according to the nearest environment keyword." + (save-excursion + (save-restriction + (widen) + (back-to-indentation) + (let ((to-add 0)) + ;; If we found some environment marker backward... + (if (catch 'found + (while (re-search-backward + (concat "(\\|)\\|\\<" meta-end-environment-regexp "\\>" + "\\|\\<" meta-begin-environment-regexp "\\>" + "\\|\\<" meta-within-environment-regexp "\\>") + nil t) + ;; If we aren't in a string or in a comment, we've found something. + (unless (or (meta-indent-in-string-p) + (nth 4 (syntax-ppss))) + (cond ((= (char-after) ?\() + (setq to-add (+ to-add meta-indent-level))) + ((= (char-after) ?\)) + (setq to-add (- to-add meta-indent-level))) + (t (throw 'found t)))))) + (progn + ;; ... then use it to compute the current indentation. + (back-to-indentation) + (+ to-add (current-indentation) (meta-indent-level-count) + ;; Compensate for backindent of end and within keywords. + (if (meta-indent-looking-at-code + (concat "\\<" meta-end-environment-regexp "\\>\\|" + "\\<" meta-within-environment-regexp "\\>")) + meta-indent-level + ;; Compensate for unfinished line. + (if (save-excursion + (meta-indent-previous-line) + (meta-indent-unfinished-line)) + (- meta-indent-level) + 0)))) + 0))))) (defun meta-indent-level-count () "Count indentation change for begin-end commands in the current line." @@ -671,18 +744,12 @@ (goto-char (match-beginning 0)) (cond ;; Count number of begin-end keywords within line. - ((looking-at + ((meta-indent-looking-at-code (concat "\\<" meta-begin-environment-regexp "\\>")) (setq count (+ count meta-indent-level))) - ((looking-at + ((meta-indent-looking-at-code (concat "\\<" meta-end-environment-regexp "\\>")) - (setq count (- count meta-indent-level))) - ;; Count number of open-close parentheses within line. - ((looking-at "(") - (setq count (+ count meta-indent-level))) - ((looking-at ")") - (setq count (- count meta-indent-level))) - ))) + (setq count (- count meta-indent-level)))))) count))))
--- a/lisp/progmodes/perl-mode.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/progmodes/perl-mode.el Tue Aug 21 04:55:30 2007 +0000 @@ -267,8 +267,16 @@ ("^[ \t]*format.*=[ \t]*\\(\n\\)" (1 '(7))) ;; Funny things in sub arg specifications like `sub myfunc ($$)' ("\\<sub\\s-+\\S-+\\s-*(\\([^)]+\\))" 1 '(1)) - ;; regexp and funny quotes - ("[?:.,;=!~({[][ \t\n]*\\(/\\)" (1 '(7))) + ;; Regexp and funny quotes. + ("\\(?:[?:.,;=!~({[]\\|\\(^\\)\\)[ \t\n]*\\(/\\)" + (2 (if (and (match-end 1) + (save-excursion + (goto-char (match-end 1)) + (skip-chars-backward " \t\n") + (not (memq (char-before) + '(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[))))) + nil ;; A division sign instead of a regexp-match. + '(7)))) ("\\(^\\|[?:.,;=!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\([^])}> \n\t]\\)" ;; Nasty cases: ;; /foo/m $a->m $#m $m @m %m
--- a/lisp/progmodes/scheme.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/progmodes/scheme.el Tue Aug 21 04:55:30 2007 +0000 @@ -156,6 +156,7 @@ ;; Look within the line for a ; following an even number of backslashes ;; after either a non-backslash or the line beginning. (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*") + (set (make-local-variable 'font-lock-comment-start-skip) ";+ *") (make-local-variable 'comment-column) (setq comment-column 40) (make-local-variable 'parse-sexp-ignore-comments)
--- a/lisp/progmodes/vhdl-mode.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/progmodes/vhdl-mode.el Tue Aug 21 04:55:30 2007 +0000 @@ -6982,10 +6982,13 @@ (when (and vhdl-progress-info (not noninteractive) (< vhdl-progress-interval (- (nth 1 (current-time)) (aref vhdl-progress-info 2)))) - (message (concat string "... (%2d%s)") - (/ (* 100 (- pos (aref vhdl-progress-info 0))) - (- (aref vhdl-progress-info 1) - (aref vhdl-progress-info 0))) "%") + (let ((delta (- (aref vhdl-progress-info 1) + (aref vhdl-progress-info 0)))) + (if (= 0 delta) + (message (concat string "... (100%s)") "%") + (message (concat string "... (%2d%s)") + (/ (* 100 (- pos (aref vhdl-progress-info 0))) + delta) "%"))) (aset vhdl-progress-info 2 (nth 1 (current-time))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
--- a/lisp/ps-print.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/ps-print.el Tue Aug 21 04:55:30 2007 +0000 @@ -2869,7 +2869,8 @@ :group 'ps-print-font) (defcustom ps-font-size '(7 . 8.5) - "*Font size, in points, for ordinary text, when generating PostScript." + "*Font size, in points, for ordinary text, when generating PostScript. +Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)." :type '(choice :menu-tag "Ordinary Text Font Size" :tag "Ordinary Text Font Size" (number :tag "Text Size") @@ -2886,7 +2887,8 @@ :group 'ps-print-font) (defcustom ps-header-font-size '(10 . 12) - "*Font size, in points, for text in the header, when generating PostScript." + "*Font size, in points, for text in the header, when generating PostScript. +Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)." :type '(choice :menu-tag "Header Font Size" :tag "Header Font Size" (number :tag "Header Size") @@ -2897,7 +2899,8 @@ :group 'ps-print-font) (defcustom ps-header-title-font-size '(12 . 14) - "*Font size, in points, for the top line of text in header, in PostScript." + "*Font size, in points, for the top line of text in header, in PostScript. +Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)." :type '(choice :menu-tag "Header Title Font Size" :tag "Header Title Font Size" (number :tag "Header Title Size") @@ -2914,7 +2917,8 @@ :group 'ps-print-font) (defcustom ps-footer-font-size '(10 . 12) - "*Font size, in points, for text in the footer, when generating PostScript." + "*Font size, in points, for text in the footer, when generating PostScript. +Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)." :type '(choice :menu-tag "Footer Font Size" :tag "Footer Font Size" (number :tag "Footer Size") @@ -2946,7 +2950,8 @@ :group 'ps-print-miscellany) (defcustom ps-line-number-font-size 6 - "*Font size, in points, for line number, when generating PostScript." + "*Font size, in points, for line number, when generating PostScript. +Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)." :type '(choice :menu-tag "Line Number Font Size" :tag "Line Number Font Size" (number :tag "Font Size") @@ -3357,6 +3362,8 @@ (defcustom ps-line-spacing 0 "*Specify line spacing, in points, for ordinary text. +Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE). + See also `ps-paragraph-spacing' and `ps-paragraph-regexp'. To get all lines with some spacing set both `ps-line-spacing' and @@ -3373,6 +3380,8 @@ (defcustom ps-paragraph-spacing 0 "*Specify paragraph spacing, in points, for ordinary text. +Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE). + See also `ps-line-spacing' and `ps-paragraph-regexp'. To get all lines with some spacing set both `ps-line-spacing' and
--- a/lisp/simple.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/simple.el Tue Aug 21 04:55:30 2007 +0000 @@ -5810,6 +5810,57 @@ ; 'insert-in-front-hooks '(minibuffer-prompt-insertion))) ; + +;;;; Problematic external packages. + +;; rms says this should be done by specifying symbols that define +;; versions together with bad values. This is therefore not as +;; flexible as it could be. See the thread: +;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00300.html +(defconst bad-packages-alist + ;; Not sure exactly which semantic versions have problems. + ;; Definitely 2.0pre3, probably all 2.0pre's before this. + '((semantic semantic-version "2\\.0pre[1-3]" + "The version of `semantic' loaded does not work in Emacs 22. +It can cause constant high CPU load. Upgrade to at least 2.0pre4.") + ;; CUA-mode does not work with GNU Emacs version 22.1 and newer. + ;; Except for version 1.2, all of the 1.x and 2.x version of cua-mode + ;; provided the `CUA-mode' feature. Since this is no longer true, + ;; we can warn the user if the `CUA-mode' feature is ever provided. + (CUA-mode t nil +"CUA-mode is now part of the standard GNU Emacs distribution, +so you can now enable CUA via the Options menu or by customizing `cua-mode'. + +You have loaded an older version of CUA-mode which does not work +correctly with this version of Emacs. You should remove the old +version and use the one distributed with Emacs.")) + "Alist of packages known to cause problems in this version of Emacs. +Each element has the form (PACKAGE SYMBOL REGEXP STRING). +PACKAGE is either a regular expression to match file names, or a +symbol (a feature name); see the documentation of +`after-load-alist', to which this variable adds functions. +SYMBOL is either the name of a string variable, or `t'. Upon +loading PACKAGE, if SYMBOL is t or matches REGEXP, display a +warning using STRING as the message.") + +(defun bad-package-check (package) + "Run a check using the element from `bad-packages-alist' matching PACKAGE." + (condition-case nil + (let* ((list (assoc package bad-packages-alist)) + (symbol (nth 1 list))) + (and list + (boundp symbol) + (or (eq symbol t) + (and (stringp (setq symbol (eval symbol))) + (string-match (nth 2 list) symbol))) + (display-warning :warning (nth 3 list)))) + (error nil))) + +(mapc (lambda (elem) + (eval-after-load (car elem) `(bad-package-check ',(car elem)))) + bad-packages-alist) + + (provide 'simple) ;; arch-tag: 24af67c0-2a49-44f6-b3b1-312d8b570dfd
--- a/lisp/smerge-mode.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/smerge-mode.el Tue Aug 21 04:55:30 2007 +0000 @@ -324,7 +324,8 @@ (defvar smerge-resolve-function (lambda () (error "Don't know how to resolve")) "Mode-specific merge function. -The function is called with no argument and with the match data set +The function is called with zero or one argument (non-nil if the resolution +function should only apply safe heuristics) and with the match data set according to `smerge-match-conflict'.") (add-to-list 'debug-ignored-errors "Don't know how to resolve") @@ -378,7 +379,7 @@ (smerge-remove-props (or beg (point-min)) (or end (point-max))) (push event unread-command-events))))) -(defun smerge-resolve () +(defun smerge-resolve (&optional safe) "Resolve the conflict at point intelligently. This relies on mode-specific knowledge and thus only works in some major modes. Uses `smerge-resolve-function' to do the actual work." @@ -393,8 +394,10 @@ ;; Mode-specific conflict resolution. ((condition-case nil (atomic-change-group - (funcall smerge-resolve-function) - t) + (if safe + (funcall smerge-resolve-function safe) + (funcall smerge-resolve-function)) + t) (error nil)) ;; Nothing to do: the resolution function has done it already. nil) @@ -412,6 +415,31 @@ (error "Don't know how to resolve"))) (smerge-auto-leave)) +(defun smerge-resolve-all () + "Perform automatic resolution on all conflicts." + (interactive) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward smerge-begin-re nil t) + (condition-case nil + (progn + (smerge-match-conflict) + (smerge-resolve 'safe)) + (error nil))))) + +(defun smerge-batch-resolve () + ;; command-line-args-left is what is left of the command line. + (if (not noninteractive) + (error "`smerge-batch-resolve' is to be used only with -batch")) + (while command-line-args-left + (let ((file (pop command-line-args-left))) + (message "Resolving conflicts in %s..." file) + (when (file-readable-p file) + (with-current-buffer (find-file-noselect file) + (smerge-resolve-all) + (save-buffer) + (kill-buffer (current-buffer))))))) + (defun smerge-keep-base () "Revert to the base version." (interactive) @@ -677,7 +705,9 @@ (unwind-protect (with-temp-buffer (let ((coding-system-for-read 'emacs-mule)) - (call-process diff-command nil t nil file1 file2)) + ;; Don't forget -a to make sure diff treats it as a text file + ;; even if it contains \0 and such. + (call-process diff-command nil t nil "-a" file1 file2)) ;; Process diff's output. (goto-char (point-min)) (while (not (eobp)) @@ -831,6 +861,10 @@ (message "Please resolve conflicts now; exit ediff when done"))) +(defconst smerge-parsep-re + (concat smerge-begin-re "\\|" smerge-end-re "\\|" + smerge-base-re "\\|" smerge-other-re "\\|")) + ;;;###autoload (define-minor-mode smerge-mode "Minor mode to simplify editing output from the diff3 program. @@ -845,6 +879,13 @@ (while (smerge-find-conflict) (save-excursion (font-lock-fontify-region (match-beginning 0) (match-end 0) nil))))) + (if (string-match (regexp-quote smerge-parsep-re) paragraph-separate) + (unless smerge-mode + (set (make-local-variable 'paragraph-separate) + (replace-match "" t t paragraph-separate))) + (when smerge-mode + (set (make-local-variable 'paragraph-separate) + (concat smerge-parsep-re paragraph-separate)))) (unless smerge-mode (smerge-remove-props (point-min) (point-max))))
--- a/lisp/startup.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/startup.el Tue Aug 21 04:55:30 2007 +0000 @@ -45,7 +45,20 @@ (defgroup initialization nil "Emacs start-up procedure." - :group 'internal) + :group 'environment) + +(defcustom initial-buffer-choice nil + "Buffer to show after starting Emacs. +If the value is nil and `inhibit-splash-screen' is nil, show the +startup screen. If the value is string, visit the specified file or +directory using `find-file'. If t, open the `*scratch*' buffer." + :type '(choice + (const :tag "Splash screen" nil) + (directory :tag "Directory" :value "~/") + (file :tag "File" :value "~/file.txt") + (const :tag "Lisp scratch buffer" t)) + :version "23.1" + :group 'initialization) (defcustom inhibit-splash-screen nil "Non-nil inhibits the startup screen. @@ -1062,10 +1075,7 @@ (if (get-buffer "*scratch*") (with-current-buffer "*scratch*" (if (eq major-mode 'fundamental-mode) - (funcall initial-major-mode)) - ;; Don't lose text that users type in *scratch*. - (setq buffer-offer-save t) - (auto-save-mode 1))) + (funcall initial-major-mode)))) ;; Load library for our terminal type. ;; User init file can set term-file-prefix to nil to prevent this. @@ -1115,6 +1125,8 @@ '((:face (variable-pitch :weight bold) "Important Help menu items:\n" :face variable-pitch + :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial))) + "\tLearn how to use Emacs efficiently" (lambda () (let* ((en "TUTORIAL") (tut (or (get-language-info current-language-environment @@ -1128,47 +1140,47 @@ (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\t\tLearn how to use Emacs efficiently" - (if (string= en tut) - "" - (concat " (" title ")")) - "\n"))) - :face variable-pitch "\ -Emacs FAQ\t\tFrequently asked questions and answers -View Emacs Manual\t\tView the Emacs manual using Info -Absence of Warranty\tGNU Emacs comes with " + (if (string= en tut) + "" + (concat " (" title ")")))) + "\n" + :face variable-pitch + :link ("Emacs FAQ" (lambda (button) (view-emacs-FAQ))) + "\tFrequently asked questions and answers\n" + :link ("View Emacs Manual" (lambda (button) (info-emacs-manual))) + "\tView the Emacs manual using Info\n" + :link ("Absence of Warranty" (lambda (button) (describe-no-warranty))) + "\tGNU Emacs comes with " :face (variable-pitch :slant oblique) "ABSOLUTELY NO WARRANTY\n" :face variable-pitch - "\ -Copying Conditions\t\tConditions for redistributing and changing Emacs -Getting New Versions\tHow to obtain the latest version of Emacs -More Manuals / Ordering Manuals Buying printed manuals from the FSF\n") - (:face variable-pitch - "\nTo quit a partially entered command, type " - :face default - "Control-g" + :link ("Copying Conditions" (lambda (button) (describe-copying))) + "\tConditions for redistributing and changing Emacs\n" + :link ("Getting New Versions" (lambda (button) (describe-distribution))) + "\tHow to obtain the latest version of Emacs\n" + :link ("More Manuals / Ordering Manuals" (lambda (button) (view-order-manuals))) + " Buying printed manuals from the FSF\n") + (:face (variable-pitch :weight bold) + "Useful tasks:\n" :face variable-pitch - ". - -Emacs Guided Tour\t\tSee http://www.gnu.org/software/emacs/tour/ + :link ("Visit New File" + (lambda (button) (call-interactively 'find-file))) + "\tSpecify a new file's name, to edit the file\n" + :link ("Open Home Directory" + (lambda (button) (dired "~"))) + "\tOpen your home directory, to operate on its files\n" + :link ("Open *scratch* buffer" + (lambda (button) (switch-to-buffer (get-buffer-create "*scratch*")))) + "\tOpen buffer for notes you don't want to save\n" + :link ("Customize Startup" + (lambda (button) (customize-group 'initialization))) + "\tChange initialization settings including this screen\n" -" - :face (variable-pitch :weight bold) - "Useful File menu items:\n" - :face variable-pitch - "Exit Emacs\t\t(Or type " - :face default - "Control-x" - :face variable-pitch - " followed by " - :face default - "Control-c" - :face variable-pitch - ") -Recover Crashed Session\tRecover files you were editing before a crash\n" - )) + "\nEmacs Guided Tour\tSee " + :link ("http://www.gnu.org/software/emacs/tour/" + (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/"))) + + )) "A list of texts to show in the middle part of splash screens. Each element in the list should be a list of strings or pairs `:face FACE', like `fancy-splash-insert' accepts them.") @@ -1200,13 +1212,22 @@ (file :tag "File"))) +(defvar splash-screen-keymap + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (set-keymap-parent map button-buffer-map) + (define-key map "\C-?" 'scroll-down) + (define-key map " " 'scroll-up) + (define-key map "q" 'exit-splash-screen) + map) + "Keymap for splash screen buffer.") + ;; These are temporary storage areas for the splash screen display. (defvar fancy-current-text nil) (defvar fancy-splash-help-echo nil) (defvar fancy-splash-stop-time nil) (defvar fancy-splash-outer-buffer nil) -(defvar fancy-splash-last-input-event nil) (defun fancy-splash-insert (&rest args) "Insert text into the current buffer, with faces. @@ -1216,14 +1237,21 @@ `put-text-property'." (let ((current-face nil)) (while args - (if (eq (car args) :face) - (setq args (cdr args) current-face (car args)) - (insert (propertize (let ((it (car args))) - (if (functionp it) - (funcall it) - it)) - 'face current-face - 'help-echo fancy-splash-help-echo))) + (cond ((eq (car args) :face) + (setq args (cdr args) current-face (car args))) + ((eq (car args) :link) + (setq args (cdr args)) + (let ((spec (car args))) + (insert-button (car spec) + 'face (list 'link current-face) + 'action (cadr spec) + 'follow-link t))) + (t (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))))) @@ -1253,18 +1281,12 @@ (eq (frame-parameter nil 'background-mode) 'dark)) (setq img (append img '(:color-symbols (("#000000" . "gray30")))))) - ;; Insert the image with a help-echo and a keymap. - (let ((map (make-sparse-keymap)) - (help-echo "mouse-2: browse http://www.gnu.org/")) - (define-key map [mouse-2] - (lambda () - (interactive) - (browse-url "http://www.gnu.org/") - (throw 'exit nil))) - (define-key map [down-mouse-2] 'ignore) - (define-key map [up-mouse-2] 'ignore) - (insert-image img (propertize "xxx" 'help-echo help-echo - 'keymap map))) + ;; Insert the image with a help-echo and a link. + (make-button (prog1 (point) (insert-image img)) (point) + 'face 'default + 'help-echo "mouse-2: browse http://www.gnu.org/" + 'action (lambda (button) (browse-url "http://www.gnu.org/")) + 'follow-link t) (insert "\n")))) (fancy-splash-insert :face '(variable-pitch :foreground "red") @@ -1275,19 +1297,22 @@ (fancy-splash-insert :face 'variable-pitch "You can do basic editing with the menu bar and scroll bar \ -using the mouse.\n\n") +using the mouse.\n" + :face 'variable-pitch + "To quit a partially entered command, type " + :face 'default + "Control-g" + :face 'variable-pitch + "." + "\n\n") (when fancy-splash-outer-buffer (fancy-splash-insert :face 'variable-pitch "Type " :face 'default - "Control-l" + "`q'" :face 'variable-pitch - " to begin editing" - (if (equal (buffer-name fancy-splash-outer-buffer) - "*scratch*") - ".\n" - " your file.\n")))) + " to exit from this screen.\n"))) (defun fancy-splash-tail () "Insert the tail part of the splash screen into the current buffer." @@ -1319,7 +1344,7 @@ "Meta-x recover-session RET" :face '(variable-pitch :foreground "red") "\nto recover" - " the files you were editing.")))) + " the files you were editing.\n")))) (defun fancy-splash-screens-1 (buffer) "Timer function displaying a splash screen." @@ -1327,7 +1352,8 @@ (throw 'stop-splashing nil)) (unless fancy-current-text (setq fancy-current-text fancy-splash-text)) - (let ((text (car fancy-current-text))) + (let ((text (car fancy-current-text)) + (inhibit-read-only t)) (set-buffer buffer) (erase-buffer) (if pure-space-overflow @@ -1359,32 +1385,30 @@ (push last-command-event unread-command-events)) (throw 'exit nil)) -(defun fancy-splash-exit () +(defun exit-splash-screen () "Exit the splash screen." - (if (get-buffer "GNU Emacs") - (throw 'stop-splashing nil))) + (if (get-buffer "*About GNU Emacs*") + (throw 'stop-splashing nil) + (quit-window t))) (defun fancy-splash-delete-frame (frame) "Exit the splash screen after the frame is deleted." ;; We can not throw from `delete-frame-events', so we set up a timer ;; to exit the recursive edit as soon as Emacs is idle again. (if (frame-live-p frame) - (run-at-time 0 nil 'fancy-splash-exit))) + (run-at-time 0 nil 'exit-splash-screen))) -(defun fancy-splash-screens (&optional hide-on-input) +(defun fancy-splash-screens (&optional static) "Display fancy splash screens when Emacs starts." - (if hide-on-input + (if (not static) (let ((old-hourglass display-hourglass) (fancy-splash-outer-buffer (current-buffer)) splash-buffer - (old-minor-mode-map-alist minor-mode-map-alist) - (old-emulation-mode-map-alists emulation-mode-map-alists) - (old-special-event-map special-event-map) (frame (fancy-splash-frame)) timer) (save-selected-window (select-frame frame) - (switch-to-buffer " GNU Emacs") + (switch-to-buffer "*About GNU Emacs*") (make-local-variable 'cursor-type) (setq splash-buffer (current-buffer)) (catch 'stop-splashing @@ -1416,8 +1440,6 @@ 'fancy-splash-special-event-action))) old-special-event-map) (setq display-hourglass nil - minor-mode-map-alist nil - emulation-mode-map-alists nil buffer-undo-list t mode-line-format (propertize "---- %b %-" 'face 'mode-line-buffer-id) @@ -1426,7 +1448,10 @@ timer (run-with-timer 0 fancy-splash-delay #'fancy-splash-screens-1 splash-buffer)) + (use-local-map splash-screen-keymap) + (setq tab-width 22) (message "%s" (startup-echo-area-message)) + (setq buffer-read-only t) (recursive-edit)) (cancel-timer timer) (setq display-hourglass old-hourglass @@ -1447,7 +1472,7 @@ (if (or (window-minibuffer-p) (window-dedicated-p (selected-window))) (pop-to-buffer (current-buffer)) - (switch-to-buffer "*About GNU Emacs*")) + (switch-to-buffer "*GNU Emacs*")) (setq buffer-read-only nil) (erase-buffer) (if pure-space-overflow @@ -1463,6 +1488,8 @@ (delete-region (point) (point-max)) (insert "\n") (fancy-splash-tail) + (use-local-map splash-screen-keymap) + (setq tab-width 22) (set-buffer-modified-p nil) (setq buffer-read-only t) (if (and view-read-only (not view-mode)) @@ -1510,15 +1537,15 @@ (> frame-height (+ image-height 19))))))) -(defun normal-splash-screen (&optional hide-on-input) +(defun normal-splash-screen (&optional static) "Display splash screen when Emacs starts." (let ((prev-buffer (current-buffer))) (unwind-protect - (with-current-buffer (get-buffer-create "GNU Emacs") + (with-current-buffer (get-buffer-create "*About GNU Emacs*") (setq buffer-read-only nil) (erase-buffer) (set (make-local-variable 'tab-width) 8) - (if hide-on-input + (if (not static) (set (make-local-variable 'mode-line-format) (propertize "---- %b %-" 'face 'mode-line-buffer-id))) @@ -1536,13 +1563,10 @@ ", one component of the GNU/Linux operating system.\n" ", a part of the GNU operating system.\n")) - (if hide-on-input + (if (not static) (insert (substitute-command-keys (concat - "\nType \\[recenter] to begin editing" - (if (equal (buffer-name prev-buffer) "*scratch*") - ".\n" - " your file.\n"))))) + "\nType \\[recenter] to quit from this screen.\n")))) (if (display-mouse-p) ;; The user can use the mouse to activate menus @@ -1550,22 +1574,58 @@ (progn (insert "\ You can do basic editing with the menu bar and scroll bar using the mouse. -To quit a partially entered command, type Control-g. - -Useful File menu items: -Exit Emacs (or type Control-x followed by Control-c) -Recover Crashed Session Recover files you were editing before a crash +To quit a partially entered command, type Control-g.\n") -Important Help menu items: -Emacs Tutorial Learn how to use Emacs efficiently -Emacs FAQ Frequently asked questions and answers -Read the Emacs Manual View the Emacs manual using Info -\(Non)Warranty GNU Emacs comes with ABSOLUTELY NO WARRANTY -Copying Conditions Conditions for redistributing and changing Emacs -Getting New Versions How to obtain the latest version of Emacs -More Manuals / Ordering Manuals How to order printed manuals from the FSF -") - (insert "\n\n" (emacs-version) + (insert "\nImportant Help menu items:\n") + (insert-button "Emacs Tutorial" + 'action (lambda (button) (help-with-tutorial)) + 'follow-link t) + (insert "\t\tLearn how to use Emacs efficiently\n") + (insert-button "Emacs FAQ" + 'action (lambda (button) (view-emacs-FAQ)) + 'follow-link t) + (insert "\t\tFrequently asked questions and answers\n") + (insert-button "Read the Emacs Manual" + 'action (lambda (button) (info-emacs-manual)) + 'follow-link t) + (insert "\tView the Emacs manual using Info\n") + (insert-button "\(Non)Warranty" + 'action (lambda (button) (describe-no-warranty)) + 'follow-link t) + (insert "\t\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n") + (insert-button "Copying Conditions" + 'action (lambda (button) (describe-copying)) + 'follow-link t) + (insert "\tConditions for redistributing and changing Emacs\n") + (insert-button "Getting New Versions" + 'action (lambda (button) (describe-distribution)) + 'follow-link t) + (insert "\tHow to obtain the latest version of Emacs\n") + (insert-button "More Manuals / Ordering Manuals" + 'action (lambda (button) (view-order-manuals)) + 'follow-link t) + (insert " How to order printed manuals from the FSF\n") + + (insert "\nUseful tasks:\n") + (insert-button "Visit New File" + 'action (lambda (button) (call-interactively 'find-file)) + 'follow-link t) + (insert "\t\tSpecify a new file's name, to edit the file\n") + (insert-button "Open Home Directory" + 'action (lambda (button) (dired "~")) + 'follow-link t) + (insert "\tOpen your home directory, to operate on its files\n") + (insert-button "Open *scratch* buffer" + 'action (lambda (button) (switch-to-buffer + (get-buffer-create "*scratch*"))) + 'follow-link t) + (insert "\tOpen buffer for notes you don't want to save\n") + (insert-button "Customize Startup" + 'action (lambda (button) (customize-group 'initialization)) + 'follow-link t) + (insert "\tChange initialization settings including this screen\n") + + (insert "\n" (emacs-version) "\n" emacs-copyright)) ;; No mouse menus, so give help using kbd commands. @@ -1579,57 +1639,139 @@ (eq (key-binding "\C-hi") 'info) (eq (key-binding "\C-hr") 'info-emacs-manual) (eq (key-binding "\C-h\C-n") 'view-emacs-news)) - (insert " + (progn + (insert " Get help C-h (Hold down CTRL and press h) -Emacs manual C-h r -Emacs tutorial C-h t Undo changes C-x u -Buy manuals C-h C-m Exit Emacs C-x C-c -Browse manuals C-h i") +") + (insert-button "Emacs manual" + 'action (lambda (button) (info-emacs-manual)) + 'follow-link t) + (insert " C-h r\t") + (insert-button "Browse manuals" + 'action (lambda (button) (Info-directory)) + 'follow-link t) + (insert "\t C-h i +") + (insert-button "Emacs tutorial" + 'action (lambda (button) (help-with-tutorial)) + 'follow-link t) + (insert " C-h t\tUndo changes\t C-x u +") + (insert-button "Buy manuals" + 'action (lambda (button) (view-order-manuals)) + 'follow-link t) + (insert "\t C-h C-m\tExit Emacs\t C-x C-c")) (insert (substitute-command-keys (format "\n Get help %s -Emacs manual \\[info-emacs-manual] -Emacs tutorial \\[help-with-tutorial]\tUndo changes\t\\[advertised-undo] -Buy manuals \\[view-order-manuals]\tExit Emacs\t\\[save-buffers-kill-terminal] -Browse manuals \\[info]" - (let ((where (where-is-internal - 'help-command nil t))) - (if where - (key-description where) - "M-x help")))))) +" + (let ((where (where-is-internal + 'help-command nil t))) + (if where + (key-description where) + "M-x help")))) + (insert-button "Emacs manual" + 'action (lambda (button) (info-emacs-manual)) + 'follow-link t) + (insert (substitute-command-keys" \\[info-emacs-manual]\t")) + (insert-button "Browse manuals" + 'action (lambda (button) (Info-directory)) + 'follow-link t) + (insert (substitute-command-keys "\t \\[info] +")) + (insert-button "Emacs tutorial" + 'action (lambda (button) (help-with-tutorial)) + 'follow-link t) + (insert (substitute-command-keys + " \\[help-with-tutorial]\tUndo changes\t \\[advertised-undo] +")) + (insert-button "Buy manuals" + 'action (lambda (button) (view-order-manuals)) + 'follow-link t) + (insert (substitute-command-keys + "\t \\[view-order-manuals]\tExit Emacs\t \\[save-buffers-kill-emacs]"))) - ;; Say how to use the menu bar with the keyboard. - (if (and (eq (key-binding "\M-`") 'tmm-menubar) - (eq (key-binding [f10]) 'tmm-menubar)) - (insert " -Activate menubar F10 or ESC ` or M-`") - (insert (substitute-command-keys " -Activate menubar \\[tmm-menubar]"))) + ;; Say how to use the menu bar with the keyboard. + (insert "\n") + (insert-button "Activate menubar" + 'action (lambda (button) (tmm-menubar)) + 'follow-link t) + (if (and (eq (key-binding "\M-`") 'tmm-menubar) + (eq (key-binding [f10]) 'tmm-menubar)) + (insert " F10 or ESC ` or M-`") + (insert (substitute-command-keys " \\[tmm-menubar]"))) ;; Many users seem to have problems with these. (insert " \(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key. If you have no Meta key, you may instead type ESC followed by the character.)") - (insert "\n\n" (emacs-version) + ;; Insert links to useful tasks + (insert "\nUseful tasks:\n") + + (insert-button "Visit New File" + 'action (lambda (button) (call-interactively 'find-file)) + 'follow-link t) + (insert "\t\t\t") + (insert-button "Open Home Directory" + 'action (lambda (button) (dired "~")) + 'follow-link t) + (insert "\n") + + (insert-button "Customize Startup" + 'action (lambda (button) (customize-group 'initialization)) + 'follow-link t) + (insert "\t\t") + (insert-button "Open *scratch* buffer" + 'action (lambda (button) (switch-to-buffer + (get-buffer-create "*scratch*"))) + 'follow-link t) + (insert "\n") + + (insert "\n" (emacs-version) "\n" emacs-copyright) (if (and (eq (key-binding "\C-h\C-c") 'describe-copying) (eq (key-binding "\C-h\C-d") 'describe-distribution) (eq (key-binding "\C-h\C-w") 'describe-no-warranty)) - (insert - "\n -GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details. + (progn + (insert + "\n +GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for ") + (insert-button "full details" + 'action (lambda (button) (describe-no-warranty)) + 'follow-link t) + (insert ". Emacs is Free Software--Free as in Freedom--so you can redistribute copies -of Emacs and modify it; type C-h C-c to see the conditions. -Type C-h C-d for information on getting the latest version.") - (insert (substitute-command-keys - "\n -GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details. +of Emacs and modify it; type C-h C-c to see ") + (insert-button "the conditions" + 'action (lambda (button) (describe-copying)) + 'follow-link t) + (insert ". +Type C-h C-d for information on ") + (insert-button "getting the latest version" + 'action (lambda (button) (describe-distribution)) + 'follow-link t) + (insert ".")) + (insert (substitute-command-keys + "\n +GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for ")) + (insert-button "full details" + 'action (lambda (button) (describe-no-warranty)) + 'follow-link t) + (insert (substitute-command-keys ". Emacs is Free Software--Free as in Freedom--so you can redistribute copies -of Emacs and modify it; type \\[describe-copying] to see the conditions. -Type \\[describe-distribution] for information on getting the latest version.")))) +of Emacs and modify it; type \\[describe-copying] to see ")) + (insert-button "the conditions" + 'action (lambda (button) (describe-copying)) + 'follow-link t) + (insert (substitute-command-keys". +Type \\[describe-distribution] for information on ")) + (insert-button "getting the latest version" + 'action (lambda (button) (describe-distribution)) + 'follow-link t) + (insert "."))) ;; The rest of the startup screen is the same on all ;; kinds of terminals. @@ -1650,7 +1792,9 @@ t) (insert "\n\nIf an Emacs session crashed recently, " "type Meta-x recover-session RET\nto recover" - " the files you were editing.")) + " the files you were editing.\n")) + + (use-local-map splash-screen-keymap) ;; Display the input that we set up in the buffer. (set-buffer-modified-p nil) @@ -1671,10 +1815,10 @@ (condition-case nil (switch-to-buffer (current-buffer)))))) ;; Unwind ... ensure splash buffer is killed - (if hide-on-input - (kill-buffer "GNU Emacs") - (switch-to-buffer "GNU Emacs") - (rename-buffer "*About GNU Emacs*" t))))) + (if (not static) + (kill-buffer "*About GNU Emacs*") + (switch-to-buffer "*About GNU Emacs*") + (rename-buffer "*GNU Emacs*" t))))) (defun startup-echo-area-message () @@ -1728,14 +1872,14 @@ (message "%s" (startup-echo-area-message)))))) -(defun display-splash-screen (&optional hide-on-input) +(defun display-splash-screen (&optional static) "Display splash screen according to display. Fancy splash screens are used on graphic displays, normal otherwise. With a prefix argument, any user input hides the splash screen." (interactive "P") ;; Prevent recursive calls from server-process-filter. - (if (not (get-buffer "GNU Emacs")) + (if (not (get-buffer "*About GNU Emacs*")) (if (use-fancy-splash-screens-p) (fancy-splash-screens hide-on-input) (normal-splash-screen hide-on-input)))) @@ -1960,8 +2104,15 @@ (or (get-buffer-window first-file-buffer) (list-buffers))))) + (when initial-buffer-choice + (cond ((eq initial-buffer-choice t) + (switch-to-buffer (get-buffer-create "*scratch*"))) + ((stringp initial-buffer-choice) + (find-file initial-buffer-choice)))) + ;; Maybe display a startup screen. (unless (or inhibit-startup-message + initial-buffer-choice noninteractive emacs-quick-startup) ;; Display a startup screen, after some preparations.
--- a/lisp/term/mac-win.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/term/mac-win.el Tue Aug 21 04:55:30 2007 +0000 @@ -1794,7 +1794,7 @@ (define-key mac-apple-event-map [internet-event get-url] 'mac-ae-get-url) -(define-key mac-apple-event-map [hi-command about] 'display-splash-screen) +(define-key mac-apple-event-map [hi-command about] 'about-emacs) ;;; Converted Carbon Events (defun mac-handle-toolbar-switch-mode (event)
--- a/lisp/vc-bzr.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/vc-bzr.el Tue Aug 21 04:55:30 2007 +0000 @@ -59,7 +59,7 @@ (defgroup vc-bzr nil "VC bzr backend." -;; :version "22" + :version "22.2" :group 'vc) (defcustom vc-bzr-program "bzr" @@ -131,38 +131,27 @@ If the `checkout/dirstate' file cannot be parsed, fall back to running `vc-bzr-state'." - (condition-case nil - (lexical-let ((root (vc-bzr-root file))) - (and root ; Short cut. - ;; This looks at internal files. May break if they change - ;; their format. - (lexical-let - ((dirstate-file (expand-file-name vc-bzr-admin-dirstate root))) - (if (file-exists-p dirstate-file) - (with-temp-buffer - (insert-file-contents dirstate-file) - (goto-char (point-min)) - (when (looking-at "#bazaar dirstate flat format 3") - (let* ((relfile (file-relative-name file root)) - (reldir (file-name-directory relfile))) - (re-search-forward - (concat "^\0" - (if reldir (regexp-quote (directory-file-name reldir))) - "\0" - (regexp-quote (file-name-nondirectory relfile)) - "\0") - nil t)))) - t)) - (vc-bzr-state file))) ; Expensive. - (file-error nil))) ; vc-bzr-program not found - -(defun vc-bzr-buffer-nonblank-p (&optional buffer) - "Return non-nil if BUFFER contains any non-blank characters." - (or (> (buffer-size buffer) 0) - (save-excursion - (set-buffer (or buffer (current-buffer))) - (goto-char (point-min)) - (re-search-forward "[^ \t\n]" (point-max) t)))) + (lexical-let ((root (vc-bzr-root file))) + (when root ; Short cut. + ;; This looks at internal files. May break if they change + ;; their format. + (lexical-let ((dirstate (expand-file-name vc-bzr-admin-dirstate root))) + (if (not (file-readable-p dirstate)) + (vc-bzr-state file) ; Expensive. + (with-temp-buffer + (insert-file-contents dirstate) + (goto-char (point-min)) + (if (not (looking-at "#bazaar dirstate flat format 3")) + (vc-bzr-state file) ; Some other unknown format? + (let* ((relfile (file-relative-name file root)) + (reldir (file-name-directory relfile))) + (re-search-forward + (concat "^\0" + (if reldir (regexp-quote (directory-file-name reldir))) + "\0" + (regexp-quote (file-name-nondirectory relfile)) + "\0") + nil t))))))))) (defconst vc-bzr-state-words "added\\|ignored\\|kind changed\\|modified\\|removed\\|renamed\\|unknown" @@ -181,61 +170,53 @@ (defun vc-bzr-status (file) "Return FILE status according to Bzr. Return value is a cons (STATUS . WARNING), where WARNING is a -string or nil, and STATUS is one of the symbols: 'added, -'ignored, 'kindchange, 'modified, 'removed, 'renamed, 'unknown, +string or nil, and STATUS is one of the symbols: `added', +`ignored', `kindchanged', `modified', `removed', `renamed', `unknown', which directly correspond to `bzr status' output, or 'unchanged for files whose copy in the working tree is identical to the one in the branch repository, or nil for files that are not registered with Bzr. If any error occurred in running `bzr status', then return nil." - (condition-case nil (with-temp-buffer - (let ((ret (vc-bzr-command "status" t 0 file)) - (status 'unchanged)) - ;; the only secure status indication in `bzr status' output - ;; is a couple of lines following the pattern:: - ;; | <status>: - ;; | <file name> - ;; if the file is up-to-date, we get no status report from `bzr', - ;; so if the regexp search for the above pattern fails, we consider - ;; the file to be up-to-date. - (goto-char (point-min)) - (when - (re-search-forward - ;; bzr prints paths relative to the repository root - (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+" - (regexp-quote (vc-bzr-file-name-relative file)) - (if (file-directory-p file) "/?" "") - "[ \t\n]*$") - (point-max) t) - (let ((start (match-beginning 0)) - (end (match-end 0))) - (goto-char start) + (let ((ret (condition-case nil + (vc-bzr-command "status" t 0 file) + (file-error nil))) ; vc-bzr-program not found. + (status 'unchanged)) + ;; the only secure status indication in `bzr status' output + ;; is a couple of lines following the pattern:: + ;; | <status>: + ;; | <file name> + ;; if the file is up-to-date, we get no status report from `bzr', + ;; so if the regexp search for the above pattern fails, we consider + ;; the file to be up-to-date. + (goto-char (point-min)) + (when (re-search-forward + ;; bzr prints paths relative to the repository root. + (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+" + (regexp-quote (vc-bzr-file-name-relative file)) + (if (file-directory-p file) "/?" "") + "[ \t\n]*$") + nil t) + (let ((status (match-string 1))) + ;; Erase the status text that matched. + (delete-region (match-beginning 0) (match-end 0)) (setq status - (cond - ((not (equal ret 0)) nil) - ((looking-at "added") 'added) - ((looking-at "kind changed") 'kindchange) - ((looking-at "renamed") 'renamed) - ((looking-at "modified") 'modified) - ((looking-at "removed") 'removed) - ((looking-at "ignored") 'ignored) - ((looking-at "unknown") 'unknown))) - ;; erase the status text that matched - (delete-region start end))) - (if status - (cons status - ;; "bzr" will output warnings and informational messages to - ;; stderr; due to Emacs' `vc-do-command' (and, it seems, - ;; `start-process' itself) limitations, we cannot catch stderr - ;; and stdout into different buffers. So, if there's anything - ;; left in the buffer after removing the above status - ;; keywords, let us just presume that any other message from - ;; "bzr" is a user warning, and display it. - (if (vc-bzr-buffer-nonblank-p) - (buffer-substring (point-min) (point-max))))))) - (file-error nil))) ; vc-bzr-program not found + (and (equal ret 0) ; Seems redundant. --Stef + (intern (replace-regexp-in-string " " "" + status)))))) + (when status + (goto-char (point-min)) + (skip-chars-forward " \n\t") ;Throw away spaces. + (cons status + ;; "bzr" will output warnings and informational messages to + ;; stderr; due to Emacs' `vc-do-command' (and, it seems, + ;; `start-process' itself) limitations, we cannot catch stderr + ;; and stdout into different buffers. So, if there's anything + ;; left in the buffer after removing the above status + ;; keywords, let us just presume that any other message from + ;; "bzr" is a user warning, and display it. + (unless (eobp) (buffer-substring (point) (point-max)))))))) (defun vc-bzr-state (file) (lexical-let ((result (vc-bzr-status file))) @@ -244,7 +225,7 @@ (message "Warnings in `bzr' output: %s" (cdr result))) (cdr (assq (car result) '((added . edited) - (kindchange . edited) + (kindchanged . edited) (renamed . edited) (modified . edited) (removed . edited) @@ -265,7 +246,7 @@ ;; bzr process. This looks at internal files. May break if they ;; change their format. (if (file-exists-p branch-format-file) - (with-temp-buffer + (with-temp-buffer (insert-file-contents branch-format-file) (goto-char (point-min)) (cond @@ -273,7 +254,7 @@ (looking-at "Bazaar-NG branch, format 0.0.4") (looking-at "Bazaar-NG branch format 5")) ;; count lines in .bzr/branch/revision-history - (insert-file-contents revhistory-file) + (insert-file-contents revhistory-file) (number-to-string (count-lines (line-end-position) (point-max)))) ((looking-at "Bazaar Branch Format 6 (bzr 0.15)") ;; revno is the first number in .bzr/branch/last-revision @@ -341,10 +322,10 @@ (setq destfile (vc-version-backup-file-name file rev))) (let ((coding-system-for-read 'binary) (coding-system-for-write 'binary)) - (with-temp-file destfile - (if rev - (vc-bzr-command "cat" t 0 file "-r" rev) - (vc-bzr-command "cat" t 0 file))))) + (with-temp-file destfile + (if rev + (vc-bzr-command "cat" t 0 file "-r" rev) + (vc-bzr-command "cat" t 0 file))))) (defun vc-bzr-revert (file &optional contents-done) (unless contents-done @@ -377,7 +358,6 @@ "Get bzr change log for FILES into specified BUFFER." ;; Fixme: This might need the locale fixing up if things like `revno' ;; got localized, but certainly it shouldn't use LC_ALL=C. - ;; NB. Can't be async -- see `vc-bzr-post-command-function'. (vc-bzr-command "log" buffer 0 files) ;; FIXME: Until Emacs-23, VC was missing a hook to sort out the mode for ;; the buffer, or at least set the regexps right. @@ -401,7 +381,6 @@ (setq rev1 nil)) (if (and (not rev1) rev2) (setq rev1 working)) - ;; NB. Can't be async -- see `vc-bzr-post-command-function'. ;; bzr diff produces condition code 1 for some reason. (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 1 files "--diff-options" (mapconcat 'identity (vc-diff-switches-list bzr) @@ -463,11 +442,11 @@ ;; Definition from Emacs 22 (unless (fboundp 'vc-annotate-convert-time) -(defun vc-annotate-convert-time (time) - "Convert a time value to a floating-point number of days. + (defun vc-annotate-convert-time (time) + "Convert a time value to a floating-point number of days. The argument TIME is a list as returned by `current-time' or `encode-time', only the first two elements of that list are considered." - (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600))) + (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600))) (defun vc-bzr-annotate-time () (when (re-search-forward "^ *[0-9]+ |" nil t) @@ -549,7 +528,7 @@ (setq current-bzr-state 'added)) ((looking-at "^kind changed") (setq current-vc-state 'edited) - (setq current-bzr-state 'kindchange)) + (setq current-bzr-state 'kindchanged)) ((looking-at "^modified") (setq current-vc-state 'edited) (setq current-bzr-state 'modified)) @@ -591,17 +570,9 @@ ;; else fall back to default vc representation (vc-default-dired-state-info 'Bzr file))))) -;; In case of just `(load "vc-bzr")', but that's probably the wrong -;; way to do it. -(add-to-list 'vc-handled-backends 'Bzr) - (eval-after-load "vc" '(add-to-list 'vc-directory-exclusion-list vc-bzr-admin-dirname t)) -(defconst vc-bzr-unload-hook - (lambda () - (setq vc-handled-backends (delq 'Bzr vc-handled-backends)) - (remove-hook 'vc-post-command-functions 'vc-bzr-post-command-function))) (provide 'vc-bzr) ;; arch-tag: 8101bad8-4e92-4e7d-85ae-d8e08b4e7c06
--- a/lisp/vc-rcs.el Mon Aug 13 13:51:08 2007 +0000 +++ b/lisp/vc-rcs.el Tue Aug 21 04:55:30 2007 +0000 @@ -717,6 +717,7 @@ " " (aref rda 0) ls) + :vc-annotate-prefix t :vc-rcs-r/d/a rda))) (maphash (if all-me
--- a/lispref/ChangeLog Mon Aug 13 13:51:08 2007 +0000 +++ b/lispref/ChangeLog Tue Aug 21 04:55:30 2007 +0000 @@ -1,3 +1,8 @@ +2007-08-16 Richard Stallman <rms@gnu.org> + + * processes.texi (Asynchronous Processes): Clarify + doc of start-file-process. + 2007-08-08 Martin Rudalics <rudalics@gmx.at> * modes.texi (Example Major Modes): Fix typo.
--- a/lispref/processes.texi Mon Aug 13 13:51:08 2007 +0000 +++ b/lispref/processes.texi Tue Aug 21 04:55:30 2007 +0000 @@ -503,23 +503,25 @@ @defun start-file-process name buffer-or-name program &rest args Like @code{start-process}, this function starts a new asynchronous -subprocess running @var{program} in it. The corresponding process -object is returned. - -If @code{default-directory} corresponds to a file handler, that -handler is invoked. @var{program} runs then on a remote host which is -identified by @code{default-directory}. The local part of -@code{default-directory} is the working directory of the subprocess. - -@var{program} and @var{program-args} might be file names. They are not -objects of file handler invocation. +subprocess running @var{program} in it, and returns its process +object---when @code{default-directory} is not a magic file name. + +If @code{default-directory} is magic, the function invokes its file +handler instead. This handler ought to run @var{program}, perhaps on +the local host, perhaps on a remote host that corresponds to +@code{default-directory}. In the latter case, the local part of +@code{default-directory} becomes the working directory of the process. + +This function does not try to invoke file name handlers for +@var{program} or for the @var{program-args}. Depending on the implementation of the file handler, it might not be possible to apply @code{process-filter} or @code{process-sentinel} to the resulting process object (@pxref{Filter Functions}, @pxref{Sentinels}). Some file handlers may not support @code{start-file-process} (for -example @code{ange-ftp-hook-function}). It returns then @code{nil}. +example @code{ange-ftp-hook-function}). In such cases, the function +does nothing and returns @code{nil}. @end defun @defun start-process-shell-command name buffer-or-name command &rest command-args
--- a/lispref/text.texi Mon Aug 13 13:51:08 2007 +0000 +++ b/lispref/text.texi Tue Aug 21 04:55:30 2007 +0000 @@ -4278,35 +4278,6 @@ functions. @end defmac -The two variables above are temporarily bound to @code{nil} during the -time that any of these functions is running. This means that if one of -these functions changes the buffer, that change won't run these -functions. If you do want a hook function to make changes that run -these functions, make it bind these variables back to their usual -values. - -One inconvenient result of this protective feature is that you cannot -have a function in @code{after-change-functions} or -@code{before-change-functions} which changes the value of that variable. -But that's not a real limitation. If you want those functions to change -the list of functions to run, simply add one fixed function to the hook, -and code that function to look in another variable for other functions -to call. Here is an example: - -@example -(setq my-own-after-change-functions nil) -(defun indirect-after-change-function (beg end len) - (let ((list my-own-after-change-functions)) - (while list - (funcall (car list) beg end len) - (setq list (cdr list))))) - -@group -(add-hooks 'after-change-functions - 'indirect-after-change-function) -@end group -@end example - @defvar first-change-hook This variable is a normal hook that is run whenever a buffer is changed that was previously in the unmodified state. @@ -4318,6 +4289,13 @@ described above in this section, as well as the hooks attached to certain special text properties (@pxref{Special Properties}) and overlay properties (@pxref{Overlay Properties}). + +Also, this variable is bound to non-@code{nil} while running those +same hook variables, so that by default modifying the buffer from +a modification hook does not cause other modification hooks to be run. +If you do want modification hooks to be run in a particular piece of +code that is itself run from a modification hook, then rebind locally +@code{inhibit-modification-hooks} to @code{nil}. @end defvar @ignore
--- a/man/ChangeLog Mon Aug 13 13:51:08 2007 +0000 +++ b/man/ChangeLog Tue Aug 21 04:55:30 2007 +0000 @@ -1,3 +1,29 @@ +2007-08-17 Eli Zaretskii <eliz@gnu.org> + + * basic.texi (Position Info): Add index entry for face at point. + Mention that character faces are also displayed by "C-u C-x =". + +2007-08-17 Jay Belanger <jay.p.belanger@gmail.com> + + * calc.texi: Move contents to beginning of file. + (Algebraic Entry): Fix the formatting of an example. + +2007-08-15 Jay Belanger <jay.p.belanger@gmail.com> + + * calc.texi (Basic Operations on Units): Mention exact versus + inexact conversions. + +2007-08-14 Jay Belanger <jay.p.belanger@gmail.com> + + * calc.texi (Basic Operations on Units): Mention default + values for new units. + (Quick Calculator Mode): Mention that binary format will + be displayed. + +2007-08-14 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus.texi (Selecting a Group): Mention gnus-maximum-newsgroup. + 2007-08-10 Katsumi Yamaoka <yamaoka@jpl.org> * gnus.texi (NNTP): Mention nntp-xref-number-is-evil.
--- a/man/basic.texi Mon Aug 13 13:51:08 2007 +0000 +++ b/man/basic.texi Tue Aug 21 04:55:30 2007 +0000 @@ -596,6 +596,7 @@ @cindex character set of character at point @cindex font of character at point @cindex text properties at point +@cindex face at point @w{@kbd{C-u C-x =}} displays the following additional information about a character. @@ -623,7 +624,8 @@ @item The character's text properties (@pxref{Text Properties,,, -elisp, the Emacs Lisp Reference Manual}), and any overlays containing it +elisp, the Emacs Lisp Reference Manual}), including any non-default +faces used to display the character, and any overlays containing it (@pxref{Overlays,,, elisp, the same manual}). @end itemize
--- a/man/calc.texi Mon Aug 13 13:51:08 2007 +0000 +++ b/man/calc.texi Tue Aug 21 04:55:30 2007 +0000 @@ -123,6 +123,13 @@ @insertcopying @end titlepage + +@summarycontents + +@c [end] + +@contents + @c [begin] @ifnottex @node Top, Getting Started, (dir), (dir) @@ -10013,11 +10020,18 @@ @cindex Algebraic notation @cindex Formulas, entering Calculations can also be entered in algebraic form. This is accomplished -by typing the apostrophe key, @kbd{'}, followed by the expression in -standard format: @kbd{@key{'} 2+3*4 @key{RET}} computes +by typing the apostrophe key, ', followed by the expression in +standard format: + +@example +' 2+3*4 @key{RET}. +@end example + +@noindent +This will compute @texline @math{2+(3\times4) = 14} @infoline @expr{2+(3*4) = 14} -and pushes that on the stack. If you wish you can +and push it on the stack. If you wish you can ignore the RPN aspect of Calc altogether and simply enter algebraic expressions in this way. You may want to use @key{DEL} every so often to clear previous results off the stack. @@ -10166,8 +10180,8 @@ @xref{Store and Recall}. If the result is an integer and the current display radix is decimal, -the number will also be displayed in hex and octal formats. If the -integer is in the range from 1 to 126, it will also be displayed as +the number will also be displayed in hex, octal and binary formats. If +the integer is in the range from 1 to 126, it will also be displayed as an ASCII character. For example, the quoted character @samp{"x"} produces the vector @@ -27436,14 +27450,29 @@ The @kbd{u c} (@code{calc-convert-units}) command converts a units expression to new, compatible units. For example, given the units expression @samp{55 mph}, typing @kbd{u c m/s @key{RET}} produces -@samp{24.5872 m/s}. If the units you request are inconsistent with -the original units, the number will be converted into your units -times whatever ``remainder'' units are left over. For example, -converting @samp{55 mph} into acres produces @samp{6.08e-3 acre / m s}. -(Recall that multiplication binds more strongly than division in Calc -formulas, so the units here are acres per meter-second.) Remainder -units are expressed in terms of ``fundamental'' units like @samp{m} and -@samp{s}, regardless of the input units. +@samp{24.5872 m/s}. If you have previously converted a units expression +with the same type of units (in this case, distance over time), you will +be offered the previous choice of new units as a default. Continuing +the above example, entering the units expression @samp{100 km/hr} and +typing @kbd{u c @key{RET}} (without specifying new units) produces +@samp{27.7777777778 m/s}. + +While many of Calc's conversion factors are exact, some are necessarily +approximate. If Calc is in fraction mode (@pxref{Fraction Mode}), then +unit conversions will try to give exact, rational conversions, but it +isn't always possible. Given @samp{55 mph} in fraction mode, typing +@kbd{u c m/s @key{RET}} produces @samp{15367:625 m/s}, for example, +while typing @kbd{u c au/yr @key{RET}} produces +@samp{5.18665819999e-3 au/yr}. + +If the units you request are inconsistent with the original units, the +number will be converted into your units times whatever ``remainder'' +units are left over. For example, converting @samp{55 mph} into acres +produces @samp{6.08e-3 acre / m s}. (Recall that multiplication binds +more strongly than division in Calc formulas, so the units here are +acres per meter-second.) Remainder units are expressed in terms of +``fundamental'' units like @samp{m} and @samp{s}, regardless of the +input units. One special exception is that if you specify a single unit name, and a compatible unit appears somewhere in the units expression, then @@ -36149,11 +36178,6 @@ @printindex fn -@summarycontents - -@c [end] - -@contents @bye
--- a/man/gnus.texi Mon Aug 13 13:51:08 2007 +0000 +++ b/man/gnus.texi Tue Aug 21 04:55:30 2007 +0000 @@ -2153,6 +2153,24 @@ @code{gnus-large-newsgroup}, but is only used for ephemeral newsgroups. +@vindex gnus-maximum-newsgroup +In groups in some news servers, there might be a big gap between a few +very old articles that will never be expired and the recent ones. In +such a case, the server will return the data like @code{(1 . 30000000)} +for the @code{LIST ACTIVE group} command, for example. Even if there +are actually only the articles 1-10 and 29999900-30000000, Gnus doesn't +know it at first and prepares for getting 30000000 articles. However, +it will consume hundreds megabytes of memories and might make Emacs get +stuck as the case may be. If you use such news servers, set the +variable @code{gnus-maximum-newsgroup} to a positive number. The value +means that Gnus ignores articles other than this number of the latest +ones in every group. For instance, the value 10000 makes Gnus get only +the articles 29990001-30000000 (if the latest article number is 30000000 +in a group). Note that setting this variable to a number might prevent +you from reading very old articles. The default value of the variable +@code{gnus-maximum-newsgroup} is @code{nil}, which means Gnus never +ignores old articles. + @vindex gnus-select-group-hook @vindex gnus-auto-select-first @vindex gnus-auto-select-subject
--- a/nt/ChangeLog Mon Aug 13 13:51:08 2007 +0000 +++ b/nt/ChangeLog Tue Aug 21 04:55:30 2007 +0000 @@ -1,3 +1,7 @@ +2007-08-14 Dhuvra Krishnamurthy <dhuvrakm@gmail.com> (tiny change) + + * makefile.w32-in (bootstrap-nmake): Change directories once more. + 2007-07-25 Glenn Morris <rgm@gnu.org> * Relicense all FSF files to GPLv3 or later.
--- a/nt/makefile.w32-in Mon Aug 13 13:51:08 2007 +0000 +++ b/nt/makefile.w32-in Tue Aug 21 04:55:30 2007 +0000 @@ -153,6 +153,7 @@ cd ..\src $(MAKE) $(MFLAGS) bootstrap $(MAKE) $(MFLAGS) bootstrap-clean + cd ..\nt $(CP) $(BLD)/cmdproxy.exe ../bin cd ..\lisp $(MAKE) $(MFLAGS) SHELL=$(SHELLTYPE) bootstrap
--- a/src/ChangeLog Mon Aug 13 13:51:08 2007 +0000 +++ b/src/ChangeLog Tue Aug 21 04:55:30 2007 +0000 @@ -1,3 +1,29 @@ +2007-08-19 Richard Stallman <rms@gnu.org> + + * eval.c (Ffunction, Fquote): Signal error if not 1 argument. + +2007-08-19 Andreas Schwab <schwab@suse.de> + + * alloc.c (pure): Round PURESIZE up. + +2007-08-17 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * xterm.c (handle_one_xevent): Remove check that mouse click is in + active frame. + +2007-08-16 Richard Stallman <rms@gnu.org> + + * eval.c (Fcommandp): Add parens to clarify. + + * minibuf.c (Fall_completions): Use enum for type of table. + + * emacs.c (USAGE2): Improve text. + +2007-08-15 Philippe Waroquiers <philippe.waroquiers@eurocontrol.int> + + * term.c (tty_default_color_capabilities): Declare static + variables in file scope, to avoid HPUX compiler problem. + 2007-08-13 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> * gtkutil.c (update_frame_tool_bar): Use -1 as index
--- a/src/alloc.c Mon Aug 13 13:51:08 2007 +0000 +++ b/src/alloc.c Tue Aug 21 04:55:30 2007 +0000 @@ -266,7 +266,7 @@ remapping on more recent systems because this is less important nowadays than in the days of small memories and timesharing. */ -EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = {1,}; +EMACS_INT pure[(PURESIZE + sizeof (EMACS_INT) - 1) / sizeof (EMACS_INT)] = {1,}; #define PUREBEG (char *) pure #else /* HAVE_SHM */
--- a/src/emacs.c Mon Aug 13 13:51:08 2007 +0000 +++ b/src/emacs.c Tue Aug 21 04:55:30 2007 +0000 @@ -281,9 +281,8 @@ Action options:\n\ \n\ FILE visit FILE using find-file\n\ -+LINE FILE visit FILE using find-file, then go to line LINE\n\ -+LINE:COLUMN FILE visit FILE using find-file, then go to line LINE,\n\ - column COLUMN\n\ ++LINE go to line LINE in next FILE\n\ ++LINE:COLUMN go to line LINE, column COLUMN, in next FILE\n\ --directory, -L DIR add DIR to variable load-path\n\ --eval EXPR evaluate Emacs Lisp expression EXPR\n\ --execute EXPR evaluate Emacs Lisp expression EXPR\n\
--- a/src/eval.c Mon Aug 13 13:51:08 2007 +0000 +++ b/src/eval.c Tue Aug 21 04:55:30 2007 +0000 @@ -202,6 +202,8 @@ extern Lisp_Object Qrisky_local_variable; +extern Lisp_Object Qfunction; + static Lisp_Object funcall_lambda P_ ((Lisp_Object, int, Lisp_Object*)); static void unwind_to_catch P_ ((struct catchtag *, Lisp_Object)) NO_RETURN; @@ -539,7 +541,7 @@ register Lisp_Object val, sym; struct gcpro gcpro1; - if (NILP(args)) + if (NILP (args)) return Qnil; args_left = args; @@ -564,6 +566,8 @@ (args) Lisp_Object args; { + if (!NILP (Fcdr (args))) + xsignal2 (Qwrong_number_of_arguments, Qquote, Flength (args)); return Fcar (args); } @@ -575,6 +579,8 @@ (args) Lisp_Object args; { + if (!NILP (Fcdr (args))) + xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args)); return Fcar (args); } @@ -2083,7 +2089,7 @@ /* Strings and vectors are keyboard macros. */ if (STRINGP (fun) || VECTORP (fun)) - return NILP (for_call_interactively) ? Qt : Qnil; + return (NILP (for_call_interactively) ? Qt : Qnil); /* Lists may represent commands. */ if (!CONSP (fun))
--- a/src/insdel.c Mon Aug 13 13:51:08 2007 +0000 +++ b/src/insdel.c Tue Aug 21 04:55:30 2007 +0000 @@ -2138,10 +2138,11 @@ (! NILP (end_marker) ? Fmarker_position (end_marker) : end) /* Set a variable to nil if an error occurred. - VAL is a cons-cell whose car is the variable name, and whose cdr is - either nil (to mean that there was indeed an error), or non-nil to mean - that the was no error (which thus causes this function to do - nothing). */ + Don't change the variable if there was no error. + VAL is a cons-cell (VARIABLE . NO-ERROR-FLAG). + VARIABLE is the variable to maybe set to nil. + NO-ERROR-FLAG is nil if there was an error, + anything else meaning no error (so this function does nothing). */ Lisp_Object reset_var_on_error (val) Lisp_Object val;
--- a/src/minibuf.c Mon Aug 13 13:51:08 2007 +0000 +++ b/src/minibuf.c Tue Aug 21 04:55:30 2007 +0000 @@ -1294,11 +1294,14 @@ int bestmatchsize = 0; /* These are in bytes, too. */ int compare, matchsize; - int type = (HASH_TABLE_P (collection) ? 3 - : VECTORP (collection) ? 2 - : NILP (collection) || (CONSP (collection) - && (!SYMBOLP (XCAR (collection)) - || NILP (XCAR (collection))))); + enum { function_table, list_table, obarray_table, hash_table} + type = (HASH_TABLE_P (collection) ? hash_table + : VECTORP (collection) ? obarray_table + : ((NILP (collection) + || (CONSP (collection) + && (!SYMBOLP (XCAR (collection)) + || NILP (XCAR (collection))))) + ? list_table : function_table)); int index = 0, obsize = 0; int matchcount = 0; int bindcount = -1; @@ -1306,7 +1309,7 @@ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; CHECK_STRING (string); - if (type == 0) + if (type == function_table) return call3 (collection, string, predicate, Qnil); bestmatch = bucket = Qnil; @@ -1314,7 +1317,7 @@ /* If COLLECTION is not a list, set TAIL just for gc pro. */ tail = collection; - if (type == 2) + if (type == obarray_table) { collection = check_obarray (collection); obsize = XVECTOR (collection)->size; @@ -1328,7 +1331,7 @@ /* elt gets the alist element or symbol. eltstring gets the name to check as a completion. */ - if (type == 1) + if (type == list_table) { if (!CONSP (tail)) break; @@ -1336,7 +1339,7 @@ eltstring = CONSP (elt) ? XCAR (elt) : elt; tail = XCDR (tail); } - else if (type == 2) + else if (type == obarray_table) { if (!EQ (bucket, zero)) { @@ -1357,7 +1360,7 @@ continue; } } - else /* if (type == 3) */ + else /* if (type == hash_table) */ { while (index < HASH_TABLE_SIZE (XHASH_TABLE (collection)) && NILP (HASH_HASH (XHASH_TABLE (collection), index))) @@ -1411,15 +1414,17 @@ tem = Fcommandp (elt, Qnil); else { - if (bindcount >= 0) { - unbind_to (bindcount, Qnil); - bindcount = -1; - } + if (bindcount >= 0) + { + unbind_to (bindcount, Qnil); + bindcount = -1; + } GCPRO4 (tail, string, eltstring, bestmatch); - tem = type == 3 - ? call2 (predicate, elt, - HASH_VALUE (XHASH_TABLE (collection), index - 1)) - : call1 (predicate, elt); + tem = (type == hash_table + ? call2 (predicate, elt, + HASH_VALUE (XHASH_TABLE (collection), + index - 1)) + : call1 (predicate, elt)); UNGCPRO; } if (NILP (tem)) continue;
--- a/src/term.c Mon Aug 13 13:51:08 2007 +0000 +++ b/src/term.c Tue Aug 21 04:55:30 2007 +0000 @@ -1967,14 +1967,21 @@ #ifndef WINDOWSNT +/* Declare here rather than in the function, as in the rest of Emacs, + to work around an HPUX compiler bug (?). See + http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00410.html */ +static int default_max_colors; +static int default_max_pairs; +static int default_no_color_video; +static char *default_orig_pair; +static char *default_set_foreground; +static char *default_set_background; + /* Save or restore the default color-related capabilities of this terminal. */ static void tty_default_color_capabilities (struct tty_display_info *tty, int save) { - static char - *default_orig_pair, *default_set_foreground, *default_set_background; - static int default_max_colors, default_max_pairs, default_no_color_video; if (save) {
--- a/src/xterm.c Mon Aug 13 13:51:08 2007 +0000 +++ b/src/xterm.c Tue Aug 21 04:55:30 2007 +0000 @@ -6866,27 +6866,23 @@ } if (!tool_bar_p) - if (!dpyinfo->x_focus_frame - || f == dpyinfo->x_focus_frame) +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) + if (! popup_activated ()) +#endif { -#if defined (USE_X_TOOLKIT) || defined (USE_GTK) - if (! popup_activated ()) -#endif - { - if (ignore_next_mouse_click_timeout) - { - if (event.type == ButtonPress - && (int)(event.xbutton.time - ignore_next_mouse_click_timeout) > 0) - { - ignore_next_mouse_click_timeout = 0; - construct_mouse_click (&inev.ie, &event.xbutton, f); - } - if (event.type == ButtonRelease) - ignore_next_mouse_click_timeout = 0; - } - else - construct_mouse_click (&inev.ie, &event.xbutton, f); - } + if (ignore_next_mouse_click_timeout) + { + if (event.type == ButtonPress + && (int)(event.xbutton.time - ignore_next_mouse_click_timeout) > 0) + { + ignore_next_mouse_click_timeout = 0; + construct_mouse_click (&inev.ie, &event.xbutton, f); + } + if (event.type == ButtonRelease) + ignore_next_mouse_click_timeout = 0; + } + else + construct_mouse_click (&inev.ie, &event.xbutton, f); } } else