aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorMiles Bader2007-08-21 04:54:03 +0000
committerMiles Bader2007-08-21 04:54:03 +0000
commit42216a6b65dabb543156bc5e52cbf89d8ce96cb9 (patch)
tree1036c82a751bd2437cbc1b1d7f047bf3af679234 /lisp
parenteb5149ee586e6df9d919497688db0643c245386c (diff)
parentbdaf8a62d53cf8d5a0dc4f0dc530ecd6fc1f44fe (diff)
downloademacs-42216a6b65dabb543156bc5e52cbf89d8ce96cb9.tar.gz
emacs-42216a6b65dabb543156bc5e52cbf89d8ce96cb9.zip
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--unicode--0--patch-249
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog368
-rw-r--r--lisp/Makefile.in12
-rw-r--r--lisp/calc/calc-aent.el3
-rw-r--r--lisp/calc/calc-bin.el4
-rw-r--r--lisp/calc/calc-comb.el21
-rw-r--r--lisp/calc/calc-ext.el10
-rw-r--r--lisp/calc/calc-funcs.el263
-rw-r--r--lisp/calc/calc-math.el6
-rw-r--r--lisp/calc/calc-units.el298
-rw-r--r--lisp/calc/calc.el7
-rw-r--r--lisp/completion.el12
-rw-r--r--lisp/ediff-util.el6
-rw-r--r--lisp/ediff.el2
-rw-r--r--lisp/emacs-lisp/cl-macs.el22
-rw-r--r--lisp/emacs-lisp/copyright.el11
-rw-r--r--lisp/emacs-lisp/eldoc.el101
-rw-r--r--lisp/emacs-lisp/lisp-mode.el107
-rw-r--r--lisp/emulation/cua-base.el16
-rw-r--r--lisp/emulation/tpu-edt.el461
-rw-r--r--lisp/emulation/tpu-extras.el66
-rw-r--r--lisp/emulation/viper-cmd.el32
-rw-r--r--lisp/emulation/viper-ex.el2
-rw-r--r--lisp/emulation/viper.el13
-rw-r--r--lisp/gnus/ChangeLog16
-rw-r--r--lisp/gnus/gnus-agent.el9
-rw-r--r--lisp/gnus/gnus-art.el11
-rw-r--r--lisp/gnus/gnus-sum.el37
-rw-r--r--lisp/gnus/gnus.el11
-rw-r--r--lisp/mail/emacsbug.el39
-rw-r--r--lisp/mail/rmail.el2
-rw-r--r--lisp/mail/undigest.el12
-rw-r--r--lisp/menu-bar.el2
-rw-r--r--lisp/mh-e/ChangeLog26
-rw-r--r--lisp/mh-e/mh-comp.el4
-rw-r--r--lisp/mh-e/mh-e.el174
-rw-r--r--lisp/mh-e/mh-mime.el36
-rw-r--r--lisp/pcvs-parse.el2
-rw-r--r--lisp/progmodes/ada-mode.el113
-rw-r--r--lisp/progmodes/ada-xref.el25
-rw-r--r--lisp/progmodes/compile.el8
-rw-r--r--lisp/progmodes/cperl-mode.el13
-rw-r--r--lisp/progmodes/gdb-ui.el6
-rw-r--r--lisp/progmodes/grep.el3
-rw-r--r--lisp/progmodes/meta-mode.el153
-rw-r--r--lisp/progmodes/perl-mode.el12
-rw-r--r--lisp/progmodes/scheme.el1
-rw-r--r--lisp/progmodes/vhdl-mode.el11
-rw-r--r--lisp/simple.el51
-rw-r--r--lisp/smerge-mode.el51
-rw-r--r--lisp/startup.el503
-rw-r--r--lisp/term/mac-win.el2
-rw-r--r--lisp/vc-bzr.el173
-rw-r--r--lisp/vc-rcs.el1
53 files changed, 2117 insertions, 1233 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 29ef69e311f..028fe5d2db5 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,9 +1,317 @@
12007-08-20 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * smerge-mode.el (smerge-resolve): New arg `safe'.
4 (smerge-resolve-all, smerge-batch-resolve): New function.
5 (smerge-refine): Make sure `diff' returns the expected result.
6 (smerge-parsep-re): New const.
7 (smerge-mode): Use it to adjust paragraph-separate.
8
9 * progmodes/perl-mode.el (perl-font-lock-syntactic-keywords):
10 Correctly match / regexp matchers as first char on a line when
11 fontifying only that line.
12
13 * emacs-lisp/cl-macs.el (cl-transform-lambda): Preserve the match-data.
14
152007-08-20 Stefan Monnier <monnier@iro.umontreal.ca>
16
17 * vc-bzr.el: Don't fiddle with vc-handled-backend.
18 (vc-bzr-registered): Don't redundantly protect against
19 file-error. Actually use the format-specific code.
20 (vc-bzr-buffer-nonblank-p): Remove.
21 (vc-bzr-status): Change `kindchange' -> `kindchanged'.
22
232007-08-20 Juri Linkov <juri@jurta.org>
24
25 * startup.el (fancy-splash-text): Change multiple tabs into one
26 tab. Remove "Useful File menu items" section (with "Exit Emacs"
27 and "Recover Crashed Session").
28 (fancy-splash-screens): Set tab-width to 22.
29 (normal-splash-screen): Replace literal tabs with \t and
30 fix whitespace. Remove "Useful File menu items" section (with
31 "Exit Emacs" and "Recover Crashed Session").
32
332007-08-20 Johannes Weiner <hannes@saeurebad.de> (tiny change)
34
35 * emacs-lisp/lisp-mode.el (preceding-sexp): New fun, the code was
36 extracted from `eval-last-sexp-1'.
37 (eval-last-sexp-1): Call `preceding-sexp'.
38
392007-08-20 Thien-Thi Nguyen <ttn@gnuvola.org>
40
41 * vc-rcs.el (vc-rcs-annotate-command):
42 Fix bug introduced 2007-07-18T16:32:40Z!esr@snark.thyrsus.com:
43 Add back :vc-annotate-prefix propertization.
44
452007-08-20 Andreas Schwab <schwab@suse.de>
46
47 * mail/rmail.el (rmail-autodetect): Doc fix.
48
492007-08-19 Juri Linkov <juri@jurta.org>
50
51 * startup.el (normal-splash-screen): Add more links.
52
532007-08-19 Juri Linkov <juri@jurta.org>
54
55 * startup.el (splash-screen-keymap): Rename from `fancy-splash-keymap'
56 because it's common to both types of splash screen: fancy and normal.
57 Bind SPC to scroll-up, DEL to scroll-down and `q' to exit-splash-screen.
58 (exit-splash-screen): Rename from `fancy-splash-quit'.
59 Use `quit-window' instead of `kill-buffer'.
60 (fancy-splash-head): Use make-button to insert GNU image link.
61 (fancy-splash-screens, normal-splash-screen): Rename " About GNU
62 Emacs" to "*About GNU Emacs*", and " GNU Emacs" to "*GNU Emacs*".
63 (normal-splash-screen): Put "Browse manuals" on the same line with
64 "Emacs manual". Remove descriptions from "Useful tasks" and put
65 all links in two columns on two lines.
66
672007-08-19 Michael Kifer <kifer@cs.stonybrook.edu>
68
69 * viper.el (viper-remove-hooks): remove some additional viper hooks
70 when the user calls viper-go-away.
71 (viper-go-away): restore the default of default-major-mode.
72 Save the value of default-major-mode before vaperization.
73
74 * viper-cmd.el: Replace error "" with "Viper bell".
75
76 * viper-ex.el: Replace error "" with "Viper bell".
77
78 * ediff-util.el (ediff-make-temp-file): use the coding system of the
79 buffer for which file is created.
80
812007-08-19 Glenn Morris <rgm@gnu.org>
82
83 * Makefile.in (custom-deps, finder-data, autoloads, recompile)
84 (progmodes/cc-mode.elc, mh-e/mh-loaddefs.el): Use $(emacs) rather
85 than $(EMACS), so that EMACSLOADPATH is set. Prevents any system
86 shadow files messing up the compilation.
87
882007-08-18 Glenn Morris <rgm@gnu.org>
89
90 * emacs-lisp/eldoc.el (eldoc-get-fnsym-args-string): Add doc
91 string. Also apply eldoc-argument-case in the help-split-fundoc
92 case. Adapt for changed behavior of eldoc-function-argstring,
93 eldoc-function-argstring-format, and
94 eldoc-highlight-function-argument.
95 (eldoc-highlight-function-argument): Handle nil INDEX argument,
96 just call eldoc-docstring-format-sym-doc in that case.
97 (eldoc-function-argstring): Change the behavior. Now it converts
98 an argument list to a string.
99 (eldoc-function-argstring-format): Change the behavior. Now it
100 applies `eldoc-argument-case' to a string.
101
102 * progmodes/scheme.el (scheme-mode-variables): Set
103 font-lock-comment-start-skip.
104
1052007-08-18 Martin Rudalics <rudalics@gmx.at>
106
107 * progmodes/ada-mode.el (ada-create-syntax-table): Move
108 set-syntax-table from here to ...
109 (ada-mode): ... here. Do not change global value of
110 comment-multi-line. Call new function
111 ada-initialize-syntax-table-properties and add new function
112 ada-handle-syntax-table-properties to font-lock-mode-hook.
113 (ada-deactivate-properties, ada-initialize-properties): Replace
114 by new functions ...
115 (ada-handle-syntax-table-properties)
116 (ada-initialize-syntax-table-properties)
117 (ada-set-syntax-table-properties): ... to set up syntax-table
118 properties uniformly, independently from whether font-lock-mode
119 is enabled or not. Handle read-only buffers and do not change
120 undo-list when setting syntax-table properties.
121 (ada-after-change-function): Use
122 ada-set-syntax-table-properties.
123
1242007-08-18 Micha,Ak(Bl Cadilhac <michael@cadilhac.name>
125
126 * progmodes/meta-mode.el (meta-indent-calculate-last): Remove.
127 (meta-indent-current-nesting): Use a computation of the nesting
128 instead.
129 (meta-indent-current-indentation): Indentation is given according
130 to nesting and if the previous line was finished or not.
131 (meta-indent-unfinished-line): Tell if the current line ends with
132 a finished expression.
133 (meta-indent-looking-at-code): Like `looking-at', but checks if
134 the point is in a string before.
135 (meta-indent-level-count): Use it. Don't count parenthesis as it's
136 done in the nesting function.
137 (meta-indent-in-string-p): Tell if the current point is in a
138 string.
139 (meta-indent-calculate): Treat b-o-b as a special case. Use the
140 previous functions.
141
1422007-08-17 Thien-Thi Nguyen <ttn@gnuvola.org>
143
144 * emacs-lisp/copyright.el (copyright-limit): New defsubst.
145 (copyright-update-year, copyright-update)
146 (copyright-fix-years): Use it.
147
1482007-08-17 Kimit Yada <kimitto@gmail.com> (tiny change)
149
150 * emacs-lisp/copyright.el (copyright-update-year):
151 Fix bug: Handle nil copyright-limit.
152
1532007-08-17 Jay Belanger <jay.p.belanger@gmail.com>
154
155 * calc/calc-units.el (math-standard-units): Give exact
156 conversion for tsp.
157
158 * calc/calc.el (math-bignum-digit-length): Compute the
159 appropriate value.
160
161 * calc/calc-bin.el (math-bignum-logb-digit-size)
162 (math-bignum-digit-power-of-two):
163 * calc/calc-comb.el (math-small-factorial-table):
164 * calc/calc-ext.el (math-approx-pi,math-approx-sqrt-e)
165 (math-approx-gamma-const):
166 * calc/calc-funcs.el (math-besJ0, math-besJ1, math-besY0)
167 (math-besY1, math-bernoulli-b-cache):
168 * calc/calc-math.el (math-approx-ln-10, math-approx-ln-2):
169 Remove `eval-when-compile's.
170
1712007-08-17 Bob Rogers <rogers-emacs@rgrjr.dyndns.org> (tiny change)
172
173 * progmode/cperl-mode.el (cperl-look-at-leading-count)
174 (cperl-find-pods-heres): Fix an error when typing expressions like
175 `s{a}{b}'.
176
1772007-08-17 Micha,Ak(Bl Cadilhac <michael@cadilhac.name>
178
179 * mail/emacsbug.el (report-emacs-bug): Remove the last number of
180 `emacs-version', use the topic prefix ``version; ''. Make MS-DOS
181 a special case (there's no build number).
182
1832007-08-17 T. V. Raman <raman@users.sf.net> (tiny change)
184
185 * completion.el (symbol-under-point, symbol-before-point)
186 (symbol-before-point-for-complete): Use
187 buffer-substring-no-properties.
188
1892007-08-17 Glenn Morris <rgm@gnu.org>
190
191 * progmodes/compile.el (compilation-get-file-structure): Make use
192 of the directory part when checking for an existing entry, to
193 handle files with same basename in different directories.
194
1952007-08-17 Jay Belanger <jay.p.belanger@gmail.com>
196
197 * calc/calc.el (calc-language-alist): Add texinfo-mode.
198
12007-08-16 Vinicius Jose Latorre <viniciusjl@ig.com.br> 1992007-08-16 Vinicius Jose Latorre <viniciusjl@ig.com.br>
2 200
3 * ps-print.el (ps-font-size, ps-header-font-size) 201 * ps-print.el (ps-header-font-size, ps-header-title-font-size)
4 (ps-header-title-font-size, ps-footer-font-size) 202 (ps-footer-font-size, ps-line-number-font-size, ps-line-spacing)
5 (ps-line-number-font-size, ps-line-spacing, ps-paragraph-spacing): 203 (ps-paragraph-spacing): Docstring fix.
6 Docstring fix. 204
2052007-08-16 Glenn Morris <rgm@gnu.org>
206
207 * ps-print.el (ps-font-size): Doc fix.
208
2092007-08-16 Richard Stallman <rms@gnu.org>
210
211 * emacs-lisp/copyright.el (copyright-names-regexp): Add custom group.
212
2132007-08-15 Juri Linkov <juri@jurta.org>
214
215 * startup.el (initialization): Change parent group from `internal'
216 to `environment'.
217 (initial-buffer-choice): New variable.
218 (command-line): Revert 2007-07-02 change that sets
219 buffer-offer-save in *scratch* and enables auto-save in it.
220 (fancy-splash-text): Add links to existing items. Add new items
221 with links for useful tasks. Move information about Control-g to
222 fancy-splash-head. Move "Emacs Guided Tour" to the end.
223 (fancy-splash-keymap): New variable.
224 (fancy-splash-last-input-event): Remove variable.
225 (fancy-splash-insert): Add processing of `:link' element.
226 (fancy-splash-head): Replace "Type Control-l to begin editing"
227 with "Type `q' to exit".
228 (fancy-splash-screens-1): Let-bind inhibit-read-only to t.
229 (fancy-splash-default-action, fancy-splash-special-event-action):
230 Remove functions.
231 (fancy-splash-quit): New function.
232 (fancy-splash-screens): Rename input arg from `hide-on-input' to
233 `static' and reverse the condition of its usage. Don't preserve
234 original values of `minor-mode-map-alist',
235 `emulation-mode-map-alists', `special-event-map'.
236 Rename startup-buffer from "*About GNU Emacs*" to " GNU Emacs".
237 Rename about-buffer from " GNU Emacs" to " About GNU Emacs".
238 Remove processing of special events. Use local key map
239 `fancy-splash-keymap'. Set buffer to read-only.
240 (normal-splash-screen): Rename input arg from `hide-on-input' to
241 `static' and reverse the condition of its usage.
242 Rename startup-buffer from "*About GNU Emacs*" to " GNU Emacs".
243 Rename about-buffer from " GNU Emacs" to " About GNU Emacs".
244 Add links to existing items. Add new items with links for useful
245 tasks. Use local key map `fancy-splash-keymap'.
246 (display-splash-screen): Rename input arg from `hide-on-input' to
247 `static'.
248 (about-emacs): Add alias to display-splash-screen.
249 (command-line-1): Use `initial-buffer-choice'.
250
251 * menu-bar.el (menu-bar-help-menu):
252 * term/mac-win.el (mac-apple-event-map): Bind About Emacs menu
253 item to about-emacs instead of display-splash-screen.
254
2552007-08-15 Jay Belanger <jay.p.belanger@gmail.com>
256
257 * calc/calc-units.el (math-standard-units): Update values.
258 Put in exact, rational values when possible.
259 (math-unit-prefixes): Replace floats with powers of ten.
260 (math-standard-units-systems): Replace floats with integers.
261 (math-make-unit-string): Remove extra spaces in output.
262
2632007-08-15 Glenn Morris <rgm@gnu.org>
264
265 * mail/undigest.el (rmail-digest-parse-rfc1153sloppy): Be even
266 sloppier, for the sake of GNU Mailman.
267 (rmail-digest-rfc1153): Initialize `result' correctly.
268
2692007-08-15 Micha,Ak(Bl Cadilhac <michael@cadilhac.name>
270
271 * mail/emacsbug.el (report-emacs-bug): Put `Bug: emacs-version; '
272 in the mail title. Suggested by Reiner Steib.
273
2742007-08-14 Chris Hecker <checker@d6.com> (tiny change)
275
276 * calc/calc-aent.el (calc-do-quick-calc): Add binary
277 representation of integers to the list of outputs.
278
2792007-08-14 Glenn Morris <rgm@gnu.org>
280
281 * simple.el (bad-packages-alist): New constant.
282 (bad-package-check): New function. Together, these two add
283 elements to `after-load-alist' to check for problematic external
284 packages.
285 * emulation/cua-base.el: Move CUA-mode check to `bad-packages-alist'.
286
2872007-08-14 Jay Belanger <jay.p.belanger@gmail.com>
288
289 * calc/calc-units.el (math-get-standard-units)
290 (math-get-units,math-make-unit-string)
291 (math-get-default-units,math-put-default-units): New functions.
292 (math-default-units-table): New variable.
293 (calc-convert-units, calc-convert-temperature): Add machinery
294 to supply default values.
295
2962007-08-14 Stefan Monnier <monnier@iro.umontreal.ca>
297
298 * emulation/tpu-edt.el: Add tpu-extras's autoloads.
299 (tpu-gold-map, tpu-global-map): Comment-out the bindings to nil.
300 (tpu-gold-map): Bind F to tpu-cursor-free-mode.
301 (minibuffer-local-map): Use funkey symbols rather than esc-sequence.
302
303 * emulation/tpu-extras.el: Remove spurious * in docstrings.
304 Put its autoloads into tpu-edt.el rather than loaddefs.el.
305 (tpu-cursor-free-mode): Rename from tpu-cursor-free.
306 Make into a proper minor-mode.
307 (tpu-backward-char, tpu-next-line, tpu-previous-line)
308 (tpu-next-end-of-line, tpu-current-end-of-line): Use new name.
309 (tpu-trim-line-ends-if-needed): Rename from tpu-before-save-hook.
310 (tpu-set-cursor-free, tpu-set-cursor-bound):
311 Delegate to tpu-cursor-free-mode.
312 (tpu-next-line, tpu-previous-line, tpu-forward-line)
313 (tpu-backward-line, tpu-scroll-window-down, tpu-scroll-window-up):
314 Use line-move or forward-line instead of next-line-internal.
7 315
82007-08-13 Nick Roberts <nickrob@snap.net.nz> 3162007-08-13 Nick Roberts <nickrob@snap.net.nz>
9 317
@@ -26,8 +334,8 @@
26 * pcvs-util.el (cvs-qtypedesc-strings): Use new names 334 * pcvs-util.el (cvs-qtypedesc-strings): Use new names
27 combine-and-quote-strings and split-string-and-unquote. 335 combine-and-quote-strings and split-string-and-unquote.
28 336
29 * subr.el (combine-and-quote-strings): Renamed from strings->string. 337 * subr.el (combine-and-quote-strings): Rename from strings->string.
30 (split-string-and-unquote): Renamed from string->strings. 338 (split-string-and-unquote): Rename from string->strings.
31 339
322007-08-10 Stefan Monnier <monnier@iro.umontreal.ca> 3402007-08-10 Stefan Monnier <monnier@iro.umontreal.ca>
33 341
@@ -163,6 +471,24 @@
163 * help.el (resize-temp-buffer-window): Use window-full-width-p 471 * help.el (resize-temp-buffer-window): Use window-full-width-p
164 instead of comparing frame-width and window-width. 472 instead of comparing frame-width and window-width.
165 473
4742007-08-13 Stephen Leake <stephen_leake@stephe-leake.org>
475
476 * pcvs-parse.el (cvs-parse-table): Handle additional instance of
477 optional quotes around files in NEED-UPDATE . REMOVED case.
478
479 * progmodes/ada-xref.el (ada-gnatls-args): Fix docstring.
480 (ada-treat-cmd-string): Improve error message.
481 (ada-do-file-completion): Call `ada-require-project-file', so
482 project variables are set properly.
483 (ada-prj-find-prj-file): Delete Emacs 20.2 support.
484 (ada-gnatfind-buffer-name): New constant.
485 (ada-find-any-references): Use new constant. Set buffer name
486 properly in compilation-start. Toggle read-only properly.
487 (ada-find-in-src-path): Fix spelling error in docstring.
488
489 * progmodes/vhdl-mode.el (vhdl-update-progress-info): Avoid divide
490 by zero error.
491
1662007-08-13 Stefan Monnier <monnier@iro.umontreal.ca> 4922007-08-13 Stefan Monnier <monnier@iro.umontreal.ca>
167 493
168 * emacs-lisp/autoload.el (autoload-print-form): Use print-quoted. 494 * emacs-lisp/autoload.el (autoload-print-form): Use print-quoted.
@@ -191,7 +517,7 @@
191 (tex-font-script-display, tex-font-lock-suscript): Change from a cons 517 (tex-font-script-display, tex-font-lock-suscript): Change from a cons
192 cell to a list of 2 elements to simplify the unfontify code. 518 cell to a list of 2 elements to simplify the unfontify code.
193 519
1942007-08-09 Edward O'Connor <hober0@gmail.com> (tiny change) 5202007-08-09 Edward O'Connor <hober0@gmail.com> (tiny change)
195 521
196 * url/url-auth.el (url-basic-auth): When prompting for username 522 * url/url-auth.el (url-basic-auth): When prompting for username
197 and password, default to the username and password in the URL. 523 and password, default to the username and password in the URL.
@@ -272,15 +598,6 @@
272 It calls comment-line-break-function if there are comments. 598 It calls comment-line-break-function if there are comments.
273 (do-auto-fill): Use that. 599 (do-auto-fill): Use that.
274 600
2752007-08-07 Ivan Kanis <apple@kanis.eu>
276
277 * time.el (display-time-world-mode, display-time-world-display)
278 (display-time-world, display-time-world-list)
279 (display-time-world-time-format, display-time-world-buffer-name)
280 (display-time-world-timer-enable)
281 (display-time-world-timer-second, display-time-world-mode-map):
282 New.
283
2842007-08-07 Sean O'Rourke <sorourke@cs.ucsd.edu> 6012007-08-07 Sean O'Rourke <sorourke@cs.ucsd.edu>
285 602
286 * complete.el (PC-lisp-complete-symbol): Complete symbol around point. 603 * complete.el (PC-lisp-complete-symbol): Complete symbol around point.
@@ -335,10 +652,9 @@
335 term-default-fg/bg-color instead of ansi-term-color-vector when the 652 term-default-fg/bg-color instead of ansi-term-color-vector when the
336 index (term-ansi-current-color or term-ansi-current-bg-color) is zero. 653 index (term-ansi-current-color or term-ansi-current-bg-color) is zero.
337 654
3382007-08-05 Jay Belanger <belanger@localhost.localdomain> 6552007-08-05 Jay Belanger <jay.p.belanger@gmail.com>
339 656
340 * calc/calc-nlfit.el (math-nlfit-curve): 657 * calc/calc-nlfit.el (math-nlfit-curve): Remove unnecessary variables.
341 Remove unnecessary variables.
342 (math-nlfit-givens): Let bind free variables. 658 (math-nlfit-givens): Let bind free variables.
343 659
3442007-08-05 Vinicius Jose Latorre <viniciusig@ig.com.br> 6602007-08-05 Vinicius Jose Latorre <viniciusig@ig.com.br>
@@ -351,7 +667,7 @@
351 * files.el (set-auto-mode): Handle also remote files wrt 667 * files.el (set-auto-mode): Handle also remote files wrt
352 `auto-mode-alist'. 668 `auto-mode-alist'.
353 669
3542007-08-04 Jay Belanger <belanger@localhost.localdomain> 6702007-08-04 Jay Belanger <jay.p.belanger@gmail.com>
355 671
356 * calc/calcalg3.el (calc-curve-fit): Add support for nonlinear 672 * calc/calcalg3.el (calc-curve-fit): Add support for nonlinear
357 curves and plotting. 673 curves and plotting.
@@ -389,7 +705,7 @@
389 705
3902007-08-03 Jay Belanger <jay.p.belanger@gmail.com> 7062007-08-03 Jay Belanger <jay.p.belanger@gmail.com>
391 707
392 * calc/calc-ext.el (math-get-value,math-get-sdev) 708 * calc/calc-ext.el (math-get-value, math-get-sdev)
393 (math-contains-sdev): New functions. 709 (math-contains-sdev): New functions.
394 710
395 * calc/calc-graph.el (calc-graph-format-data) 711 * calc/calc-graph.el (calc-graph-format-data)
@@ -444,8 +760,8 @@
444 760
445 * net/telnet.el (telnet-mode): Set comint-use-prompt-regexp to t. 761 * net/telnet.el (telnet-mode): Set comint-use-prompt-regexp to t.
446 762
447 * progmodes/fortran.el (fortran-font-lock-syntactic-keywords): Fix 763 * progmodes/fortran.el (fortran-font-lock-syntactic-keywords):
448 off-by-one error in previous change. 764 Fix off-by-one error in previous change.
449 765
4502007-08-03 Drew Adams <drew.adams@oracle.com> 7662007-08-03 Drew Adams <drew.adams@oracle.com>
451 767
@@ -454,8 +770,8 @@
454 770
4552007-08-01 Jay Belanger <jay.p.belanger@gmail.com> 7712007-08-01 Jay Belanger <jay.p.belanger@gmail.com>
456 772
457 * calc/calc-math.el (math-sqrt-raw,math-sin-raw-2) 773 * calc/calc-math.el (math-sqrt-raw, math-sin-raw-2)
458 (math-cos-raw-2,math-arctan-raw,math-ln-raw): 774 (math-cos-raw-2, math-arctan-raw, math-ln-raw):
459 Use native Emacs functions, when appropriate. 775 Use native Emacs functions, when appropriate.
460 776
4612007-08-01 Dan Nicolaescu <dann@ics.uci.edu> 7772007-08-01 Dan Nicolaescu <dann@ics.uci.edu>
@@ -593,7 +909,7 @@
5932007-07-28 Masatake YAMATO <jet@gyve.org> 9092007-07-28 Masatake YAMATO <jet@gyve.org>
594 910
595 * vc.el (vc-dired-mode): Add a menu for VC related operation. 911 * vc.el (vc-dired-mode): Add a menu for VC related operation.
596 Use backend name as the menu label Suggested by David Kastrup. 912 Use backend name as the menu label. Suggested by David Kastrup.
597 913
5982007-07-28 Alan Mackenzie <acm@muc.de> 9142007-07-28 Alan Mackenzie <acm@muc.de>
599 915
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 69efa57a2fb..a00b482a943 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -92,12 +92,12 @@ $(lisp)/cus-load.el:
92custom-deps: $(lisp)/subdirs.el $(lisp)/loaddefs.el $(lisp)/cus-load.el doit 92custom-deps: $(lisp)/subdirs.el $(lisp)/loaddefs.el $(lisp)/cus-load.el doit
93 wd=$(lisp); $(setwins_almost); \ 93 wd=$(lisp); $(setwins_almost); \
94 echo Directories: $$wins; \ 94 echo Directories: $$wins; \
95 LC_ALL=C $(EMACS) $(EMACSOPT) -l cus-dep --eval '(setq generated-custom-dependencies-file "$(lisp)/cus-load.el")' -f custom-make-dependencies $$wins 95 LC_ALL=C $(emacs) -l cus-dep --eval '(setq generated-custom-dependencies-file "$(lisp)/cus-load.el")' -f custom-make-dependencies $$wins
96 96
97finder-data: $(lisp)/subdirs.el $(lisp)/loaddefs.el doit 97finder-data: $(lisp)/subdirs.el $(lisp)/loaddefs.el doit
98 wd=$(lisp); $(setwins_almost); \ 98 wd=$(lisp); $(setwins_almost); \
99 echo Directories: $$wins; \ 99 echo Directories: $$wins; \
100 LC_ALL=C $(EMACS) $(EMACSOPT) -l finder --eval '(setq generated-finder-keywords-file "$(lisp)/finder-inf.el")' -f finder-compile-keywords-make-dist $$wins 100 LC_ALL=C $(emacs) -l finder --eval '(setq generated-finder-keywords-file "$(lisp)/finder-inf.el")' -f finder-compile-keywords-make-dist $$wins
101 101
102$(lisp)/loaddefs.el: 102$(lisp)/loaddefs.el:
103 echo ";;; loaddefs.el --- automatically extracted autoloads" >> $@ 103 echo ";;; loaddefs.el --- automatically extracted autoloads" >> $@
@@ -112,7 +112,7 @@ $(lisp)/loaddefs.el:
112autoloads: $(lisp)/subdirs.el $(lisp)/loaddefs.el doit 112autoloads: $(lisp)/subdirs.el $(lisp)/loaddefs.el doit
113 wd=$(lisp); $(setwins_almost); \ 113 wd=$(lisp); $(setwins_almost); \
114 echo Directories: $$wins; \ 114 echo Directories: $$wins; \
115 LC_ALL=C $(EMACS) $(EMACSOPT) -l autoload --eval '(setq generated-autoload-file "$(lisp)/loaddefs.el")' -f batch-update-autoloads $$wins 115 LC_ALL=C $(emacs) -l autoload --eval '(setq generated-autoload-file "$(lisp)/loaddefs.el")' -f batch-update-autoloads $$wins
116 116
117$(lisp)/subdirs.el: 117$(lisp)/subdirs.el:
118 $(MAKE) $(MFLAGS) update-subdirs 118 $(MAKE) $(MFLAGS) update-subdirs
@@ -212,7 +212,7 @@ compile-after-backup: backup-compiled-files compile-always
212# new ones. 212# new ones.
213 213
214recompile: doit mh-autoloads $(lisp)/progmodes/cc-mode.elc 214recompile: doit mh-autoloads $(lisp)/progmodes/cc-mode.elc
215 LC_ALL=C $(EMACS) $(EMACSOPT) --eval "(batch-byte-recompile-directory 0)" $(lisp) 215 LC_ALL=C $(emacs) --eval "(batch-byte-recompile-directory 0)" $(lisp)
216 216
217# CC Mode uses a compile time macro system which causes a compile time 217# CC Mode uses a compile time macro system which causes a compile time
218# dependency in cc-mode.elc on the macros in cc-langs.el and the 218# dependency in cc-mode.elc on the macros in cc-langs.el and the
@@ -221,7 +221,7 @@ $(lisp)/progmodes/cc-mode.elc: \
221 $(lisp)/progmodes/cc-mode.el \ 221 $(lisp)/progmodes/cc-mode.el \
222 $(lisp)/progmodes/cc-langs.el \ 222 $(lisp)/progmodes/cc-langs.el \
223 $(lisp)/progmodes/cc-defs.el 223 $(lisp)/progmodes/cc-defs.el
224 $(EMACS) $(EMACSOPT) -f batch-byte-compile $(lisp)/progmodes/cc-mode.el 224 $(emacs) -f batch-byte-compile $(lisp)/progmodes/cc-mode.el
225 225
226# Update MH-E internal autoloads. These are not to be confused with 226# Update MH-E internal autoloads. These are not to be confused with
227# the autoloads for the MH-E entry points, which are already in 227# the autoloads for the MH-E entry points, which are already in
@@ -258,7 +258,7 @@ $(lisp)/mh-e/mh-loaddefs.el: $(lisp)/subdirs.el $(MH_E_SRC)
258 echo ";; no-update-autoloads: t" >> $@ 258 echo ";; no-update-autoloads: t" >> $@
259 echo ";; End:" >> $@ 259 echo ";; End:" >> $@
260 echo ";;; mh-loaddefs.el ends here" >> $@ 260 echo ";;; mh-loaddefs.el ends here" >> $@
261 $(EMACS) $(EMACSOPT) \ 261 $(emacs) \
262 -l autoload \ 262 -l autoload \
263 --eval "(setq generate-autoload-cookie \";;;###mh-autoload\")" \ 263 --eval "(setq generate-autoload-cookie \";;;###mh-autoload\")" \
264 --eval "(setq generated-autoload-file \"$(lisp)/mh-e/mh-loaddefs.el\")" \ 264 --eval "(setq generated-autoload-file \"$(lisp)/mh-e/mh-loaddefs.el\")" \
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el
index e640eb5c438..ffd07bd8f2e 100644
--- a/lisp/calc/calc-aent.el
+++ b/lisp/calc/calc-aent.el
@@ -74,6 +74,9 @@
74 ", " 74 ", "
75 (let ((calc-number-radix 8)) 75 (let ((calc-number-radix 8))
76 (math-format-value (car alg-exp) 1000)) 76 (math-format-value (car alg-exp) 1000))
77 ", "
78 (let ((calc-number-radix 2))
79 (math-format-value (car alg-exp) 1000))
77 (if (and (integerp (car alg-exp)) 80 (if (and (integerp (car alg-exp))
78 (> (car alg-exp) 0) 81 (> (car alg-exp) 0)
79 (< (car alg-exp) 127)) 82 (< (car alg-exp) 127))
diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el
index c58d0addd77..0f219272a5f 100644
--- a/lisp/calc/calc-bin.el
+++ b/lisp/calc/calc-bin.el
@@ -34,13 +34,13 @@
34 34
35;;; Some useful numbers 35;;; Some useful numbers
36(defconst math-bignum-logb-digit-size 36(defconst math-bignum-logb-digit-size
37 (eval-when-compile (logb math-bignum-digit-size)) 37 (logb math-bignum-digit-size)
38 "The logb of the size of a bignum digit. 38 "The logb of the size of a bignum digit.
39This is the largest value of B such that 2^B is less than 39This is the largest value of B such that 2^B is less than
40the size of a Calc bignum digit.") 40the size of a Calc bignum digit.")
41 41
42(defconst math-bignum-digit-power-of-two 42(defconst math-bignum-digit-power-of-two
43 (eval-when-compile (expt 2 (logb math-bignum-digit-size))) 43 (expt 2 (logb math-bignum-digit-size))
44 "The largest power of 2 less than the size of a Calc bignum digit.") 44 "The largest power of 2 less than the size of a Calc bignum digit.")
45 45
46;;; b-prefix binary commands. 46;;; b-prefix binary commands.
diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el
index 90a0a20f5d6..b6182cd710e 100644
--- a/lisp/calc/calc-comb.el
+++ b/lisp/calc/calc-comb.el
@@ -295,17 +295,16 @@
295;;; Factorial and related functions. 295;;; Factorial and related functions.
296 296
297(defconst math-small-factorial-table 297(defconst math-small-factorial-table
298 (eval-when-compile 298 (vector 1 1 2 6 24 120 720 5040 40320 362880 3628800 39916800
299 (vector 1 1 2 6 24 120 720 5040 40320 362880 3628800 39916800 299 (math-read-number-simple "479001600")
300 (math-read-number-simple "479001600") 300 (math-read-number-simple "6227020800")
301 (math-read-number-simple "6227020800") 301 (math-read-number-simple "87178291200")
302 (math-read-number-simple "87178291200") 302 (math-read-number-simple "1307674368000")
303 (math-read-number-simple "1307674368000") 303 (math-read-number-simple "20922789888000")
304 (math-read-number-simple "20922789888000") 304 (math-read-number-simple "355687428096000")
305 (math-read-number-simple "355687428096000") 305 (math-read-number-simple "6402373705728000")
306 (math-read-number-simple "6402373705728000") 306 (math-read-number-simple "121645100408832000")
307 (math-read-number-simple "121645100408832000") 307 (math-read-number-simple "2432902008176640000")))
308 (math-read-number-simple "2432902008176640000"))))
309 308
310(defun calcFunc-fact (n) ; [I I] [F F] [Public] 309(defun calcFunc-fact (n) ; [I I] [F F] [Public]
311 (let (temp) 310 (let (temp)
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 5a334778aa5..ab8f743eb34 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -1926,8 +1926,7 @@ calc-kill calc-kill-region calc-yank))))
1926 1926
1927;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239). [F] [Public] 1927;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239). [F] [Public]
1928(defconst math-approx-pi 1928(defconst math-approx-pi
1929 (eval-when-compile 1929 (math-read-number-simple "3.141592653589793238463")
1930 (math-read-number-simple "3.141592653589793238463"))
1931 "An approximation for pi.") 1930 "An approximation for pi.")
1932 1931
1933(math-defcache math-pi math-approx-pi 1932(math-defcache math-pi math-approx-pi
@@ -1962,7 +1961,7 @@ calc-kill calc-kill-region calc-yank))))
1962 (math-sqrt-float (math-two-pi))) 1961 (math-sqrt-float (math-two-pi)))
1963 1962
1964(defconst math-approx-sqrt-e 1963(defconst math-approx-sqrt-e
1965 (eval-when-compile (math-read-number-simple "1.648721270700128146849")) 1964 (math-read-number-simple "1.648721270700128146849")
1966 "An approximation for sqrt(3).") 1965 "An approximation for sqrt(3).")
1967 1966
1968(math-defcache math-sqrt-e math-approx-sqrt-e 1967(math-defcache math-sqrt-e math-approx-sqrt-e
@@ -1976,9 +1975,8 @@ calc-kill calc-kill-region calc-yank))))
1976 '(float 5 -1))) 1975 '(float 5 -1)))
1977 1976
1978(defconst math-approx-gamma-const 1977(defconst math-approx-gamma-const
1979 (eval-when-compile 1978 (math-read-number-simple
1980 (math-read-number-simple 1979 "0.5772156649015328606065120900824024310421593359399235988057672348848677267776646709369470632917467495")
1981 "0.5772156649015328606065120900824024310421593359399235988057672348848677267776646709369470632917467495"))
1982 "An approximation for gamma.") 1980 "An approximation for gamma.")
1983 1981
1984(math-defcache math-gamma-const nil 1982(math-defcache math-gamma-const nil
diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el
index b0209d39d73..d73d676bdef 100644
--- a/lisp/calc/calc-funcs.el
+++ b/lisp/calc/calc-funcs.el
@@ -569,53 +569,47 @@
569 (let* ((z (math-div '(float 8 0) x)) 569 (let* ((z (math-div '(float 8 0) x))
570 (y (math-sqr z)) 570 (y (math-sqr z))
571 (xx (math-add x 571 (xx (math-add x
572 (eval-when-compile 572 (math-read-number-simple "-0.785398164")))
573 (math-read-number-simple "-0.785398164"))))
574 (a1 (math-poly-eval y 573 (a1 (math-poly-eval y
575 (eval-when-compile
576 (list 574 (list
577 (math-read-number-simple "0.0000002093887211") 575 (math-read-number-simple "0.0000002093887211")
578 (math-read-number-simple "-0.000002073370639") 576 (math-read-number-simple "-0.000002073370639")
579 (math-read-number-simple "0.00002734510407") 577 (math-read-number-simple "0.00002734510407")
580 (math-read-number-simple "-0.001098628627") 578 (math-read-number-simple "-0.001098628627")
581 '(float 1 0))))) 579 '(float 1 0))))
582 (a2 (math-poly-eval y 580 (a2 (math-poly-eval y
583 (eval-when-compile 581 (list
584 (list 582 (math-read-number-simple "-0.0000000934935152")
585 (math-read-number-simple "-0.0000000934935152") 583 (math-read-number-simple "0.0000007621095161")
586 (math-read-number-simple "0.0000007621095161") 584 (math-read-number-simple "-0.000006911147651")
587 (math-read-number-simple "-0.000006911147651") 585 (math-read-number-simple "0.0001430488765")
588 (math-read-number-simple "0.0001430488765") 586 (math-read-number-simple "-0.01562499995"))))
589 (math-read-number-simple "-0.01562499995")))))
590 (sc (math-sin-cos-raw xx))) 587 (sc (math-sin-cos-raw xx)))
591 (if yflag 588 (if yflag
592 (setq sc (cons (math-neg (cdr sc)) (car sc)))) 589 (setq sc (cons (math-neg (cdr sc)) (car sc))))
593 (math-mul (math-sqrt 590 (math-mul (math-sqrt
594 (math-div (eval-when-compile 591 (math-div (math-read-number-simple "0.636619722")
595 (math-read-number-simple "0.636619722")) 592 x))
596 x))
597 (math-sub (math-mul (cdr sc) a1) 593 (math-sub (math-mul (cdr sc) a1)
598 (math-mul (car sc) (math-mul z a2)))))) 594 (math-mul (car sc) (math-mul z a2))))))
599 (t 595 (t
600 (let ((y (math-sqr x))) 596 (let ((y (math-sqr x)))
601 (math-div (math-poly-eval y 597 (math-div (math-poly-eval y
602 (eval-when-compile 598 (list
603 (list 599 (math-read-number-simple "-184.9052456")
604 (math-read-number-simple "-184.9052456") 600 (math-read-number-simple "77392.33017")
605 (math-read-number-simple "77392.33017") 601 (math-read-number-simple "-11214424.18")
606 (math-read-number-simple "-11214424.18") 602 (math-read-number-simple "651619640.7")
607 (math-read-number-simple "651619640.7") 603 (math-read-number-simple "-13362590354.0")
608 (math-read-number-simple "-13362590354.0") 604 (math-read-number-simple "57568490574.0")))
609 (math-read-number-simple "57568490574.0"))))
610 (math-poly-eval y 605 (math-poly-eval y
611 (eval-when-compile 606 (list
612 (list 607 '(float 1 0)
613 '(float 1 0) 608 (math-read-number-simple "267.8532712")
614 (math-read-number-simple "267.8532712") 609 (math-read-number-simple "59272.64853")
615 (math-read-number-simple "59272.64853") 610 (math-read-number-simple "9494680.718")
616 (math-read-number-simple "9494680.718") 611 (math-read-number-simple "1029532985.0")
617 (math-read-number-simple "1029532985.0") 612 (math-read-number-simple "57568490411.0"))))))))
618 (math-read-number-simple "57568490411.0")))))))))
619 613
620(defun math-besJ1 (x &optional yflag) 614(defun math-besJ1 (x &optional yflag)
621 (cond ((and (math-negp (calcFunc-re x)) (not yflag)) 615 (cond ((and (math-negp (calcFunc-re x)) (not yflag))
@@ -623,32 +617,28 @@
623 ((Math-lessp '(float 8 0) (math-abs-approx x)) 617 ((Math-lessp '(float 8 0) (math-abs-approx x))
624 (let* ((z (math-div '(float 8 0) x)) 618 (let* ((z (math-div '(float 8 0) x))
625 (y (math-sqr z)) 619 (y (math-sqr z))
626 (xx (math-add x (eval-when-compile 620 (xx (math-add x (math-read-number-simple "-2.356194491")))
627 (math-read-number-simple "-2.356194491"))))
628 (a1 (math-poly-eval y 621 (a1 (math-poly-eval y
629 (eval-when-compile 622 (list
630 (list 623 (math-read-number-simple "-0.000000240337019")
631 (math-read-number-simple "-0.000000240337019") 624 (math-read-number-simple "0.000002457520174")
632 (math-read-number-simple "0.000002457520174") 625 (math-read-number-simple "-0.00003516396496")
633 (math-read-number-simple "-0.00003516396496") 626 '(float 183105 -8)
634 '(float 183105 -8) 627 '(float 1 0))))
635 '(float 1 0)))))
636 (a2 (math-poly-eval y 628 (a2 (math-poly-eval y
637 (eval-when-compile 629 (list
638 (list 630 (math-read-number-simple "0.000000105787412")
639 (math-read-number-simple "0.000000105787412") 631 (math-read-number-simple "-0.00000088228987")
640 (math-read-number-simple "-0.00000088228987") 632 (math-read-number-simple "0.000008449199096")
641 (math-read-number-simple "0.000008449199096") 633 (math-read-number-simple "-0.0002002690873")
642 (math-read-number-simple "-0.0002002690873") 634 (math-read-number-simple "0.04687499995"))))
643 (math-read-number-simple "0.04687499995")))))
644 (sc (math-sin-cos-raw xx))) 635 (sc (math-sin-cos-raw xx)))
645 (if yflag 636 (if yflag
646 (setq sc (cons (math-neg (cdr sc)) (car sc))) 637 (setq sc (cons (math-neg (cdr sc)) (car sc)))
647 (if (math-negp x) 638 (if (math-negp x)
648 (setq sc (cons (math-neg (car sc)) (math-neg (cdr sc)))))) 639 (setq sc (cons (math-neg (car sc)) (math-neg (cdr sc))))))
649 (math-mul (math-sqrt (math-div 640 (math-mul (math-sqrt (math-div
650 (eval-when-compile 641 (math-read-number-simple "0.636619722")
651 (math-read-number-simple "0.636619722"))
652 x)) 642 x))
653 (math-sub (math-mul (cdr sc) a1) 643 (math-sub (math-mul (cdr sc) a1)
654 (math-mul (car sc) (math-mul z a2)))))) 644 (math-mul (car sc) (math-mul z a2))))))
@@ -657,23 +647,21 @@
657 (math-mul 647 (math-mul
658 x 648 x
659 (math-div (math-poly-eval y 649 (math-div (math-poly-eval y
660 (eval-when-compile 650 (list
661 (list 651 (math-read-number-simple "-30.16036606")
662 (math-read-number-simple "-30.16036606") 652 (math-read-number-simple "15704.4826")
663 (math-read-number-simple "15704.4826") 653 (math-read-number-simple "-2972611.439")
664 (math-read-number-simple "-2972611.439") 654 (math-read-number-simple "242396853.1")
665 (math-read-number-simple "242396853.1") 655 (math-read-number-simple "-7895059235.0")
666 (math-read-number-simple "-7895059235.0") 656 (math-read-number-simple "72362614232.0")))
667 (math-read-number-simple "72362614232.0"))))
668 (math-poly-eval y 657 (math-poly-eval y
669 (eval-when-compile 658 (list
670 (list 659 '(float 1 0)
671 '(float 1 0) 660 (math-read-number-simple "376.9991397")
672 (math-read-number-simple "376.9991397") 661 (math-read-number-simple "99447.43394")
673 (math-read-number-simple "99447.43394") 662 (math-read-number-simple "18583304.74")
674 (math-read-number-simple "18583304.74") 663 (math-read-number-simple "2300535178.0")
675 (math-read-number-simple "2300535178.0") 664 (math-read-number-simple "144725228442.0")))))))))
676 (math-read-number-simple "144725228442.0"))))))))))
677 665
678(defun calcFunc-besY (v x) 666(defun calcFunc-besY (v x)
679 (math-inexact-result) 667 (math-inexact-result)
@@ -712,27 +700,24 @@
712(defun math-besY0 (x) 700(defun math-besY0 (x)
713 (cond ((Math-lessp (math-abs-approx x) '(float 8 0)) 701 (cond ((Math-lessp (math-abs-approx x) '(float 8 0))
714 (let ((y (math-sqr x))) 702 (let ((y (math-sqr x)))
715 (math-add 703 (math-add
716 (math-div (math-poly-eval y 704 (math-div (math-poly-eval y
717 (eval-when-compile 705 (list
718 (list 706 (math-read-number-simple "228.4622733")
719 (math-read-number-simple "228.4622733") 707 (math-read-number-simple "-86327.92757")
720 (math-read-number-simple "-86327.92757") 708 (math-read-number-simple "10879881.29")
721 (math-read-number-simple "10879881.29") 709 (math-read-number-simple "-512359803.6")
722 (math-read-number-simple "-512359803.6") 710 (math-read-number-simple "7062834065.0")
723 (math-read-number-simple "7062834065.0") 711 (math-read-number-simple "-2957821389.0")))
724 (math-read-number-simple "-2957821389.0"))))
725 (math-poly-eval y 712 (math-poly-eval y
726 (eval-when-compile 713 (list
727 (list 714 '(float 1 0)
728 '(float 1 0) 715 (math-read-number-simple "226.1030244")
729 (math-read-number-simple "226.1030244") 716 (math-read-number-simple "47447.2647")
730 (math-read-number-simple "47447.2647") 717 (math-read-number-simple "7189466.438")
731 (math-read-number-simple "7189466.438") 718 (math-read-number-simple "745249964.8")
732 (math-read-number-simple "745249964.8") 719 (math-read-number-simple "40076544269.0"))))
733 (math-read-number-simple "40076544269.0"))))) 720 (math-mul (math-read-number-simple "0.636619772")
734 (math-mul (eval-when-compile
735 (math-read-number-simple "0.636619772"))
736 (math-mul (math-besJ0 x) (math-ln-raw x)))))) 721 (math-mul (math-besJ0 x) (math-ln-raw x))))))
737 ((math-negp (calcFunc-re x)) 722 ((math-negp (calcFunc-re x))
738 (math-add (math-besJ0 (math-neg x) t) 723 (math-add (math-besJ0 (math-neg x) t)
@@ -748,25 +733,23 @@
748 (math-mul 733 (math-mul
749 x 734 x
750 (math-div (math-poly-eval y 735 (math-div (math-poly-eval y
751 (eval-when-compile 736 (list
752 (list 737 (math-read-number-simple "8511.937935")
753 (math-read-number-simple "8511.937935") 738 (math-read-number-simple "-4237922.726")
754 (math-read-number-simple "-4237922.726") 739 (math-read-number-simple "734926455.1")
755 (math-read-number-simple "734926455.1") 740 (math-read-number-simple "-51534381390.0")
756 (math-read-number-simple "-51534381390.0") 741 (math-read-number-simple "1275274390000.0")
757 (math-read-number-simple "1275274390000.0") 742 (math-read-number-simple "-4900604943000.0")))
758 (math-read-number-simple "-4900604943000.0"))))
759 (math-poly-eval y 743 (math-poly-eval y
760 (eval-when-compile 744 (list
761 (list 745 '(float 1 0)
762 '(float 1 0) 746 (math-read-number-simple "354.9632885")
763 (math-read-number-simple "354.9632885") 747 (math-read-number-simple "102042.605")
764 (math-read-number-simple "102042.605") 748 (math-read-number-simple "22459040.02")
765 (math-read-number-simple "22459040.02") 749 (math-read-number-simple "3733650367.0")
766 (math-read-number-simple "3733650367.0") 750 (math-read-number-simple "424441966400.0")
767 (math-read-number-simple "424441966400.0") 751 (math-read-number-simple "24995805700000.0")))))
768 (math-read-number-simple "24995805700000.0")))))) 752 (math-mul (math-read-number-simple "0.636619772")
769 (math-mul (eval-when-compile (math-read-number-simple "0.636619772"))
770 (math-sub (math-mul (math-besJ1 x) (math-ln-raw x)) 753 (math-sub (math-mul (math-besJ1 x) (math-ln-raw x))
771 (math-div 1 x)))))) 754 (math-div 1 x))))))
772 ((math-negp (calcFunc-re x)) 755 ((math-negp (calcFunc-re x))
@@ -832,45 +815,45 @@
832 (calcFunc-euler n '(float 5 -1))) 815 (calcFunc-euler n '(float 5 -1)))
833 (calcFunc-euler n '(frac 1 2)))))) 816 (calcFunc-euler n '(frac 1 2))))))
834 817
835(defvar math-bernoulli-b-cache 818(defvar math-bernoulli-b-cache
836 (eval-when-compile 819 (list
837 (list 820 (list 'frac
838 (list 'frac 821 -174611
839 -174611 822 (math-read-number-simple "802857662698291200000"))
840 (math-read-number-simple "802857662698291200000")) 823 (list 'frac
841 (list 'frac 824 43867
842 43867 825 (math-read-number-simple "5109094217170944000"))
843 (math-read-number-simple "5109094217170944000")) 826 (list 'frac
844 (list 'frac 827 -3617
845 -3617 828 (math-read-number-simple "10670622842880000"))
846 (math-read-number-simple "10670622842880000")) 829 (list 'frac
847 (list 'frac 830 1
848 1 831 (math-read-number-simple "74724249600"))
849 (math-read-number-simple "74724249600")) 832 (list 'frac
850 (list 'frac 833 -691
851 -691 834 (math-read-number-simple "1307674368000"))
852 (math-read-number-simple "1307674368000")) 835 (list 'frac
853 (list 'frac 836 1
854 1 837 (math-read-number-simple "47900160"))
855 (math-read-number-simple "47900160")) 838 (list 'frac
856 (list 'frac 839 -1
857 -1 840 (math-read-number-simple "1209600"))
858 (math-read-number-simple "1209600")) 841 (list 'frac
859 (list 'frac 842 1
860 1 843 30240)
861 30240) 844 (list 'frac
862 (list 'frac 845 -1
863 -1 846 720)
864 720) 847 (list 'frac
865 (list 'frac 848 1
866 1 849 12)
867 12) 850 1 ))
868 1 ))) 851
869 852(defvar math-bernoulli-B-cache
870(defvar math-bernoulli-B-cache '((frac -174611 330) (frac 43867 798) 853 '((frac -174611 330) (frac 43867 798)
871 (frac -3617 510) (frac 7 6) (frac -691 2730) 854 (frac -3617 510) (frac 7 6) (frac -691 2730)
872 (frac 5 66) (frac -1 30) (frac 1 42) 855 (frac 5 66) (frac -1 30) (frac 1 42)
873 (frac -1 30) (frac 1 6) 1 )) 856 (frac -1 30) (frac 1 6) 1 ))
874 857
875(defvar math-bernoulli-cache-size 11) 858(defvar math-bernoulli-cache-size 11)
876(defun math-bernoulli-coefs (n) 859(defun math-bernoulli-coefs (n)
diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el
index a4dad15c14e..3e4743d58ae 100644
--- a/lisp/calc/calc-math.el
+++ b/lisp/calc/calc-math.el
@@ -1794,16 +1794,14 @@ If this can't be done, return NIL."
1794 (math-lnp1-series nextsum (1+ n) nextx x)))) 1794 (math-lnp1-series nextsum (1+ n) nextx x))))
1795 1795
1796(defconst math-approx-ln-10 1796(defconst math-approx-ln-10
1797 (eval-when-compile 1797 (math-read-number-simple "2.302585092994045684018")
1798 (math-read-number-simple "2.302585092994045684018"))
1799 "An approximation for ln(10).") 1798 "An approximation for ln(10).")
1800 1799
1801(math-defcache math-ln-10 math-approx-ln-10 1800(math-defcache math-ln-10 math-approx-ln-10
1802 (math-ln-raw-2 '(float 1 1))) 1801 (math-ln-raw-2 '(float 1 1)))
1803 1802
1804(defconst math-approx-ln-2 1803(defconst math-approx-ln-2
1805 (eval-when-compile 1804 (math-read-number-simple "0.693147180559945309417")
1806 (math-read-number-simple "0.693147180559945309417"))
1807 "An approximation for ln(2).") 1805 "An approximation for ln(2).")
1808 1806
1809(math-defcache math-ln-2 math-approx-ln-2 1807(math-defcache math-ln-2 math-approx-ln-2
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index e823a57aef0..3724490169a 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -40,45 +40,47 @@
40;;; with some additions by Przemek Klosowski (przemek@rrdstrad.nist.gov) 40;;; with some additions by Przemek Klosowski (przemek@rrdstrad.nist.gov)
41;;; Updated April 2002 by Jochen Küpper 41;;; Updated April 2002 by Jochen Küpper
42 42
43;;; for CODATA 1998 see one of 43;;; Updated August 2007, using
44;;; - Journal of Physical and Chemical Reference Data, 28(6), 1713-1852, 1999. 44;;; CODATA (http://physics.nist.gov/cuu/Constants/index.html)
45;;; - Reviews of Modern Physics, 72(2), 351-495, 2000. 45;;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html)
46;;; for CODATA 2005 see 46;;; ESUWM (Encyclopaedia of Scientific Units, Weights and
47;;; - http://physics.nist.gov/cuu/Constants/index.html 47;;; Measures, by François Cardarelli)
48;;; All conversions are exact unless otherwise noted.
48 49
49(defvar math-standard-units 50(defvar math-standard-units
50 '( ;; Length 51 '( ;; Length
51 ( m nil "*Meter" ) 52 ( m nil "*Meter" )
52 ( in "2.54 cm" "Inch" ) 53 ( in "254*10^(-2) cm" "Inch" )
53 ( ft "12 in" "Foot" ) 54 ( ft "12 in" "Foot" )
54 ( yd "3 ft" "Yard" ) 55 ( yd "3 ft" "Yard" )
55 ( mi "5280 ft" "Mile" ) 56 ( mi "5280 ft" "Mile" )
56 ( au "149597870691 m" "Astronomical Unit" ) ;; NASA JPL (http://neo.jpl.nasa.gov/glossary/au.html) 57 ( au "149597870691. m" "Astronomical Unit" )
57 ( lyr "9460536207068016 m" "Light Year" ) 58 ;; (approx) NASA JPL (http://neo.jpl.nasa.gov/glossary/au.html)
58 ( pc "206264.80625 au" "Parsec" ) 59 ( lyr "c yr" "Light Year" )
60 ( pc "3.0856775854e16 m" "Parsec" ) ;; (approx) ESUWM
59 ( nmi "1852 m" "Nautical Mile" ) 61 ( nmi "1852 m" "Nautical Mile" )
60 ( fath "6 ft" "Fathom" ) 62 ( fath "6 ft" "Fathom" )
61 ( mu "1 um" "Micron" ) 63 ( mu "1 um" "Micron" )
62 ( mil "in/1000" "Mil" ) 64 ( mil "in/1000" "Mil" )
63 ( point "in/72" "Point (1/72 inch)" ) 65 ( point "in/72" "Point (1/72 inch)" )
64 ( Ang "1e-10 m" "Angstrom" ) 66 ( Ang "10^(-10) m" "Angstrom" )
65 ( mfi "mi+ft+in" "Miles + feet + inches" ) 67 ( mfi "mi+ft+in" "Miles + feet + inches" )
66 ;; TeX lengths 68 ;; TeX lengths
67 ( texpt "in/72.27" "Point (TeX conventions)" ) 69 ( texpt "(100/7227) in" "Point (TeX conventions)" )
68 ( texpc "12 texpt" "Pica" ) 70 ( texpc "12 texpt" "Pica" )
69 ( texbp "point" "Big point (TeX conventions)" ) 71 ( texbp "point" "Big point (TeX conventions)" )
70 ( texdd "1238/1157 texpt" "Didot point" ) 72 ( texdd "(1238/1157) texpt" "Didot point" )
71 ( texcc "12 texdd" "Cicero" ) 73 ( texcc "12 texdd" "Cicero" )
72 ( texsp "1/66536 texpt" "Scaled TeX point" ) 74 ( texsp "(1/65536) texpt" "Scaled TeX point" )
73 75
74 ;; Area 76 ;; Area
75 ( hect "10000 m^2" "*Hectare" ) 77 ( hect "10000 m^2" "*Hectare" )
76 ( a "100 m^2" "Are") 78 ( a "100 m^2" "Are")
77 ( acre "mi^2 / 640" "Acre" ) 79 ( acre "mi^2 / 640" "Acre" )
78 ( b "1e-28 m^2" "Barn" ) 80 ( b "10^(-28) m^2" "Barn" )
79 81
80 ;; Volume 82 ;; Volume
81 ( L "1e-3 m^3" "*Liter" ) 83 ( L "10^(-3) m^3" "*Liter" )
82 ( l "L" "Liter" ) 84 ( l "L" "Liter" )
83 ( gal "4 qt" "US Gallon" ) 85 ( gal "4 qt" "US Gallon" )
84 ( qt "2 pt" "Quart" ) 86 ( qt "2 pt" "Quart" )
@@ -87,10 +89,12 @@
87 ( ozfl "2 tbsp" "Fluid Ounce" ) 89 ( ozfl "2 tbsp" "Fluid Ounce" )
88 ( floz "2 tbsp" "Fluid Ounce" ) 90 ( floz "2 tbsp" "Fluid Ounce" )
89 ( tbsp "3 tsp" "Tablespoon" ) 91 ( tbsp "3 tsp" "Tablespoon" )
90 ( tsp "4.92892159375 ml" "Teaspoon" ) 92 ;; ESUWM defines a US gallon as 231 in^3.
93 ;; That gives the following exact value for tsp.
94 ( tsp "492892159375*10^(-11) ml" "Teaspoon" )
91 ( vol "tsp+tbsp+ozfl+cup+pt+qt+gal" "Gallons + ... + teaspoons" ) 95 ( vol "tsp+tbsp+ozfl+cup+pt+qt+gal" "Gallons + ... + teaspoons" )
92 ( galC "4.54609 L" "Canadian Gallon" ) 96 ( galC "galUK" "Canadian Gallon" )
93 ( galUK "4.546092 L" "UK Gallon" ) 97 ( galUK "454609*10^(-5) L" "UK Gallon" ) ;; NIST
94 98
95 ;; Time 99 ;; Time
96 ( s nil "*Second" ) 100 ( s nil "*Second" )
@@ -100,44 +104,44 @@
100 ( day "24 hr" "Day" ) 104 ( day "24 hr" "Day" )
101 ( wk "7 day" "Week" ) 105 ( wk "7 day" "Week" )
102 ( hms "wk+day+hr+min+s" "Hours, minutes, seconds" ) 106 ( hms "wk+day+hr+min+s" "Hours, minutes, seconds" )
103 ( yr "365.25 day" "Year" ) 107 ( yr "365.25 day" "Year" ) ;; (approx, but keep)
104 ( Hz "1/s" "Hertz" ) 108 ( Hz "1/s" "Hertz" )
105 109
106 ;; Speed 110 ;; Speed
107 ( mph "mi/hr" "*Miles per hour" ) 111 ( mph "mi/hr" "*Miles per hour" )
108 ( kph "km/hr" "Kilometers per hour" ) 112 ( kph "km/hr" "Kilometers per hour" )
109 ( knot "nmi/hr" "Knot" ) 113 ( knot "nmi/hr" "Knot" )
110 ( c "299792458 m/s" "Speed of light" ) ;;; CODATA 2005 114 ( c "299792458 m/s" "Speed of light" ) ;;; CODATA
111 115
112 ;; Acceleration 116 ;; Acceleration
113 ( ga "9.80665 m/s^2" "*\"g\" acceleration" ) ;; CODATA 2005 117 ( ga "980665*10^(-5) m/s^2" "*\"g\" acceleration" ) ;; CODATA
114 118
115 ;; Mass 119 ;; Mass
116 ( g nil "*Gram" ) 120 ( g nil "*Gram" )
117 ( lb "16 oz" "Pound (mass)" ) 121 ( lb "16 oz" "Pound (mass)" )
118 ( oz "28.349523125 g" "Ounce (mass)" ) 122 ( oz "28349523125*10^(-9) g" "Ounce (mass)" ) ;; ESUWM
119 ( ton "2000 lb" "Ton" ) 123 ( ton "2000 lb" "Ton" )
120 ( tpo "ton+lb+oz" "Tons + pounds + ounces (mass)" ) 124 ( tpo "ton+lb+oz" "Tons + pounds + ounces (mass)" )
121 ( t "1000 kg" "Metric ton" ) 125 ( t "1000 kg" "Metric ton" )
122 ( tonUK "1016.0469088 kg" "UK ton" ) 126 ( tonUK "10160469088*10^(-7) kg" "UK ton" ) ;; ESUWM
123 ( lbt "12 ozt" "Troy pound" ) 127 ( lbt "12 ozt" "Troy pound" )
124 ( ozt "31.103475 g" "Troy ounce" ) 128 ( ozt "31.10347680 g" "Troy ounce" ) ;; (approx) ESUWM
125 ( ct ".2 g" "Carat" ) 129 ( ct "(2/10) g" "Carat" ) ;; ESUWM
126 ( u "1.66053886e-27 kg" "Unified atomic mass" ) ;; CODATA 2005 130 ( u "1.660538782e-27 kg" "Unified atomic mass" );;(approx) CODATA
127 131
128 ;; Force 132 ;; Force
129 ( N "m kg/s^2" "*Newton" ) 133 ( N "m kg/s^2" "*Newton" )
130 ( dyn "1e-5 N" "Dyne" ) 134 ( dyn "10^(-5) N" "Dyne" )
131 ( gf "ga g" "Gram (force)" ) 135 ( gf "ga g" "Gram (force)" )
132 ( lbf "4.44822161526 N" "Pound (force)" ) 136 ( lbf "ga lb" "Pound (force)" )
133 ( kip "1000 lbf" "Kilopound (force)" ) 137 ( kip "1000 lbf" "Kilopound (force)" )
134 ( pdl "0.138255 N" "Poundal" ) 138 ( pdl "138254954376*10^(-12) N" "Poundal" ) ;; ESUWM
135 139
136 ;; Energy 140 ;; Energy
137 ( J "N m" "*Joule" ) 141 ( J "N m" "*Joule" )
138 ( erg "1e-7 J" "Erg" ) 142 ( erg "10^(-7) J" "Erg" )
139 ( cal "4.1868 J" "International Table Calorie" ) 143 ( cal "4.18674 J" "International Table Calorie" );;(approx) ESUWM
140 ( Btu "1055.05585262 J" "International Table Btu" ) 144 ( Btu "105505585262*10^(-8) J" "International Table Btu" ) ;; ESUWM
141 ( eV "ech V" "Electron volt" ) 145 ( eV "ech V" "Electron volt" )
142 ( ev "eV" "Electron volt" ) 146 ( ev "eV" "Electron volt" )
143 ( therm "105506000 J" "EEC therm" ) 147 ( therm "105506000 J" "EEC therm" )
@@ -151,7 +155,7 @@
151 155
152 ;; Power 156 ;; Power
153 ( W "J/s" "*Watt" ) 157 ( W "J/s" "*Watt" )
154 ( hp "745.7 W" "Horsepower" ) 158 ( hp "745.699871581 W" "Horsepower" ) ;;(approx) ESUWM
155 159
156 ;; Temperature 160 ;; Temperature
157 ( K nil "*Degree Kelvin" K ) 161 ( K nil "*Degree Kelvin" K )
@@ -164,24 +168,24 @@
164 168
165 ;; Pressure 169 ;; Pressure
166 ( Pa "N/m^2" "*Pascal" ) 170 ( Pa "N/m^2" "*Pascal" )
167 ( bar "1e5 Pa" "Bar" ) 171 ( bar "10^5 Pa" "Bar" )
168 ( atm "101325 Pa" "Standard atmosphere" ) ;; CODATA 2005 172 ( atm "101325 Pa" "Standard atmosphere" ) ;; CODATA
169 ( Torr " 1.333224e2 Pa" "Torr" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html) 173 ( Torr "1.333224e2 Pa" "Torr" ) ;;(approx) NIST
170 ( mHg "1000 Torr" "Meter of mercury" ) 174 ( mHg "1000 Torr" "Meter of mercury" )
171 ( inHg "25.4 mmHg" "Inch of mercury" ) 175 ( inHg "254*10^(-1) mmHg" "Inch of mercury" )
172 ( inH2O "2.490889e2 Pa" "Inch of water" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html) 176 ( inH2O "2.490889e2 Pa" "Inch of water" ) ;;(approx) NIST
173 ( psi "6894.75729317 Pa" "Pound per square inch" ) 177 ( psi "lbf/in^2" "Pounds per square inch" )
174 178
175 ;; Viscosity 179 ;; Viscosity
176 ( P "0.1 Pa s" "*Poise" ) 180 ( P "(1/10) Pa s" "*Poise" )
177 ( St "1e-4 m^2/s" "Stokes" ) 181 ( St "10^(-4) m^2/s" "Stokes" )
178 182
179 ;; Electromagnetism 183 ;; Electromagnetism
180 ( A nil "*Ampere" ) 184 ( A nil "*Ampere" )
181 ( C "A s" "Coulomb" ) 185 ( C "A s" "Coulomb" )
182 ( Fdy "ech Nav" "Faraday" ) 186 ( Fdy "ech Nav" "Faraday" )
183 ( e "1.60217653e-19 C" "Elementary charge" ) ;; CODATA 2005 187 ( e "ech" "Elementary charge" )
184 ( ech "1.60217653e-19 C" "Elementary charge" ) ;; CODATA 2005 188 ( ech "1.602176487e-19 C" "Elementary charge" ) ;;(approx) CODATA
185 ( V "W/A" "Volt" ) 189 ( V "W/A" "Volt" )
186 ( ohm "V/A" "Ohm" ) 190 ( ohm "V/A" "Ohm" )
187 ( mho "A/V" "Mho" ) 191 ( mho "A/V" "Mho" )
@@ -189,26 +193,26 @@
189 ( F "C/V" "Farad" ) 193 ( F "C/V" "Farad" )
190 ( H "Wb/A" "Henry" ) 194 ( H "Wb/A" "Henry" )
191 ( T "Wb/m^2" "Tesla" ) 195 ( T "Wb/m^2" "Tesla" )
192 ( Gs "1e-4 T" "Gauss" ) 196 ( Gs "10^(-4) T" "Gauss" )
193 ( Wb "V s" "Weber" ) 197 ( Wb "V s" "Weber" )
194 198
195 ;; Luminous intensity 199 ;; Luminous intensity
196 ( cd nil "*Candela" ) 200 ( cd nil "*Candela" )
197 ( sb "1e4 cd/m^2" "Stilb" ) 201 ( sb "10000 cd/m^2" "Stilb" )
198 ( lm "cd sr" "Lumen" ) 202 ( lm "cd sr" "Lumen" )
199 ( lx "lm/m^2" "Lux" ) 203 ( lx "lm/m^2" "Lux" )
200 ( ph "1e4 lx" "Phot" ) 204 ( ph "10000 lx" "Phot" )
201 ( fc "10.76391 lx" "Footcandle" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html) 205 ( fc "10.76391 lx" "Footcandle" ) ;;(approx) NIST
202 ( lam "1e4 lm/m^2" "Lambert" ) 206 ( lam "10000 lm/m^2" "Lambert" )
203 ( flam "3.426259 cd/m^2" "Footlambert" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html) 207 ( flam "3.426259 cd/m^2" "Footlambert" ) ;;(approx) NIST
204 208
205 ;; Radioactivity 209 ;; Radioactivity
206 ( Bq "1/s" "*Becquerel" ) 210 ( Bq "1/s" "*Becquerel" )
207 ( Ci "3.7e10 Bq" "Curie" ) 211 ( Ci "37*10^9 Bq" "Curie" ) ;; ESUWM
208 ( Gy "J/kg" "Gray" ) 212 ( Gy "J/kg" "Gray" )
209 ( Sv "Gy" "Sievert" ) 213 ( Sv "Gy" "Sievert" )
210 ( R "2.58e-4 C/kg" "Roentgen" ) 214 ( R "258*10^(-6) C/kg" "Roentgen" ) ;; NIST
211 ( rd ".01 Gy" "Rad" ) 215 ( rd "(1/100) Gy" "Rad" )
212 ( rem "rd" "Rem" ) 216 ( rem "rd" "Rem" )
213 217
214 ;; Amount of substance 218 ;; Amount of substance
@@ -228,23 +232,24 @@
228 ( sr nil "*Steradian" ) 232 ( sr nil "*Steradian" )
229 233
230 ;; Other physical quantities 234 ;; Other physical quantities
231 ( h "6.6260693e-34 J s" "*Planck's constant" ) ;; CODATA 2005 235 ;; The values are from CODATA, and are approximate.
232 ( hbar "h / 2 pi" "Planck's constant" ) 236 ( h "6.62606896e-34 J s" "*Planck's constant" )
233 ( mu0 "4 pi 1e-7 H/m" "Permeability of vacuum" ) 237 ( hbar "h / (2 pi)" "Planck's constant" )
234 ( G "6.6742e-11 m^3/kg^1/s^2" "Gravitational constant" ) ;; CODATA 2005 238 ( mu0 "4 pi 10^(-7) H/m" "Permeability of vacuum" )
235 ( Nav "6.02214115e23 / mol" "Avagadro's constant" ) ;; CODATA 2005 239 ( G "6.67428e-11 m^3/(kg s^2)" "Gravitational constant" )
236 ( me "9.1093826e-31 kg" "Electron rest mass" ) ;; CODATA 2005 240 ( Nav "6.02214179e23 / mol" "Avagadro's constant" )
237 ( mp "1.67262171e-27 kg" "Proton rest mass" ) ;; CODATA 2005 241 ( me "9.10938215e-31 kg" "Electron rest mass" )
238 ( mn "1.67492728e-27 kg" "Neutron rest mass" ) ;; CODATA 2005 242 ( mp "1.672621637e-27 kg" "Proton rest mass" )
239 ( mmu "1.88353140e-28 kg" "Muon rest mass" ) ;; CODATA 2005 243 ( mn "1.674927211e-27 kg" "Neutron rest mass" )
240 ( Ryd "10973731.568525 /m" "Rydberg's constant" ) ;; CODATA 2005 244 ( mmu "1.88353130e-28 kg" "Muon rest mass" )
241 ( k "1.3806505e-23 J/K" "Boltzmann's constant" ) ;; CODATA 2005 245 ( Ryd "10973731.568527 /m" "Rydberg's constant" )
242 ( alpha "7.297352568e-3" "Fine structure constant" ) ;; CODATA 2005 246 ( k "1.3806504e-23 J/K" "Boltzmann's constant" )
243 ( muB "927.400949e-26 J/T" "Bohr magneton" ) ;; CODATA 2005 247 ( alpha "7.2973525376e-3" "Fine structure constant" )
244 ( muN "5.05078343e-27 J/T" "Nuclear magneton" ) ;; CODATA 2005 248 ( muB "927.400915e-26 J/T" "Bohr magneton" )
245 ( mue "-928.476412e-26 J/T" "Electron magnetic moment" ) ;; CODATA 2005 249 ( muN "5.05078324e-27 J/T" "Nuclear magneton" )
246 ( mup "1.41060671e-26 J/T" "Proton magnetic moment" ) ;; CODATA 2005 250 ( mue "-928.476377e-26 J/T" "Electron magnetic moment" )
247 ( R0 "8.314472 J/mol/K" "Molar gas constant" ) ;; CODATA 2005 251 ( mup "1.410606662e-26 J/T" "Proton magnetic moment" )
252 ( R0 "8.314472 J/(mol K)" "Molar gas constant" )
248 ( V0 "22.710981e-3 m^3/mol" "Standard volume of ideal gas" ))) 253 ( V0 "22.710981e-3 m^3/mol" "Standard volume of ideal gas" )))
249 254
250 255
@@ -255,35 +260,35 @@ If this is changed, be sure to set math-units-table to nil to ensure
255that the combined units table will be rebuilt.") 260that the combined units table will be rebuilt.")
256 261
257(defvar math-unit-prefixes 262(defvar math-unit-prefixes
258 '( ( ?Y (float 1 24) "Yotta" ) 263 '( ( ?Y (^ 10 24) "Yotta" )
259 ( ?Z (float 1 21) "Zetta" ) 264 ( ?Z (^ 10 21) "Zetta" )
260 ( ?E (float 1 18) "Exa" ) 265 ( ?E (^ 10 18) "Exa" )
261 ( ?P (float 1 15) "Peta" ) 266 ( ?P (^ 10 15) "Peta" )
262 ( ?T (float 1 12) "Tera" ) 267 ( ?T (^ 10 12) "Tera" )
263 ( ?G (float 1 9) "Giga" ) 268 ( ?G (^ 10 9) "Giga" )
264 ( ?M (float 1 6) "Mega" ) 269 ( ?M (^ 10 6) "Mega" )
265 ( ?k (float 1 3) "Kilo" ) 270 ( ?k (^ 10 3) "Kilo" )
266 ( ?K (float 1 3) "Kilo" ) 271 ( ?K (^ 10 3) "Kilo" )
267 ( ?h (float 1 2) "Hecto" ) 272 ( ?h (^ 10 2) "Hecto" )
268 ( ?H (float 1 2) "Hecto" ) 273 ( ?H (^ 10 2) "Hecto" )
269 ( ?D (float 1 1) "Deka" ) 274 ( ?D (^ 10 1) "Deka" )
270 ( 0 (float 1 0) nil ) 275 ( 0 (^ 10 0) nil )
271 ( ?d (float 1 -1) "Deci" ) 276 ( ?d (^ 10 -1) "Deci" )
272 ( ?c (float 1 -2) "Centi" ) 277 ( ?c (^ 10 -2) "Centi" )
273 ( ?m (float 1 -3) "Milli" ) 278 ( ?m (^ 10 -3) "Milli" )
274 ( ?u (float 1 -6) "Micro" ) 279 ( ?u (^ 10 -6) "Micro" )
275 ( ?n (float 1 -9) "Nano" ) 280 ( ?n (^ 10 -9) "Nano" )
276 ( ?p (float 1 -12) "Pico" ) 281 ( ?p (^ 10 -12) "Pico" )
277 ( ?f (float 1 -15) "Femto" ) 282 ( ?f (^ 10 -15) "Femto" )
278 ( ?a (float 1 -18) "Atto" ) 283 ( ?a (^ 10 -18) "Atto" )
279 ( ?z (float 1 -21) "zepto" ) 284 ( ?z (^ 10 -21) "zepto" )
280 ( ?y (float 1 -24) "yocto" ))) 285 ( ?y (^ 10 -24) "yocto" )))
281 286
282(defvar math-standard-units-systems 287(defvar math-standard-units-systems
283 '( ( base nil ) 288 '( ( base nil )
284 ( si ( ( g '(* (var kg var-kg) (float 1 -3)) ) ) ) 289 ( si ( ( g '(/ (var kg var-kg) 1000) ) ) )
285 ( mks ( ( g '(* (var kg var-kg) (float 1 -3)) ) ) ) 290 ( mks ( ( g '(/ (var kg var-kg) 1000) ) ) )
286 ( cgs ( ( m '(* (var cm var-cm) 100 ) ) ) ))) 291 ( cgs ( ( m '(* (var cm var-cm) 100 ) ) ) )))
287 292
288(defvar math-units-table nil 293(defvar math-units-table nil
289 "Internal units table derived from math-defined-units. 294 "Internal units table derived from math-defined-units.
@@ -321,13 +326,67 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).")
321 (math-simplify-units 326 (math-simplify-units
322 (math-mul expr (nth pos units)))))))) 327 (math-mul expr (nth pos units))))))))
323 328
329(defun math-get-standard-units (expr)
330 "Return the standard units in EXPR."
331 (math-simplify-units
332 (math-extract-units
333 (math-to-standard-units expr nil))))
334
335(defun math-get-units (expr)
336 "Return the units in EXPR."
337 (math-simplify-units
338 (math-extract-units expr)))
339
340(defun math-make-unit-string (expr)
341 "Return EXPR in string form.
342If EXPR is nil, return nil."
343 (if expr
344 (let ((cexpr (math-compose-expr expr 0)))
345 (replace-regexp-in-string
346 " / " "/"
347 (if (stringp cexpr)
348 cexpr
349 (math-composition-to-string cexpr))))))
350
351(defvar math-default-units-table
352 (make-hash-table :test 'equal)
353 "A table storing previously converted units.")
354
355(defun math-get-default-units (expr)
356 "Get default units to use when converting the units in EXPR."
357 (let* ((units (math-get-units expr))
358 (standard-units (math-get-standard-units expr))
359 (default-units (gethash
360 standard-units
361 math-default-units-table)))
362 (if (equal units (car default-units))
363 (math-make-unit-string (cadr default-units))
364 (math-make-unit-string (car default-units)))))
365
366(defun math-put-default-units (expr)
367 "Put the units in EXPR in the default units table."
368 (let* ((units (math-get-units expr))
369 (standard-units (math-get-standard-units expr))
370 (default-units (gethash
371 standard-units
372 math-default-units-table)))
373 (cond
374 ((not default-units)
375 (puthash standard-units (list units) math-default-units-table))
376 ((not (equal units (car default-units)))
377 (puthash standard-units
378 (list units (car default-units))
379 math-default-units-table)))))
380
381
324(defun calc-convert-units (&optional old-units new-units) 382(defun calc-convert-units (&optional old-units new-units)
325 (interactive) 383 (interactive)
326 (calc-slow-wrapper 384 (calc-slow-wrapper
327 (let ((expr (calc-top-n 1)) 385 (let ((expr (calc-top-n 1))
328 (uoldname nil) 386 (uoldname nil)
329 unew 387 unew
330 units) 388 units
389 defunits)
331 (unless (math-units-in-expr-p expr t) 390 (unless (math-units-in-expr-p expr t)
332 (let ((uold (or old-units 391 (let ((uold (or old-units
333 (progn 392 (progn
@@ -343,16 +402,31 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).")
343 (error "Bad format in units expression: %s" (nth 1 uold))) 402 (error "Bad format in units expression: %s" (nth 1 uold)))
344 (setq expr (math-mul expr uold)))) 403 (setq expr (math-mul expr uold))))
345 (unless new-units 404 (unless new-units
346 (setq new-units (read-string (if uoldname 405 (setq defunits (math-get-default-units expr))
347 (concat "Old units: " 406 (setq new-units
348 uoldname 407 (read-string (concat
349 ", new units: ") 408 (if uoldname
350 "New units: ")))) 409 (concat "Old units: "
410 uoldname
411 ", new units")
412 "New units")
413 (if defunits
414 (concat
415 " (default: "
416 defunits
417 "): ")
418 ": "))))
419
420 (if (and
421 (string= new-units "")
422 defunits)
423 (setq new-units defunits)))
351 (when (string-match "\\` */" new-units) 424 (when (string-match "\\` */" new-units)
352 (setq new-units (concat "1" new-units))) 425 (setq new-units (concat "1" new-units)))
353 (setq units (math-read-expr new-units)) 426 (setq units (math-read-expr new-units))
354 (when (eq (car-safe units) 'error) 427 (when (eq (car-safe units) 'error)
355 (error "Bad format in units expression: %s" (nth 2 units))) 428 (error "Bad format in units expression: %s" (nth 2 units)))
429 (math-put-default-units units)
356 (let ((unew (math-units-in-expr-p units t)) 430 (let ((unew (math-units-in-expr-p units t))
357 (std (and (eq (car-safe units) 'var) 431 (std (and (eq (car-safe units) 'var)
358 (assq (nth 1 units) math-standard-units-systems)))) 432 (assq (nth 1 units) math-standard-units-systems))))
@@ -381,7 +455,8 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).")
381 (let ((expr (calc-top-n 1)) 455 (let ((expr (calc-top-n 1))
382 (uold nil) 456 (uold nil)
383 (uoldname nil) 457 (uoldname nil)
384 unew) 458 unew
459 defunits)
385 (setq uold (or old-units 460 (setq uold (or old-units
386 (let ((units (math-single-units-in-expr-p expr))) 461 (let ((units (math-single-units-in-expr-p expr)))
387 (if units 462 (if units
@@ -398,15 +473,24 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).")
398 (error "Bad format in units expression: %s" (nth 2 uold))) 473 (error "Bad format in units expression: %s" (nth 2 uold)))
399 (or (math-units-in-expr-p expr nil) 474 (or (math-units-in-expr-p expr nil)
400 (setq expr (math-mul expr uold))) 475 (setq expr (math-mul expr uold)))
476 (setq defunits (math-get-default-units expr))
401 (setq unew (or new-units 477 (setq unew (or new-units
402 (math-read-expr 478 (math-read-expr
403 (read-string (if uoldname 479 (read-string
404 (concat "Old temperature units: " 480 (concat
405 uoldname 481 (if uoldname
406 ", new units: ") 482 (concat "Old temperature units: "
407 "New temperature units: "))))) 483 uoldname
484 ", new units")
485 "New temperature units")
486 (if defunits
487 (concat " (default: "
488 defunits
489 "): ")
490 ": "))))))
408 (when (eq (car-safe unew) 'error) 491 (when (eq (car-safe unew) 'error)
409 (error "Bad format in units expression: %s" (nth 2 unew))) 492 (error "Bad format in units expression: %s" (nth 2 unew)))
493 (math-put-default-units unew)
410 (calc-enter-result 1 "cvtm" (math-simplify-units 494 (calc-enter-result 1 "cvtm" (math-simplify-units
411 (math-convert-temperature expr uold unew 495 (math-convert-temperature expr uold unew
412 uoldname)))))) 496 uoldname))))))
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 755834f913c..8e416293a45 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -229,7 +229,8 @@
229 (c-mode . c) 229 (c-mode . c)
230 (c++-mode . c) 230 (c++-mode . c)
231 (fortran-mode . fortran) 231 (fortran-mode . fortran)
232 (f90-mode . fortran)) 232 (f90-mode . fortran)
233 (texinfo-mode . calc-normal-language))
233 "*Alist of major modes with appropriate Calc languages." 234 "*Alist of major modes with appropriate Calc languages."
234 :group 'calc 235 :group 'calc
235 :type '(alist :key-type (symbol :tag "Major mode") 236 :type '(alist :key-type (symbol :tag "Major mode")
@@ -2283,8 +2284,8 @@ See calc-keypad for details."
2283 2284
2284 2285
2285 2286
2286(defconst math-bignum-digit-length 4 2287(defconst math-bignum-digit-length
2287; (truncate (/ (log10 (/ most-positive-fixnum 2)) 2)) 2288 (truncate (/ (log10 (/ most-positive-fixnum 2)) 2))
2288 "The length of a \"digit\" in Calc bignums. 2289 "The length of a \"digit\" in Calc bignums.
2289If a big integer is of the form (bigpos N0 N1 ...), this is the 2290If a big integer is of the form (bigpos N0 N1 ...), this is the
2290length of the allowable Emacs integers N0, N1,... 2291length of the allowable Emacs integers N0, N1,...
diff --git a/lisp/completion.el b/lisp/completion.el
index 99d559df967..b8bf5bd93b8 100644
--- a/lisp/completion.el
+++ b/lisp/completion.el
@@ -568,7 +568,8 @@ But only if it is longer than `completion-min-length'."
568 (- cmpl-symbol-end cmpl-symbol-start)) 568 (- cmpl-symbol-end cmpl-symbol-start))
569 (<= (- cmpl-symbol-end cmpl-symbol-start) 569 (<= (- cmpl-symbol-end cmpl-symbol-start)
570 completion-max-length)) 570 completion-max-length))
571 (buffer-substring cmpl-symbol-start cmpl-symbol-end)))))) 571 (buffer-substring-no-properties
572 cmpl-symbol-start cmpl-symbol-end))))))
572 573
573;; tests for symbol-under-point 574;; tests for symbol-under-point
574;; `^' indicates cursor pos. where value is returned 575;; `^' indicates cursor pos. where value is returned
@@ -601,7 +602,8 @@ Returns nil if there isn't one longer than `completion-min-length'."
601 ;; Return value if long enough. 602 ;; Return value if long enough.
602 (if (>= cmpl-symbol-end 603 (if (>= cmpl-symbol-end
603 (+ cmpl-symbol-start completion-min-length)) 604 (+ cmpl-symbol-start completion-min-length))
604 (buffer-substring cmpl-symbol-start cmpl-symbol-end))) 605 (buffer-substring-no-properties
606 cmpl-symbol-start cmpl-symbol-end)))
605 ((= cmpl-preceding-syntax ?w) 607 ((= cmpl-preceding-syntax ?w)
606 ;; chars to ignore at end 608 ;; chars to ignore at end
607 (let ((saved-point (point))) 609 (let ((saved-point (point)))
@@ -621,7 +623,8 @@ Returns nil if there isn't one longer than `completion-min-length'."
621 (- cmpl-symbol-end cmpl-symbol-start)) 623 (- cmpl-symbol-end cmpl-symbol-start))
622 (<= (- cmpl-symbol-end cmpl-symbol-start) 624 (<= (- cmpl-symbol-end cmpl-symbol-start)
623 completion-max-length)) 625 completion-max-length))
624 (buffer-substring cmpl-symbol-start cmpl-symbol-end))))))) 626 (buffer-substring-no-properties
627 cmpl-symbol-start cmpl-symbol-end)))))))
625 628
626;; tests for symbol-before-point 629;; tests for symbol-before-point
627;; `^' indicates cursor pos. where value is returned 630;; `^' indicates cursor pos. where value is returned
@@ -670,7 +673,8 @@ Returns nil if there isn't one longer than `completion-min-length'."
670 (- cmpl-symbol-end cmpl-symbol-start)) 673 (- cmpl-symbol-end cmpl-symbol-start))
671 (<= (- cmpl-symbol-end cmpl-symbol-start) 674 (<= (- cmpl-symbol-end cmpl-symbol-start)
672 completion-max-length)) 675 completion-max-length))
673 (buffer-substring cmpl-symbol-start cmpl-symbol-end)))))) 676 (buffer-substring-no-properties
677 cmpl-symbol-start cmpl-symbol-end))))))
674 678
675;; tests for symbol-before-point-for-complete 679;; tests for symbol-before-point-for-complete
676;; `^' indicates cursor pos. where value is returned 680;; `^' indicates cursor pos. where value is returned
diff --git a/lisp/ediff-util.el b/lisp/ediff-util.el
index decff4474d4..e60faa0a0da 100644
--- a/lisp/ediff-util.el
+++ b/lisp/ediff-util.el
@@ -3164,7 +3164,11 @@ Hit \\[ediff-recenter] to reset the windows afterward."
3164(defun ediff-make-temp-file (buff &optional prefix given-file start end) 3164(defun ediff-make-temp-file (buff &optional prefix given-file start end)
3165 (let* ((p (ediff-convert-standard-filename (or prefix "ediff"))) 3165 (let* ((p (ediff-convert-standard-filename (or prefix "ediff")))
3166 (short-p p) 3166 (short-p p)
3167 (coding-system-for-write ediff-coding-system-for-write) 3167 (coding-system-for-write
3168 (ediff-with-current-buffer buff
3169 (if (boundp 'buffer-file-coding-system)
3170 buffer-file-coding-system
3171 ediff-coding-system-for-write)))
3168 f short-f) 3172 f short-f)
3169 (if (and (fboundp 'msdos-long-file-names) 3173 (if (and (fboundp 'msdos-long-file-names)
3170 (not (msdos-long-file-names)) 3174 (not (msdos-long-file-names))
diff --git a/lisp/ediff.el b/lisp/ediff.el
index 39700782e0e..7475834fba6 100644
--- a/lisp/ediff.el
+++ b/lisp/ediff.el
@@ -8,7 +8,7 @@
8;; Keywords: comparing, merging, patching, tools, unix 8;; Keywords: comparing, merging, patching, tools, unix
9 9
10(defconst ediff-version "2.81.2" "The current version of Ediff") 10(defconst ediff-version "2.81.2" "The current version of Ediff")
11(defconst ediff-date "June 13, 2007" "Date of last update") 11(defconst ediff-date "August 18, 2007" "Date of last update")
12 12
13 13
14;; This file is part of GNU Emacs. 14;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index ab87fd53361..8b55dd4a379 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -272,15 +272,19 @@ its argument list allows full Common Lisp conventions."
272 (nconc (nreverse simple-args) 272 (nconc (nreverse simple-args)
273 (list '&rest (car (pop bind-lets)))) 273 (list '&rest (car (pop bind-lets))))
274 (nconc (let ((hdr (nreverse header))) 274 (nconc (let ((hdr (nreverse header)))
275 (require 'help-fns) 275 ;; Macro expansion can take place in the middle of
276 (cons (help-add-fundoc-usage 276 ;; apparently harmless computation, so it should not
277 (if (stringp (car hdr)) (pop hdr)) 277 ;; touch the match-data.
278 ;; orig-args can contain &cl-defs (an internal CL 278 (save-match-data
279 ;; thingy that I do not understand), so remove it. 279 (require 'help-fns)
280 (let ((x (memq '&cl-defs orig-args))) 280 (cons (help-add-fundoc-usage
281 (if (null x) orig-args 281 (if (stringp (car hdr)) (pop hdr))
282 (delq (car x) (remq (cadr x) orig-args))))) 282 ;; orig-args can contain &cl-defs (an internal
283 hdr)) 283 ;; CL thingy I don't understand), so remove it.
284 (let ((x (memq '&cl-defs orig-args)))
285 (if (null x) orig-args
286 (delq (car x) (remq (cadr x) orig-args)))))
287 hdr)))
284 (list (nconc (list 'let* bind-lets) 288 (list (nconc (list 'let* bind-lets)
285 (nreverse bind-forms) body))))))) 289 (nreverse bind-forms) body)))))))
286 290
diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el
index 7538439d76c..b7e8c84cf27 100644
--- a/lisp/emacs-lisp/copyright.el
+++ b/lisp/emacs-lisp/copyright.el
@@ -57,6 +57,7 @@ The second \\( \\) construct must match the years."
57Only copyright lines where the name matches this regexp will be updated. 57Only copyright lines where the name matches this regexp will be updated.
58This allows you to avoid adding yars to a copyright notice belonging to 58This allows you to avoid adding yars to a copyright notice belonging to
59someone else or to a group for which you do not work." 59someone else or to a group for which you do not work."
60 :group 'copyright
60 :type 'regexp) 61 :type 'regexp)
61 62
62(defcustom copyright-years-regexp 63(defcustom copyright-years-regexp
@@ -87,13 +88,16 @@ When this is `function', only ask when called non-interactively."
87(defvar copyright-current-year (substring (current-time-string) -4) 88(defvar copyright-current-year (substring (current-time-string) -4)
88 "String representing the current year.") 89 "String representing the current year.")
89 90
91(defsubst copyright-limit () ; re-search-forward BOUND
92 (and copyright-limit (+ (point) copyright-limit)))
93
90(defun copyright-update-year (replace noquery) 94(defun copyright-update-year (replace noquery)
91 (when 95 (when
92 (condition-case err 96 (condition-case err
93 (re-search-forward (concat "\\(" copyright-regexp 97 (re-search-forward (concat "\\(" copyright-regexp
94 "\\)\\([ \t]*\n\\)?.*\\(?:" 98 "\\)\\([ \t]*\n\\)?.*\\(?:"
95 copyright-names-regexp "\\)") 99 copyright-names-regexp "\\)")
96 (if copyright-limit (+ (point) copyright-limit)) 100 (copyright-limit)
97 t) 101 t)
98 ;; In case the regexp is rejected. This is useful because 102 ;; In case the regexp is rejected. This is useful because
99 ;; copyright-update is typically called from before-save-hook where 103 ;; copyright-update is typically called from before-save-hook where
@@ -179,7 +183,7 @@ interactively."
179 "\\(the Free Software Foundation;\ 183 "\\(the Free Software Foundation;\
180 either \\|; a\\^u eldono \\([0-9]+\\)a, ? a\\^u (la\\^u via \\)\ 184 either \\|; a\\^u eldono \\([0-9]+\\)a, ? a\\^u (la\\^u via \\)\
181version \\([0-9]+\\), or (at" 185version \\([0-9]+\\), or (at"
182 (if copyright-limit (+ (point) copyright-limit)) t) 186 (copyright-limit) t)
183 (not (string= (match-string 3) copyright-current-gpl-version)) 187 (not (string= (match-string 3) copyright-current-gpl-version))
184 (or noquery 188 (or noquery
185 (y-or-n-p (concat "Replace GPL version by " 189 (y-or-n-p (concat "Replace GPL version by "
@@ -201,8 +205,7 @@ Uses heuristic: year >= 50 means 19xx, < 50 means 20xx."
201 (interactive) 205 (interactive)
202 (widen) 206 (widen)
203 (goto-char (point-min)) 207 (goto-char (point-min))
204 (if (re-search-forward copyright-regexp 208 (if (re-search-forward copyright-regexp (copyright-limit) t)
205 (if copyright-limit (+ (point) copyright-limit)) t)
206 (let ((s (match-beginning 2)) 209 (let ((s (match-beginning 2))
207 (e (copy-marker (1+ (match-end 2)))) 210 (e (copy-marker (1+ (match-end 2))))
208 (p (make-marker)) 211 (p (make-marker))
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 2ff273ebab3..8b2538d299c 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -264,30 +264,43 @@ Emacs Lisp mode) that support Eldoc.")
264 ;; so we need to be careful that errors aren't ignored. 264 ;; so we need to be careful that errors aren't ignored.
265 (error (message "eldoc error: %s" err)))) 265 (error (message "eldoc error: %s" err))))
266 266
267;; Return a string containing the function parameter list, or 1-line 267(defun eldoc-get-fnsym-args-string (sym &optional index)
268;; docstring if function is a subr and no arglist is obtainable from the 268 "Return a string containing the parameter list of the function SYM.
269;; docstring or elsewhere. 269If SYM is a subr and no arglist is obtainable from the docstring
270(defun eldoc-get-fnsym-args-string (sym &optional argument-index) 270or elsewhere, return a 1-line docstring. Calls the functions
271 (let ((args nil) 271`eldoc-function-argstring-format' and
272 (doc nil)) 272`eldoc-highlight-function-argument' to format the result. The
273former calls `eldoc-argument-case'; the latter gives the
274function name `font-lock-function-name-face', and optionally
275highlights argument number INDEX. "
276 (let (args doc)
273 (cond ((not (and sym (symbolp sym) (fboundp sym)))) 277 (cond ((not (and sym (symbolp sym) (fboundp sym))))
274 ((and (eq sym (aref eldoc-last-data 0)) 278 ((and (eq sym (aref eldoc-last-data 0))
275 (eq 'function (aref eldoc-last-data 2))) 279 (eq 'function (aref eldoc-last-data 2)))
276 (setq doc (aref eldoc-last-data 1))) 280 (setq doc (aref eldoc-last-data 1)))
277 ((setq doc (help-split-fundoc (documentation sym t) sym)) 281 ((setq doc (help-split-fundoc (documentation sym t) sym))
278 (setq args (car doc)) 282 (setq args (car doc))
283 ;; Remove any enclosing (), since e-function-argstring adds them.
279 (string-match "\\`[^ )]* ?" args) 284 (string-match "\\`[^ )]* ?" args)
280 (setq args (concat "(" (substring args (match-end 0)))) 285 (setq args (substring args (match-end 0)))
281 (eldoc-last-data-store sym args 'function)) 286 (if (string-match ")\\'" args)
282 (t 287 (setq args (substring args 0 -1))))
283 (setq args (eldoc-function-argstring sym)))) 288 (t
284 (and args 289 (setq args (help-function-arglist sym))))
285 argument-index 290 (if args
286 (setq doc (eldoc-highlight-function-argument sym args argument-index))) 291 ;; Stringify, and store before highlighting, downcasing, etc.
287 doc)) 292 ;; FIXME should truncate before storing.
288 293 (eldoc-last-data-store sym (setq args (eldoc-function-argstring args))
289;; Highlight argument INDEX in ARGS list for SYM. 294 'function)
295 (setq args doc)) ; use stored value
296 ;; Change case, highlight, truncate.
297 (if args
298 (eldoc-highlight-function-argument
299 sym (eldoc-function-argstring-format args) index))))
300
290(defun eldoc-highlight-function-argument (sym args index) 301(defun eldoc-highlight-function-argument (sym args index)
302 "Highlight argument INDEX in ARGS list for function SYM.
303In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
291 (let ((start nil) 304 (let ((start nil)
292 (end 0) 305 (end 0)
293 (argument-face 'bold)) 306 (argument-face 'bold))
@@ -298,7 +311,7 @@ Emacs Lisp mode) that support Eldoc.")
298 ;; (defun NAME ARGLIST [DOCSTRING] BODY...) case? 311 ;; (defun NAME ARGLIST [DOCSTRING] BODY...) case?
299 ;; The problem is there is no robust way to determine if 312 ;; The problem is there is no robust way to determine if
300 ;; the current argument is indeed a docstring. 313 ;; the current argument is indeed a docstring.
301 (while (>= index 1) 314 (while (and index (>= index 1))
302 (if (string-match "[^ ()]+" args end) 315 (if (string-match "[^ ()]+" args end)
303 (progn 316 (progn
304 (setq start (match-beginning 0) 317 (setq start (match-beginning 0)
@@ -438,29 +451,31 @@ Emacs Lisp mode) that support Eldoc.")
438 (error (setq defn nil)))) 451 (error (setq defn nil))))
439 defn)) 452 defn))
440 453
441(defun eldoc-function-argstring (fn) 454(defun eldoc-function-argstring (arglist)
442 (eldoc-function-argstring-format (help-function-arglist fn))) 455 "Return ARGLIST as a string enclosed by ().
443 456ARGLIST is either a string, or a list of strings or symbols."
444(defun eldoc-function-argstring-format (arglist) 457 (cond ((stringp arglist))
445 (cond ((not (listp arglist)) 458 ((not (listp arglist))
446 (setq arglist nil)) 459 (setq arglist nil))
447 ((symbolp (car arglist)) 460 ((symbolp (car arglist))
448 (setq arglist 461 (setq arglist
449 (mapcar (function (lambda (s) 462 (mapconcat (lambda (s) (symbol-name s))
450 (if (memq s '(&optional &rest)) 463 arglist " ")))
451 (symbol-name s) 464 ((stringp (car arglist))
452 (funcall eldoc-argument-case 465 (setq arglist
453 (symbol-name s))))) 466 (mapconcat (lambda (s) s)
454 arglist))) 467 arglist " "))))
455 ((stringp (car arglist)) 468 (if arglist
456 (setq arglist 469 (format "(%s)" arglist)))
457 (mapcar (function (lambda (s) 470
458 (if (member s '("&optional" "&rest")) 471(defun eldoc-function-argstring-format (argstring)
459 s 472 "Apply `eldoc-argument-case' to each word in argstring.
460 (funcall eldoc-argument-case s)))) 473The words \"&rest\", \"&optional\" are returned unchanged."
461 arglist)))) 474 (mapconcat (lambda (s)
462 (concat "(" (mapconcat 'identity arglist " ") ")")) 475 (if (member s '("&optional" "&rest"))
463 476 s
477 (funcall eldoc-argument-case s)))
478 (split-string argstring) " "))
464 479
465;; When point is in a sexp, the function args are not reprinted in the echo 480;; When point is in a sexp, the function args are not reprinted in the echo
466;; area after every possible interactive command because some of them print 481;; area after every possible interactive command because some of them print
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 655677998e0..b6f6a450791 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -539,62 +539,65 @@ If CHAR is not a character, return nil."
539 string)))) 539 string))))
540 540
541 541
542(defun preceding-sexp ()
543 "Return sexp before the point."
544 (let ((opoint (point))
545 ignore-quotes
546 expr)
547 (save-excursion
548 (with-syntax-table emacs-lisp-mode-syntax-table
549 ;; If this sexp appears to be enclosed in `...'
550 ;; then ignore the surrounding quotes.
551 (setq ignore-quotes
552 (or (eq (following-char) ?\')
553 (eq (preceding-char) ?\')))
554 (forward-sexp -1)
555 ;; If we were after `?\e' (or similar case),
556 ;; use the whole thing, not just the `e'.
557 (when (eq (preceding-char) ?\\)
558 (forward-char -1)
559 (when (eq (preceding-char) ??)
560 (forward-char -1)))
561
562 ;; Skip over `#N='s.
563 (when (eq (preceding-char) ?=)
564 (let (labeled-p)
565 (save-excursion
566 (skip-chars-backward "0-9#=")
567 (setq labeled-p (looking-at "\\(#[0-9]+=\\)+")))
568 (when labeled-p
569 (forward-sexp -1))))
570
571 (save-restriction
572 ;; vladimir@cs.ualberta.ca 30-Jul-1997: skip ` in
573 ;; `variable' so that the value is returned, not the
574 ;; name
575 (if (and ignore-quotes
576 (eq (following-char) ?`))
577 (forward-char))
578 (narrow-to-region (point-min) opoint)
579 (setq expr (read (current-buffer)))
580 ;; If it's an (interactive ...) form, it's more
581 ;; useful to show how an interactive call would
582 ;; use it.
583 (and (consp expr)
584 (eq (car expr) 'interactive)
585 (setq expr
586 (list 'call-interactively
587 (list 'quote
588 (list 'lambda
589 '(&rest args)
590 expr
591 'args)))))
592 expr)))))
593
594
542(defun eval-last-sexp-1 (eval-last-sexp-arg-internal) 595(defun eval-last-sexp-1 (eval-last-sexp-arg-internal)
543 "Evaluate sexp before point; print value in minibuffer. 596 "Evaluate sexp before point; print value in minibuffer.
544With argument, print output into current buffer." 597With argument, print output into current buffer."
545 (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t))) 598 (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)))
546 (let ((value 599 (eval-last-sexp-print-value (eval (preceding-sexp)))))
547 (eval (let ((stab (syntax-table)) 600
548 (opoint (point))
549 ignore-quotes
550 expr)
551 (save-excursion
552 (with-syntax-table emacs-lisp-mode-syntax-table
553 ;; If this sexp appears to be enclosed in `...'
554 ;; then ignore the surrounding quotes.
555 (setq ignore-quotes
556 (or (eq (following-char) ?\')
557 (eq (preceding-char) ?\')))
558 (forward-sexp -1)
559 ;; If we were after `?\e' (or similar case),
560 ;; use the whole thing, not just the `e'.
561 (when (eq (preceding-char) ?\\)
562 (forward-char -1)
563 (when (eq (preceding-char) ??)
564 (forward-char -1)))
565
566 ;; Skip over `#N='s.
567 (when (eq (preceding-char) ?=)
568 (let (labeled-p)
569 (save-excursion
570 (skip-chars-backward "0-9#=")
571 (setq labeled-p (looking-at "\\(#[0-9]+=\\)+")))
572 (when labeled-p
573 (forward-sexp -1))))
574
575 (save-restriction
576 ;; vladimir@cs.ualberta.ca 30-Jul-1997: skip ` in
577 ;; `variable' so that the value is returned, not the
578 ;; name
579 (if (and ignore-quotes
580 (eq (following-char) ?`))
581 (forward-char))
582 (narrow-to-region (point-min) opoint)
583 (setq expr (read (current-buffer)))
584 ;; If it's an (interactive ...) form, it's more
585 ;; useful to show how an interactive call would
586 ;; use it.
587 (and (consp expr)
588 (eq (car expr) 'interactive)
589 (setq expr
590 (list 'call-interactively
591 (list 'quote
592 (list 'lambda
593 '(&rest args)
594 expr
595 'args)))))
596 expr)))))))
597 (eval-last-sexp-print-value value))))
598 601
599(defun eval-last-sexp-print-value (value) 602(defun eval-last-sexp-print-value (value)
600 (let ((unabbreviated (let ((print-length nil) (print-level nil)) 603 (let ((unabbreviated (let ((print-length nil) (print-level nil))
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index d0ec55781e7..6e420b36242 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -1601,22 +1601,6 @@ shifted movement key, set `cua-highlight-region-shift-only'."
1601 (interactive) 1601 (interactive)
1602 (setq cua--debug (not cua--debug))) 1602 (setq cua--debug (not cua--debug)))
1603 1603
1604;; Install run-time check for older versions of CUA-mode which does not
1605;; work with GNU Emacs version 22.1 and newer.
1606;;
1607;; Except for version 1.2, all of the 1.x and 2.x version of cua-mode
1608;; provided the `CUA-mode' feature. Since this is no longer true,
1609;; we can warn the user if the `CUA-mode' feature is ever provided.
1610
1611;;;###autoload (eval-after-load 'CUA-mode
1612;;;###autoload '(error (concat "\n\n"
1613;;;###autoload "CUA-mode is now part of the standard GNU Emacs distribution, so you may\n"
1614;;;###autoload "now enable CUA via the Options menu or by customizing option `cua-mode'.\n\n"
1615;;;###autoload "You have loaded an older version of CUA-mode which does\n"
1616;;;###autoload "not work correctly with this version of GNU Emacs.\n\n"
1617;;;###autoload (if user-init-file (concat
1618;;;###autoload "To correct this, remove the loading and customization of the\n"
1619;;;###autoload "old version from the " user-init-file " file.\n\n")))))
1620 1604
1621(provide 'cua) 1605(provide 'cua)
1622 1606
diff --git a/lisp/emulation/tpu-edt.el b/lisp/emulation/tpu-edt.el
index 81187112a66..12e64940b06 100644
--- a/lisp/emulation/tpu-edt.el
+++ b/lisp/emulation/tpu-edt.el
@@ -322,176 +322,176 @@
322 ;; that term/*.el does its job to map the escape sequence to the right 322 ;; that term/*.el does its job to map the escape sequence to the right
323 ;; key-symbol. 323 ;; key-symbol.
324 324
325 (define-key map [up] 'tpu-move-to-beginning) ; up-arrow 325 (define-key map [up] 'tpu-move-to-beginning) ; up-arrow
326 (define-key map [down] 'tpu-move-to-end) ; down-arrow 326 (define-key map [down] 'tpu-move-to-end) ; down-arrow
327 (define-key map [right] 'end-of-line) ; right-arrow 327 (define-key map [right] 'end-of-line) ; right-arrow
328 (define-key map [left] 'beginning-of-line) ; left-arrow 328 (define-key map [left] 'beginning-of-line) ; left-arrow
329 329
330 (define-key map [find] 'nil) ; Find 330 ;; (define-key map [find] nil) ; Find
331 (define-key map [insert] 'nil) ; Insert Here 331 ;; (define-key map [insert] nil) ; Insert Here
332 (define-key map [delete] 'tpu-store-text) ; Remove 332 (define-key map [delete] 'tpu-store-text) ; Remove
333 (define-key map [select] 'tpu-unselect) ; Select 333 (define-key map [select] 'tpu-unselect) ; Select
334 (define-key map [prior] 'tpu-previous-window) ; Prev Screen 334 (define-key map [prior] 'tpu-previous-window) ; Prev Screen
335 (define-key map [next] 'tpu-next-window) ; Next Screen 335 (define-key map [next] 'tpu-next-window) ; Next Screen
336 336
337 (define-key map [f1] 'nil) ; F1 337 ;; (define-key map [f1] nil) ; F1
338 (define-key map [f2] 'nil) ; F2 338 ;; (define-key map [f2] nil) ; F2
339 (define-key map [f3] 'nil) ; F3 339 ;; (define-key map [f3] nil) ; F3
340 (define-key map [f4] 'nil) ; F4 340 ;; (define-key map [f4] nil) ; F4
341 (define-key map [f5] 'nil) ; F5 341 ;; (define-key map [f5] nil) ; F5
342 (define-key map [f6] 'nil) ; F6 342 ;; (define-key map [f6] nil) ; F6
343 (define-key map [f7] 'nil) ; F7 343 ;; (define-key map [f7] nil) ; F7
344 (define-key map [f8] 'nil) ; F8 344 ;; (define-key map [f8] nil) ; F8
345 (define-key map [f9] 'nil) ; F9 345 ;; (define-key map [f9] nil) ; F9
346 (define-key map [f10] 'nil) ; F10 346 ;; (define-key map [f10] nil) ; F10
347 (define-key map [f11] 'nil) ; F11 347 ;; (define-key map [f11] nil) ; F11
348 (define-key map [f12] 'nil) ; F12 348 ;; (define-key map [f12] nil) ; F12
349 (define-key map [f13] 'nil) ; F13 349 ;; (define-key map [f13] nil) ; F13
350 (define-key map [f14] 'nil) ; F14 350 ;; (define-key map [f14] nil) ; F14
351 (define-key map [help] 'describe-bindings) ; HELP 351 (define-key map [help] 'describe-bindings) ; HELP
352 (define-key map [menu] 'nil) ; DO 352 ;; (define-key map [menu] nil) ; DO
353 (define-key map [f17] 'tpu-drop-breadcrumb) ; F17 353 (define-key map [f17] 'tpu-drop-breadcrumb) ; F17
354 (define-key map [f18] 'nil) ; F18 354 ;; (define-key map [f18] nil) ; F18
355 (define-key map [f19] 'nil) ; F19 355 ;; (define-key map [f19] nil) ; F19
356 (define-key map [f20] 'nil) ; F20 356 ;; (define-key map [f20] nil) ; F20
357 357
358 (define-key map [kp-f1] 'keyboard-quit) ; PF1 358 (define-key map [kp-f1] 'keyboard-quit) ; PF1
359 (define-key map [kp-f2] 'help-for-help) ; PF2 359 (define-key map [kp-f2] 'help-for-help) ; PF2
360 (define-key map [kp-f3] 'tpu-search) ; PF3 360 (define-key map [kp-f3] 'tpu-search) ; PF3
361 (define-key map [kp-f4] 'tpu-undelete-lines) ; PF4 361 (define-key map [kp-f4] 'tpu-undelete-lines) ; PF4
362 (define-key map [kp-0] 'open-line) ; KP0 362 (define-key map [kp-0] 'open-line) ; KP0
363 (define-key map [kp-1] 'tpu-change-case) ; KP1 363 (define-key map [kp-1] 'tpu-change-case) ; KP1
364 (define-key map [kp-2] 'tpu-delete-to-eol) ; KP2 364 (define-key map [kp-2] 'tpu-delete-to-eol) ; KP2
365 (define-key map [kp-3] 'tpu-special-insert) ; KP3 365 (define-key map [kp-3] 'tpu-special-insert) ; KP3
366 (define-key map [kp-4] 'tpu-move-to-end) ; KP4 366 (define-key map [kp-4] 'tpu-move-to-end) ; KP4
367 (define-key map [kp-5] 'tpu-move-to-beginning) ; KP5 367 (define-key map [kp-5] 'tpu-move-to-beginning) ; KP5
368 (define-key map [kp-6] 'tpu-paste) ; KP6 368 (define-key map [kp-6] 'tpu-paste) ; KP6
369 (define-key map [kp-7] 'execute-extended-command) ; KP7 369 (define-key map [kp-7] 'execute-extended-command) ; KP7
370 (define-key map [kp-8] 'tpu-fill) ; KP8 370 (define-key map [kp-8] 'tpu-fill) ; KP8
371 (define-key map [kp-9] 'tpu-replace) ; KP9 371 (define-key map [kp-9] 'tpu-replace) ; KP9
372 (define-key map [kp-subtract] 'tpu-undelete-words) ; KP- 372 (define-key map [kp-subtract] 'tpu-undelete-words) ; KP-
373 (define-key map [kp-separator] 'tpu-undelete-char) ; KP, 373 (define-key map [kp-separator] 'tpu-undelete-char) ; KP,
374 (define-key map [kp-decimal] 'tpu-unselect) ; KP. 374 (define-key map [kp-decimal] 'tpu-unselect) ; KP.
375 (define-key map [kp-enter] 'tpu-substitute) ; KPenter 375 (define-key map [kp-enter] 'tpu-substitute) ; KPenter
376 376
377 ;; 377 ;;
378 (define-key map "\C-A" 'tpu-toggle-overwrite-mode) ; ^A 378 (define-key map "\C-A" 'tpu-toggle-overwrite-mode) ; ^A
379 (define-key map "\C-B" 'nil) ; ^B 379 ;; (define-key map "\C-B" nil) ; ^B
380 (define-key map "\C-C" 'nil) ; ^C 380 ;; (define-key map "\C-C" nil) ; ^C
381 (define-key map "\C-D" 'nil) ; ^D 381 ;; (define-key map "\C-D" nil) ; ^D
382 (define-key map "\C-E" 'nil) ; ^E 382 ;; (define-key map "\C-E" nil) ; ^E
383 (define-key map "\C-F" 'set-visited-file-name) ; ^F 383 (define-key map "\C-F" 'set-visited-file-name) ; ^F
384 (define-key map "\C-g" 'keyboard-quit) ; safety first 384 (define-key map "\C-g" 'keyboard-quit) ; safety first
385 (define-key map "\C-h" 'delete-other-windows) ; BS 385 (define-key map "\C-h" 'delete-other-windows) ; BS
386 (define-key map "\C-i" 'other-window) ; TAB 386 (define-key map "\C-i" 'other-window) ; TAB
387 (define-key map "\C-J" 'nil) ; ^J 387 ;; (define-key map "\C-J" nil) ; ^J
388 (define-key map "\C-K" 'tpu-define-macro-key) ; ^K 388 (define-key map "\C-K" 'tpu-define-macro-key) ; ^K
389 (define-key map "\C-l" 'downcase-region) ; ^L 389 (define-key map "\C-l" 'downcase-region) ; ^L
390 (define-key map "\C-M" 'nil) ; ^M 390 ;; (define-key map "\C-M" nil) ; ^M
391 (define-key map "\C-N" 'nil) ; ^N 391 ;; (define-key map "\C-N" nil) ; ^N
392 (define-key map "\C-O" 'nil) ; ^O 392 ;; (define-key map "\C-O" nil) ; ^O
393 (define-key map "\C-P" 'nil) ; ^P 393 ;; (define-key map "\C-P" nil) ; ^P
394 (define-key map "\C-Q" 'nil) ; ^Q 394 ;; (define-key map "\C-Q" nil) ; ^Q
395 (define-key map "\C-R" 'nil) ; ^R 395 ;; (define-key map "\C-R" nil) ; ^R
396 (define-key map "\C-S" 'nil) ; ^S 396 ;; (define-key map "\C-S" nil) ; ^S
397 (define-key map "\C-T" 'tpu-toggle-control-keys) ; ^T 397 (define-key map "\C-T" 'tpu-toggle-control-keys) ; ^T
398 (define-key map "\C-u" 'upcase-region) ; ^U 398 (define-key map "\C-u" 'upcase-region) ; ^U
399 (define-key map "\C-V" 'nil) ; ^V 399 ;; (define-key map "\C-V" nil) ; ^V
400 (define-key map "\C-w" 'tpu-write-current-buffers) ; ^W 400 (define-key map "\C-w" 'tpu-write-current-buffers) ; ^W
401 (define-key map "\C-X" 'nil) ; ^X 401 ;; (define-key map "\C-X" nil) ; ^X
402 (define-key map "\C-Y" 'nil) ; ^Y 402 ;; (define-key map "\C-Y" nil) ; ^Y
403 (define-key map "\C-Z" 'nil) ; ^Z 403 ;; (define-key map "\C-Z" nil) ; ^Z
404 (define-key map " " 'undo) ; SPC 404 (define-key map " " 'undo) ; SPC
405 (define-key map "!" 'nil) ; ! 405 ;; (define-key map "!" nil) ; !
406 (define-key map "#" 'nil) ; # 406 ;; (define-key map "#" nil) ; #
407 (define-key map "$" 'tpu-add-at-eol) ; $ 407 (define-key map "$" 'tpu-add-at-eol) ; $
408 (define-key map "%" 'tpu-goto-percent) ; % 408 (define-key map "%" 'tpu-goto-percent) ; %
409 (define-key map "&" 'nil) ; & 409 ;; (define-key map "&" nil) ; &
410 (define-key map "(" 'nil) ; ( 410 ;; (define-key map "(" nil) ; (
411 (define-key map ")" 'nil) ; ) 411 ;; (define-key map ")" nil) ; )
412 (define-key map "*" 'tpu-toggle-regexp) ; * 412 (define-key map "*" 'tpu-toggle-regexp) ; *
413 (define-key map "+" 'nil) ; + 413 ;; (define-key map "+" nil) ; +
414 (define-key map "," 'tpu-goto-breadcrumb) ; , 414 (define-key map "," 'tpu-goto-breadcrumb) ; ,
415 (define-key map "-" 'negative-argument) ; - 415 (define-key map "-" 'negative-argument) ; -
416 (define-key map "." 'tpu-drop-breadcrumb) ; . 416 (define-key map "." 'tpu-drop-breadcrumb) ; .
417 (define-key map "/" 'tpu-emacs-replace) ; / 417 (define-key map "/" 'tpu-emacs-replace) ; /
418 (define-key map "0" 'digit-argument) ; 0 418 (define-key map "0" 'digit-argument) ; 0
419 (define-key map "1" 'digit-argument) ; 1 419 (define-key map "1" 'digit-argument) ; 1
420 (define-key map "2" 'digit-argument) ; 2 420 (define-key map "2" 'digit-argument) ; 2
421 (define-key map "3" 'digit-argument) ; 3 421 (define-key map "3" 'digit-argument) ; 3
422 (define-key map "4" 'digit-argument) ; 4 422 (define-key map "4" 'digit-argument) ; 4
423 (define-key map "5" 'digit-argument) ; 5 423 (define-key map "5" 'digit-argument) ; 5
424 (define-key map "6" 'digit-argument) ; 6 424 (define-key map "6" 'digit-argument) ; 6
425 (define-key map "7" 'digit-argument) ; 7 425 (define-key map "7" 'digit-argument) ; 7
426 (define-key map "8" 'digit-argument) ; 8 426 (define-key map "8" 'digit-argument) ; 8
427 (define-key map "9" 'digit-argument) ; 9 427 (define-key map "9" 'digit-argument) ; 9
428 (define-key map ":" 'nil) ; : 428 ;; (define-key map ":" nil) ; :
429 (define-key map ";" 'tpu-trim-line-ends) ; ; 429 (define-key map ";" 'tpu-trim-line-ends) ; ;
430 (define-key map "<" 'nil) ; < 430 ;; (define-key map "<" nil) ; <
431 (define-key map "=" 'nil) ; = 431 ;; (define-key map "=" nil) ; =
432 (define-key map ">" 'nil) ; > 432 ;; (define-key map ">" nil) ; >
433 (define-key map "?" 'tpu-spell-check) ; ? 433 (define-key map "?" 'tpu-spell-check) ; ?
434 (define-key map "A" 'tpu-toggle-newline-and-indent) ; A 434 ;; (define-key map "A" 'tpu-toggle-newline-and-indent) ; A
435 (define-key map "B" 'tpu-next-buffer) ; B 435 ;; (define-key map "B" 'tpu-next-buffer) ; B
436 (define-key map "C" 'repeat-complex-command) ; C 436 ;; (define-key map "C" 'repeat-complex-command) ; C
437 (define-key map "D" 'shell-command) ; D 437 ;; (define-key map "D" 'shell-command) ; D
438 (define-key map "E" 'tpu-exit) ; E 438 ;; (define-key map "E" 'tpu-exit) ; E
439 (define-key map "F" 'tpu-set-cursor-free) ; F 439 ;; (define-key map "F" 'tpu-cursor-free-mode) ; F
440 (define-key map "G" 'tpu-get) ; G 440 ;; (define-key map "G" 'tpu-get) ; G
441 (define-key map "H" 'nil) ; H 441 ;; (define-key map "H" nil) ; H
442 (define-key map "I" 'tpu-include) ; I 442 ;; (define-key map "I" 'tpu-include) ; I
443 (define-key map "K" 'tpu-kill-buffer) ; K 443 ;; (define-key map "K" 'tpu-kill-buffer) ; K
444 (define-key map "L" 'tpu-what-line) ; L 444 (define-key map "L" 'tpu-what-line) ; L
445 (define-key map "M" 'buffer-menu) ; M 445 ;; (define-key map "M" 'buffer-menu) ; M
446 (define-key map "N" 'tpu-next-file-buffer) ; N 446 ;; (define-key map "N" 'tpu-next-file-buffer) ; N
447 (define-key map "O" 'occur) ; O 447 ;; (define-key map "O" 'occur) ; O
448 (define-key map "P" 'lpr-buffer) ; P 448 (define-key map "P" 'lpr-buffer) ; P
449 (define-key map "Q" 'tpu-quit) ; Q 449 ;; (define-key map "Q" 'tpu-quit) ; Q
450 (define-key map "R" 'tpu-toggle-rectangle) ; R 450 ;; (define-key map "R" 'tpu-toggle-rectangle) ; R
451 (define-key map "S" 'replace) ; S 451 ;; (define-key map "S" 'replace) ; S
452 (define-key map "T" 'tpu-line-to-top-of-window) ; T 452 ;; (define-key map "T" 'tpu-line-to-top-of-window) ; T
453 (define-key map "U" 'undo) ; U 453 ;; (define-key map "U" 'undo) ; U
454 (define-key map "V" 'tpu-version) ; V 454 ;; (define-key map "V" 'tpu-version) ; V
455 (define-key map "W" 'save-buffer) ; W 455 ;; (define-key map "W" 'save-buffer) ; W
456 (define-key map "X" 'tpu-save-all-buffers-kill-emacs) ; X 456 ;; (define-key map "X" 'tpu-save-all-buffers-kill-emacs) ; X
457 (define-key map "Y" 'copy-region-as-kill) ; Y 457 ;; (define-key map "Y" 'copy-region-as-kill) ; Y
458 (define-key map "Z" 'suspend-emacs) ; Z 458 ;; (define-key map "Z" 'suspend-emacs) ; Z
459 (define-key map "[" 'blink-matching-open) ; [ 459 (define-key map "[" 'blink-matching-open) ; [
460 (define-key map "\\" 'nil) ; \ 460 ;; (define-key map "\\" nil) ; \
461 (define-key map "]" 'blink-matching-open) ; ] 461 (define-key map "]" 'blink-matching-open) ; ]
462 (define-key map "^" 'tpu-add-at-bol) ; ^ 462 (define-key map "^" 'tpu-add-at-bol) ; ^
463 (define-key map "_" 'split-window-vertically) ; - 463 (define-key map "_" 'split-window-vertically) ; -
464 (define-key map "`" 'what-line) ; ` 464 (define-key map "`" 'what-line) ; `
465 (define-key map "a" 'tpu-toggle-newline-and-indent) ; a 465 (define-key map "a" 'tpu-toggle-newline-and-indent) ; a
466 (define-key map "b" 'tpu-next-buffer) ; b 466 (define-key map "b" 'tpu-next-buffer) ; b
467 (define-key map "c" 'repeat-complex-command) ; c 467 (define-key map "c" 'repeat-complex-command) ; c
468 (define-key map "d" 'shell-command) ; d 468 (define-key map "d" 'shell-command) ; d
469 (define-key map "e" 'tpu-exit) ; e 469 (define-key map "e" 'tpu-exit) ; e
470 (define-key map "f" 'tpu-set-cursor-free) ; f 470 (define-key map "f" 'tpu-cursor-free-mode) ; f
471 (define-key map "g" 'tpu-get) ; g 471 (define-key map "g" 'tpu-get) ; g
472 (define-key map "h" 'nil) ; h 472 ;; (define-key map "h" nil) ; h
473 (define-key map "i" 'tpu-include) ; i 473 (define-key map "i" 'tpu-include) ; i
474 (define-key map "k" 'tpu-kill-buffer) ; k 474 (define-key map "k" 'tpu-kill-buffer) ; k
475 (define-key map "l" 'goto-line) ; l 475 (define-key map "l" 'goto-line) ; l
476 (define-key map "m" 'buffer-menu) ; m 476 (define-key map "m" 'buffer-menu) ; m
477 (define-key map "n" 'tpu-next-file-buffer) ; n 477 (define-key map "n" 'tpu-next-file-buffer) ; n
478 (define-key map "o" 'occur) ; o 478 (define-key map "o" 'occur) ; o
479 (define-key map "p" 'lpr-region) ; p 479 (define-key map "p" 'lpr-region) ; p
480 (define-key map "q" 'tpu-quit) ; q 480 (define-key map "q" 'tpu-quit) ; q
481 (define-key map "r" 'tpu-toggle-rectangle) ; r 481 (define-key map "r" 'tpu-toggle-rectangle) ; r
482 (define-key map "s" 'replace) ; s 482 (define-key map "s" 'replace) ; s
483 (define-key map "t" 'tpu-line-to-top-of-window) ; t 483 (define-key map "t" 'tpu-line-to-top-of-window) ; t
484 (define-key map "u" 'undo) ; u 484 (define-key map "u" 'undo) ; u
485 (define-key map "v" 'tpu-version) ; v 485 (define-key map "v" 'tpu-version) ; v
486 (define-key map "w" 'save-buffer) ; w 486 (define-key map "w" 'save-buffer) ; w
487 (define-key map "x" 'tpu-save-all-buffers-kill-emacs) ; x 487 (define-key map "x" 'tpu-save-all-buffers-kill-emacs) ; x
488 (define-key map "y" 'copy-region-as-kill) ; y 488 (define-key map "y" 'copy-region-as-kill) ; y
489 (define-key map "z" 'suspend-emacs) ; z 489 (define-key map "z" 'suspend-emacs) ; z
490 (define-key map "{" 'nil) ; { 490 ;; (define-key map "{" nil) ; {
491 (define-key map "|" 'split-window-horizontally) ; | 491 (define-key map "|" 'split-window-horizontally) ; |
492 (define-key map "}" 'nil) ; } 492 ;; (define-key map "}" nil) ; }
493 (define-key map "~" 'exchange-point-and-mark) ; ~ 493 (define-key map "~" 'exchange-point-and-mark) ; ~
494 (define-key map "\177" 'delete-window) ; <X] 494 (define-key map "\177" 'delete-window) ; <X]
495 map) 495 map)
496 "Maps the function keys on the VT100 keyboard preceded by PF1. 496 "Maps the function keys on the VT100 keyboard preceded by PF1.
497GOLD is the ASCII 7-bit escape sequence <ESC>OP.") 497GOLD is the ASCII 7-bit escape sequence <ESC>OP.")
@@ -502,61 +502,61 @@ GOLD is the ASCII 7-bit escape sequence <ESC>OP.")
502 502
503 ;; Previously defined in CSI-map. We now presume that term/*.el does 503 ;; Previously defined in CSI-map. We now presume that term/*.el does
504 ;; its job to map the escape sequence to the right key-symbol. 504 ;; its job to map the escape sequence to the right key-symbol.
505 (define-key map [find] 'tpu-search) ; Find 505 (define-key map [find] 'tpu-search) ; Find
506 (define-key map [insert] 'tpu-paste) ; Insert Here 506 (define-key map [insert] 'tpu-paste) ; Insert Here
507 (define-key map [delete] 'tpu-cut) ; Remove 507 (define-key map [delete] 'tpu-cut) ; Remove
508 (define-key map [select] 'tpu-select) ; Select 508 (define-key map [select] 'tpu-select) ; Select
509 (define-key map [prior] 'tpu-scroll-window-down) ; Prev Screen 509 (define-key map [prior] 'tpu-scroll-window-down) ; Prev Screen
510 (define-key map [next] 'tpu-scroll-window-up) ; Next Screen 510 (define-key map [next] 'tpu-scroll-window-up) ; Next Screen
511 511
512 (define-key map [f1] 'nil) ; F1 512 ;; (define-key map [f1] nil) ; F1
513 (define-key map [f2] 'nil) ; F2 513 ;; (define-key map [f2] nil) ; F2
514 (define-key map [f3] 'nil) ; F3 514 ;; (define-key map [f3] nil) ; F3
515 (define-key map [f4] 'nil) ; F4 515 ;; (define-key map [f4] nil) ; F4
516 (define-key map [f5] 'nil) ; F5 516 ;; (define-key map [f5] nil) ; F5
517 (define-key map [f6] 'nil) ; F6 517 ;; (define-key map [f6] nil) ; F6
518 (define-key map [f7] 'nil) ; F7 518 ;; (define-key map [f7] nil) ; F7
519 (define-key map [f8] 'nil) ; F8 519 ;; (define-key map [f8] nil) ; F8
520 (define-key map [f9] 'nil) ; F9 520 ;; (define-key map [f9] nil) ; F9
521 (define-key map [f10] 'tpu-exit) ; F10 521 (define-key map [f10] 'tpu-exit) ; F10
522 (define-key map [f11] 'tpu-insert-escape) ; F11 (ESC) 522 (define-key map [f11] 'tpu-insert-escape) ; F11 (ESC)
523 (define-key map [f12] 'tpu-next-beginning-of-line) ; F12 (BS) 523 (define-key map [f12] 'tpu-next-beginning-of-line) ; F12 (BS)
524 (define-key map [f13] 'tpu-delete-previous-word) ; F13 (LF) 524 (define-key map [f13] 'tpu-delete-previous-word) ; F13 (LF)
525 (define-key map [f14] 'tpu-toggle-overwrite-mode) ; F14 525 (define-key map [f14] 'tpu-toggle-overwrite-mode) ; F14
526 (define-key map [help] 'tpu-help) ; HELP 526 (define-key map [help] 'tpu-help) ; HELP
527 (define-key map [menu] 'execute-extended-command) ; DO 527 (define-key map [menu] 'execute-extended-command) ; DO
528 (define-key map [f17] 'tpu-goto-breadcrumb) ; F17 528 (define-key map [f17] 'tpu-goto-breadcrumb) ; F17
529 (define-key map [f18] 'nil) ; F18 529 ;; (define-key map [f18] nil) ; F18
530 (define-key map [f19] 'nil) ; F19 530 ;; (define-key map [f19] nil) ; F19
531 (define-key map [f20] 'nil) ; F20 531 ;; (define-key map [f20] nil) ; F20
532 532
533 533
534 ;; Previously defined in SS3-map. We now presume that term/*.el does 534 ;; Previously defined in SS3-map. We now presume that term/*.el does
535 ;; its job to map the escape sequence to the right key-symbol. 535 ;; its job to map the escape sequence to the right key-symbol.
536 (define-key map [kp-f1] tpu-gold-map) ; GOLD map 536 (define-key map [kp-f1] tpu-gold-map) ; GOLD map
537 ;; 537 ;;
538 (define-key map [up] 'tpu-previous-line) ; up 538 (define-key map [up] 'tpu-previous-line) ; up
539 (define-key map [down] 'tpu-next-line) ; down 539 (define-key map [down] 'tpu-next-line) ; down
540 (define-key map [right] 'tpu-forward-char) ; right 540 (define-key map [right] 'tpu-forward-char) ; right
541 (define-key map [left] 'tpu-backward-char) ; left 541 (define-key map [left] 'tpu-backward-char) ; left
542 542
543 (define-key map [kp-f2] 'tpu-help) ; PF2 543 (define-key map [kp-f2] 'tpu-help) ; PF2
544 (define-key map [kp-f3] 'tpu-search-again) ; PF3 544 (define-key map [kp-f3] 'tpu-search-again) ; PF3
545 (define-key map [kp-f4] 'tpu-delete-current-line) ; PF4 545 (define-key map [kp-f4] 'tpu-delete-current-line) ; PF4
546 (define-key map [kp-0] 'tpu-line) ; KP0 546 (define-key map [kp-0] 'tpu-line) ; KP0
547 (define-key map [kp-1] 'tpu-word) ; KP1 547 (define-key map [kp-1] 'tpu-word) ; KP1
548 (define-key map [kp-2] 'tpu-end-of-line) ; KP2 548 (define-key map [kp-2] 'tpu-end-of-line) ; KP2
549 (define-key map [kp-3] 'tpu-char) ; KP3 549 (define-key map [kp-3] 'tpu-char) ; KP3
550 (define-key map [kp-4] 'tpu-advance-direction) ; KP4 550 (define-key map [kp-4] 'tpu-advance-direction) ; KP4
551 (define-key map [kp-5] 'tpu-backup-direction) ; KP5 551 (define-key map [kp-5] 'tpu-backup-direction) ; KP5
552 (define-key map [kp-6] 'tpu-cut) ; KP6 552 (define-key map [kp-6] 'tpu-cut) ; KP6
553 (define-key map [kp-7] 'tpu-page) ; KP7 553 (define-key map [kp-7] 'tpu-page) ; KP7
554 (define-key map [kp-8] 'tpu-scroll-window) ; KP8 554 (define-key map [kp-8] 'tpu-scroll-window) ; KP8
555 (define-key map [kp-9] 'tpu-append-region) ; KP9 555 (define-key map [kp-9] 'tpu-append-region) ; KP9
556 (define-key map [kp-subtract] 'tpu-delete-current-word) ; KP- 556 (define-key map [kp-subtract] 'tpu-delete-current-word) ; KP-
557 (define-key map [kp-separator] 'tpu-delete-current-char) ; KP, 557 (define-key map [kp-separator] 'tpu-delete-current-char) ; KP,
558 (define-key map [kp-decimal] 'tpu-select) ; KP. 558 (define-key map [kp-decimal] 'tpu-select) ; KP.
559 (define-key map [kp-enter] 'newline) ; KPenter 559 (define-key map [kp-enter] 'newline) ; KPenter
560 560
561 map) 561 map)
562 "TPU-edt global keymap.") 562 "TPU-edt global keymap.")
@@ -2225,8 +2225,8 @@ Accepts a prefix argument for the number of tpu-pan-columns to scroll."
2225;;; 2225;;;
2226;;; Minibuffer map additions to set search direction 2226;;; Minibuffer map additions to set search direction
2227;;; 2227;;;
2228(define-key minibuffer-local-map "\eOt" 'tpu-search-forward-exit) ;KP4 2228(define-key minibuffer-local-map [kp-4] 'tpu-search-forward-exit) ;KP4
2229(define-key minibuffer-local-map "\eOu" 'tpu-search-backward-exit) ;KP5 2229(define-key minibuffer-local-map [kp-5] 'tpu-search-backward-exit) ;KP5
2230 2230
2231 2231
2232;;; 2232;;;
@@ -2428,6 +2428,33 @@ If FILE is nil, try to load a default file. The default file names are
2428 (ad-disable-regexp "\\`tpu-") 2428 (ad-disable-regexp "\\`tpu-")
2429 (setq tpu-edt-mode nil)) 2429 (setq tpu-edt-mode nil))
2430 2430
2431
2432;;;### (autoloads (tpu-set-cursor-bound tpu-set-cursor-free tpu-set-scroll-margins
2433;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "e0629234f1abe076917a303456b48329")
2434;;; Generated autoloads from tpu-extras.el
2435
2436(autoload 'tpu-cursor-free-mode "tpu-extras" "\
2437Minor mode to allow the cursor to move freely about the screen.
2438
2439\(fn &optional ARG)" t nil)
2440
2441(autoload 'tpu-set-scroll-margins "tpu-extras" "\
2442Set scroll margins.
2443
2444\(fn TOP BOTTOM)" t nil)
2445
2446(autoload 'tpu-set-cursor-free "tpu-extras" "\
2447Allow the cursor to move freely about the screen.
2448
2449\(fn)" t nil)
2450
2451(autoload 'tpu-set-cursor-bound "tpu-extras" "\
2452Constrain the cursor to the flow of the text.
2453
2454\(fn)" t nil)
2455
2456;;;***
2457
2431(provide 'tpu-edt) 2458(provide 'tpu-edt)
2432 2459
2433;; arch-tag: f3dfe61c-2cbd-4f73-b9cc-eb215020b857 2460;; arch-tag: f3dfe61c-2cbd-4f73-b9cc-eb215020b857
diff --git a/lisp/emulation/tpu-extras.el b/lisp/emulation/tpu-extras.el
index 609ce2e203b..062082a295a 100644
--- a/lisp/emulation/tpu-extras.el
+++ b/lisp/emulation/tpu-extras.el
@@ -112,18 +112,18 @@
112;;; Customization variables 112;;; Customization variables
113 113
114(defcustom tpu-top-scroll-margin 0 114(defcustom tpu-top-scroll-margin 0
115 "*Scroll margin at the top of the screen. 115 "Scroll margin at the top of the screen.
116Interpreted as a percent of the current window size." 116Interpreted as a percent of the current window size."
117 :type 'integer 117 :type 'integer
118 :group 'tpu) 118 :group 'tpu)
119(defcustom tpu-bottom-scroll-margin 0 119(defcustom tpu-bottom-scroll-margin 0
120 "*Scroll margin at the bottom of the screen. 120 "Scroll margin at the bottom of the screen.
121Interpreted as a percent of the current window size." 121Interpreted as a percent of the current window size."
122 :type 'integer 122 :type 'integer
123 :group 'tpu) 123 :group 'tpu)
124 124
125(defcustom tpu-backward-char-like-tpu t 125(defcustom tpu-backward-char-like-tpu t
126 "*If non-nil, in free cursor mode backward-char (left-arrow) works 126 "If non-nil, in free cursor mode backward-char (left-arrow) works
127just like TPU/edt. Otherwise, backward-char will move to the end of 127just like TPU/edt. Otherwise, backward-char will move to the end of
128the previous line when starting from a line beginning." 128the previous line when starting from a line beginning."
129 :type 'boolean 129 :type 'boolean
@@ -132,8 +132,12 @@ the previous line when starting from a line beginning."
132 132
133;;; Global variables 133;;; Global variables
134 134
135(defvar tpu-cursor-free nil 135;;;###autoload
136 "If non-nil, let the cursor roam free.") 136(define-minor-mode tpu-cursor-free-mode
137 "Minor mode to allow the cursor to move freely about the screen."
138 :init-value nil
139 (if (not tpu-cursor-free-mode)
140 (tpu-trim-line-ends)))
137 141
138 142
139;;; Hooks -- Set cursor free in picture mode. 143;;; Hooks -- Set cursor free in picture mode.
@@ -141,11 +145,10 @@ the previous line when starting from a line beginning."
141 145
142(add-hook 'picture-mode-hook 'tpu-set-cursor-free) 146(add-hook 'picture-mode-hook 'tpu-set-cursor-free)
143 147
144(defun tpu-before-save-hook () 148(defun tpu-trim-line-ends-if-needed ()
145 "Eliminate whitespace at ends of lines, if the cursor is free." 149 "Eliminate whitespace at ends of lines, if the cursor is free."
146 (if (and (buffer-modified-p) tpu-cursor-free) (tpu-trim-line-ends))) 150 (if (and (buffer-modified-p) tpu-cursor-free-mode) (tpu-trim-line-ends)))
147 151(add-hook 'before-save-hook 'tpu-trim-line-ends-if-needed)
148(add-hook 'before-save-hook 'tpu-before-save-hook)
149 152
150 153
151;;; Utility routines for implementing scroll margins 154;;; Utility routines for implementing scroll margins
@@ -171,12 +174,12 @@ the previous line when starting from a line beginning."
171(defun tpu-forward-char (num) 174(defun tpu-forward-char (num)
172 "Move right ARG characters (left if ARG is negative)." 175 "Move right ARG characters (left if ARG is negative)."
173 (interactive "p") 176 (interactive "p")
174 (if tpu-cursor-free (picture-forward-column num) (forward-char num))) 177 (if tpu-cursor-free-mode (picture-forward-column num) (forward-char num)))
175 178
176(defun tpu-backward-char (num) 179(defun tpu-backward-char (num)
177 "Move left ARG characters (right if ARG is negative)." 180 "Move left ARG characters (right if ARG is negative)."
178 (interactive "p") 181 (interactive "p")
179 (cond ((not tpu-cursor-free) 182 (cond ((not tpu-cursor-free-mode)
180 (backward-char num)) 183 (backward-char num))
181 (tpu-backward-char-like-tpu 184 (tpu-backward-char-like-tpu
182 (picture-backward-column num)) 185 (picture-backward-column num))
@@ -195,8 +198,8 @@ the previous line when starting from a line beginning."
195Prefix argument serves as a repeat count." 198Prefix argument serves as a repeat count."
196 (interactive "p") 199 (interactive "p")
197 (let ((beg (tpu-current-line))) 200 (let ((beg (tpu-current-line)))
198 (if tpu-cursor-free (or (eobp) (picture-move-down num)) 201 (if tpu-cursor-free-mode (or (eobp) (picture-move-down num))
199 (next-line-internal num)) 202 (line-move num))
200 (tpu-bottom-check beg num) 203 (tpu-bottom-check beg num)
201 (setq this-command 'next-line))) 204 (setq this-command 'next-line)))
202 205
@@ -205,7 +208,7 @@ Prefix argument serves as a repeat count."
205Prefix argument serves as a repeat count." 208Prefix argument serves as a repeat count."
206 (interactive "p") 209 (interactive "p")
207 (let ((beg (tpu-current-line))) 210 (let ((beg (tpu-current-line)))
208 (if tpu-cursor-free (picture-move-up num) (next-line-internal (- num))) 211 (if tpu-cursor-free-mode (picture-move-up num) (line-move (- num)))
209 (tpu-top-check beg num) 212 (tpu-top-check beg num)
210 (setq this-command 'previous-line))) 213 (setq this-command 'previous-line)))
211 214
@@ -223,7 +226,7 @@ Accepts a prefix argument for the number of lines to move."
223Accepts a prefix argument for the number of lines to move." 226Accepts a prefix argument for the number of lines to move."
224 (interactive "p") 227 (interactive "p")
225 (let ((beg (tpu-current-line))) 228 (let ((beg (tpu-current-line)))
226 (cond (tpu-cursor-free 229 (cond (tpu-cursor-free-mode
227 (let ((beg (point))) 230 (let ((beg (point)))
228 (if (< 1 num) (forward-line num)) 231 (if (< 1 num) (forward-line num))
229 (picture-end-of-line) 232 (picture-end-of-line)
@@ -238,7 +241,7 @@ Accepts a prefix argument for the number of lines to move."
238Accepts a prefix argument for the number of lines to move." 241Accepts a prefix argument for the number of lines to move."
239 (interactive "p") 242 (interactive "p")
240 (let ((beg (tpu-current-line))) 243 (let ((beg (tpu-current-line)))
241 (cond (tpu-cursor-free 244 (cond (tpu-cursor-free-mode
242 (picture-end-of-line (- 1 num))) 245 (picture-end-of-line (- 1 num)))
243 (t 246 (t
244 (end-of-line (- 1 num)))) 247 (end-of-line (- 1 num))))
@@ -248,7 +251,7 @@ Accepts a prefix argument for the number of lines to move."
248 "Move point to end of current line." 251 "Move point to end of current line."
249 (interactive) 252 (interactive)
250 (let ((beg (point))) 253 (let ((beg (point)))
251 (if tpu-cursor-free (picture-end-of-line) (end-of-line)) 254 (if tpu-cursor-free-mode (picture-end-of-line) (end-of-line))
252 (if (= beg (point)) (message "You are already at the end of a line.")))) 255 (if (= beg (point)) (message "You are already at the end of a line."))))
253 256
254(defun tpu-forward-line (num) 257(defun tpu-forward-line (num)
@@ -256,9 +259,8 @@ Accepts a prefix argument for the number of lines to move."
256Prefix argument serves as a repeat count." 259Prefix argument serves as a repeat count."
257 (interactive "p") 260 (interactive "p")
258 (let ((beg (tpu-current-line))) 261 (let ((beg (tpu-current-line)))
259 (next-line-internal num) 262 (forward-line num)
260 (tpu-bottom-check beg num) 263 (tpu-bottom-check beg num)))
261 (beginning-of-line)))
262 264
263(defun tpu-backward-line (num) 265(defun tpu-backward-line (num)
264 "Move to beginning of previous line. 266 "Move to beginning of previous line.
@@ -266,9 +268,8 @@ Prefix argument serves as repeat count."
266 (interactive "p") 268 (interactive "p")
267 (let ((beg (tpu-current-line))) 269 (let ((beg (tpu-current-line)))
268 (or (bolp) (>= 0 num) (setq num (- num 1))) 270 (or (bolp) (>= 0 num) (setq num (- num 1)))
269 (next-line-internal (- num)) 271 (forward-line (- num))
270 (tpu-top-check beg num) 272 (tpu-top-check beg num)))
271 (beginning-of-line)))
272 273
273 274
274;;; Movement by paragraph 275;;; Movement by paragraph
@@ -346,7 +347,7 @@ A repeat count means scroll that many sections."
346 (let* ((beg (tpu-current-line)) 347 (let* ((beg (tpu-current-line))
347 (height (1- (window-height))) 348 (height (1- (window-height)))
348 (lines (* num (/ (* height tpu-percent-scroll) 100)))) 349 (lines (* num (/ (* height tpu-percent-scroll) 100))))
349 (next-line-internal (- lines)) 350 (line-move (- lines))
350 (tpu-top-check beg lines))) 351 (tpu-top-check beg lines)))
351 352
352(defun tpu-scroll-window-up (num) 353(defun tpu-scroll-window-up (num)
@@ -356,7 +357,7 @@ A repeat count means scroll that many sections."
356 (let* ((beg (tpu-current-line)) 357 (let* ((beg (tpu-current-line))
357 (height (1- (window-height))) 358 (height (1- (window-height)))
358 (lines (* num (/ (* height tpu-percent-scroll) 100)))) 359 (lines (* num (/ (* height tpu-percent-scroll) 100))))
359 (next-line-internal lines) 360 (line-move lines)
360 (tpu-bottom-check beg lines))) 361 (tpu-bottom-check beg lines)))
361 362
362 363
@@ -448,22 +449,19 @@ A repeat count means scroll that many sections."
448(defun tpu-set-cursor-free () 449(defun tpu-set-cursor-free ()
449 "Allow the cursor to move freely about the screen." 450 "Allow the cursor to move freely about the screen."
450 (interactive) 451 (interactive)
451 (setq tpu-cursor-free t) 452 (tpu-cursor-free-mode 1)
452 (substitute-key-definition 'tpu-set-cursor-free
453 'tpu-set-cursor-bound
454 GOLD-map)
455 (message "The cursor will now move freely about the screen.")) 453 (message "The cursor will now move freely about the screen."))
456 454
457;;;###autoload 455;;;###autoload
458(defun tpu-set-cursor-bound () 456(defun tpu-set-cursor-bound ()
459 "Constrain the cursor to the flow of the text." 457 "Constrain the cursor to the flow of the text."
460 (interactive) 458 (interactive)
461 (tpu-trim-line-ends) 459 (tpu-cursor-free-mode -1)
462 (setq tpu-cursor-free nil)
463 (substitute-key-definition 'tpu-set-cursor-bound
464 'tpu-set-cursor-free
465 GOLD-map)
466 (message "The cursor is now bound to the flow of your text.")) 460 (message "The cursor is now bound to the flow of your text."))
467 461
462;; Local Variables:
463;; generated-autoload-file: "tpu-edt.el"
464;; End:
465
468;; arch-tag: 89676fa4-33ec-48cb-9135-6f3bf230ab1a 466;; arch-tag: 89676fa4-33ec-48cb-9135-6f3bf230ab1a
469;;; tpu-extras.el ends here 467;;; tpu-extras.el ends here
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index 8dd22e9ea1f..82dc312cf28 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -1116,7 +1116,7 @@ as a Meta key and any number of multiple escapes is allowed."
1116 "Function that implements ESC key in Viper emulation of Vi." 1116 "Function that implements ESC key in Viper emulation of Vi."
1117 (interactive) 1117 (interactive)
1118 (let ((cmd (or (key-binding (viper-envelop-ESC-key)) 1118 (let ((cmd (or (key-binding (viper-envelop-ESC-key))
1119 '(lambda () (interactive) (error ""))))) 1119 '(lambda () (interactive) (error "Viper bell")))))
1120 1120
1121 ;; call the actual function to execute ESC (if no other symbols followed) 1121 ;; call the actual function to execute ESC (if no other symbols followed)
1122 ;; or the key bound to the ESC sequence (if the sequence was issued 1122 ;; or the key bound to the ESC sequence (if the sequence was issued
@@ -1238,7 +1238,7 @@ as a Meta key and any number of multiple escapes is allowed."
1238 ;; it is an error. 1238 ;; it is an error.
1239 (progn 1239 (progn
1240 ;; new com is (CHAR . OLDCOM) 1240 ;; new com is (CHAR . OLDCOM)
1241 (if (viper-memq-char char '(?# ?\")) (error "")) 1241 (if (viper-memq-char char '(?# ?\")) (error "Viper bell"))
1242 (setq com (cons char com)) 1242 (setq com (cons char com))
1243 (setq cont nil)) 1243 (setq cont nil))
1244 ;; If com is nil we set com as char, and read more. Again, if char is 1244 ;; If com is nil we set com as char, and read more. Again, if char is
@@ -1257,7 +1257,7 @@ as a Meta key and any number of multiple escapes is allowed."
1257 (let ((reg (read-char))) 1257 (let ((reg (read-char)))
1258 (if (viper-valid-register reg) 1258 (if (viper-valid-register reg)
1259 (setq viper-use-register reg) 1259 (setq viper-use-register reg)
1260 (error "")) 1260 (error "Viper bell"))
1261 (setq char (read-char)))) 1261 (setq char (read-char))))
1262 (t 1262 (t
1263 (setq com char) 1263 (setq com char)
@@ -1279,7 +1279,7 @@ as a Meta key and any number of multiple escapes is allowed."
1279 (viper-regsuffix-command-p char) 1279 (viper-regsuffix-command-p char)
1280 (viper= char ?!) ; bang command 1280 (viper= char ?!) ; bang command
1281 (viper= char ?g) ; the gg command (like G0) 1281 (viper= char ?g) ; the gg command (like G0)
1282 (error "")) 1282 (error "Viper bell"))
1283 (setq cmd-to-exec-at-end 1283 (setq cmd-to-exec-at-end
1284 (viper-exec-form-in-vi 1284 (viper-exec-form-in-vi
1285 `(key-binding (char-to-string ,char))))) 1285 `(key-binding (char-to-string ,char)))))
@@ -1313,7 +1313,7 @@ as a Meta key and any number of multiple escapes is allowed."
1313 ((equal com '(?= . ?=)) (viper-line (cons value ?=))) 1313 ((equal com '(?= . ?=)) (viper-line (cons value ?=)))
1314 ;; gg acts as G0 1314 ;; gg acts as G0
1315 ((equal (car com) ?g) (viper-goto-line 0)) 1315 ((equal (car com) ?g) (viper-goto-line 0))
1316 (t (error ""))))) 1316 (t (error "Viper bell")))))
1317 1317
1318 (if cmd-to-exec-at-end 1318 (if cmd-to-exec-at-end
1319 (progn 1319 (progn
@@ -2738,9 +2738,9 @@ On reaching end of line, stop and signal error."
2738 ;; the forward motion before the 'viper-execute-com', but, of 2738 ;; the forward motion before the 'viper-execute-com', but, of
2739 ;; course, 'dl' doesn't work on an empty line, so we have to 2739 ;; course, 'dl' doesn't work on an empty line, so we have to
2740 ;; catch that condition before 'viper-execute-com' 2740 ;; catch that condition before 'viper-execute-com'
2741 (if (and (eolp) (bolp)) (error "") (forward-char val)) 2741 (if (and (eolp) (bolp)) (error "Viper bell") (forward-char val))
2742 (if com (viper-execute-com 'viper-forward-char val com)) 2742 (if com (viper-execute-com 'viper-forward-char val com))
2743 (if (eolp) (progn (backward-char 1) (error "")))) 2743 (if (eolp) (progn (backward-char 1) (error "Viper bell"))))
2744 (forward-char val) 2744 (forward-char val)
2745 (if com (viper-execute-com 'viper-forward-char val com))))) 2745 (if com (viper-execute-com 'viper-forward-char val com)))))
2746 2746
@@ -2755,7 +2755,7 @@ On reaching beginning of line, stop and signal error."
2755 (if com (viper-move-marker-locally 'viper-com-point (point))) 2755 (if com (viper-move-marker-locally 'viper-com-point (point)))
2756 (if viper-ex-style-motion 2756 (if viper-ex-style-motion
2757 (progn 2757 (progn
2758 (if (bolp) (error "") (backward-char val)) 2758 (if (bolp) (error "Viper bell") (backward-char val))
2759 (if com (viper-execute-com 'viper-backward-char val com))) 2759 (if com (viper-execute-com 'viper-backward-char val com)))
2760 (backward-char val) 2760 (backward-char val)
2761 (if com (viper-execute-com 'viper-backward-char val com))))) 2761 (if com (viper-execute-com 'viper-backward-char val com)))))
@@ -3078,7 +3078,7 @@ On reaching beginning of line, stop and signal error."
3078 (if com (viper-execute-com 'viper-goto-col val com)) 3078 (if com (viper-execute-com 'viper-goto-col val com))
3079 (save-excursion 3079 (save-excursion
3080 (end-of-line) 3080 (end-of-line)
3081 (if (> val (current-column)) (error ""))) 3081 (if (> val (current-column)) (error "Viper bell")))
3082 )) 3082 ))
3083 3083
3084 3084
@@ -3198,7 +3198,7 @@ If point is on a widget or a button, simulate clicking on that widget/button."
3198;; If FORWARD then search is forward, otherwise backward. OFFSET is used to 3198;; If FORWARD then search is forward, otherwise backward. OFFSET is used to
3199;; adjust point after search. 3199;; adjust point after search.
3200(defun viper-find-char (arg char forward offset) 3200(defun viper-find-char (arg char forward offset)
3201 (or (char-or-string-p char) (error "")) 3201 (or (char-or-string-p char) (error "Viper bell"))
3202 (let ((arg (if forward arg (- arg))) 3202 (let ((arg (if forward arg (- arg)))
3203 (cmd (if (eq viper-intermediate-command 'viper-repeat) 3203 (cmd (if (eq viper-intermediate-command 'viper-repeat)
3204 (nth 5 viper-d-com) 3204 (nth 5 viper-d-com)
@@ -3544,7 +3544,7 @@ controlled by the sign of prefix numeric value."
3544 (if com (viper-move-marker-locally 'viper-com-point (point))) 3544 (if com (viper-move-marker-locally 'viper-com-point (point)))
3545 (backward-sexp 1) 3545 (backward-sexp 1)
3546 (if com (viper-execute-com 'viper-paren-match nil com))) 3546 (if com (viper-execute-com 'viper-paren-match nil com)))
3547 (t (error "")))))) 3547 (t (error "Viper bell"))))))
3548 3548
3549(defun viper-toggle-parse-sexp-ignore-comments () 3549(defun viper-toggle-parse-sexp-ignore-comments ()
3550 (interactive) 3550 (interactive)
@@ -4107,7 +4107,7 @@ Null string will repeat previous search."
4107 (let ((reg viper-use-register)) 4107 (let ((reg viper-use-register))
4108 (setq viper-use-register nil) 4108 (setq viper-use-register nil)
4109 (error viper-EmptyRegister reg)) 4109 (error viper-EmptyRegister reg))
4110 (error ""))) 4110 (error "Viper bell")))
4111 (setq viper-use-register nil) 4111 (setq viper-use-register nil)
4112 (if (viper-end-with-a-newline-p text) 4112 (if (viper-end-with-a-newline-p text)
4113 (progn 4113 (progn
@@ -4157,7 +4157,7 @@ Null string will repeat previous search."
4157 (let ((reg viper-use-register)) 4157 (let ((reg viper-use-register))
4158 (setq viper-use-register nil) 4158 (setq viper-use-register nil)
4159 (error viper-EmptyRegister reg)) 4159 (error viper-EmptyRegister reg))
4160 (error ""))) 4160 (error "Viper bell")))
4161 (setq viper-use-register nil) 4161 (setq viper-use-register nil)
4162 (if (viper-end-with-a-newline-p text) (beginning-of-line)) 4162 (if (viper-end-with-a-newline-p text) (beginning-of-line))
4163 (viper-set-destructive-command 4163 (viper-set-destructive-command
@@ -4202,7 +4202,7 @@ Null string will repeat previous search."
4202 (> val (viper-chars-in-region (point) (viper-line-pos 'end)))) 4202 (> val (viper-chars-in-region (point) (viper-line-pos 'end))))
4203 (setq val (viper-chars-in-region (point) (viper-line-pos 'end)))) 4203 (setq val (viper-chars-in-region (point) (viper-line-pos 'end))))
4204 (if (and viper-ex-style-motion (eolp)) 4204 (if (and viper-ex-style-motion (eolp))
4205 (if (bolp) (error "") (setq val 0))) ; not bol---simply back 1 ch 4205 (if (bolp) (error "Viper bell") (setq val 0))) ; not bol---simply back 1 ch
4206 (save-excursion 4206 (save-excursion
4207 (viper-forward-char-carefully val) 4207 (viper-forward-char-carefully val)
4208 (setq end-del-pos (point))) 4208 (setq end-del-pos (point)))
@@ -4467,7 +4467,7 @@ and regexp replace."
4467 ((viper= char ?,) (viper-cycle-through-mark-ring)) 4467 ((viper= char ?,) (viper-cycle-through-mark-ring))
4468 ((viper= char ?^) (push-mark viper-saved-mark t t)) 4468 ((viper= char ?^) (push-mark viper-saved-mark t t))
4469 ((viper= char ?D) (mark-defun)) 4469 ((viper= char ?D) (mark-defun))
4470 (t (error "")) 4470 (t (error "Viper bell"))
4471 ))) 4471 )))
4472 4472
4473;; Algorithm: If first invocation of this command save mark on ring, goto 4473;; Algorithm: If first invocation of this command save mark on ring, goto
@@ -4566,7 +4566,7 @@ One can use `` and '' to temporarily jump 1 step back."
4566 (switch-to-buffer buff) 4566 (switch-to-buffer buff)
4567 (goto-char viper-com-point) 4567 (goto-char viper-com-point)
4568 (viper-change-state-to-vi) 4568 (viper-change-state-to-vi)
4569 (error ""))))) 4569 (error "Viper bell")))))
4570 ((and (not skip-white) (viper= char ?`)) 4570 ((and (not skip-white) (viper= char ?`))
4571 (if com (viper-move-marker-locally 'viper-com-point (point))) 4571 (if com (viper-move-marker-locally 'viper-com-point (point)))
4572 (if (and (viper-same-line (point) viper-last-jump) 4572 (if (and (viper-same-line (point) viper-last-jump)
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el
index fda882ae6a2..627d2ff1814 100644
--- a/lisp/emulation/viper-ex.el
+++ b/lisp/emulation/viper-ex.el
@@ -1236,7 +1236,7 @@ reversed."
1236 (read-string "[Hit return to confirm] ") 1236 (read-string "[Hit return to confirm] ")
1237 (quit 1237 (quit
1238 (save-excursion (kill-buffer " *delete text*")) 1238 (save-excursion (kill-buffer " *delete text*"))
1239 (error ""))) 1239 (error "Viper bell")))
1240 (save-excursion (kill-buffer " *delete text*"))) 1240 (save-excursion (kill-buffer " *delete text*")))
1241 (if ex-buffer 1241 (if ex-buffer
1242 (cond ((viper-valid-register ex-buffer '(Letter)) 1242 (cond ((viper-valid-register ex-buffer '(Letter))
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 63cafb4a734..ff3217ac144 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -9,7 +9,7 @@
9;; Author: Michael Kifer <kifer@cs.stonybrook.edu> 9;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
10;; Keywords: emulations 10;; Keywords: emulations
11 11
12(defconst viper-version "3.14 of June 14, 2007" 12(defconst viper-version "3.14 of August 18, 2007"
13 "The current version of Viper") 13 "The current version of Viper")
14 14
15;; This file is part of GNU Emacs. 15;; This file is part of GNU Emacs.
@@ -646,6 +646,11 @@ This startup message appears whenever you load Viper, unless you type `y' now."
646 (remove-hook symbol 'viper-change-state-to-emacs) 646 (remove-hook symbol 'viper-change-state-to-emacs)
647 (remove-hook symbol 'viper-change-state-to-insert) 647 (remove-hook symbol 'viper-change-state-to-insert)
648 (remove-hook symbol 'viper-change-state-to-vi) 648 (remove-hook symbol 'viper-change-state-to-vi)
649 (remove-hook symbol 'viper-minibuffer-post-command-hook)
650 (remove-hook symbol 'viper-minibuffer-setup-sentinel)
651 (remove-hook symbol 'viper-major-mode-change-sentinel)
652 (remove-hook symbol 'set-viper-state-in-major-mode)
653 (remove-hook symbol 'viper-post-command-sentinel)
649 ))) 654 )))
650 655
651;; Remove local value in all existing buffers 656;; Remove local value in all existing buffers
@@ -682,6 +687,9 @@ It also can't undo some Viper settings."
682 global-mode-string 687 global-mode-string
683 (delq 'viper-mode-string global-mode-string)) 688 (delq 'viper-mode-string global-mode-string))
684 689
690 (setq default-major-mode
691 (viper-standard-value 'default-major-mode viper-saved-non-viper-variables))
692
685 (if viper-emacs-p 693 (if viper-emacs-p
686 (setq-default 694 (setq-default
687 mark-even-if-inactive 695 mark-even-if-inactive
@@ -772,9 +780,7 @@ It also can't undo some Viper settings."
772 (mapatoms 'viper-remove-hooks) 780 (mapatoms 'viper-remove-hooks)
773 (remove-hook 'comint-mode-hook 'viper-comint-mode-hook) 781 (remove-hook 'comint-mode-hook 'viper-comint-mode-hook)
774 (remove-hook 'erc-mode-hook 'viper-comint-mode-hook) 782 (remove-hook 'erc-mode-hook 'viper-comint-mode-hook)
775 (remove-hook 'minibuffer-setup-hook 'viper-minibuffer-setup-sentinel)
776 (remove-hook 'change-major-mode-hook 'viper-major-mode-change-sentinel) 783 (remove-hook 'change-major-mode-hook 'viper-major-mode-change-sentinel)
777 (remove-hook 'post-command-hook 'viper-minibuffer-post-command-hook)
778 784
779 ;; unbind Viper mouse bindings 785 ;; unbind Viper mouse bindings
780 (viper-unbind-mouse-search-key) 786 (viper-unbind-mouse-search-key)
@@ -1214,6 +1220,7 @@ These two lines must come in the order given.
1214(if (null viper-saved-non-viper-variables) 1220(if (null viper-saved-non-viper-variables)
1215 (setq viper-saved-non-viper-variables 1221 (setq viper-saved-non-viper-variables
1216 (list 1222 (list
1223 (cons 'default-major-mode (list default-major-mode))
1217 (cons 'next-line-add-newlines (list next-line-add-newlines)) 1224 (cons 'next-line-add-newlines (list next-line-add-newlines))
1218 (cons 'require-final-newline (list require-final-newline)) 1225 (cons 'require-final-newline (list require-final-newline))
1219 (cons 'scroll-step (list scroll-step)) 1226 (cons 'scroll-step (list scroll-step))
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 7fd187a4aeb..201b7fefdcb 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,19 @@
12007-08-17 Katsumi Yamaoka <yamaoka@jpl.org>
2
3 * gnus-art.el (gnus-article-summary-command-nosave)
4 (gnus-article-read-summary-keys): Don't use 3rd arg of pop-to-buffer.
5
62007-08-14 Katsumi Yamaoka <yamaoka@jpl.org>
7
8 * gnus.el (gnus-maximum-newsgroup): New variable.
9
10 * gnus-agent.el (gnus-agent-fetch-headers): Limit the range of articles
11 according to gnus-maximum-newsgroup.
12
13 * gnus-sum.el (gnus-articles-to-read, gnus-list-of-unread-articles)
14 (gnus-list-of-read-articles, gnus-sequence-of-unread-articles): Limit
15 the range of articles according to gnus-maximum-newsgroup.
16
12007-08-10 Katsumi Yamaoka <yamaoka@jpl.org> 172007-08-10 Katsumi Yamaoka <yamaoka@jpl.org>
2 18
3 * nntp.el (nntp-xref-number-is-evil): New server variable. 19 * nntp.el (nntp-xref-number-is-evil): New server variable.
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 7b98b1e045a..347b57983e6 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -1765,7 +1765,14 @@ article numbers will be returned."
1765 (gnus-agent-find-parameter group 1765 (gnus-agent-find-parameter group
1766 'agent-predicate))))) 1766 'agent-predicate)))))
1767 (articles (if fetch-all 1767 (articles (if fetch-all
1768 (gnus-uncompress-range (gnus-active group)) 1768 (if gnus-maximum-newsgroup
1769 (let ((active (gnus-active group)))
1770 (gnus-uncompress-range
1771 (cons (max (car active)
1772 (- (cdr active)
1773 gnus-maximum-newsgroup -1))
1774 (cdr active))))
1775 (gnus-uncompress-range (gnus-active group)))
1769 (gnus-list-of-unread-articles group))) 1776 (gnus-list-of-unread-articles group)))
1770 (gnus-decode-encoded-word-function 'identity) 1777 (gnus-decode-encoded-word-function 'identity)
1771 (gnus-decode-encoded-address-function 'identity) 1778 (gnus-decode-encoded-address-function 'identity)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 6ccba3b108f..696222e0043 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -5607,7 +5607,7 @@ not have a face in `gnus-article-boring-faces'."
5607 "Execute the last keystroke in the summary buffer." 5607 "Execute the last keystroke in the summary buffer."
5608 (interactive) 5608 (interactive)
5609 (let (func) 5609 (let (func)
5610 (pop-to-buffer gnus-article-current-summary nil (not (featurep 'xemacs))) 5610 (pop-to-buffer gnus-article-current-summary)
5611 (setq func (lookup-key (current-local-map) (this-command-keys))) 5611 (setq func (lookup-key (current-local-map) (this-command-keys)))
5612 (call-interactively func))) 5612 (call-interactively func)))
5613 5613
@@ -5646,8 +5646,7 @@ not have a face in `gnus-article-boring-faces'."
5646 (member keys nosave-in-article)) 5646 (member keys nosave-in-article))
5647 (let (func) 5647 (let (func)
5648 (save-window-excursion 5648 (save-window-excursion
5649 (pop-to-buffer gnus-article-current-summary 5649 (pop-to-buffer gnus-article-current-summary)
5650 nil (not (featurep 'xemacs)))
5651 ;; We disable the pick minor mode commands. 5650 ;; We disable the pick minor mode commands.
5652 (let (gnus-pick-mode) 5651 (let (gnus-pick-mode)
5653 (setq func (lookup-key (current-local-map) keys)))) 5652 (setq func (lookup-key (current-local-map) keys))))
@@ -5659,16 +5658,14 @@ not have a face in `gnus-article-boring-faces'."
5659 (call-interactively func) 5658 (call-interactively func)
5660 (setq new-sum-point (point))) 5659 (setq new-sum-point (point)))
5661 (when (member keys nosave-but-article) 5660 (when (member keys nosave-but-article)
5662 (pop-to-buffer gnus-article-buffer 5661 (pop-to-buffer gnus-article-buffer)))
5663 nil (not (featurep 'xemacs)))))
5664 ;; These commands should restore window configuration. 5662 ;; These commands should restore window configuration.
5665 (let ((obuf (current-buffer)) 5663 (let ((obuf (current-buffer))
5666 (owin (current-window-configuration)) 5664 (owin (current-window-configuration))
5667 (opoint (point)) 5665 (opoint (point))
5668 win func in-buffer selected new-sum-start new-sum-hscroll) 5666 win func in-buffer selected new-sum-start new-sum-hscroll)
5669 (cond (not-restore-window 5667 (cond (not-restore-window
5670 (pop-to-buffer gnus-article-current-summary 5668 (pop-to-buffer gnus-article-current-summary))
5671 nil (not (featurep 'xemacs))))
5672 ((setq win (get-buffer-window gnus-article-current-summary)) 5669 ((setq win (get-buffer-window gnus-article-current-summary))
5673 (select-window win)) 5670 (select-window win))
5674 (t 5671 (t
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 708689fef9e..851ec88c96f 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -5472,7 +5472,13 @@ If SELECT-ARTICLES, only select those articles from GROUP."
5472 ;; articles in the group, or (if that's nil), the 5472 ;; articles in the group, or (if that's nil), the
5473 ;; articles in the cache. 5473 ;; articles in the cache.
5474 (or 5474 (or
5475 (gnus-uncompress-range (gnus-active group)) 5475 (if gnus-maximum-newsgroup
5476 (let ((active (gnus-active group)))
5477 (gnus-uncompress-range
5478 (cons (max (car active)
5479 (- (cdr active) gnus-maximum-newsgroup -1))
5480 (cdr active))))
5481 (gnus-uncompress-range (gnus-active group)))
5476 (gnus-cache-articles-in-group group)) 5482 (gnus-cache-articles-in-group group))
5477 ;; Select only the "normal" subset of articles. 5483 ;; Select only the "normal" subset of articles.
5478 (gnus-sorted-nunion 5484 (gnus-sorted-nunion
@@ -6534,23 +6540,26 @@ displayed, no centering will be performed."
6534 (let* ((read (gnus-info-read (gnus-get-info group))) 6540 (let* ((read (gnus-info-read (gnus-get-info group)))
6535 (active (or (gnus-active group) (gnus-activate-group group))) 6541 (active (or (gnus-active group) (gnus-activate-group group)))
6536 (last (cdr active)) 6542 (last (cdr active))
6543 (bottom (if gnus-maximum-newsgroup
6544 (max (car active) (- last gnus-maximum-newsgroup -1))
6545 (car active)))
6537 first nlast unread) 6546 first nlast unread)
6538 ;; If none are read, then all are unread. 6547 ;; If none are read, then all are unread.
6539 (if (not read) 6548 (if (not read)
6540 (setq first (car active)) 6549 (setq first bottom)
6541 ;; If the range of read articles is a single range, then the 6550 ;; If the range of read articles is a single range, then the
6542 ;; first unread article is the article after the last read 6551 ;; first unread article is the article after the last read
6543 ;; article. Sounds logical, doesn't it? 6552 ;; article. Sounds logical, doesn't it?
6544 (if (and (not (listp (cdr read))) 6553 (if (and (not (listp (cdr read)))
6545 (or (< (car read) (car active)) 6554 (or (< (car read) bottom)
6546 (progn (setq read (list read)) 6555 (progn (setq read (list read))
6547 nil))) 6556 nil)))
6548 (setq first (max (car active) (1+ (cdr read)))) 6557 (setq first (max bottom (1+ (cdr read))))
6549 ;; `read' is a list of ranges. 6558 ;; `read' is a list of ranges.
6550 (when (/= (setq nlast (or (and (numberp (car read)) (car read)) 6559 (when (/= (setq nlast (or (and (numberp (car read)) (car read))
6551 (caar read))) 6560 (caar read)))
6552 1) 6561 1)
6553 (setq first (car active))) 6562 (setq first bottom))
6554 (while read 6563 (while read
6555 (when first 6564 (when first
6556 (while (< first nlast) 6565 (while (< first nlast)
@@ -6575,7 +6584,12 @@ displayed, no centering will be performed."
6575 (gnus-list-range-difference 6584 (gnus-list-range-difference
6576 (gnus-list-range-difference 6585 (gnus-list-range-difference
6577 (gnus-sorted-complement 6586 (gnus-sorted-complement
6578 (gnus-uncompress-range active) 6587 (gnus-uncompress-range
6588 (if gnus-maximum-newsgroup
6589 (cons (max (car active)
6590 (- (cdr active) gnus-maximum-newsgroup -1))
6591 (cdr active))
6592 active))
6579 (gnus-list-of-unread-articles group)) 6593 (gnus-list-of-unread-articles group))
6580 (cdr (assq 'dormant marked))) 6594 (cdr (assq 'dormant marked)))
6581 (cdr (assq 'tick marked)))))) 6595 (cdr (assq 'tick marked))))))
@@ -6587,23 +6601,26 @@ displayed, no centering will be performed."
6587 (let* ((read (gnus-info-read (gnus-get-info group))) 6601 (let* ((read (gnus-info-read (gnus-get-info group)))
6588 (active (or (gnus-active group) (gnus-activate-group group))) 6602 (active (or (gnus-active group) (gnus-activate-group group)))
6589 (last (cdr active)) 6603 (last (cdr active))
6604 (bottom (if gnus-maximum-newsgroup
6605 (max (car active) (- last gnus-maximum-newsgroup -1))
6606 (car active)))
6590 first nlast unread) 6607 first nlast unread)
6591 ;; If none are read, then all are unread. 6608 ;; If none are read, then all are unread.
6592 (if (not read) 6609 (if (not read)
6593 (setq first (car active)) 6610 (setq first bottom)
6594 ;; If the range of read articles is a single range, then the 6611 ;; If the range of read articles is a single range, then the
6595 ;; first unread article is the article after the last read 6612 ;; first unread article is the article after the last read
6596 ;; article. Sounds logical, doesn't it? 6613 ;; article. Sounds logical, doesn't it?
6597 (if (and (not (listp (cdr read))) 6614 (if (and (not (listp (cdr read)))
6598 (or (< (car read) (car active)) 6615 (or (< (car read) bottom)
6599 (progn (setq read (list read)) 6616 (progn (setq read (list read))
6600 nil))) 6617 nil)))
6601 (setq first (max (car active) (1+ (cdr read)))) 6618 (setq first (max bottom (1+ (cdr read))))
6602 ;; `read' is a list of ranges. 6619 ;; `read' is a list of ranges.
6603 (when (/= (setq nlast (or (and (numberp (car read)) (car read)) 6620 (when (/= (setq nlast (or (and (numberp (car read)) (car read))
6604 (caar read))) 6621 (caar read)))
6605 1) 6622 1)
6606 (setq first (car active))) 6623 (setq first bottom))
6607 (while read 6624 (while read
6608 (when first 6625 (when first
6609 (push (cons first nlast) unread)) 6626 (push (cons first nlast) unread))
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 0e8e9908cf4..3f75bba6d1c 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1501,6 +1501,17 @@ If it is nil, no confirmation is required."
1501 :type '(choice (const :tag "No limit" nil) 1501 :type '(choice (const :tag "No limit" nil)
1502 integer)) 1502 integer))
1503 1503
1504(defcustom gnus-maximum-newsgroup nil
1505 "The maximum number of articles a newsgroup.
1506If this is a number, old articles in a newsgroup exceeding this number
1507are silently ignored. If it is nil, no article is ignored. Note that
1508setting this variable to a number might prevent you from reading very
1509old articles."
1510 :group 'gnus-group-select
1511 :version "22.2"
1512 :type '(choice (const :tag "No limit" nil)
1513 integer))
1514
1504(defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix))) 1515(defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
1505 "*Non-nil means that the default name of a file to save articles in is the group name. 1516 "*Non-nil means that the default name of a file to save articles in is the group name.
1506If it's nil, the directory form of the group name is used instead. 1517If it's nil, the directory form of the group name is used instead.
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index cfcad60c11a..70169615b0d 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -73,18 +73,27 @@ Prompts for bug subject. Leaves you in a mail buffer."
73 ;; This strange form ensures that (recent-keys) is the value before 73 ;; This strange form ensures that (recent-keys) is the value before
74 ;; the bug subject string is read. 74 ;; the bug subject string is read.
75 (interactive (reverse (list (recent-keys) (read-string "Bug Subject: ")))) 75 (interactive (reverse (list (recent-keys) (read-string "Bug Subject: "))))
76 ;; If there are four numbers in emacs-version, this is a pretest 76 ;; The syntax `version;' is preferred to `[version]' because the
77 ;; version. 77 ;; latter could be mistakenly stripped by mailing software.
78 (let* ((pretest-p (string-match "\\..*\\..*\\." emacs-version)) 78 (if (eq system-type 'ms-dos)
79 (from-buffer (current-buffer)) 79 (setq topic (concat emacs-version "; " topic))
80 (reporting-address (if pretest-p 80 (when (string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version)
81 report-emacs-bug-pretest-address 81 (setq topic (concat (match-string 1 emacs-version) "; " topic))))
82 report-emacs-bug-address)) 82 ;; If there are four numbers in emacs-version (three for MS-DOS),
83 ;; Put these properties on semantically-void text. 83 ;; this is a pretest version.
84 (prompt-properties '(field emacsbug-prompt 84 (let* ((pretest-p (string-match (if (eq system-type 'ms-dos)
85 intangible but-helpful 85 "\\..*\\."
86 rear-nonsticky t)) 86 "\\..*\\..*\\.")
87 user-point message-end-point) 87 emacs-version))
88 (from-buffer (current-buffer))
89 (reporting-address (if pretest-p
90 report-emacs-bug-pretest-address
91 report-emacs-bug-address))
92 ;; Put these properties on semantically-void text.
93 (prompt-properties '(field emacsbug-prompt
94 intangible but-helpful
95 rear-nonsticky t))
96 user-point message-end-point)
88 (setq message-end-point 97 (setq message-end-point
89 (with-current-buffer (get-buffer-create "*Messages*") 98 (with-current-buffer (get-buffer-create "*Messages*")
90 (point-max-marker))) 99 (point-max-marker)))
@@ -106,7 +115,7 @@ Prompts for bug subject. Leaves you in a mail buffer."
106 (let ((pos (point))) 115 (let ((pos (point)))
107 (insert "not to your local site managers!") 116 (insert "not to your local site managers!")
108 (put-text-property pos (point) 'face 'highlight))) 117 (put-text-property pos (point) 'face 'highlight)))
109 (insert "\nPlease write in ") 118 (insert "\nPlease write in ")
110 (let ((pos (point))) 119 (let ((pos (point)))
111 (insert "English") 120 (insert "English")
112 (put-text-property pos (point) 'face 'highlight)) 121 (put-text-property pos (point) 'face 'highlight))
@@ -132,8 +141,8 @@ usually do not have translators to read other languages for them.\n\n")
132 141
133 (let ((debug-file (expand-file-name "DEBUG" data-directory))) 142 (let ((debug-file (expand-file-name "DEBUG" data-directory)))
134 (if (file-readable-p debug-file) 143 (if (file-readable-p debug-file)
135 (insert "If you would like to further debug the crash, please read the file\n" 144 (insert "If you would like to further debug the crash, please read the file\n"
136 debug-file " for instructions.\n"))) 145 debug-file " for instructions.\n")))
137 (add-text-properties (1+ user-point) (point) prompt-properties) 146 (add-text-properties (1+ user-point) (point) prompt-properties)
138 147
139 (insert "\n\nIn " (emacs-version) "\n") 148 (insert "\n\nIn " (emacs-version) "\n")
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 2dd381fdafb..b2e697a247a 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -204,7 +204,7 @@ We do this by executing it with `--version' and analyzing its output."
204 'emacs)))))) 204 'emacs))))))
205 205
206(defun rmail-autodetect () 206(defun rmail-autodetect ()
207 "Determine and return the file name of the `movemail' program. 207 "Determine the file name of the `movemail' program and return its flavor.
208If `rmail-movemail-program' is non-nil, use it. 208If `rmail-movemail-program' is non-nil, use it.
209Otherwise, look for `movemail' in the directories in 209Otherwise, look for `movemail' in the directories in
210`rmail-movemail-search-path', those in `exec-path', and `exec-directory'." 210`rmail-movemail-search-path', those in `exec-path', and `exec-directory'."
diff --git a/lisp/mail/undigest.el b/lisp/mail/undigest.el
index 5b01f711176..5d6f266b3b0 100644
--- a/lisp/mail/undigest.el
+++ b/lisp/mail/undigest.el
@@ -93,7 +93,15 @@ See rmail-digest-methods."
93 (rmail-digest-rfc1153 93 (rmail-digest-rfc1153
94 "^-\\{55,\\}\n\n" 94 "^-\\{55,\\}\n\n"
95 "^\n-\\{27,\\}\n\n" 95 "^\n-\\{27,\\}\n\n"
96 "^\n-\\{27,\\}\n\nEnd of")) 96 ;; GNU Mailman knowingly (see comment at line 353 of ToDigest.py in
97 ;; Mailman source) produces non-conformant rfc 1153 digests, in that
98 ;; the trailer contains a "digest footer" like this:
99 ;; _______________________________________________
100 ;; <one or more lines of list blurb>
101 ;;
102 ;; End of Foo Digest...
103 ;; **************************************
104 "^\nEnd of"))
97 105
98(defun rmail-digest-rfc1153 (prolog-sep message-sep trailer-sep) 106(defun rmail-digest-rfc1153 (prolog-sep message-sep trailer-sep)
99 (goto-char (point-min)) 107 (goto-char (point-min))
@@ -104,7 +112,7 @@ See rmail-digest-methods."
104 separator result) 112 separator result)
105 (move-marker start (match-beginning 0)) 113 (move-marker start (match-beginning 0))
106 (move-marker end (match-end 0)) 114 (move-marker end (match-end 0))
107 (setq result (cons (copy-marker start) (copy-marker end t))) 115 (setq result (list (cons (copy-marker start) (copy-marker end t))))
108 (when (re-search-forward message-sep nil t) 116 (when (re-search-forward message-sep nil t)
109 ;; Ok, at least one message separator found 117 ;; Ok, at least one message separator found
110 (setq separator (match-string 0)) 118 (setq separator (match-string 0))
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 8bc0bd86a41..fcf11f05314 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -1381,7 +1381,7 @@ key, a click, or a menu-item"))
1381 data-directory)) 1381 data-directory))
1382 (goto-address))) 1382 (goto-address)))
1383(define-key menu-bar-help-menu [about] 1383(define-key menu-bar-help-menu [about]
1384 '(menu-item "About Emacs" display-splash-screen 1384 '(menu-item "About Emacs" about-emacs
1385 :help "Display version number, copyright info, and basic help")) 1385 :help "Display version number, copyright info, and basic help"))
1386(define-key menu-bar-help-menu [sep2] 1386(define-key menu-bar-help-menu [sep2]
1387 '("--")) 1387 '("--"))
diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog
index b7fe48ccd7c..45d0842c909 100644
--- a/lisp/mh-e/ChangeLog
+++ b/lisp/mh-e/ChangeLog
@@ -1,3 +1,29 @@
12007-08-20 Jeffrey C Honig <jch@honig.net>
2
3 * mh-mime.el (message-options-set): Add missing autoloads from my
4 last change.
5
6 * mh-comp.el (mh-forward): Address SF 1730393. When forwarding
7 with mml, messages were included in reverse order.
8
9 * mh-mime.el (mh-mml-forward-message): Address SF 1378993 and
10 forward messages as inline attatchments.
11
122007-08-19 Jeffrey C Honig <jch@honig.net>
13
14 * mh-e.el (mh-invisible-header-fields-internal): We want to show
15 Comments: and hide Comment:, not the other way around.
16
17 * mh-mime.el (mh-mml-to-mime): GPG requires e-mail addresses, not
18 aliases. So resolve aliases before passing addresses to GPG/PGP.
19 Closes SF #649226.
20
21 * mh-e.el (mh-invisible-header-fields-internal): Update with all
22 the entries from
23 http://people.dsv.su.se/~jpalme/ietf/mail-headers, plus some of my
24 own. I added attributions to entries we already had that did not
25 list an RFC.
26
12007-08-08 Glenn Morris <rgm@gnu.org> 272007-08-08 Glenn Morris <rgm@gnu.org>
2 28
3 * mh-folder.el, mh-letter.el, mh-show.el: Replace `iff' in 29 * mh-folder.el, mh-letter.el, mh-show.el: Replace `iff' in
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index b74c445238e..a71de8246c5 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -497,7 +497,9 @@ See also `mh-compose-forward-as-mime-flag',
497 (dolist (msg msgs) 497 (dolist (msg msgs)
498 (setq i (1+ i)) 498 (setq i (1+ i))
499 (mh-mml-forward-message (format description i) 499 (mh-mml-forward-message (format description i)
500 folder msg)))))) 500 folder msg)
501 ;; Was inserted before us, move to end of file to preserve order
502 (goto-char (point-max)))))))
501 ;; Postition just before forwarded message 503 ;; Postition just before forwarded message
502 (if (re-search-forward "^------- Forwarded Message" nil t) 504 (if (re-search-forward "^------- Forwarded Message" nil t)
503 (forward-line -1) 505 (forward-line -1)
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index 200998da4ca..a9236473995 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -2383,130 +2383,189 @@ of citations entirely, choose \"None\"."
2383 2383
2384;; Keep fields alphabetized. Mention source, if known. 2384;; Keep fields alphabetized. Mention source, if known.
2385(defvar mh-invisible-header-fields-internal 2385(defvar mh-invisible-header-fields-internal
2386 '("Approved:" 2386 '("Abuse-Reports-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2387 "Autoforwarded:" 2387 "Also-Control:" ; H. Spencer: News Article Format and Transmission, June 1994
2388 "Alternate-recipient:" ; RFC 2156
2389 "Approved-By:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2390 "Approved:" ; RFC 1036
2391 "Article-Names:" ; H. Spencer: News Article Format and Transmission, June 1994
2392 "Article-Updates:" ; H. Spencer: News Article Format and Transmission, June 1994
2393 "Authentication-Results:"
2394 "Auto-forwarded:" ; RFC 2156
2395 "Autoforwarded:" ; RFC 2156
2388 "Bestservhost:" 2396 "Bestservhost:"
2397 "Cancel-Key:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2389 "Cancel-Lock:" ; NNTP posts 2398 "Cancel-Lock:" ; NNTP posts
2390 "Content-" ; RFC 2045 2399 "Comment:" ; Shows up with DomainKeys
2391 "Delivered-To:" ; Egroups/yahoogroups mailing list manager 2400;; "Comments:" ; RFC 2822 - show this one
2392 "Delivery-Date:" ; MH 2401 "Content-" ; RFC 2045, 1123, 1766, 1864, 2045, 2110, 2156, 2183, 2912
2402 "Control:" ; RFC 1036
2403 "Conversion-With-Loss:" ; RFC 2156
2404 "Conversion:" ; RFC 2156
2405 "DKIM-" ; http://antispam.yahoo.com/domainkeys
2406 "DL-Expansion-History:" ; RFC 2156
2407 "Delivered-To:" ; Egroups/yahoogroups mailing list manager
2408 "Delivery-Date:" ; RFC 2156
2393 "Delivery:" 2409 "Delivery:"
2394 "DomainKey-Signature:" ;http://antispam.yahoo.com/domainkeys 2410 "Discarded-X400-" ; RFC 2156
2395 "Encoding:" 2411 "Disclose-Recipients:" ; RFC 2156
2412 "Disposition-Notification-Options:" ; RFC 2298
2413 "Disposition-Notification-To:" ; RFC 2298
2414 "Distribution:" ; RFC 1036
2415 "DomainKey-" ; http://antispam.yahoo.com/domainkeys
2416 "Encoding:" ; RFC 1505
2396 "Envelope-to:" 2417 "Envelope-to:"
2397 "Errors-To:" 2418 "Errors-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2419 "Expires:" ; RFC 1036
2420 "Expiry-Date:" ; RFC 2156
2398 "Face:" ; Gnus Face header 2421 "Face:" ; Gnus Face header
2422 "Fax:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2423 "Followup-To:" ; RFC 1036
2424 "For-Approval:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2425 "For-Comment:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2426 "For-Handdling:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2399 "Forwarded:" ; MH 2427 "Forwarded:" ; MH
2400 "From " ; sendmail 2428 "From " ; sendmail
2401 "Importance:" ; MS Outlook 2429 "Generate-Delivery-Report:" ; RFC 2156
2402 "In-Reply-To:" ; MH 2430 "Importance:" ; RFC 2156, 2421
2403 "Lines:" 2431 "In-Reply-To:" ; RFC 2822
2404 "List-" ; Mailman mailing list manager 2432 "Incomplete-Copy:" ; RFC 2156
2405 "List-" ; Unknown mailing list managers 2433 "Keywords:" ; RFC 2822
2406 "List-Subscribe:" ; Unknown mailing list managers 2434 "Language:" ; RFC 2156
2407 "List-Unsubscribe:" ; Unknown mailing list managers 2435 "Lines:" ; RFC 1036
2436 "List-" ; RFC 2369, 2919
2437 "Mail-Copies-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2438 "Mail-Followup-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2439 "Mail-Reply-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2408 "Mail-from:" ; MH 2440 "Mail-from:" ; MH
2409 "Mailing-List:" ; Egroups/yahoogroups mailing list manager 2441 "Mailing-List:" ; Egroups/yahoogroups mailing list manager
2442 "Message-Content:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2410 "Message-Id:" ; RFC 822 2443 "Message-Id:" ; RFC 822
2444 "Message-Type:" ; RFC 2156
2411 "Mime-Version" ; RFC 2045 2445 "Mime-Version" ; RFC 2045
2412 "NNTP-" ; News 2446 "NNTP-" ; News
2447 "Newsgroups:" ; RFC 1036
2448 "Obsoletes:" ; RFC 2156
2413 "Old-Return-Path:" 2449 "Old-Return-Path:"
2414 "Original-Encoded-Information-Types:" ; X400 2450 "OpenPGP:"
2451 "Original-Encoded-Information-Types:" ; RFC 2156
2415 "Original-Lines:" ; mail to news 2452 "Original-Lines:" ; mail to news
2416 "Original-NNTP-" ; mail to news 2453 "Original-NNTP-" ; mail to news
2417 "Original-Newsgroups:" ; mail to news 2454 "Original-Newsgroups:" ; mail to news
2418 "Original-Path:" ; mail to news 2455 "Original-Path:" ; mail to news
2419 "Original-Received:" ; mail to news 2456 "Original-Received:" ; mail to news
2457 "Original-Recipt:" ; RFC 2298
2420 "Original-To:" ; mail to news 2458 "Original-To:" ; mail to news
2421 "Original-X-" ; mail to news 2459 "Original-X-" ; mail to news
2422 "Originator:" 2460 "Origination-Client:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2461 "Originator:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2423 "P1-Content-Type:" ; X400 2462 "P1-Content-Type:" ; X400
2424 "P1-Message-Id:" ; X400 2463 "P1-Message-Id:" ; X400
2425 "P1-Recipient:" ; X400 2464 "P1-Recipient:" ; X400
2426 "Path:" 2465 "Path:" ; RFC 1036
2427 "Precedence:" 2466 "Phone:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2467 "Pics-Label:" ; W3C
2468 "Posted-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2469 "Precedence:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2428 "Prev-Resent" ; MH 2470 "Prev-Resent" ; MH
2429 "Priority:" 2471 "Prevent-NonDelivery-Report:" ; RFC 2156
2430 "Received:" ; RFC 822 2472 "Priority:" ; RFC 2156
2473 "Read-Receipt-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2431 "Received-SPF:" ; Gmail 2474 "Received-SPF:" ; Gmail
2432 "References:" 2475 "Received:" ; RFC 822
2476 "References:" ; RFC 2822
2477 "Registered-Mail-Reply-Requested-By:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2433 "Remailed-" ; MH 2478 "Remailed-" ; MH
2479 "Replaces:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2434 "Replied:" ; MH 2480 "Replied:" ; MH
2435 "Resent" ; MH 2481 "Resent-" ; RFC 2822
2436 "Return-Path:" ; RFC 822 2482 "Return-Path:" ; RFC 822
2437 "Sensitivity:" ; MS Outlook 2483 "Return-Receipt-Requested:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2484 "Return-Receipt-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2485 "See-Also:" ; H. Spencer: News Article Format and Transmission, June 1994
2486 "Sensitivity:" ; RFC 2156, 2421
2487 "Speach-Act:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2438 "Status:" ; sendmail 2488 "Status:" ; sendmail
2489 "Supersedes:" ; H. Spencer: News Article Format and Transmission, June 1994
2490 "Telefax:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2439 "Thread-" 2491 "Thread-"
2492 "Translated-By:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2493 "Translation-Of:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2440 "Ua-Content-Id:" ; X400 2494 "Ua-Content-Id:" ; X400
2441;; "User-Agent:" ; Similar to X-Mailer, so display it.
2442 "Via:" ; MH 2495 "Via:" ; MH
2496 "X-AMAZON" ; Amazon.com
2443 "X-AOL-IP:" ; AOL WebMail 2497 "X-AOL-IP:" ; AOL WebMail
2444 "X-Abuse-Info:" 2498 "X-Abuse-Info:"
2445 "X-Abuse-and-DMCA-" 2499 "X-Abuse-and-DMCA-"
2446 "X-Accept-Language:" 2500 "X-Accept-Language:"
2447 "X-Accept-Language:" ; Netscape/Mozilla 2501 "X-Accept-Language:" ; Netscape/Mozilla
2448 "X-Ack:" 2502 "X-Ack:"
2503 "X-Admin:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2449 "X-Administrivia-To:" 2504 "X-Administrivia-To:"
2450 "X-AntiAbuse:" ; cPanel 2505 "X-AntiAbuse:" ; cPanel
2451 "X-Apparently-From:" ; MS Outlook 2506 "X-Apparently-From:" ; MS Outlook
2452 "X-Apparently-To:" ; Egroups/yahoogroups mailing list manager 2507 "X-Apparently-To:" ; Egroups/yahoogroups mailing list manager
2508 "X-AuditID:"
2453 "X-Authenticated-Sender:" ; AT&T Message Center (webmail) 2509 "X-Authenticated-Sender:" ; AT&T Message Center (webmail)
2454 "X-Authentication-Warning:" ; sendmail 2510 "X-Authentication-Warning:" ; sendmail
2455 "X-Barracuda-" ; Barracuda spam scores 2511 "X-Barracuda-" ; Barracuda spam scores
2456 "X-Beenthere:" ; Mailman mailing list manager 2512 "X-Beenthere:" ; Mailman mailing list manager
2513 "X-Bigfish:"
2457 "X-Bogosity:" ; bogofilter 2514 "X-Bogosity:" ; bogofilter
2458 "X-BrightmailFiltered:" ; Brightmail
2459 "X-Brightmail-Tracker:" ; Brightmail 2515 "X-Brightmail-Tracker:" ; Brightmail
2516 "X-BrightmailFiltered:" ; Brightmail
2460 "X-Bugzilla-" ; Bugzilla 2517 "X-Bugzilla-" ; Bugzilla
2461 "X-Complaints-To:" 2518 "X-Complaints-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2519 "X-Confirm-Reading-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2462 "X-ContentStamp:" ; NetZero 2520 "X-ContentStamp:" ; NetZero
2463 "X-Cron-Env:" 2521 "X-Cron-Env:"
2464 "X-DMCA" 2522 "X-DMCA"
2465 "X-Delivered" 2523 "X-Delivered"
2466 "X-EFL-Spamscore:" ; MIT alumni spam filtering 2524 "X-EFL-Spamscore:" ; MIT alumni spam filtering
2467 "X-ELNK-Trace:" ; Earthlink mailer 2525 "X-ELNK-Trace:" ; Earthlink mailer
2526 "X-Enigmail-Version:"
2468 "X-Envelope-Date:" ; GNU mailutils 2527 "X-Envelope-Date:" ; GNU mailutils
2469 "X-Envelope-From:" 2528 "X-Envelope-From:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2470 "X-Envelope-Sender:" 2529 "X-Envelope-Sender:"
2471 "X-Envelope-To:" 2530 "X-Envelope-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2472 "X-Evolution:" ; Evolution mail client 2531 "X-Evolution:" ; Evolution mail client
2473 "X-Face:" 2532 "X-ExtLoop"
2533 "X-Face:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2474 "X-Folder:" ; Spam 2534 "X-Folder:" ; Spam
2475 "X-From-Line" 2535 "X-From-Line"
2476 "X-Gmail-" ; Gmail 2536 "X-Gmail-" ; Gmail
2477 "X-Gnus-Mail-Source:" ; gnus 2537 "X-Gnus-Mail-Source:" ; gnus
2538 "X-Google-" ; Google mail
2478 "X-Greylist:" ; milter-greylist-1.2.1 2539 "X-Greylist:" ; milter-greylist-1.2.1
2479 "X-Habeas-SWE-1:" ; Spam 2540 "X-HTTP-UserAgent:"
2480 "X-Habeas-SWE-2:" ; Spam 2541 "X-Habeas-SWE-" ; Spam
2481 "X-Habeas-SWE-3:" ; Spam
2482 "X-Habeas-SWE-4:" ; Spam
2483 "X-Habeas-SWE-5:" ; Spam
2484 "X-Habeas-SWE-6:" ; Spam
2485 "X-Habeas-SWE-7:" ; Spam
2486 "X-Habeas-SWE-8:" ; Spam
2487 "X-Habeas-SWE-9:" ; Spam
2488 "X-Hashcash:" ; hashcash 2542 "X-Hashcash:" ; hashcash
2543 "X-IMAP:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2544 "X-Image-URL:"
2489 "X-Info:" ; NTMail 2545 "X-Info:" ; NTMail
2490 "X-IronPort-AV:" ; IronPort AV 2546 "X-IronPort-" ; IronPort AV
2491 "X-Juno-" ; Juno 2547 "X-Juno-" ; Juno
2492 "X-List-Host:" ; Unknown mailing list managers 2548 "X-List-Host:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2493 "X-List-Subscribe:" ; Unknown mailing list managers 2549 "X-List-Subscribe:" ; Unknown mailing list managers
2494 "X-List-Unsubscribe:" ; Unknown mailing list managers 2550 "X-List-Unsubscribe:" ; Unknown mailing list managers
2495 "X-Listprocessor-" ; ListProc(tm) by CREN 2551 "X-Listprocessor-" ; ListProc(tm) by CREN
2496 "X-Listserver:" ; Unknown mailing list managers 2552 "X-Listserver:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2497 "X-Loop:" ; Unknown mailing list managers 2553 "X-Loop:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2498 "X-Lumos-SenderID:" ; Roving ConstantContact 2554 "X-Lumos-SenderID:" ; Roving ConstantContact
2499 "X-MAIL-INFO:" ; NetZero 2555 "X-MAIL-INFO:" ; NetZero
2500 "X-MB-Message-" ; AOL WebMail 2556 "X-MB-Message-" ; AOL WebMail
2501 "X-MHE-Checksum:" ; Checksum added during index search 2557 "X-MHE-Checksum:" ; Checksum added during index search
2502 "X-MIME-Autoconverted:" ; sendmail 2558 "X-MIME-Autoconverted:" ; sendmail
2559 "X-MIMEOLE:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/sendmail
2503 "X-MIMETrack:" 2560 "X-MIMETrack:"
2504 "X-MS-" ; MS Outlook 2561 "X-MS-" ; MS Outlook
2562 "X-MSMail-Priority" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2505 "X-Mail-from:" ; fastmail.fm 2563 "X-Mail-from:" ; fastmail.fm
2506 "X-MailScanner" ; ListProc(tm) by CREN 2564 "X-MailScanner" ; ListProc(tm) by CREN
2507 "X-Mailing-List:" ; Unknown mailing list managers 2565 "X-Mailing-List:" ; Unknown mailing list managers
2508 "X-Mailman-Approved-At:" ; Mailman mailing list manager 2566 "X-Mailman-Approved-At:" ; Mailman mailing list manager
2509 "X-Mailman-Version:" ; Mailman mailing list manager 2567 "X-Mailman-Version:" ; Mailman mailing list manager
2568 "X-Mailutils-Message-Id" ; GNU Mailutils
2510 "X-Majordomo:" ; Majordomo mailing list manager 2569 "X-Majordomo:" ; Majordomo mailing list manager
2511 "X-Message-Id" 2570 "X-Message-Id"
2512 "X-MessageWall-Score:" ; Unknown mailing list manager, AUC TeX 2571 "X-MessageWall-Score:" ; Unknown mailing list manager, AUC TeX
@@ -2516,24 +2575,29 @@ of citations entirely, choose \"None\"."
2516 "X-Msmail-" ; MS Outlook 2575 "X-Msmail-" ; MS Outlook
2517 "X-NAI-Spam-" ; Network Associates Inc. SpamKiller 2576 "X-NAI-Spam-" ; Network Associates Inc. SpamKiller
2518 "X-News:" ; News 2577 "X-News:" ; News
2519 "X-No-Archive:" 2578 "X-Newsreader:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2579 "X-No-Archive:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2520 "X-Notes-Item:" ; Lotus Notes Domino structured header 2580 "X-Notes-Item:" ; Lotus Notes Domino structured header
2521 "X-OperatingSystem:" 2581 "X-OperatingSystem:"
2522 ;;"X-Operator:" ; Similar to X-Mailer, so display it
2523 "X-Orcl-Content-Type:" 2582 "X-Orcl-Content-Type:"
2583 "X-Original-Arrival-Type:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2524 "X-Original-Complaints-To:" 2584 "X-Original-Complaints-To:"
2525 "X-Original-Date:" ; SourceForge mailing list manager 2585 "X-Original-Date:" ; SourceForge mailing list manager
2526 "X-Original-To:" 2586 "X-Original-To:"
2527 "X-Original-Trace:" 2587 "X-Original-Trace:"
2528 "X-OriginalArrivalTime:" ; Hotmail 2588 "X-OriginalArrivalTime:" ; Hotmail
2589 "X-Originating-Email:" ; Hotmail
2529 "X-Originating-IP:" ; Hotmail 2590 "X-Originating-IP:" ; Hotmail
2591 "X-PMG-"
2530 "X-Postfilter:" 2592 "X-Postfilter:"
2531 "X-Priority:" ; MS Outlook 2593 "X-Priority:" ; MS Outlook
2532 "X-Provags-ID:" 2594 "X-Provags-ID:"
2533 "X-Qotd-" ; User added 2595 "X-Qotd-" ; User added
2596 "X-RCPT-TO:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2534 "X-RM" 2597 "X-RM"
2535 "X-Received-Date:" 2598 "X-Received-Date:"
2536 "X-Received:" 2599 "X-Received:"
2600 "X-Report-Abuse-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2537 "X-Request-" 2601 "X-Request-"
2538 "X-Resolved-to:" ; fastmail.fm 2602 "X-Resolved-to:" ; fastmail.fm
2539 "X-Return-Path-Hint:" ; Roving ConstantContact 2603 "X-Return-Path-Hint:" ; Roving ConstantContact
@@ -2546,7 +2610,7 @@ of citations entirely, choose \"None\"."
2546 "X-SMTP-" 2610 "X-SMTP-"
2547 "X-Sasl-enc:" ; Apple Mail 2611 "X-Sasl-enc:" ; Apple Mail
2548 "X-Scanned-By:" 2612 "X-Scanned-By:"
2549 "X-Sender:" 2613 "X-Sender:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2550 "X-Server-Date:" 2614 "X-Server-Date:"
2551 "X-Server-Uuid:" 2615 "X-Server-Uuid:"
2552 "X-Sieve:" ; Sieve filtering 2616 "X-Sieve:" ; Sieve filtering
@@ -2558,21 +2622,33 @@ of citations entirely, choose \"None\"."
2558 "X-Telecom-Digest" 2622 "X-Telecom-Digest"
2559 "X-Trace:" 2623 "X-Trace:"
2560 "X-UID" 2624 "X-UID"
2561 "X-UIDL:" 2625 "X-UIDL:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2562 "X-UNTD-" ; NetZero 2626 "X-UNTD-" ; NetZero
2627 "X-URI:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2628 "X-URL:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2563 "X-USANET-" ; usa.net 2629 "X-USANET-" ; usa.net
2630 "X-Unity"
2564 "X-UserInfo1:" 2631 "X-UserInfo1:"
2565 "X-VSMLoop:" ; NTMail 2632 "X-VSMLoop:" ; NTMail
2566 "X-Virus-Scanned" ; amavisd-new 2633 "X-Virus-Scanned" ; amavisd-new
2567 "X-Vms-To:" 2634 "X-Vms-To:"
2568 "X-WebTV-Signature:" 2635 "X-WebTV-Signature:"
2569 "X-Wss-Id:" ; Worldtalk gateways 2636 "X-Wss-Id:" ; Worldtalk gateways
2637 "X-X-Sender:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2638 "X-YMail-"
2570 "X-Yahoo" 2639 "X-Yahoo"
2571 "X-eGroups-" ; Egroups/yahoogroups mailing list manager 2640 "X-eGroups-" ; Egroups/yahoogroups mailing list manager
2572 "X-pgp:" 2641 "X-pgp:"
2573 "X-submission-address:" 2642 "X-submission-address:"
2574 "X400-" ; X400 2643 "X400-" ; X400
2575 "Xref:") 2644 ;;"X-Operator:" ; Similar to X-Mailer, so display it
2645;; "Mail-System-Version:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2646;; "Mailer:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
2647;; "Reply-By:" ; RFC 2156
2648;; "Reply-To:" ; RFC 2822
2649;; "User-Agent:" ; Similar to X-Mailer, so display it.
2650 "Xref:" ; RFC 1036
2651 )
2576 "List of default header fields that are not to be shown. 2652 "List of default header fields that are not to be shown.
2577 2653
2578Do not alter this variable directly. Instead, add entries from 2654Do not alter this variable directly. Instead, add entries from
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index 4b10ad18592..f67220eaaf2 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -60,7 +60,10 @@
60(autoload 'mail-decode-encoded-word-string "mail-parse") 60(autoload 'mail-decode-encoded-word-string "mail-parse")
61(autoload 'mail-header-parse-content-type "mail-parse") 61(autoload 'mail-header-parse-content-type "mail-parse")
62(autoload 'mail-header-strip "mail-parse") 62(autoload 'mail-header-strip "mail-parse")
63(autoload 'message-options-get "message")
64(autoload 'message-options-set "message")
63(autoload 'message-options-set-recipient "message") 65(autoload 'message-options-set-recipient "message")
66(autoload 'mh-alias-expand "mh-alias")
64(autoload 'mm-decode-body "mm-bodies") 67(autoload 'mm-decode-body "mm-bodies")
65(autoload 'mm-uu-dissect "mm-uu") 68(autoload 'mm-uu-dissect "mm-uu")
66(autoload 'mml-unsecure-message "mml-sec") 69(autoload 'mml-unsecure-message "mml-sec")
@@ -1220,16 +1223,11 @@ MESSAGE number."
1220 mh-sent-from-msg 1223 mh-sent-from-msg
1221 (string-to-number message)))) 1224 (string-to-number message))))
1222 (cond ((integerp msg) 1225 (cond ((integerp msg)
1223 (if (string= "" description) 1226 (mml-attach-file (format "%s%s/%d"
1224 ;; Rationale: mml-attach-file constructs a malformed composition 1227 mh-user-path (substring folder 1) msg)
1225 ;; if the description string is empty. This fixes SF #625168. 1228 "message/rfc822"
1226 (mml-attach-file (format "%s%s/%d" 1229 (if (string= "" description) nil description)
1227 mh-user-path (substring folder 1) msg) 1230 "inline"))
1228 "message/rfc822")
1229 (mml-attach-file (format "%s%s/%d"
1230 mh-user-path (substring folder 1) msg)
1231 "message/rfc822"
1232 description)))
1233 (t (error "The message number, %s, is not a integer" msg))))) 1231 (t (error "The message number, %s, is not a integer" msg)))))
1234 1232
1235(defun mh-mh-forward-message (&optional description folder messages) 1233(defun mh-mh-forward-message (&optional description folder messages)
@@ -1621,8 +1619,22 @@ encoding if you wish by running this command.
1621This action can be undone by running \\[undo]." 1619This action can be undone by running \\[undo]."
1622 (interactive) 1620 (interactive)
1623 (require 'message) 1621 (require 'message)
1624 (when mh-pgp-support-flag ;; This is only needed for PGP 1622 (when mh-pgp-support-flag
1625 (message-options-set-recipient)) 1623 ;; PGP requires actual e-mail addresses, not aliases.
1624 ;; Parse the recipients and sender from the message
1625 (message-options-set-recipient)
1626 ;; Do an alias lookup on sender
1627 (message-options-set 'message-sender
1628 (mail-strip-quoted-names
1629 (mh-alias-expand
1630 (message-options-get 'message-sender))))
1631 ;; Do an alias lookup on recipients
1632 (message-options-set 'message-recipients
1633 (mapconcat
1634 '(lambda (ali)
1635 (mail-strip-quoted-names (mh-alias-expand ali)))
1636 (split-string (message-options-get 'message-recipients) "[, ]+")
1637 ", ")))
1626 (let ((saved-text (buffer-string)) 1638 (let ((saved-text (buffer-string))
1627 (buffer (current-buffer)) 1639 (buffer (current-buffer))
1628 (modified-flag (buffer-modified-p))) 1640 (modified-flag (buffer-modified-p)))
diff --git a/lisp/pcvs-parse.el b/lisp/pcvs-parse.el
index c26a27ed008..3ca1829030f 100644
--- a/lisp/pcvs-parse.el
+++ b/lisp/pcvs-parse.el
@@ -284,6 +284,8 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
284 ;; File removed, since it is removed (by third party) in repository. 284 ;; File removed, since it is removed (by third party) in repository.
285 (and 285 (and
286 (cvs-or 286 (cvs-or
287 ;; some cvs versions output quotes around these files
288 (cvs-match "warning: `\\(.*\\)' is not (any longer) pertinent$" (file 1))
287 (cvs-match "warning: \\(.*\\) is not (any longer) pertinent$" (file 1)) 289 (cvs-match "warning: \\(.*\\) is not (any longer) pertinent$" (file 1))
288 (cvs-match "`\\(.*\\)' is no longer in the repository$" (file 1)) 290 (cvs-match "`\\(.*\\)' is no longer in the repository$" (file 1))
289 (cvs-match "\\(.*\\) is no longer in the repository$" (file 1))) 291 (cvs-match "\\(.*\\) is no longer in the repository$" (file 1)))
diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el
index c9a69005eaf..aa3aea0d71b 100644
--- a/lisp/progmodes/ada-mode.el
+++ b/lisp/progmodes/ada-mode.el
@@ -829,13 +829,12 @@ the 4 file locations can be clicked on and jumped to."
829;; Thus their syntax property is changed automatically, and we can still use 829;; Thus their syntax property is changed automatically, and we can still use
830;; the standard Emacs functions for sexp (see `ada-in-string-p') 830;; the standard Emacs functions for sexp (see `ada-in-string-p')
831;; 831;;
832;; On Emacs, this is done through the `syntax-table' text property. The 832;; On Emacs, this is done through the `syntax-table' text property. The
833;; modification is done automatically each time the user as typed a new 833;; corresponding action is applied automatically each time the buffer
834;; character. This is already done in `font-lock-mode' (in 834;; changes. If `font-lock-mode' is enabled (the default) the action is
835;; `font-lock-syntactic-keywords', so we take advantage of the existing 835;; set up by `font-lock-syntactic-keywords'. Otherwise, we do it
836;; mechanism. If font-lock-mode is not activated, we do it by hand in 836;; manually in `ada-after-change-function'. The proper method is
837;; `ada-after-change-function', thanks to `ada-deactivate-properties' and 837;; installed by `ada-handle-syntax-table-properties'.
838;; `ada-initialize-properties'.
839;; 838;;
840;; on XEmacs, the `syntax-table' property does not exist and we have to use a 839;; on XEmacs, the `syntax-table' property does not exist and we have to use a
841;; slow advice to `parse-partial-sexp' to do the same thing. 840;; slow advice to `parse-partial-sexp' to do the same thing.
@@ -852,7 +851,6 @@ The standard table declares `_' as a symbol constituent, the second one
852declares it as a word constituent." 851declares it as a word constituent."
853 (interactive) 852 (interactive)
854 (setq ada-mode-syntax-table (make-syntax-table)) 853 (setq ada-mode-syntax-table (make-syntax-table))
855 (set-syntax-table ada-mode-syntax-table)
856 854
857 ;; define string brackets (`%' is alternative string bracket, but 855 ;; define string brackets (`%' is alternative string bracket, but
858 ;; almost never used as such and throws font-lock and indentation 856 ;; almost never used as such and throws font-lock and indentation
@@ -936,50 +934,59 @@ declares it as a word constituent."
936 (insert (caddar change)) 934 (insert (caddar change))
937 (setq change (cdr change))))))) 935 (setq change (cdr change)))))))
938 936
939(defun ada-deactivate-properties () 937(defun ada-set-syntax-table-properties ()
940 "Deactivate Ada mode's properties handling. 938 "Assign `syntax-table' properties in accessible part of buffer.
941This would be a duplicate of font-lock if both are used at the same time." 939In particular, character constants are said to be strings, #...#
942 (remove-hook 'after-change-functions 'ada-after-change-function t)) 940are treated as numbers instead of gnatprep comments."
943 941 (let ((modified (buffer-modified-p))
944(defun ada-initialize-properties () 942 (buffer-undo-list t)
945 "Initialize some special text properties in the whole buffer. 943 (inhibit-read-only t)
946In particular, character constants are said to be strings, #...# are treated 944 (inhibit-point-motion-hooks t)
947as numbers instead of gnatprep comments." 945 (inhibit-modification-hooks t))
948 (save-excursion 946 (remove-text-properties (point-min) (point-max) '(syntax-table nil))
949 (save-restriction 947 (goto-char (point-min))
950 (widen) 948 (while (re-search-forward
951 (goto-char (point-min)) 949 ;; The following regexp was adapted from
952 (while (re-search-forward "'.'" nil t) 950 ;; `ada-font-lock-syntactic-keywords'.
953 (add-text-properties (match-beginning 0) (match-end 0) 951 "^[ \t]*\\(#\\(?:if\\|else\\|elsif\\|end\\)\\)\\|[^a-zA-Z0-9)]\\('\\)[^'\n]\\('\\)"
954 '(syntax-table ("'" . ?\")))) 952 nil t)
955 (goto-char (point-min)) 953 (if (match-beginning 1)
956 (while (re-search-forward "^[ \t]*#" nil t) 954 (put-text-property
957 (add-text-properties (match-beginning 0) (match-end 0) 955 (match-beginning 1) (match-end 1) 'syntax-table '(11 . ?\n))
958 '(syntax-table (11 . 10)))) 956 (put-text-property
959 (set-buffer-modified-p nil) 957 (match-beginning 2) (match-end 2) 'syntax-table '(7 . ?'))
960 958 (put-text-property
961 ;; Setting this only if font-lock is not set won't work 959 (match-beginning 3) (match-end 3) 'syntax-table '(7 . ?'))))
962 ;; if the user activates or deactivates font-lock-mode, 960 (unless modified
963 ;; but will make things faster most of the time 961 (restore-buffer-modified-p nil))))
964 (add-hook 'after-change-functions 'ada-after-change-function nil t)
965 )))
966 962
967(defun ada-after-change-function (beg end old-len) 963(defun ada-after-change-function (beg end old-len)
968 "Called when the region between BEG and END was changed in the buffer. 964 "Called when the region between BEG and END was changed in the buffer.
969OLD-LEN indicates what the length of the replaced text was." 965OLD-LEN indicates what the length of the replaced text was."
970 (let ((inhibit-point-motion-hooks t) 966 (save-excursion
971 (eol (point))) 967 (save-restriction
968 (let ((from (progn (goto-char beg) (line-beginning-position)))
969 (to (progn (goto-char end) (line-end-position))))
970 (narrow-to-region from to)
971 (save-match-data
972 (ada-set-syntax-table-properties))))))
973
974(defun ada-initialize-syntax-table-properties ()
975 "Assign `syntax-table' properties in current buffer."
972 (save-excursion 976 (save-excursion
973 (save-match-data 977 (save-restriction
974 (beginning-of-line) 978 (widen)
975 (remove-text-properties (point) eol '(syntax-table nil)) 979 (save-match-data
976 (while (re-search-forward "'.'" eol t) 980 (ada-set-syntax-table-properties))))
977 (add-text-properties (match-beginning 0) (match-end 0) 981 (add-hook 'after-change-functions 'ada-after-change-function nil t))
978 '(syntax-table ("'" . ?\")))) 982
979 (beginning-of-line) 983(defun ada-handle-syntax-table-properties ()
980 (if (looking-at "^[ \t]*#") 984 "Handle `syntax-table' properties."
981 (add-text-properties (match-beginning 0) (match-end 0) 985 (if font-lock-mode
982 '(syntax-table (11 . 10)))))))) 986 ;; `font-lock-mode' will take care of `syntax-table' properties.
987 (remove-hook 'after-change-functions 'ada-after-change-function t)
988 ;; Take care of `syntax-table' properties manually.
989 (ada-initialize-syntax-table-properties)))
983 990
984;;------------------------------------------------------------------ 991;;------------------------------------------------------------------
985;; Testing the grammatical context 992;; Testing the grammatical context
@@ -1150,6 +1157,8 @@ If you use ada-xref.el:
1150 1157
1151 (interactive) 1158 (interactive)
1152 (kill-all-local-variables) 1159 (kill-all-local-variables)
1160
1161 (set-syntax-table ada-mode-syntax-table)
1153 1162
1154 (set (make-local-variable 'require-final-newline) mode-require-final-newline) 1163 (set (make-local-variable 'require-final-newline) mode-require-final-newline)
1155 1164
@@ -1340,7 +1349,7 @@ If you use ada-xref.el:
1340 (setq which-func-functions '(ada-which-function)) 1349 (setq which-func-functions '(ada-which-function))
1341 1350
1342 ;; Support for indent-new-comment-line (Especially for XEmacs) 1351 ;; Support for indent-new-comment-line (Especially for XEmacs)
1343 (setq comment-multi-line nil) 1352 (set (make-local-variable 'comment-multi-line) nil)
1344 1353
1345 (setq major-mode 'ada-mode 1354 (setq major-mode 'ada-mode
1346 mode-name "Ada") 1355 mode-name "Ada")
@@ -1377,9 +1386,8 @@ If you use ada-xref.el:
1377 ;; font-lock-mode 1386 ;; font-lock-mode
1378 1387
1379 (unless (featurep 'xemacs) 1388 (unless (featurep 'xemacs)
1380 (progn 1389 (ada-initialize-syntax-table-properties)
1381 (ada-initialize-properties) 1390 (add-hook 'font-lock-mode-hook 'ada-handle-syntax-table-properties nil t))
1382 (add-hook 'font-lock-mode-hook 'ada-deactivate-properties nil t)))
1383 1391
1384 ;; the following has to be done after running the ada-mode-hook 1392 ;; the following has to be done after running the ada-mode-hook
1385 ;; because users might want to set the values of these variable 1393 ;; because users might want to set the values of these variable
@@ -5200,8 +5208,7 @@ Return nil if no body was found."
5200 ;; This sets the properties of the characters, so that ada-in-string-p 5208 ;; This sets the properties of the characters, so that ada-in-string-p
5201 ;; correctly handles '"' too... 5209 ;; correctly handles '"' too...
5202 '(("[^a-zA-Z0-9)]\\('\\)[^'\n]\\('\\)" (1 (7 . ?')) (2 (7 . ?'))) 5210 '(("[^a-zA-Z0-9)]\\('\\)[^'\n]\\('\\)" (1 (7 . ?')) (2 (7 . ?')))
5203 ("^[ \t]*\\(#\\(if\\|else\\|elsif\\|end\\)\\)" (1 (11 . ?\n))) 5211 ("^[ \t]*\\(#\\(if\\|else\\|elsif\\|end\\)\\)" (1 (11 . ?\n)))))
5204 ))
5205 5212
5206(defvar ada-font-lock-keywords 5213(defvar ada-font-lock-keywords
5207 (eval-when-compile 5214 (eval-when-compile
diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el
index e8db3d51c2a..c37d11910d4 100644
--- a/lisp/progmodes/ada-xref.el
+++ b/lisp/progmodes/ada-xref.el
@@ -71,7 +71,7 @@ Set to 0, if you don't use crunched filenames. This should be a string."
71 :type 'string :group 'ada) 71 :type 'string :group 'ada)
72 72
73(defcustom ada-gnatls-args '("-v") 73(defcustom ada-gnatls-args '("-v")
74 "*Arguments to pass to `gnatfind' to find location of the runtime. 74 "*Arguments to pass to `gnatls' to find location of the runtime.
75Typical use is to pass `--RTS=soft-floats' on some systems that support it. 75Typical use is to pass `--RTS=soft-floats' on some systems that support it.
76 76
77You can also add `-I-' if you do not want the current directory to be included. 77You can also add `-I-' if you do not want the current directory to be included.
@@ -322,7 +322,6 @@ CROSS-PREFIX is the prefix to use for the `gnatls' command."
322 (reverse ada-xref-runtime-library-ali-path)) 322 (reverse ada-xref-runtime-library-ali-path))
323 )) 323 ))
324 324
325
326(defun ada-treat-cmd-string (cmd-string) 325(defun ada-treat-cmd-string (cmd-string)
327 "Replace meta-sequences like ${...} in CMD-STRING with the appropriate value. 326 "Replace meta-sequences like ${...} in CMD-STRING with the appropriate value.
328Assumes project exists. 327Assumes project exists.
@@ -345,7 +344,7 @@ replaced by the name including the extension."
345 ;; Check if there is an environment variable with the same name 344 ;; Check if there is an environment variable with the same name
346 (if (null value) 345 (if (null value)
347 (if (not (setq value (getenv name))) 346 (if (not (setq value (getenv name)))
348 (message "%s" (concat "No environment variable " name " found")))) 347 (message "%s" (concat "No project or environment variable " name " found"))))
349 348
350 (cond 349 (cond
351 ((null value) 350 ((null value)
@@ -535,6 +534,11 @@ All the directories are returned as absolute directories."
535Completion is attempted in all the directories in the source path, as 534Completion is attempted in all the directories in the source path, as
536defined in the project file." 535defined in the project file."
537 ;; FIXME: doc arguments 536 ;; FIXME: doc arguments
537
538 ;; This function is not itself interactive, but it is called as part
539 ;; of the prompt of interactive functions, so we require a project
540 ;; file.
541 (ada-require-project-file)
538 (let (list 542 (let (list
539 (dirs (ada-xref-get-src-dir-field))) 543 (dirs (ada-xref-get-src-dir-field)))
540 544
@@ -663,9 +667,6 @@ is non-nil, prompt the user to select one. If none are found, return
663 ada-prj-file-extension)) 667 ada-prj-file-extension))
664 (dir (file-name-directory current-file)) 668 (dir (file-name-directory current-file))
665 669
666 ;; on Emacs 20.2, directory-files does not work if
667 ;; parse-sexp-lookup-properties is set
668 (parse-sexp-lookup-properties nil)
669 (prj-files (directory-files 670 (prj-files (directory-files
670 dir t 671 dir t
671 (concat ".*" (regexp-quote 672 (concat ".*" (regexp-quote
@@ -905,6 +906,8 @@ If ARG is t, the contents of the old *gnatfind* buffer is preserved."
905 (interactive "d\nP") 906 (interactive "d\nP")
906 (ada-find-references pos arg t)) 907 (ada-find-references pos arg t))
907 908
909(defconst ada-gnatfind-buffer-name "*gnatfind*")
910
908(defun ada-find-any-references 911(defun ada-find-any-references
909 (entity &optional file line column local-only append) 912 (entity &optional file line column local-only append)
910 "Search for references to any entity whose name is ENTITY. 913 "Search for references to any entity whose name is ENTITY.
@@ -943,23 +946,25 @@ buffer `*gnatfind*', if there is one."
943 (setq command (concat command " -P" ada-prj-default-project-file)) 946 (setq command (concat command " -P" ada-prj-default-project-file))
944 (setq command (concat command " -p" ada-prj-default-project-file)))) 947 (setq command (concat command " -p" ada-prj-default-project-file))))
945 948
946 (if (and append (get-buffer "*gnatfind*")) 949 (if (and append (get-buffer ada-gnatfind-buffer-name))
947 (save-excursion 950 (save-excursion
948 (set-buffer "*gnatfind*") 951 (set-buffer "*gnatfind*")
949 (setq old-contents (buffer-string)))) 952 (setq old-contents (buffer-string))))
950 953
951 (let ((compilation-error "reference")) 954 (let ((compilation-error "reference"))
952 (compilation-start command)) 955 (compilation-start command 'compilation-mode (lambda (mode) ada-gnatfind-buffer-name)))
953 956
954 ;; Hide the "Compilation" menu 957 ;; Hide the "Compilation" menu
955 (save-excursion 958 (save-excursion
956 (set-buffer "*gnatfind*") 959 (set-buffer ada-gnatfind-buffer-name)
957 (local-unset-key [menu-bar compilation-menu]) 960 (local-unset-key [menu-bar compilation-menu])
958 961
959 (if old-contents 962 (if old-contents
960 (progn 963 (progn
961 (goto-char 1) 964 (goto-char 1)
965 (set 'buffer-read-only nil)
962 (insert old-contents) 966 (insert old-contents)
967 (set 'buffer-read-only t)
963 (goto-char (point-max))))) 968 (goto-char (point-max)))))
964 ) 969 )
965 ) 970 )
@@ -1940,7 +1945,7 @@ This function attempts to find the possible declarations for the identifier
1940anywhere in the object path. 1945anywhere in the object path.
1941This command requires the external `egrep' program to be available. 1946This command requires the external `egrep' program to be available.
1942 1947
1943This works well when one is using an external librarie and wants to find 1948This works well when one is using an external library and wants to find
1944the declaration and documentation of the subprograms one is using." 1949the declaration and documentation of the subprograms one is using."
1945;; FIXME: what does this function do? 1950;; FIXME: what does this function do?
1946 (let (list 1951 (let (list
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 805ed3c4040..9b83cfc9f3d 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -1972,7 +1972,13 @@ The file-structure looks like this:
1972 ;; Store it for the possibly unnormalized name 1972 ;; Store it for the possibly unnormalized name
1973 (puthash file 1973 (puthash file
1974 ;; Retrieve or create file-structure for normalized name 1974 ;; Retrieve or create file-structure for normalized name
1975 (or (gethash (list filename) compilation-locs) 1975 ;; The gethash used to not use spec-directory, but
1976 ;; this leads to errors when files in different
1977 ;; directories have the same name:
1978 ;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00463.html
1979 (or (gethash (cons filename spec-directory) compilation-locs)
1980 ;; TODO should this, without spec-directory, be
1981 ;; done at all?
1976 (puthash (list filename) 1982 (puthash (list filename)
1977 (list (list filename spec-directory) fmt) 1983 (list (list filename spec-directory) fmt)
1978 compilation-locs)) 1984 compilation-locs))
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index cd7dabb8825..5a91141db6c 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -3736,8 +3736,12 @@ Should be called with the point before leading colon of an attribute."
3736 (set-syntax-table reset-st)))) 3736 (set-syntax-table reset-st))))
3737 3737
3738(defsubst cperl-look-at-leading-count (is-x-REx e) 3738(defsubst cperl-look-at-leading-count (is-x-REx e)
3739 (if (re-search-forward (concat "\\=" (if is-x-REx "[ \t\n]*" "") "[{?+*]") 3739 (if (and (> (point) e)
3740 (1- e) t) ; return nil on failure, no moving 3740 ;; return nil on failure, no moving
3741 (re-search-forward (concat "\\="
3742 (if is-x-REx "[ \t\n]*" "")
3743 "[{?+*]")
3744 (1- e) t))
3741 (if (eq ?\{ (preceding-char)) nil 3745 (if (eq ?\{ (preceding-char)) nil
3742 (cperl-postpone-fontification 3746 (cperl-postpone-fontification
3743 (1- (point)) (point) 3747 (1- (point)) (point)
@@ -3750,7 +3754,7 @@ If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify
3750the sections using `cperl-pod-head-face', `cperl-pod-face', 3754the sections using `cperl-pod-head-face', `cperl-pod-face',
3751`cperl-here-face'." 3755`cperl-here-face'."
3752 (interactive) 3756 (interactive)
3753 (or min (setq min (point-min) 3757 (or min (setq min (point-min)
3754 cperl-syntax-state nil 3758 cperl-syntax-state nil
3755 cperl-syntax-done-to min)) 3759 cperl-syntax-done-to min))
3756 (or max (setq max (point-max))) 3760 (or max (setq max (point-max)))
@@ -4785,7 +4789,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
4785 (progn 4789 (progn
4786 (cperl-postpone-fontification 4790 (cperl-postpone-fontification
4787 (1- e1) e1 'face my-cperl-delimiters-face) 4791 (1- e1) e1 'face my-cperl-delimiters-face)
4788 (if (assoc (char-after b) cperl-starters) 4792 (if (and (not (eobp))
4793 (assoc (char-after b) cperl-starters))
4789 (progn 4794 (progn
4790 (cperl-postpone-fontification 4795 (cperl-postpone-fontification
4791 b1 (1+ b1) 'face my-cperl-delimiters-face) 4796 b1 (1+ b1) 'face my-cperl-delimiters-face)
diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el
index c4d14462245..716b79138f9 100644
--- a/lisp/progmodes/gdb-ui.el
+++ b/lisp/progmodes/gdb-ui.el
@@ -1132,10 +1132,10 @@ This filter may simply queue input for a later time."
1132 (let ((item (concat string "\n"))) 1132 (let ((item (concat string "\n")))
1133 (if gdb-enable-debug (push (cons 'send item) gdb-debug-log)) 1133 (if gdb-enable-debug (push (cons 'send item) gdb-debug-log))
1134 (process-send-string proc item))) 1134 (process-send-string proc item)))
1135 (if (and (string-match "\\\\$" string) 1135 (if (string-match "\\\\\\'" string)
1136 (not comint-input-sender-no-newline)) ;;Try to catch C-d.
1137 (setq gdb-continuation (concat gdb-continuation string "\n")) 1136 (setq gdb-continuation (concat gdb-continuation string "\n"))
1138 (let ((item (concat gdb-continuation string "\n"))) 1137 (let ((item (concat gdb-continuation string
1138 (if (not comint-input-sender-no-newline) "\n"))))
1139 (gdb-enqueue-input item) 1139 (gdb-enqueue-input item)
1140 (setq gdb-continuation nil))))) 1140 (setq gdb-continuation nil)))))
1141 1141
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index bafe42b950f..91518641938 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -770,7 +770,8 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
770 ;; even when async processes aren't supported. 770 ;; even when async processes aren't supported.
771 (compilation-start (if (and grep-use-null-device null-device) 771 (compilation-start (if (and grep-use-null-device null-device)
772 (concat command " " null-device) 772 (concat command " " null-device)
773 command) 'grep-mode)) 773 command)
774 'grep-mode))
774 (if (eq next-error-last-buffer (current-buffer)) 775 (if (eq next-error-last-buffer (current-buffer))
775 (setq default-directory dir)))))) 776 (setq default-directory dir))))))
776 777
diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el
index a2fd9cdab04..6b911dd1e7a 100644
--- a/lisp/progmodes/meta-mode.el
+++ b/lisp/progmodes/meta-mode.el
@@ -51,7 +51,7 @@
51;; these lines to your startup file: 51;; these lines to your startup file:
52;; 52;;
53;; (add-hook 'meta-mode-load-hook 53;; (add-hook 'meta-mode-load-hook
54;; '(lambda () (require 'meta-buf))) 54;; (lambda () (require 'meta-buf)))
55;; 55;;
56;; The add-on package loaded this way may in turn make use of the 56;; The add-on package loaded this way may in turn make use of the
57;; mode-hooks provided in this package to activate additional features 57;; mode-hooks provided in this package to activate additional features
@@ -605,14 +605,16 @@ If the list was changed, sort the list and remove duplicates first."
605 605
606(defun meta-indent-calculate () 606(defun meta-indent-calculate ()
607 "Return the indentation of current line of Metafont or MetaPost source." 607 "Return the indentation of current line of Metafont or MetaPost source."
608 ;; Indentation within strings is not considered as Meta* don't allow multi
609 ;; line strings.
608 (save-excursion 610 (save-excursion
609 (back-to-indentation) 611 (back-to-indentation)
610 (cond 612 (cond
611 ;; Comments to the left margin. 613 ;; Comments to the left margin.
612 ((and meta-left-comment-regexp 614 ((and meta-left-comment-regexp
613 (looking-at meta-left-comment-regexp)) 615 (looking-at meta-left-comment-regexp))
614 0) 616 0)
615 ;; Comments to the right margin. 617 ;; Comments to the right margin.
616 ((and meta-right-comment-regexp 618 ((and meta-right-comment-regexp
617 (looking-at meta-right-comment-regexp)) 619 (looking-at meta-right-comment-regexp))
618 comment-column) 620 comment-column)
@@ -620,42 +622,113 @@ If the list was changed, sort the list and remove duplicates first."
620 ((and meta-ignore-comment-regexp 622 ((and meta-ignore-comment-regexp
621 (looking-at meta-ignore-comment-regexp)) 623 (looking-at meta-ignore-comment-regexp))
622 (current-indentation)) 624 (current-indentation))
625 ;; Beginning of buffer.
626 ((eq (point-at-bol) (point-min))
627 0)
623 ;; Backindent at end of environments. 628 ;; Backindent at end of environments.
624 ((looking-at 629 ((meta-indent-looking-at-code
625 (concat "\\<" meta-end-environment-regexp "\\>")) 630 (concat "\\<" meta-end-environment-regexp "\\>"))
626 (- (meta-indent-calculate-last) meta-indent-level)) 631 (- (meta-indent-current-indentation) meta-indent-level))
627 ;; Backindent at keywords within environments. 632 ;; Backindent at keywords within environments.
628 ((looking-at 633 ((meta-indent-looking-at-code
629 (concat "\\<" meta-within-environment-regexp "\\>")) 634 (concat "\\<" meta-within-environment-regexp "\\>"))
630 (- (meta-indent-calculate-last) meta-indent-level)) 635 (- (meta-indent-current-indentation) meta-indent-level))
631 (t (meta-indent-calculate-last))))) 636 (t (meta-indent-current-indentation)))))
632 637
633(defun meta-indent-calculate-last () 638(defun meta-indent-in-string-p ()
634 "Return the indentation of previous line of Metafont or MetaPost source." 639 "Tell if the point is in a string."
635 (save-restriction 640 (or (nth 3 (syntax-ppss))
636 (widen) 641 (eq (get-text-property (point) 'face) font-lock-string-face)))
642
643(defun meta-indent-looking-at-code (regexp)
644 "Same as `looking-at' but checks that the point is not in a string."
645 (unless (meta-indent-in-string-p)
646 (looking-at regexp)))
647
648(defun meta-indent-previous-line ()
649 "Go to the previous line of code, skipping comments."
650 (skip-chars-backward "\n\t ")
651 (move-to-column (current-indentation))
652 ;; Ignore comments.
653 (while (and (looking-at comment-start) (not (bobp)))
637 (skip-chars-backward "\n\t ") 654 (skip-chars-backward "\n\t ")
638 (move-to-column (current-indentation)) 655 (if (not (bobp))
639 ;; Ignore comments. 656 (move-to-column (current-indentation)))))
640 (while (and (looking-at comment-start) (not (bobp))) 657
641 (skip-chars-backward "\n\t ") 658(defun meta-indent-unfinished-line ()
642 (if (not (bobp)) 659 "Tell if the current line of code ends with an unfinished expression."
643 (move-to-column (current-indentation)))) 660 (save-excursion
644 (cond 661 (end-of-line)
645 ((bobp) 0) 662 ;; Skip backward the comments.
646 (t (+ (current-indentation) 663 (while (search-backward comment-start (point-at-bol) t))
647 (meta-indent-level-count) 664 ;; Search for the end of the previous expression.
648 (cond 665 (if (search-backward ";" (point-at-bol) t)
649 ;; Compensate for backindent at end of environments. 666 (progn (while (and (meta-indent-in-string-p)
650 ((looking-at 667 (search-backward ";" (point-at-bol) t)))
651 (concat "\\<"meta-end-environment-regexp "\\>")) 668 (if (= (char-after) ?\;)
652 meta-indent-level) 669 (forward-char)
653 ;; Compensate for backindent within environments. 670 (beginning-of-line)))
654 ((looking-at 671 (beginning-of-line))
655 (concat "\\<" meta-within-environment-regexp "\\>")) 672 ;; See if the last statement of the line is environment-related,
656 meta-indent-level) 673 ;; or exists at all.
657 (t 0))))) 674 (if (meta-indent-looking-at-code
658 )) 675 (concat "[ \t]*\\($\\|" (regexp-quote comment-start)
676 "\\|\\<" meta-end-environment-regexp "\\>"
677 "\\|\\<" meta-begin-environment-regexp "\\>"
678 "\\|\\<" meta-within-environment-regexp "\\>\\)"))
679 nil
680 t)))
681
682(defun meta-indent-current-indentation ()
683 "Return the indentation wanted for the current line of code."
684 (+ (meta-indent-current-nesting)
685 (if (save-excursion
686 (back-to-indentation)
687 (and (not (looking-at (concat "\\<" meta-end-environment-regexp "\\>"
688 "\\|\\<" meta-within-environment-regexp "\\>")))
689 (progn (meta-indent-previous-line)
690 (meta-indent-unfinished-line))))
691 meta-indent-level
692 0)))
693
694(defun meta-indent-current-nesting ()
695 "Return the indentation according to the nearest environment keyword."
696 (save-excursion
697 (save-restriction
698 (widen)
699 (back-to-indentation)
700 (let ((to-add 0))
701 ;; If we found some environment marker backward...
702 (if (catch 'found
703 (while (re-search-backward
704 (concat "(\\|)\\|\\<" meta-end-environment-regexp "\\>"
705 "\\|\\<" meta-begin-environment-regexp "\\>"
706 "\\|\\<" meta-within-environment-regexp "\\>")
707 nil t)
708 ;; If we aren't in a string or in a comment, we've found something.
709 (unless (or (meta-indent-in-string-p)
710 (nth 4 (syntax-ppss)))
711 (cond ((= (char-after) ?\()
712 (setq to-add (+ to-add meta-indent-level)))
713 ((= (char-after) ?\))
714 (setq to-add (- to-add meta-indent-level)))
715 (t (throw 'found t))))))
716 (progn
717 ;; ... then use it to compute the current indentation.
718 (back-to-indentation)
719 (+ to-add (current-indentation) (meta-indent-level-count)
720 ;; Compensate for backindent of end and within keywords.
721 (if (meta-indent-looking-at-code
722 (concat "\\<" meta-end-environment-regexp "\\>\\|"
723 "\\<" meta-within-environment-regexp "\\>"))
724 meta-indent-level
725 ;; Compensate for unfinished line.
726 (if (save-excursion
727 (meta-indent-previous-line)
728 (meta-indent-unfinished-line))
729 (- meta-indent-level)
730 0))))
731 0)))))
659 732
660(defun meta-indent-level-count () 733(defun meta-indent-level-count ()
661 "Count indentation change for begin-end commands in the current line." 734 "Count indentation change for begin-end commands in the current line."
@@ -671,18 +744,12 @@ If the list was changed, sort the list and remove duplicates first."
671 (goto-char (match-beginning 0)) 744 (goto-char (match-beginning 0))
672 (cond 745 (cond
673 ;; Count number of begin-end keywords within line. 746 ;; Count number of begin-end keywords within line.
674 ((looking-at 747 ((meta-indent-looking-at-code
675 (concat "\\<" meta-begin-environment-regexp "\\>")) 748 (concat "\\<" meta-begin-environment-regexp "\\>"))
676 (setq count (+ count meta-indent-level))) 749 (setq count (+ count meta-indent-level)))
677 ((looking-at 750 ((meta-indent-looking-at-code
678 (concat "\\<" meta-end-environment-regexp "\\>")) 751 (concat "\\<" meta-end-environment-regexp "\\>"))
679 (setq count (- count meta-indent-level))) 752 (setq count (- count meta-indent-level))))))
680 ;; Count number of open-close parentheses within line.
681 ((looking-at "(")
682 (setq count (+ count meta-indent-level)))
683 ((looking-at ")")
684 (setq count (- count meta-indent-level)))
685 )))
686 count)))) 753 count))))
687 754
688 755
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index a38a5525bc9..2e7e641096b 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -267,8 +267,16 @@ The expansion is entirely correct because it uses the C preprocessor."
267 ("^[ \t]*format.*=[ \t]*\\(\n\\)" (1 '(7))) 267 ("^[ \t]*format.*=[ \t]*\\(\n\\)" (1 '(7)))
268 ;; Funny things in sub arg specifications like `sub myfunc ($$)' 268 ;; Funny things in sub arg specifications like `sub myfunc ($$)'
269 ("\\<sub\\s-+\\S-+\\s-*(\\([^)]+\\))" 1 '(1)) 269 ("\\<sub\\s-+\\S-+\\s-*(\\([^)]+\\))" 1 '(1))
270 ;; regexp and funny quotes 270 ;; Regexp and funny quotes.
271 ("[?:.,;=!~({[][ \t\n]*\\(/\\)" (1 '(7))) 271 ("\\(?:[?:.,;=!~({[]\\|\\(^\\)\\)[ \t\n]*\\(/\\)"
272 (2 (if (and (match-end 1)
273 (save-excursion
274 (goto-char (match-end 1))
275 (skip-chars-backward " \t\n")
276 (not (memq (char-before)
277 '(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[)))))
278 nil ;; A division sign instead of a regexp-match.
279 '(7))))
272 ("\\(^\\|[?:.,;=!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\([^])}> \n\t]\\)" 280 ("\\(^\\|[?:.,;=!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\([^])}> \n\t]\\)"
273 ;; Nasty cases: 281 ;; Nasty cases:
274 ;; /foo/m $a->m $#m $m @m %m 282 ;; /foo/m $a->m $#m $m @m %m
diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el
index 5bf7cb1e9eb..e5fb8cbc7f8 100644
--- a/lisp/progmodes/scheme.el
+++ b/lisp/progmodes/scheme.el
@@ -156,6 +156,7 @@
156 ;; Look within the line for a ; following an even number of backslashes 156 ;; Look within the line for a ; following an even number of backslashes
157 ;; after either a non-backslash or the line beginning. 157 ;; after either a non-backslash or the line beginning.
158 (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*") 158 (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*")
159 (set (make-local-variable 'font-lock-comment-start-skip) ";+ *")
159 (make-local-variable 'comment-column) 160 (make-local-variable 'comment-column)
160 (setq comment-column 40) 161 (setq comment-column 40)
161 (make-local-variable 'parse-sexp-ignore-comments) 162 (make-local-variable 'parse-sexp-ignore-comments)
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index a1bd32a313d..0d909a4a3ff 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -6982,10 +6982,13 @@ only-lines."
6982 (when (and vhdl-progress-info (not noninteractive) 6982 (when (and vhdl-progress-info (not noninteractive)
6983 (< vhdl-progress-interval 6983 (< vhdl-progress-interval
6984 (- (nth 1 (current-time)) (aref vhdl-progress-info 2)))) 6984 (- (nth 1 (current-time)) (aref vhdl-progress-info 2))))
6985 (message (concat string "... (%2d%s)") 6985 (let ((delta (- (aref vhdl-progress-info 1)
6986 (/ (* 100 (- pos (aref vhdl-progress-info 0))) 6986 (aref vhdl-progress-info 0))))
6987 (- (aref vhdl-progress-info 1) 6987 (if (= 0 delta)
6988 (aref vhdl-progress-info 0))) "%") 6988 (message (concat string "... (100%s)") "%")
6989 (message (concat string "... (%2d%s)")
6990 (/ (* 100 (- pos (aref vhdl-progress-info 0)))
6991 delta) "%")))
6989 (aset vhdl-progress-info 2 (nth 1 (current-time))))) 6992 (aset vhdl-progress-info 2 (nth 1 (current-time)))))
6990 6993
6991;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 6994;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/lisp/simple.el b/lisp/simple.el
index fa825663783..bcdac1bf598 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -5797,6 +5797,57 @@ works by saving the value of `buffer-invisibility-spec' and setting it to nil."
5797; 'insert-in-front-hooks '(minibuffer-prompt-insertion))) 5797; 'insert-in-front-hooks '(minibuffer-prompt-insertion)))
5798; 5798;
5799 5799
5800
5801;;;; Problematic external packages.
5802
5803;; rms says this should be done by specifying symbols that define
5804;; versions together with bad values. This is therefore not as
5805;; flexible as it could be. See the thread:
5806;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00300.html
5807(defconst bad-packages-alist
5808 ;; Not sure exactly which semantic versions have problems.
5809 ;; Definitely 2.0pre3, probably all 2.0pre's before this.
5810 '((semantic semantic-version "2\\.0pre[1-3]"
5811 "The version of `semantic' loaded does not work in Emacs 22.
5812It can cause constant high CPU load. Upgrade to at least 2.0pre4.")
5813 ;; CUA-mode does not work with GNU Emacs version 22.1 and newer.
5814 ;; Except for version 1.2, all of the 1.x and 2.x version of cua-mode
5815 ;; provided the `CUA-mode' feature. Since this is no longer true,
5816 ;; we can warn the user if the `CUA-mode' feature is ever provided.
5817 (CUA-mode t nil
5818"CUA-mode is now part of the standard GNU Emacs distribution,
5819so you can now enable CUA via the Options menu or by customizing `cua-mode'.
5820
5821You have loaded an older version of CUA-mode which does not work
5822correctly with this version of Emacs. You should remove the old
5823version and use the one distributed with Emacs."))
5824 "Alist of packages known to cause problems in this version of Emacs.
5825Each element has the form (PACKAGE SYMBOL REGEXP STRING).
5826PACKAGE is either a regular expression to match file names, or a
5827symbol (a feature name); see the documentation of
5828`after-load-alist', to which this variable adds functions.
5829SYMBOL is either the name of a string variable, or `t'. Upon
5830loading PACKAGE, if SYMBOL is t or matches REGEXP, display a
5831warning using STRING as the message.")
5832
5833(defun bad-package-check (package)
5834 "Run a check using the element from `bad-packages-alist' matching PACKAGE."
5835 (condition-case nil
5836 (let* ((list (assoc package bad-packages-alist))
5837 (symbol (nth 1 list)))
5838 (and list
5839 (boundp symbol)
5840 (or (eq symbol t)
5841 (and (stringp (setq symbol (eval symbol)))
5842 (string-match (nth 2 list) symbol)))
5843 (display-warning :warning (nth 3 list))))
5844 (error nil)))
5845
5846(mapc (lambda (elem)
5847 (eval-after-load (car elem) `(bad-package-check ',(car elem))))
5848 bad-packages-alist)
5849
5850
5800(provide 'simple) 5851(provide 'simple)
5801 5852
5802;; arch-tag: 24af67c0-2a49-44f6-b3b1-312d8b570dfd 5853;; arch-tag: 24af67c0-2a49-44f6-b3b1-312d8b570dfd
diff --git a/lisp/smerge-mode.el b/lisp/smerge-mode.el
index ef80ef81679..e3484bb0a48 100644
--- a/lisp/smerge-mode.el
+++ b/lisp/smerge-mode.el
@@ -324,7 +324,8 @@ Can be nil if the style is undecided, or else:
324(defvar smerge-resolve-function 324(defvar smerge-resolve-function
325 (lambda () (error "Don't know how to resolve")) 325 (lambda () (error "Don't know how to resolve"))
326 "Mode-specific merge function. 326 "Mode-specific merge function.
327The function is called with no argument and with the match data set 327The function is called with zero or one argument (non-nil if the resolution
328function should only apply safe heuristics) and with the match data set
328according to `smerge-match-conflict'.") 329according to `smerge-match-conflict'.")
329(add-to-list 'debug-ignored-errors "Don't know how to resolve") 330(add-to-list 'debug-ignored-errors "Don't know how to resolve")
330 331
@@ -378,7 +379,7 @@ according to `smerge-match-conflict'.")
378 (smerge-remove-props (or beg (point-min)) (or end (point-max))) 379 (smerge-remove-props (or beg (point-min)) (or end (point-max)))
379 (push event unread-command-events))))) 380 (push event unread-command-events)))))
380 381
381(defun smerge-resolve () 382(defun smerge-resolve (&optional safe)
382 "Resolve the conflict at point intelligently. 383 "Resolve the conflict at point intelligently.
383This relies on mode-specific knowledge and thus only works in 384This relies on mode-specific knowledge and thus only works in
384some major modes. Uses `smerge-resolve-function' to do the actual work." 385some major modes. Uses `smerge-resolve-function' to do the actual work."
@@ -393,8 +394,10 @@ some major modes. Uses `smerge-resolve-function' to do the actual work."
393 ;; Mode-specific conflict resolution. 394 ;; Mode-specific conflict resolution.
394 ((condition-case nil 395 ((condition-case nil
395 (atomic-change-group 396 (atomic-change-group
396 (funcall smerge-resolve-function) 397 (if safe
397 t) 398 (funcall smerge-resolve-function safe)
399 (funcall smerge-resolve-function))
400 t)
398 (error nil)) 401 (error nil))
399 ;; Nothing to do: the resolution function has done it already. 402 ;; Nothing to do: the resolution function has done it already.
400 nil) 403 nil)
@@ -412,6 +415,31 @@ some major modes. Uses `smerge-resolve-function' to do the actual work."
412 (error "Don't know how to resolve"))) 415 (error "Don't know how to resolve")))
413 (smerge-auto-leave)) 416 (smerge-auto-leave))
414 417
418(defun smerge-resolve-all ()
419 "Perform automatic resolution on all conflicts."
420 (interactive)
421 (save-excursion
422 (goto-char (point-min))
423 (while (re-search-forward smerge-begin-re nil t)
424 (condition-case nil
425 (progn
426 (smerge-match-conflict)
427 (smerge-resolve 'safe))
428 (error nil)))))
429
430(defun smerge-batch-resolve ()
431 ;; command-line-args-left is what is left of the command line.
432 (if (not noninteractive)
433 (error "`smerge-batch-resolve' is to be used only with -batch"))
434 (while command-line-args-left
435 (let ((file (pop command-line-args-left)))
436 (message "Resolving conflicts in %s..." file)
437 (when (file-readable-p file)
438 (with-current-buffer (find-file-noselect file)
439 (smerge-resolve-all)
440 (save-buffer)
441 (kill-buffer (current-buffer)))))))
442
415(defun smerge-keep-base () 443(defun smerge-keep-base ()
416 "Revert to the base version." 444 "Revert to the base version."
417 (interactive) 445 (interactive)
@@ -677,7 +705,9 @@ Point is moved to the end of the conflict."
677 (unwind-protect 705 (unwind-protect
678 (with-temp-buffer 706 (with-temp-buffer
679 (let ((coding-system-for-read 'emacs-mule)) 707 (let ((coding-system-for-read 'emacs-mule))
680 (call-process diff-command nil t nil file1 file2)) 708 ;; Don't forget -a to make sure diff treats it as a text file
709 ;; even if it contains \0 and such.
710 (call-process diff-command nil t nil "-a" file1 file2))
681 ;; Process diff's output. 711 ;; Process diff's output.
682 (goto-char (point-min)) 712 (goto-char (point-min))
683 (while (not (eobp)) 713 (while (not (eobp))
@@ -831,6 +861,10 @@ buffer names."
831 (message "Please resolve conflicts now; exit ediff when done"))) 861 (message "Please resolve conflicts now; exit ediff when done")))
832 862
833 863
864(defconst smerge-parsep-re
865 (concat smerge-begin-re "\\|" smerge-end-re "\\|"
866 smerge-base-re "\\|" smerge-other-re "\\|"))
867
834;;;###autoload 868;;;###autoload
835(define-minor-mode smerge-mode 869(define-minor-mode smerge-mode
836 "Minor mode to simplify editing output from the diff3 program. 870 "Minor mode to simplify editing output from the diff3 program.
@@ -845,6 +879,13 @@ buffer names."
845 (while (smerge-find-conflict) 879 (while (smerge-find-conflict)
846 (save-excursion 880 (save-excursion
847 (font-lock-fontify-region (match-beginning 0) (match-end 0) nil))))) 881 (font-lock-fontify-region (match-beginning 0) (match-end 0) nil)))))
882 (if (string-match (regexp-quote smerge-parsep-re) paragraph-separate)
883 (unless smerge-mode
884 (set (make-local-variable 'paragraph-separate)
885 (replace-match "" t t paragraph-separate)))
886 (when smerge-mode
887 (set (make-local-variable 'paragraph-separate)
888 (concat smerge-parsep-re paragraph-separate))))
848 (unless smerge-mode 889 (unless smerge-mode
849 (smerge-remove-props (point-min) (point-max)))) 890 (smerge-remove-props (point-min) (point-max))))
850 891
diff --git a/lisp/startup.el b/lisp/startup.el
index 3430e588309..5bf85a169ee 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -38,7 +38,20 @@
38 38
39(defgroup initialization nil 39(defgroup initialization nil
40 "Emacs start-up procedure." 40 "Emacs start-up procedure."
41 :group 'internal) 41 :group 'environment)
42
43(defcustom initial-buffer-choice nil
44 "Buffer to show after starting Emacs.
45If the value is nil and `inhibit-splash-screen' is nil, show the
46startup screen. If the value is string, visit the specified file or
47directory using `find-file'. If t, open the `*scratch*' buffer."
48 :type '(choice
49 (const :tag "Splash screen" nil)
50 (directory :tag "Directory" :value "~/")
51 (file :tag "File" :value "~/file.txt")
52 (const :tag "Lisp scratch buffer" t))
53 :version "23.1"
54 :group 'initialization)
42 55
43(defcustom inhibit-splash-screen nil 56(defcustom inhibit-splash-screen nil
44 "Non-nil inhibits the startup screen. 57 "Non-nil inhibits the startup screen.
@@ -1056,10 +1069,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
1056 (if (get-buffer "*scratch*") 1069 (if (get-buffer "*scratch*")
1057 (with-current-buffer "*scratch*" 1070 (with-current-buffer "*scratch*"
1058 (if (eq major-mode 'fundamental-mode) 1071 (if (eq major-mode 'fundamental-mode)
1059 (funcall initial-major-mode)) 1072 (funcall initial-major-mode))))
1060 ;; Don't lose text that users type in *scratch*.
1061 (setq buffer-offer-save t)
1062 (auto-save-mode 1)))
1063 1073
1064 ;; Load library for our terminal type. 1074 ;; Load library for our terminal type.
1065 ;; User init file can set term-file-prefix to nil to prevent this. 1075 ;; User init file can set term-file-prefix to nil to prevent this.
@@ -1132,6 +1142,8 @@ regardless of the value of this variable."
1132 '((:face (variable-pitch :weight bold) 1142 '((:face (variable-pitch :weight bold)
1133 "Important Help menu items:\n" 1143 "Important Help menu items:\n"
1134 :face variable-pitch 1144 :face variable-pitch
1145 :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial)))
1146 "\tLearn how to use Emacs efficiently"
1135 (lambda () 1147 (lambda ()
1136 (let* ((en "TUTORIAL") 1148 (let* ((en "TUTORIAL")
1137 (tut (or (get-language-info current-language-environment 1149 (tut (or (get-language-info current-language-environment
@@ -1145,47 +1157,47 @@ regardless of the value of this variable."
1145 (buffer-substring (point-min) (1- (point)))))) 1157 (buffer-substring (point-min) (1- (point))))))
1146 ;; If there is a specific tutorial for the current language 1158 ;; If there is a specific tutorial for the current language
1147 ;; environment and it is not English, append its title. 1159 ;; environment and it is not English, append its title.
1148 (concat 1160 (if (string= en tut)
1149 "Emacs Tutorial\t\tLearn how to use Emacs efficiently" 1161 ""
1150 (if (string= en tut) 1162 (concat " (" title ")"))))
1151 "" 1163 "\n"
1152 (concat " (" title ")")) 1164 :face variable-pitch
1153 "\n"))) 1165 :link ("Emacs FAQ" (lambda (button) (view-emacs-FAQ)))
1154 :face variable-pitch "\ 1166 "\tFrequently asked questions and answers\n"
1155Emacs FAQ\t\tFrequently asked questions and answers 1167 :link ("View Emacs Manual" (lambda (button) (info-emacs-manual)))
1156View Emacs Manual\t\tView the Emacs manual using Info 1168 "\tView the Emacs manual using Info\n"
1157Absence of Warranty\tGNU Emacs comes with " 1169 :link ("Absence of Warranty" (lambda (button) (describe-no-warranty)))
1170 "\tGNU Emacs comes with "
1158 :face (variable-pitch :slant oblique) 1171 :face (variable-pitch :slant oblique)
1159 "ABSOLUTELY NO WARRANTY\n" 1172 "ABSOLUTELY NO WARRANTY\n"
1160 :face variable-pitch 1173 :face variable-pitch
1161 "\ 1174 :link ("Copying Conditions" (lambda (button) (describe-copying)))
1162Copying Conditions\t\tConditions for redistributing and changing Emacs 1175 "\tConditions for redistributing and changing Emacs\n"
1163Getting New Versions\tHow to obtain the latest version of Emacs 1176 :link ("Getting New Versions" (lambda (button) (describe-distribution)))
1164More Manuals / Ordering Manuals Buying printed manuals from the FSF\n") 1177 "\tHow to obtain the latest version of Emacs\n"
1165 (:face variable-pitch 1178 :link ("More Manuals / Ordering Manuals" (lambda (button) (view-order-manuals)))
1166 "\nTo quit a partially entered command, type " 1179 " Buying printed manuals from the FSF\n")
1167 :face default 1180 (:face (variable-pitch :weight bold)
1168 "Control-g" 1181 "Useful tasks:\n"
1169 :face variable-pitch
1170 ".
1171
1172Emacs Guided Tour\t\tSee http://www.gnu.org/software/emacs/tour/
1173
1174"
1175 :face (variable-pitch :weight bold)
1176 "Useful File menu items:\n"
1177 :face variable-pitch 1182 :face variable-pitch
1178 "Exit Emacs\t\t(Or type " 1183 :link ("Visit New File"
1179 :face default 1184 (lambda (button) (call-interactively 'find-file)))
1180 "Control-x" 1185 "\tSpecify a new file's name, to edit the file\n"
1181 :face variable-pitch 1186 :link ("Open Home Directory"
1182 " followed by " 1187 (lambda (button) (dired "~")))
1183 :face default 1188 "\tOpen your home directory, to operate on its files\n"
1184 "Control-c" 1189 :link ("Open *scratch* buffer"
1185 :face variable-pitch 1190 (lambda (button) (switch-to-buffer (get-buffer-create "*scratch*"))))
1186 ") 1191 "\tOpen buffer for notes you don't want to save\n"
1187Recover Crashed Session\tRecover files you were editing before a crash\n" 1192 :link ("Customize Startup"
1188 )) 1193 (lambda (button) (customize-group 'initialization)))
1194 "\tChange initialization settings including this screen\n"
1195
1196 "\nEmacs Guided Tour\tSee "
1197 :link ("http://www.gnu.org/software/emacs/tour/"
1198 (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/")))
1199
1200 ))
1189 "A list of texts to show in the middle part of splash screens. 1201 "A list of texts to show in the middle part of splash screens.
1190Each element in the list should be a list of strings or pairs 1202Each element in the list should be a list of strings or pairs
1191`:face FACE', like `fancy-splash-insert' accepts them.") 1203`:face FACE', like `fancy-splash-insert' accepts them.")
@@ -1217,13 +1229,22 @@ Values less than twice `fancy-splash-delay' are ignored."
1217 (file :tag "File"))) 1229 (file :tag "File")))
1218 1230
1219 1231
1232(defvar splash-screen-keymap
1233 (let ((map (make-sparse-keymap)))
1234 (suppress-keymap map)
1235 (set-keymap-parent map button-buffer-map)
1236 (define-key map "\C-?" 'scroll-down)
1237 (define-key map " " 'scroll-up)
1238 (define-key map "q" 'exit-splash-screen)
1239 map)
1240 "Keymap for splash screen buffer.")
1241
1220;; These are temporary storage areas for the splash screen display. 1242;; These are temporary storage areas for the splash screen display.
1221 1243
1222(defvar fancy-current-text nil) 1244(defvar fancy-current-text nil)
1223(defvar fancy-splash-help-echo nil) 1245(defvar fancy-splash-help-echo nil)
1224(defvar fancy-splash-stop-time nil) 1246(defvar fancy-splash-stop-time nil)
1225(defvar fancy-splash-outer-buffer nil) 1247(defvar fancy-splash-outer-buffer nil)
1226(defvar fancy-splash-last-input-event nil)
1227 1248
1228(defun fancy-splash-insert (&rest args) 1249(defun fancy-splash-insert (&rest args)
1229 "Insert text into the current buffer, with faces. 1250 "Insert text into the current buffer, with faces.
@@ -1233,14 +1254,21 @@ where FACE is a valid face specification, as it can be used with
1233`put-text-property'." 1254`put-text-property'."
1234 (let ((current-face nil)) 1255 (let ((current-face nil))
1235 (while args 1256 (while args
1236 (if (eq (car args) :face) 1257 (cond ((eq (car args) :face)
1237 (setq args (cdr args) current-face (car args)) 1258 (setq args (cdr args) current-face (car args)))
1238 (insert (propertize (let ((it (car args))) 1259 ((eq (car args) :link)
1239 (if (functionp it) 1260 (setq args (cdr args))
1240 (funcall it) 1261 (let ((spec (car args)))
1241 it)) 1262 (insert-button (car spec)
1242 'face current-face 1263 'face (list 'link current-face)
1243 'help-echo fancy-splash-help-echo))) 1264 'action (cadr spec)
1265 'follow-link t)))
1266 (t (insert (propertize (let ((it (car args)))
1267 (if (functionp it)
1268 (funcall it)
1269 it))
1270 'face current-face
1271 'help-echo fancy-splash-help-echo))))
1244 (setq args (cdr args))))) 1272 (setq args (cdr args)))))
1245 1273
1246 1274
@@ -1270,18 +1298,12 @@ where FACE is a valid face specification, as it can be used with
1270 (eq (frame-parameter nil 'background-mode) 'dark)) 1298 (eq (frame-parameter nil 'background-mode) 'dark))
1271 (setq img (append img '(:color-symbols (("#000000" . "gray30")))))) 1299 (setq img (append img '(:color-symbols (("#000000" . "gray30"))))))
1272 1300
1273 ;; Insert the image with a help-echo and a keymap. 1301 ;; Insert the image with a help-echo and a link.
1274 (let ((map (make-sparse-keymap)) 1302 (make-button (prog1 (point) (insert-image img)) (point)
1275 (help-echo "mouse-2: browse http://www.gnu.org/")) 1303 'face 'default
1276 (define-key map [mouse-2] 1304 'help-echo "mouse-2: browse http://www.gnu.org/"
1277 (lambda () 1305 'action (lambda (button) (browse-url "http://www.gnu.org/"))
1278 (interactive) 1306 'follow-link t)
1279 (browse-url "http://www.gnu.org/")
1280 (throw 'exit nil)))
1281 (define-key map [down-mouse-2] 'ignore)
1282 (define-key map [up-mouse-2] 'ignore)
1283 (insert-image img (propertize "xxx" 'help-echo help-echo
1284 'keymap map)))
1285 (insert "\n")))) 1307 (insert "\n"))))
1286 (fancy-splash-insert 1308 (fancy-splash-insert
1287 :face '(variable-pitch :background "red") 1309 :face '(variable-pitch :background "red")
@@ -1295,19 +1317,22 @@ where FACE is a valid face specification, as it can be used with
1295 (fancy-splash-insert 1317 (fancy-splash-insert
1296 :face 'variable-pitch 1318 :face 'variable-pitch
1297 "You can do basic editing with the menu bar and scroll bar \ 1319 "You can do basic editing with the menu bar and scroll bar \
1298using the mouse.\n\n") 1320using the mouse.\n"
1321 :face 'variable-pitch
1322 "To quit a partially entered command, type "
1323 :face 'default
1324 "Control-g"
1325 :face 'variable-pitch
1326 "."
1327 "\n\n")
1299 (when fancy-splash-outer-buffer 1328 (when fancy-splash-outer-buffer
1300 (fancy-splash-insert 1329 (fancy-splash-insert
1301 :face 'variable-pitch 1330 :face 'variable-pitch
1302 "Type " 1331 "Type "
1303 :face 'default 1332 :face 'default
1304 "Control-l" 1333 "`q'"
1305 :face 'variable-pitch 1334 :face 'variable-pitch
1306 " to begin editing" 1335 " to exit from this screen.\n")))
1307 (if (equal (buffer-name fancy-splash-outer-buffer)
1308 "*scratch*")
1309 ".\n"
1310 " your file.\n"))))
1311 1336
1312(defun fancy-splash-tail () 1337(defun fancy-splash-tail ()
1313 "Insert the tail part of the splash screen into the current buffer." 1338 "Insert the tail part of the splash screen into the current buffer."
@@ -1339,7 +1364,7 @@ using the mouse.\n\n")
1339 "Meta-x recover-session RET" 1364 "Meta-x recover-session RET"
1340 :face '(variable-pitch :foreground "red") 1365 :face '(variable-pitch :foreground "red")
1341 "\nto recover" 1366 "\nto recover"
1342 " the files you were editing.")))) 1367 " the files you were editing.\n"))))
1343 1368
1344(defun fancy-splash-screens-1 (buffer) 1369(defun fancy-splash-screens-1 (buffer)
1345 "Timer function displaying a splash screen." 1370 "Timer function displaying a splash screen."
@@ -1347,7 +1372,8 @@ using the mouse.\n\n")
1347 (throw 'stop-splashing nil)) 1372 (throw 'stop-splashing nil))
1348 (unless fancy-current-text 1373 (unless fancy-current-text
1349 (setq fancy-current-text fancy-splash-text)) 1374 (setq fancy-current-text fancy-splash-text))
1350 (let ((text (car fancy-current-text))) 1375 (let ((text (car fancy-current-text))
1376 (inhibit-read-only t))
1351 (set-buffer buffer) 1377 (set-buffer buffer)
1352 (erase-buffer) 1378 (erase-buffer)
1353 (if pure-space-overflow 1379 (if pure-space-overflow
@@ -1364,73 +1390,30 @@ Warning Warning!!! Pure space overflow !!!Warning Warning
1364 (force-mode-line-update) 1390 (force-mode-line-update)
1365 (setq fancy-current-text (cdr fancy-current-text)))) 1391 (setq fancy-current-text (cdr fancy-current-text))))
1366 1392
1367 1393(defun exit-splash-screen ()
1368(defun fancy-splash-default-action () 1394 "Stop displaying the splash screen buffer."
1369 "Stop displaying the splash screen buffer.
1370This is an internal function used to turn off the splash screen after
1371the user caused an input event by hitting a key or clicking with the
1372mouse."
1373 (interactive) 1395 (interactive)
1374 (if (and (memq 'down (event-modifiers last-command-event)) 1396 (if fancy-splash-outer-buffer
1375 (eq (posn-window (event-start last-command-event)) 1397 (throw 'exit nil)
1376 (selected-window))) 1398 (quit-window t)))
1377 ;; This is a mouse-down event in the spash screen window.
1378 ;; Ignore it and consume the corresponding mouse-up event.
1379 (read-event)
1380 (push last-command-event unread-command-events))
1381 (throw 'exit nil))
1382
1383(defun fancy-splash-special-event-action ()
1384 "Save the last event and stop displaying the splash screen buffer.
1385This is an internal function used to turn off the splash screen after
1386the user caused an input event that is bound in `special-event-map'"
1387 (interactive)
1388 (setq fancy-splash-last-input-event last-input-event)
1389 (throw 'exit nil))
1390
1391 1399
1392(defun fancy-splash-screens (&optional hide-on-input) 1400(defun fancy-splash-screens (&optional static)
1393 "Display fancy splash screens when Emacs starts." 1401 "Display fancy splash screens when Emacs starts."
1394 (if hide-on-input 1402 (if (not static)
1395 (let ((old-hourglass display-hourglass) 1403 (let ((old-hourglass display-hourglass)
1396 (fancy-splash-outer-buffer (current-buffer)) 1404 (fancy-splash-outer-buffer (current-buffer))
1397 splash-buffer 1405 splash-buffer
1398 (old-minor-mode-map-alist minor-mode-map-alist)
1399 (old-emulation-mode-map-alists emulation-mode-map-alists)
1400 (old-special-event-map special-event-map)
1401 (frame (fancy-splash-frame)) 1406 (frame (fancy-splash-frame))
1402 timer) 1407 timer)
1403 (save-selected-window 1408 (save-selected-window
1404 (select-frame frame) 1409 (select-frame frame)
1405 (switch-to-buffer " GNU Emacs") 1410 (switch-to-buffer "*About GNU Emacs*")
1406 (make-local-variable 'cursor-type) 1411 (make-local-variable 'cursor-type)
1407 (setq splash-buffer (current-buffer)) 1412 (setq splash-buffer (current-buffer))
1408 (catch 'stop-splashing 1413 (catch 'stop-splashing
1409 (unwind-protect 1414 (unwind-protect
1410 (let ((map (make-sparse-keymap)) 1415 (let ((cursor-type nil))
1411 (cursor-type nil))
1412 (use-local-map map)
1413 (define-key map [switch-frame] 'ignore)
1414 (define-key map [t] 'fancy-splash-default-action)
1415 (define-key map [mouse-movement] 'ignore)
1416 (define-key map [mode-line t] 'ignore)
1417 ;; Temporarily bind special events to
1418 ;; fancy-splash-special-event-action so as to stop
1419 ;; displaying splash screens with such events.
1420 ;; Otherwise, drag-n-drop into splash screens may
1421 ;; leave us in recursive editing with invisible
1422 ;; cursors for a while.
1423 (setq special-event-map (make-sparse-keymap))
1424 (map-keymap
1425 (lambda (key def)
1426 (define-key special-event-map (vector key)
1427 (if (eq def 'ignore)
1428 'ignore
1429 'fancy-splash-special-event-action)))
1430 old-special-event-map)
1431 (setq display-hourglass nil 1416 (setq display-hourglass nil
1432 minor-mode-map-alist nil
1433 emulation-mode-map-alists nil
1434 buffer-undo-list t 1417 buffer-undo-list t
1435 mode-line-format (propertize "---- %b %-" 1418 mode-line-format (propertize "---- %b %-"
1436 'face 'mode-line-buffer-id) 1419 'face 'mode-line-buffer-id)
@@ -1439,25 +1422,19 @@ the user caused an input event that is bound in `special-event-map'"
1439 timer (run-with-timer 0 fancy-splash-delay 1422 timer (run-with-timer 0 fancy-splash-delay
1440 #'fancy-splash-screens-1 1423 #'fancy-splash-screens-1
1441 splash-buffer)) 1424 splash-buffer))
1425 (use-local-map splash-screen-keymap)
1426 (setq tab-width 22)
1442 (message "%s" (startup-echo-area-message)) 1427 (message "%s" (startup-echo-area-message))
1428 (setq buffer-read-only t)
1443 (recursive-edit)) 1429 (recursive-edit))
1444 (cancel-timer timer) 1430 (cancel-timer timer)
1445 (setq display-hourglass old-hourglass 1431 (setq display-hourglass old-hourglass)
1446 minor-mode-map-alist old-minor-mode-map-alist 1432 (kill-buffer splash-buffer)))))
1447 emulation-mode-map-alists old-emulation-mode-map-alists 1433 ;; If static is non-nil, don't show fancy splash screen.
1448 special-event-map old-special-event-map)
1449 (kill-buffer splash-buffer)
1450 (when fancy-splash-last-input-event
1451 (setq last-input-event fancy-splash-last-input-event
1452 fancy-splash-last-input-event nil)
1453 (command-execute (lookup-key special-event-map
1454 (vector last-input-event))
1455 nil (vector last-input-event) t))))))
1456 ;; If hide-on-input is nil, don't hide the buffer on input.
1457 (if (or (window-minibuffer-p) 1434 (if (or (window-minibuffer-p)
1458 (window-dedicated-p (selected-window))) 1435 (window-dedicated-p (selected-window)))
1459 (pop-to-buffer (current-buffer)) 1436 (pop-to-buffer (current-buffer))
1460 (switch-to-buffer "*About GNU Emacs*")) 1437 (switch-to-buffer "*GNU Emacs*"))
1461 (setq buffer-read-only nil) 1438 (setq buffer-read-only nil)
1462 (erase-buffer) 1439 (erase-buffer)
1463 (if pure-space-overflow 1440 (if pure-space-overflow
@@ -1473,6 +1450,8 @@ Warning Warning!!! Pure space overflow !!!Warning Warning
1473 (delete-region (point) (point-max)) 1450 (delete-region (point) (point-max))
1474 (insert "\n") 1451 (insert "\n")
1475 (fancy-splash-tail) 1452 (fancy-splash-tail)
1453 (use-local-map splash-screen-keymap)
1454 (setq tab-width 22)
1476 (set-buffer-modified-p nil) 1455 (set-buffer-modified-p nil)
1477 (setq buffer-read-only t) 1456 (setq buffer-read-only t)
1478 (if (and view-read-only (not view-mode)) 1457 (if (and view-read-only (not view-mode))
@@ -1511,15 +1490,15 @@ we put it on this frame."
1511 (> frame-height (+ image-height 19))))))) 1490 (> frame-height (+ image-height 19)))))))
1512 1491
1513 1492
1514(defun normal-splash-screen (&optional hide-on-input) 1493(defun normal-splash-screen (&optional static)
1515 "Display splash screen when Emacs starts." 1494 "Display splash screen when Emacs starts."
1516 (let ((prev-buffer (current-buffer))) 1495 (let ((prev-buffer (current-buffer)))
1517 (unwind-protect 1496 (unwind-protect
1518 (with-current-buffer (get-buffer-create "GNU Emacs") 1497 (with-current-buffer (get-buffer-create "*About GNU Emacs*")
1519 (setq buffer-read-only nil) 1498 (setq buffer-read-only nil)
1520 (erase-buffer) 1499 (erase-buffer)
1521 (set (make-local-variable 'tab-width) 8) 1500 (set (make-local-variable 'tab-width) 8)
1522 (if hide-on-input 1501 (if (not static)
1523 (set (make-local-variable 'mode-line-format) 1502 (set (make-local-variable 'mode-line-format)
1524 (propertize "---- %b %-" 'face 'mode-line-buffer-id))) 1503 (propertize "---- %b %-" 'face 'mode-line-buffer-id)))
1525 1504
@@ -1537,13 +1516,10 @@ Warning Warning!!! Pure space overflow !!!Warning Warning
1537 ", one component of the GNU/Linux operating system.\n" 1516 ", one component of the GNU/Linux operating system.\n"
1538 ", a part of the GNU operating system.\n")) 1517 ", a part of the GNU operating system.\n"))
1539 1518
1540 (if hide-on-input 1519 (if (not static)
1541 (insert (substitute-command-keys 1520 (insert (substitute-command-keys
1542 (concat 1521 (concat
1543 "\nType \\[recenter] to begin editing" 1522 "\nType \\[recenter] to quit from this screen.\n"))))
1544 (if (equal (buffer-name prev-buffer) "*scratch*")
1545 ".\n"
1546 " your file.\n")))))
1547 1523
1548 (if (display-mouse-p) 1524 (if (display-mouse-p)
1549 ;; The user can use the mouse to activate menus 1525 ;; The user can use the mouse to activate menus
@@ -1551,22 +1527,58 @@ Warning Warning!!! Pure space overflow !!!Warning Warning
1551 (progn 1527 (progn
1552 (insert "\ 1528 (insert "\
1553You can do basic editing with the menu bar and scroll bar using the mouse. 1529You can do basic editing with the menu bar and scroll bar using the mouse.
1554To quit a partially entered command, type Control-g. 1530To quit a partially entered command, type Control-g.\n")
1555 1531
1556Useful File menu items: 1532 (insert "\nImportant Help menu items:\n")
1557Exit Emacs (or type Control-x followed by Control-c) 1533 (insert-button "Emacs Tutorial"
1558Recover Crashed Session Recover files you were editing before a crash 1534 'action (lambda (button) (help-with-tutorial))
1559 1535 'follow-link t)
1560Important Help menu items: 1536 (insert "\t\tLearn how to use Emacs efficiently\n")
1561Emacs Tutorial Learn how to use Emacs efficiently 1537 (insert-button "Emacs FAQ"
1562Emacs FAQ Frequently asked questions and answers 1538 'action (lambda (button) (view-emacs-FAQ))
1563Read the Emacs Manual View the Emacs manual using Info 1539 'follow-link t)
1564\(Non)Warranty GNU Emacs comes with ABSOLUTELY NO WARRANTY 1540 (insert "\t\tFrequently asked questions and answers\n")
1565Copying Conditions Conditions for redistributing and changing Emacs 1541 (insert-button "Read the Emacs Manual"
1566Getting New Versions How to obtain the latest version of Emacs 1542 'action (lambda (button) (info-emacs-manual))
1567More Manuals / Ordering Manuals How to order printed manuals from the FSF 1543 'follow-link t)
1568") 1544 (insert "\tView the Emacs manual using Info\n")
1569 (insert "\n\n" (emacs-version) 1545 (insert-button "\(Non)Warranty"
1546 'action (lambda (button) (describe-no-warranty))
1547 'follow-link t)
1548 (insert "\t\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n")
1549 (insert-button "Copying Conditions"
1550 'action (lambda (button) (describe-copying))
1551 'follow-link t)
1552 (insert "\tConditions for redistributing and changing Emacs\n")
1553 (insert-button "Getting New Versions"
1554 'action (lambda (button) (describe-distribution))
1555 'follow-link t)
1556 (insert "\tHow to obtain the latest version of Emacs\n")
1557 (insert-button "More Manuals / Ordering Manuals"
1558 'action (lambda (button) (view-order-manuals))
1559 'follow-link t)
1560 (insert " How to order printed manuals from the FSF\n")
1561
1562 (insert "\nUseful tasks:\n")
1563 (insert-button "Visit New File"
1564 'action (lambda (button) (call-interactively 'find-file))
1565 'follow-link t)
1566 (insert "\t\tSpecify a new file's name, to edit the file\n")
1567 (insert-button "Open Home Directory"
1568 'action (lambda (button) (dired "~"))
1569 'follow-link t)
1570 (insert "\tOpen your home directory, to operate on its files\n")
1571 (insert-button "Open *scratch* buffer"
1572 'action (lambda (button) (switch-to-buffer
1573 (get-buffer-create "*scratch*")))
1574 'follow-link t)
1575 (insert "\tOpen buffer for notes you don't want to save\n")
1576 (insert-button "Customize Startup"
1577 'action (lambda (button) (customize-group 'initialization))
1578 'follow-link t)
1579 (insert "\tChange initialization settings including this screen\n")
1580
1581 (insert "\n" (emacs-version)
1570 "\n" emacs-copyright)) 1582 "\n" emacs-copyright))
1571 1583
1572 ;; No mouse menus, so give help using kbd commands. 1584 ;; No mouse menus, so give help using kbd commands.
@@ -1580,57 +1592,138 @@ More Manuals / Ordering Manuals How to order printed manuals from the FSF
1580 (eq (key-binding "\C-hi") 'info) 1592 (eq (key-binding "\C-hi") 'info)
1581 (eq (key-binding "\C-hr") 'info-emacs-manual) 1593 (eq (key-binding "\C-hr") 'info-emacs-manual)
1582 (eq (key-binding "\C-h\C-n") 'view-emacs-news)) 1594 (eq (key-binding "\C-h\C-n") 'view-emacs-news))
1583 (insert " 1595 (progn
1596 (insert "
1584Get help C-h (Hold down CTRL and press h) 1597Get help C-h (Hold down CTRL and press h)
1585Emacs manual C-h r 1598")
1586Emacs tutorial C-h t Undo changes C-x u 1599 (insert-button "Emacs manual"
1587Buy manuals C-h C-m Exit Emacs C-x C-c 1600 'action (lambda (button) (info-emacs-manual))
1588Browse manuals C-h i") 1601 'follow-link t)
1602 (insert " C-h r\t")
1603 (insert-button "Browse manuals"
1604 'action (lambda (button) (Info-directory))
1605 'follow-link t)
1606 (insert "\t C-h i
1607")
1608 (insert-button "Emacs tutorial"
1609 'action (lambda (button) (help-with-tutorial))
1610 'follow-link t)
1611 (insert " C-h t\tUndo changes\t C-x u
1612")
1613 (insert-button "Buy manuals"
1614 'action (lambda (button) (view-order-manuals))
1615 'follow-link t)
1616 (insert "\t C-h C-m\tExit Emacs\t C-x C-c"))
1589 1617
1590 (insert (substitute-command-keys 1618 (insert (format "
1591 (format "\n
1592Get help %s 1619Get help %s
1593Emacs manual \\[info-emacs-manual] 1620"
1594Emacs tutorial \\[help-with-tutorial]\tUndo changes\t\\[advertised-undo] 1621 (let ((where (where-is-internal
1595Buy manuals \\[view-order-manuals]\tExit Emacs\t\\[save-buffers-kill-emacs] 1622 'help-command nil t)))
1596Browse manuals \\[info]" 1623 (if where
1597 (let ((where (where-is-internal 1624 (key-description where)
1598 'help-command nil t))) 1625 "M-x help"))))
1599 (if where 1626 (insert-button "Emacs manual"
1600 (key-description where) 1627 'action (lambda (button) (info-emacs-manual))
1601 "M-x help")))))) 1628 'follow-link t)
1629 (insert (substitute-command-keys" \\[info-emacs-manual]\t"))
1630 (insert-button "Browse manuals"
1631 'action (lambda (button) (Info-directory))
1632 'follow-link t)
1633 (insert (substitute-command-keys "\t \\[info]
1634"))
1635 (insert-button "Emacs tutorial"
1636 'action (lambda (button) (help-with-tutorial))
1637 'follow-link t)
1638 (insert (substitute-command-keys
1639 " \\[help-with-tutorial]\tUndo changes\t \\[advertised-undo]
1640"))
1641 (insert-button "Buy manuals"
1642 'action (lambda (button) (view-order-manuals))
1643 'follow-link t)
1644 (insert (substitute-command-keys
1645 "\t \\[view-order-manuals]\tExit Emacs\t \\[save-buffers-kill-emacs]")))
1602 1646
1603 ;; Say how to use the menu bar with the keyboard. 1647 ;; Say how to use the menu bar with the keyboard.
1648 (insert "\n")
1649 (insert-button "Activate menubar"
1650 'action (lambda (button) (tmm-menubar))
1651 'follow-link t)
1604 (if (and (eq (key-binding "\M-`") 'tmm-menubar) 1652 (if (and (eq (key-binding "\M-`") 'tmm-menubar)
1605 (eq (key-binding [f10]) 'tmm-menubar)) 1653 (eq (key-binding [f10]) 'tmm-menubar))
1606 (insert " 1654 (insert " F10 or ESC ` or M-`")
1607Activate menubar F10 or ESC ` or M-`") 1655 (insert (substitute-command-keys " \\[tmm-menubar]")))
1608 (insert (substitute-command-keys "
1609Activate menubar \\[tmm-menubar]")))
1610 1656
1611 ;; Many users seem to have problems with these. 1657 ;; Many users seem to have problems with these.
1612 (insert " 1658 (insert "
1613\(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key. 1659\(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key.
1614If you have no Meta key, you may instead type ESC followed by the character.)") 1660If you have no Meta key, you may instead type ESC followed by the character.)")
1615 1661
1616 (insert "\n\n" (emacs-version) 1662 ;; Insert links to useful tasks
1663 (insert "\nUseful tasks:\n")
1664
1665 (insert-button "Visit New File"
1666 'action (lambda (button) (call-interactively 'find-file))
1667 'follow-link t)
1668 (insert "\t\t\t")
1669 (insert-button "Open Home Directory"
1670 'action (lambda (button) (dired "~"))
1671 'follow-link t)
1672 (insert "\n")
1673
1674 (insert-button "Customize Startup"
1675 'action (lambda (button) (customize-group 'initialization))
1676 'follow-link t)
1677 (insert "\t\t")
1678 (insert-button "Open *scratch* buffer"
1679 'action (lambda (button) (switch-to-buffer
1680 (get-buffer-create "*scratch*")))
1681 'follow-link t)
1682 (insert "\n")
1683
1684 (insert "\n" (emacs-version)
1617 "\n" emacs-copyright) 1685 "\n" emacs-copyright)
1618 1686
1619 (if (and (eq (key-binding "\C-h\C-c") 'describe-copying) 1687 (if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
1620 (eq (key-binding "\C-h\C-d") 'describe-distribution) 1688 (eq (key-binding "\C-h\C-d") 'describe-distribution)
1621 (eq (key-binding "\C-h\C-w") 'describe-no-warranty)) 1689 (eq (key-binding "\C-h\C-w") 'describe-no-warranty))
1622 (insert 1690 (progn
1623 "\n 1691 (insert
1624GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details. 1692 "\n
1693GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for ")
1694 (insert-button "full details"
1695 'action (lambda (button) (describe-no-warranty))
1696 'follow-link t)
1697 (insert ".
1625Emacs is Free Software--Free as in Freedom--so you can redistribute copies 1698Emacs is Free Software--Free as in Freedom--so you can redistribute copies
1626of Emacs and modify it; type C-h C-c to see the conditions. 1699of Emacs and modify it; type C-h C-c to see ")
1627Type C-h C-d for information on getting the latest version.") 1700 (insert-button "the conditions"
1701 'action (lambda (button) (describe-copying))
1702 'follow-link t)
1703 (insert ".
1704Type C-h C-d for information on ")
1705 (insert-button "getting the latest version"
1706 'action (lambda (button) (describe-distribution))
1707 'follow-link t)
1708 (insert "."))
1628 (insert (substitute-command-keys 1709 (insert (substitute-command-keys
1629 "\n 1710 "\n
1630GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details. 1711GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for "))
1712 (insert-button "full details"
1713 'action (lambda (button) (describe-no-warranty))
1714 'follow-link t)
1715 (insert (substitute-command-keys ".
1631Emacs is Free Software--Free as in Freedom--so you can redistribute copies 1716Emacs is Free Software--Free as in Freedom--so you can redistribute copies
1632of Emacs and modify it; type \\[describe-copying] to see the conditions. 1717of Emacs and modify it; type \\[describe-copying] to see "))
1633Type \\[describe-distribution] for information on getting the latest version.")))) 1718 (insert-button "the conditions"
1719 'action (lambda (button) (describe-copying))
1720 'follow-link t)
1721 (insert (substitute-command-keys".
1722Type \\[describe-distribution] for information on "))
1723 (insert-button "getting the latest version"
1724 'action (lambda (button) (describe-distribution))
1725 'follow-link t)
1726 (insert ".")))
1634 1727
1635 ;; The rest of the startup screen is the same on all 1728 ;; The rest of the startup screen is the same on all
1636 ;; kinds of terminals. 1729 ;; kinds of terminals.
@@ -1651,7 +1744,9 @@ Type \\[describe-distribution] for information on getting the latest version."))
1651 t) 1744 t)
1652 (insert "\n\nIf an Emacs session crashed recently, " 1745 (insert "\n\nIf an Emacs session crashed recently, "
1653 "type Meta-x recover-session RET\nto recover" 1746 "type Meta-x recover-session RET\nto recover"
1654 " the files you were editing.")) 1747 " the files you were editing.\n"))
1748
1749 (use-local-map splash-screen-keymap)
1655 1750
1656 ;; Display the input that we set up in the buffer. 1751 ;; Display the input that we set up in the buffer.
1657 (set-buffer-modified-p nil) 1752 (set-buffer-modified-p nil)
@@ -1659,10 +1754,10 @@ Type \\[describe-distribution] for information on getting the latest version."))
1659 (if (and view-read-only (not view-mode)) 1754 (if (and view-read-only (not view-mode))
1660 (view-mode-enter nil 'kill-buffer)) 1755 (view-mode-enter nil 'kill-buffer))
1661 (goto-char (point-min)) 1756 (goto-char (point-min))
1662 (if hide-on-input 1757 (if (not static)
1663 (if (or (window-minibuffer-p) 1758 (if (or (window-minibuffer-p)
1664 (window-dedicated-p (selected-window))) 1759 (window-dedicated-p (selected-window)))
1665 ;; If hide-on-input is nil, creating a new frame will 1760 ;; If static is nil, creating a new frame will
1666 ;; generate enough events that the subsequent `sit-for' 1761 ;; generate enough events that the subsequent `sit-for'
1667 ;; will immediately return anyway. 1762 ;; will immediately return anyway.
1668 nil ;; (pop-to-buffer (current-buffer)) 1763 nil ;; (pop-to-buffer (current-buffer))
@@ -1674,10 +1769,10 @@ Type \\[describe-distribution] for information on getting the latest version."))
1674 ;; In case the window is dedicated or something. 1769 ;; In case the window is dedicated or something.
1675 (error (pop-to-buffer (current-buffer)))))) 1770 (error (pop-to-buffer (current-buffer))))))
1676 ;; Unwind ... ensure splash buffer is killed 1771 ;; Unwind ... ensure splash buffer is killed
1677 (if hide-on-input 1772 (if (not static)
1678 (kill-buffer "GNU Emacs") 1773 (kill-buffer "*About GNU Emacs*")
1679 (switch-to-buffer "GNU Emacs") 1774 (switch-to-buffer "*About GNU Emacs*")
1680 (rename-buffer "*About GNU Emacs*" t))))) 1775 (rename-buffer "*GNU Emacs*" t)))))
1681 1776
1682 1777
1683(defun startup-echo-area-message () 1778(defun startup-echo-area-message ()
@@ -1693,16 +1788,17 @@ Type \\[describe-distribution] for information on getting the latest version."))
1693 (message "%s" (startup-echo-area-message)))) 1788 (message "%s" (startup-echo-area-message))))
1694 1789
1695 1790
1696(defun display-splash-screen (&optional hide-on-input) 1791(defun display-splash-screen (&optional static)
1697 "Display splash screen according to display. 1792 "Display splash screen according to display.
1698Fancy splash screens are used on graphic displays, 1793Fancy splash screens are used on graphic displays,
1699normal otherwise. 1794normal otherwise.
1700With a prefix argument, any user input hides the splash screen." 1795With a prefix argument, any user input hides the splash screen."
1701 (interactive "P") 1796 (interactive "P")
1702 (if (use-fancy-splash-screens-p) 1797 (if (use-fancy-splash-screens-p)
1703 (fancy-splash-screens hide-on-input) 1798 (fancy-splash-screens static)
1704 (normal-splash-screen hide-on-input))) 1799 (normal-splash-screen static)))
1705 1800
1801(defalias 'about-emacs 'display-splash-screen)
1706 1802
1707(defun command-line-1 (command-line-args-left) 1803(defun command-line-1 (command-line-args-left)
1708 (or noninteractive (input-pending-p) init-file-had-error 1804 (or noninteractive (input-pending-p) init-file-had-error
@@ -1962,8 +2058,15 @@ With a prefix argument, any user input hides the splash screen."
1962 (or (get-buffer-window first-file-buffer) 2058 (or (get-buffer-window first-file-buffer)
1963 (list-buffers))))) 2059 (list-buffers)))))
1964 2060
2061 (when initial-buffer-choice
2062 (cond ((eq initial-buffer-choice t)
2063 (switch-to-buffer (get-buffer-create "*scratch*")))
2064 ((stringp initial-buffer-choice)
2065 (find-file initial-buffer-choice))))
2066
1965 ;; Maybe display a startup screen. 2067 ;; Maybe display a startup screen.
1966 (unless (or inhibit-startup-message 2068 (unless (or inhibit-startup-message
2069 initial-buffer-choice
1967 noninteractive 2070 noninteractive
1968 emacs-quick-startup) 2071 emacs-quick-startup)
1969 ;; Display a startup screen, after some preparations. 2072 ;; Display a startup screen, after some preparations.
diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el
index 6d3d4de11e3..5050788f9fb 100644
--- a/lisp/term/mac-win.el
+++ b/lisp/term/mac-win.el
@@ -1841,7 +1841,7 @@ Currently the `mailto' scheme is supported."
1841 1841
1842(define-key mac-apple-event-map [internet-event get-url] 'mac-ae-get-url) 1842(define-key mac-apple-event-map [internet-event get-url] 'mac-ae-get-url)
1843 1843
1844(define-key mac-apple-event-map [hi-command about] 'display-splash-screen) 1844(define-key mac-apple-event-map [hi-command about] 'about-emacs)
1845 1845
1846;;; Converted Carbon Events 1846;;; Converted Carbon Events
1847(defun mac-handle-toolbar-switch-mode (event) 1847(defun mac-handle-toolbar-switch-mode (event)
diff --git a/lisp/vc-bzr.el b/lisp/vc-bzr.el
index 20a9ca9b2fb..c42a64969f2 100644
--- a/lisp/vc-bzr.el
+++ b/lisp/vc-bzr.el
@@ -59,7 +59,7 @@
59 59
60(defgroup vc-bzr nil 60(defgroup vc-bzr nil
61 "VC bzr backend." 61 "VC bzr backend."
62;; :version "22" 62 :version "22.2"
63 :group 'vc) 63 :group 'vc)
64 64
65(defcustom vc-bzr-program "bzr" 65(defcustom vc-bzr-program "bzr"
@@ -131,38 +131,27 @@ format 3' in the first line.
131 131
132If the `checkout/dirstate' file cannot be parsed, fall back to 132If the `checkout/dirstate' file cannot be parsed, fall back to
133running `vc-bzr-state'." 133running `vc-bzr-state'."
134 (condition-case nil 134 (lexical-let ((root (vc-bzr-root file)))
135 (lexical-let ((root (vc-bzr-root file))) 135 (when root ; Short cut.
136 (and root ; Short cut. 136 ;; This looks at internal files. May break if they change
137 ;; This looks at internal files. May break if they change 137 ;; their format.
138 ;; their format. 138 (lexical-let ((dirstate (expand-file-name vc-bzr-admin-dirstate root)))
139 (lexical-let 139 (if (not (file-readable-p dirstate))
140 ((dirstate-file (expand-file-name vc-bzr-admin-dirstate root))) 140 (vc-bzr-state file) ; Expensive.
141 (if (file-exists-p dirstate-file) 141 (with-temp-buffer
142 (with-temp-buffer 142 (insert-file-contents dirstate)
143 (insert-file-contents dirstate-file) 143 (goto-char (point-min))
144 (goto-char (point-min)) 144 (if (not (looking-at "#bazaar dirstate flat format 3"))
145 (when (looking-at "#bazaar dirstate flat format 3") 145 (vc-bzr-state file) ; Some other unknown format?
146 (let* ((relfile (file-relative-name file root)) 146 (let* ((relfile (file-relative-name file root))
147 (reldir (file-name-directory relfile))) 147 (reldir (file-name-directory relfile)))
148 (re-search-forward 148 (re-search-forward
149 (concat "^\0" 149 (concat "^\0"
150 (if reldir (regexp-quote (directory-file-name reldir))) 150 (if reldir (regexp-quote (directory-file-name reldir)))
151 "\0" 151 "\0"
152 (regexp-quote (file-name-nondirectory relfile)) 152 (regexp-quote (file-name-nondirectory relfile))
153 "\0") 153 "\0")
154 nil t)))) 154 nil t)))))))))
155 t))
156 (vc-bzr-state file))) ; Expensive.
157 (file-error nil))) ; vc-bzr-program not found
158
159(defun vc-bzr-buffer-nonblank-p (&optional buffer)
160 "Return non-nil if BUFFER contains any non-blank characters."
161 (or (> (buffer-size buffer) 0)
162 (save-excursion
163 (set-buffer (or buffer (current-buffer)))
164 (goto-char (point-min))
165 (re-search-forward "[^ \t\n]" (point-max) t))))
166 155
167(defconst vc-bzr-state-words 156(defconst vc-bzr-state-words
168 "added\\|ignored\\|kind changed\\|modified\\|removed\\|renamed\\|unknown" 157 "added\\|ignored\\|kind changed\\|modified\\|removed\\|renamed\\|unknown"
@@ -181,61 +170,53 @@ running `vc-bzr-state'."
181(defun vc-bzr-status (file) 170(defun vc-bzr-status (file)
182 "Return FILE status according to Bzr. 171 "Return FILE status according to Bzr.
183Return value is a cons (STATUS . WARNING), where WARNING is a 172Return value is a cons (STATUS . WARNING), where WARNING is a
184string or nil, and STATUS is one of the symbols: 'added, 173string or nil, and STATUS is one of the symbols: `added',
185'ignored, 'kindchange, 'modified, 'removed, 'renamed, 'unknown, 174`ignored', `kindchanged', `modified', `removed', `renamed', `unknown',
186which directly correspond to `bzr status' output, or 'unchanged 175which directly correspond to `bzr status' output, or 'unchanged
187for files whose copy in the working tree is identical to the one 176for files whose copy in the working tree is identical to the one
188in the branch repository, or nil for files that are not 177in the branch repository, or nil for files that are not
189registered with Bzr. 178registered with Bzr.
190 179
191If any error occurred in running `bzr status', then return nil." 180If any error occurred in running `bzr status', then return nil."
192 (condition-case nil
193 (with-temp-buffer 181 (with-temp-buffer
194 (let ((ret (vc-bzr-command "status" t 0 file)) 182 (let ((ret (condition-case nil
195 (status 'unchanged)) 183 (vc-bzr-command "status" t 0 file)
196 ;; the only secure status indication in `bzr status' output 184 (file-error nil))) ; vc-bzr-program not found.
197 ;; is a couple of lines following the pattern:: 185 (status 'unchanged))
198 ;; | <status>: 186 ;; the only secure status indication in `bzr status' output
199 ;; | <file name> 187 ;; is a couple of lines following the pattern::
200 ;; if the file is up-to-date, we get no status report from `bzr', 188 ;; | <status>:
201 ;; so if the regexp search for the above pattern fails, we consider 189 ;; | <file name>
202 ;; the file to be up-to-date. 190 ;; if the file is up-to-date, we get no status report from `bzr',
203 (goto-char (point-min)) 191 ;; so if the regexp search for the above pattern fails, we consider
204 (when 192 ;; the file to be up-to-date.
205 (re-search-forward 193 (goto-char (point-min))
206 ;; bzr prints paths relative to the repository root 194 (when (re-search-forward
207 (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+" 195 ;; bzr prints paths relative to the repository root.
208 (regexp-quote (vc-bzr-file-name-relative file)) 196 (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+"
209 (if (file-directory-p file) "/?" "") 197 (regexp-quote (vc-bzr-file-name-relative file))
210 "[ \t\n]*$") 198 (if (file-directory-p file) "/?" "")
211 (point-max) t) 199 "[ \t\n]*$")
212 (let ((start (match-beginning 0)) 200 nil t)
213 (end (match-end 0))) 201 (let ((status (match-string 1)))
214 (goto-char start) 202 ;; Erase the status text that matched.
203 (delete-region (match-beginning 0) (match-end 0))
215 (setq status 204 (setq status
216 (cond 205 (and (equal ret 0) ; Seems redundant. --Stef
217 ((not (equal ret 0)) nil) 206 (intern (replace-regexp-in-string " " ""
218 ((looking-at "added") 'added) 207 status))))))
219 ((looking-at "kind changed") 'kindchange) 208 (when status
220 ((looking-at "renamed") 'renamed) 209 (goto-char (point-min))
221 ((looking-at "modified") 'modified) 210 (skip-chars-forward " \n\t") ;Throw away spaces.
222 ((looking-at "removed") 'removed) 211 (cons status
223 ((looking-at "ignored") 'ignored) 212 ;; "bzr" will output warnings and informational messages to
224 ((looking-at "unknown") 'unknown))) 213 ;; stderr; due to Emacs' `vc-do-command' (and, it seems,
225 ;; erase the status text that matched 214 ;; `start-process' itself) limitations, we cannot catch stderr
226 (delete-region start end))) 215 ;; and stdout into different buffers. So, if there's anything
227 (if status 216 ;; left in the buffer after removing the above status
228 (cons status 217 ;; keywords, let us just presume that any other message from
229 ;; "bzr" will output warnings and informational messages to 218 ;; "bzr" is a user warning, and display it.
230 ;; stderr; due to Emacs' `vc-do-command' (and, it seems, 219 (unless (eobp) (buffer-substring (point) (point-max))))))))
231 ;; `start-process' itself) limitations, we cannot catch stderr
232 ;; and stdout into different buffers. So, if there's anything
233 ;; left in the buffer after removing the above status
234 ;; keywords, let us just presume that any other message from
235 ;; "bzr" is a user warning, and display it.
236 (if (vc-bzr-buffer-nonblank-p)
237 (buffer-substring (point-min) (point-max)))))))
238 (file-error nil))) ; vc-bzr-program not found
239 220
240(defun vc-bzr-state (file) 221(defun vc-bzr-state (file)
241 (lexical-let ((result (vc-bzr-status file))) 222 (lexical-let ((result (vc-bzr-status file)))
@@ -244,7 +225,7 @@ If any error occurred in running `bzr status', then return nil."
244 (message "Warnings in `bzr' output: %s" (cdr result))) 225 (message "Warnings in `bzr' output: %s" (cdr result)))
245 (cdr (assq (car result) 226 (cdr (assq (car result)
246 '((added . edited) 227 '((added . edited)
247 (kindchange . edited) 228 (kindchanged . edited)
248 (renamed . edited) 229 (renamed . edited)
249 (modified . edited) 230 (modified . edited)
250 (removed . edited) 231 (removed . edited)
@@ -265,7 +246,7 @@ If any error occurred in running `bzr status', then return nil."
265 ;; bzr process. This looks at internal files. May break if they 246 ;; bzr process. This looks at internal files. May break if they
266 ;; change their format. 247 ;; change their format.
267 (if (file-exists-p branch-format-file) 248 (if (file-exists-p branch-format-file)
268 (with-temp-buffer 249 (with-temp-buffer
269 (insert-file-contents branch-format-file) 250 (insert-file-contents branch-format-file)
270 (goto-char (point-min)) 251 (goto-char (point-min))
271 (cond 252 (cond
@@ -273,7 +254,7 @@ If any error occurred in running `bzr status', then return nil."
273 (looking-at "Bazaar-NG branch, format 0.0.4") 254 (looking-at "Bazaar-NG branch, format 0.0.4")
274 (looking-at "Bazaar-NG branch format 5")) 255 (looking-at "Bazaar-NG branch format 5"))
275 ;; count lines in .bzr/branch/revision-history 256 ;; count lines in .bzr/branch/revision-history
276 (insert-file-contents revhistory-file) 257 (insert-file-contents revhistory-file)
277 (number-to-string (count-lines (line-end-position) (point-max)))) 258 (number-to-string (count-lines (line-end-position) (point-max))))
278 ((looking-at "Bazaar Branch Format 6 (bzr 0.15)") 259 ((looking-at "Bazaar Branch Format 6 (bzr 0.15)")
279 ;; revno is the first number in .bzr/branch/last-revision 260 ;; revno is the first number in .bzr/branch/last-revision
@@ -341,10 +322,10 @@ EDITABLE is ignored."
341 (setq destfile (vc-version-backup-file-name file rev))) 322 (setq destfile (vc-version-backup-file-name file rev)))
342 (let ((coding-system-for-read 'binary) 323 (let ((coding-system-for-read 'binary)
343 (coding-system-for-write 'binary)) 324 (coding-system-for-write 'binary))
344 (with-temp-file destfile 325 (with-temp-file destfile
345 (if rev 326 (if rev
346 (vc-bzr-command "cat" t 0 file "-r" rev) 327 (vc-bzr-command "cat" t 0 file "-r" rev)
347 (vc-bzr-command "cat" t 0 file))))) 328 (vc-bzr-command "cat" t 0 file)))))
348 329
349(defun vc-bzr-revert (file &optional contents-done) 330(defun vc-bzr-revert (file &optional contents-done)
350 (unless contents-done 331 (unless contents-done
@@ -377,7 +358,6 @@ EDITABLE is ignored."
377 "Get bzr change log for FILES into specified BUFFER." 358 "Get bzr change log for FILES into specified BUFFER."
378 ;; Fixme: This might need the locale fixing up if things like `revno' 359 ;; Fixme: This might need the locale fixing up if things like `revno'
379 ;; got localized, but certainly it shouldn't use LC_ALL=C. 360 ;; got localized, but certainly it shouldn't use LC_ALL=C.
380 ;; NB. Can't be async -- see `vc-bzr-post-command-function'.
381 (vc-bzr-command "log" buffer 0 files) 361 (vc-bzr-command "log" buffer 0 files)
382 ;; FIXME: Until Emacs-23, VC was missing a hook to sort out the mode for 362 ;; FIXME: Until Emacs-23, VC was missing a hook to sort out the mode for
383 ;; the buffer, or at least set the regexps right. 363 ;; the buffer, or at least set the regexps right.
@@ -401,7 +381,6 @@ EDITABLE is ignored."
401 (setq rev1 nil)) 381 (setq rev1 nil))
402 (if (and (not rev1) rev2) 382 (if (and (not rev1) rev2)
403 (setq rev1 working)) 383 (setq rev1 working))
404 ;; NB. Can't be async -- see `vc-bzr-post-command-function'.
405 ;; bzr diff produces condition code 1 for some reason. 384 ;; bzr diff produces condition code 1 for some reason.
406 (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 1 files 385 (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 1 files
407 "--diff-options" (mapconcat 'identity (vc-diff-switches-list bzr) 386 "--diff-options" (mapconcat 'identity (vc-diff-switches-list bzr)
@@ -463,11 +442,11 @@ property containing author and date information."
463 442
464;; Definition from Emacs 22 443;; Definition from Emacs 22
465(unless (fboundp 'vc-annotate-convert-time) 444(unless (fboundp 'vc-annotate-convert-time)
466(defun vc-annotate-convert-time (time) 445 (defun vc-annotate-convert-time (time)
467 "Convert a time value to a floating-point number of days. 446 "Convert a time value to a floating-point number of days.
468The argument TIME is a list as returned by `current-time' or 447The argument TIME is a list as returned by `current-time' or
469`encode-time', only the first two elements of that list are considered." 448`encode-time', only the first two elements of that list are considered."
470 (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600))) 449 (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600)))
471 450
472(defun vc-bzr-annotate-time () 451(defun vc-bzr-annotate-time ()
473 (when (re-search-forward "^ *[0-9]+ |" nil t) 452 (when (re-search-forward "^ *[0-9]+ |" nil t)
@@ -549,7 +528,7 @@ Optional argument LOCALP is always ignored."
549 (setq current-bzr-state 'added)) 528 (setq current-bzr-state 'added))
550 ((looking-at "^kind changed") 529 ((looking-at "^kind changed")
551 (setq current-vc-state 'edited) 530 (setq current-vc-state 'edited)
552 (setq current-bzr-state 'kindchange)) 531 (setq current-bzr-state 'kindchanged))
553 ((looking-at "^modified") 532 ((looking-at "^modified")
554 (setq current-vc-state 'edited) 533 (setq current-vc-state 'edited)
555 (setq current-bzr-state 'modified)) 534 (setq current-bzr-state 'modified))
@@ -591,17 +570,9 @@ Optional argument LOCALP is always ignored."
591 ;; else fall back to default vc representation 570 ;; else fall back to default vc representation
592 (vc-default-dired-state-info 'Bzr file))))) 571 (vc-default-dired-state-info 'Bzr file)))))
593 572
594;; In case of just `(load "vc-bzr")', but that's probably the wrong
595;; way to do it.
596(add-to-list 'vc-handled-backends 'Bzr)
597
598(eval-after-load "vc" 573(eval-after-load "vc"
599 '(add-to-list 'vc-directory-exclusion-list vc-bzr-admin-dirname t)) 574 '(add-to-list 'vc-directory-exclusion-list vc-bzr-admin-dirname t))
600 575
601(defconst vc-bzr-unload-hook
602 (lambda ()
603 (setq vc-handled-backends (delq 'Bzr vc-handled-backends))
604 (remove-hook 'vc-post-command-functions 'vc-bzr-post-command-function)))
605 576
606(provide 'vc-bzr) 577(provide 'vc-bzr)
607;; arch-tag: 8101bad8-4e92-4e7d-85ae-d8e08b4e7c06 578;; arch-tag: 8101bad8-4e92-4e7d-85ae-d8e08b4e7c06
diff --git a/lisp/vc-rcs.el b/lisp/vc-rcs.el
index 1cda8849219..e50e74e5eba 100644
--- a/lisp/vc-rcs.el
+++ b/lisp/vc-rcs.el
@@ -717,6 +717,7 @@ Optional arg REVISION is a revision to annotate from."
717 " " 717 " "
718 (aref rda 0) 718 (aref rda 0)
719 ls) 719 ls)
720 :vc-annotate-prefix t
720 :vc-rcs-r/d/a rda))) 721 :vc-rcs-r/d/a rda)))
721 (maphash 722 (maphash
722 (if all-me 723 (if all-me
generated by cgit v1.2.1 (git 2.18.0) at 2026-02-13 08:15:29 +0000