aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiles Bader2007-08-21 04:55:30 +0000
committerMiles Bader2007-08-21 04:55:30 +0000
commit1fb072d1dff954c21d4805196df62c8eeead301c (patch)
treeda374db1a51e2a355b46f26a1c99e1ac5db5dca4
parentaaf34461ff5804e5cebe163b31e535da72e81d87 (diff)
parentbdaf8a62d53cf8d5a0dc4f0dc530ecd6fc1f44fe (diff)
downloademacs-1fb072d1dff954c21d4805196df62c8eeead301c.tar.gz
emacs-1fb072d1dff954c21d4805196df62c8eeead301c.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--multi-tty--0--patch-32
Diffstat
-rw-r--r--admin/FOR-RELEASE27
-rw-r--r--etc/ChangeLog4
-rw-r--r--etc/NEWS9
-rw-r--r--etc/NEWS.226
-rw-r--r--lisp/ChangeLog367
-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/ps-print.el19
-rw-r--r--lisp/simple.el51
-rw-r--r--lisp/smerge-mode.el51
-rw-r--r--lisp/startup.el449
-rw-r--r--lisp/term/mac-win.el2
-rw-r--r--lisp/vc-bzr.el173
-rw-r--r--lisp/vc-rcs.el1
-rw-r--r--lispref/ChangeLog5
-rw-r--r--lispref/processes.texi20
-rw-r--r--lispref/text.texi36
-rw-r--r--man/ChangeLog26
-rw-r--r--man/basic.texi4
-rw-r--r--man/calc.texi60
-rw-r--r--man/gnus.texi18
-rw-r--r--nt/ChangeLog4
-rw-r--r--nt/makefile.w32-in1
-rw-r--r--src/ChangeLog26
-rw-r--r--src/alloc.c2
-rw-r--r--src/emacs.c5
-rw-r--r--src/eval.c10
-rw-r--r--src/insdel.c9
-rw-r--r--src/minibuf.c41
-rw-r--r--src/term.c13
-rw-r--r--src/xterm.c34
75 files changed, 2363 insertions, 1311 deletions
diff --git a/admin/FOR-RELEASE b/admin/FOR-RELEASE
index 6ddf0bb54dd..c1ad49587b7 100644
--- a/admin/FOR-RELEASE
+++ b/admin/FOR-RELEASE
@@ -44,34 +44,21 @@ NB the definitive copy of this file for Emacs 22 is on the
44EMACS_22_BASE branch. Any entries below are automatically copied from 44EMACS_22_BASE branch. Any entries below are automatically copied from
45that branch. Do not make manual changes to this file on the trunk. 45that branch. Do not make manual changes to this file on the trunk.
46 46
47** michael.ewe@arcor.de, Apr 24: 22.0.98 not starting on Solaris 10/I386
48http://lists.gnu.org/archive/html/emacs-devel/2007-04/msg01113.html
49
50** davby@ida.liu.se, 6 July: Bug in pos-visible-in-window-p
51** dak@gnu.org, 30 May: Redraw problem with overlapping frames
52
53** bojohan+news@dd.chalmers.se, 1 Aug: n_schumacher@web.de: modification hooks called only once in
54
55** ams@gnu.org, 9 July: eshell and external commands 47** ams@gnu.org, 9 July: eshell and external commands
48http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00385.html
56 49
57** timh@insightful.com, 25 June: undigestify-rmail-message in emacs 22.1 doesn't split a digest 50** Check all non-file-scope static vars to make sure they
51won't lose on USG or HPUX systems.
58 52
59** andreas.roehler@online.de, 24 Jul: CVS build on Suse 10.0 failed 53* FIXES FOR EMACS 22.3
60
61** Gtk+ tool bar looses focus when pressing next tool bar button in GUD.
62http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-08/msg00008.html
63
64* FIXES FOR EMACS 22.2
65 54
66Here we list small fixes that arrived too late for Emacs 22.2, but 55Here we list small fixes that arrived too late for Emacs 22.2, but
67that should be installed on the release branch after 22.2 is released. 56that should be installed on the release branch after 22.2 is released.
68 57
69** Changes to six pbm icons in etc/images. 58** bojohan+news@dd.chalmers.se, 1 Aug: n_schumacher@web.de: modification hooks called only once in
70Sync change from trunk 2007-05-19. 59Fix is on the trunk: 2007-08-13 change to insdel.c by Stefan Monnier.
71 60http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00457.html
72** viper should not load cl at run time.
73 61
74** yamaoka@jpl.org's patch for mail-extract-address-components problem.
75 62
76* DOCUMENTATION 63* DOCUMENTATION
77 64
diff --git a/etc/ChangeLog b/etc/ChangeLog
index 9fd1a50736c..2a09fa9c369 100644
--- a/etc/ChangeLog
+++ b/etc/ChangeLog
@@ -1,3 +1,7 @@
12007-08-14 Glenn Morris <rgm@gnu.org>
2
3 * NEWS: Mention `bad-packages-alist'.
4
12007-08-08 Glenn Morris <rgm@gnu.org> 52007-08-08 Glenn Morris <rgm@gnu.org>
2 6
3 * TODO: `iff' item is dealt with. 7 * TODO: `iff' item is dealt with.
diff --git a/etc/NEWS b/etc/NEWS
index c70f968e41a..f0e00c99eba 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -56,6 +56,10 @@ to a remote display, e.g. because the display is about to become unreachable.
56 56
57* Startup Changes in Emacs 23.1 57* Startup Changes in Emacs 23.1
58 58
59** New user option `initial-buffer-choice' specifies what to display
60after starting Emacs: startup screen, *scratch* buffer, visiting a
61file or directory.
62
59 63
60* Incompatible Editing Changes in Emacs 23.1 64* Incompatible Editing Changes in Emacs 23.1
61 65
@@ -171,6 +175,11 @@ supported on other platforms, but not on Windows due to using the winsock
171 175
172* Lisp Changes in Emacs 23.1 176* Lisp Changes in Emacs 23.1
173 177
178+++
179** inhibit-modification-hooks is bound to t while running modification hooks.
180As a happy consequence, after-change-functions and before-change-functions
181are not bound to nil any more while running an (after|before)-change-function.
182
174** Non-breaking space now acts as whitespace. 183** Non-breaking space now acts as whitespace.
175 184
176+++ 185+++
diff --git a/etc/NEWS.22 b/etc/NEWS.22
index 6e227639fed..cdf1ef1dd02 100644
--- a/etc/NEWS.22
+++ b/etc/NEWS.22
@@ -28,7 +28,8 @@ any older versions of these packages to ensure that the Emacs 22
28version is used. You can use M-x list-load-path-shadows to find such 28version is used. You can use M-x list-load-path-shadows to find such
29older packages. 29older packages.
30 30
31Some specific packages that are known to cause problems are: 31Some specific packages that are known to cause problems are given
32below. Emacs tries to warn you about these through `bad-packages-alist'.
32 33
33** Semantic (used by CEDET, ECB, JDEE): upgrade to latest version. 34** Semantic (used by CEDET, ECB, JDEE): upgrade to latest version.
34 35
@@ -40,6 +41,9 @@ Some specific packages that are known to cause problems are:
40 41
41* Changes in Emacs 22.2 42* Changes in Emacs 22.2
42 43
44** `bad-packages-alist' will warn about external packages that are known
45to cause problems in this version of Emacs.
46
43** The values of `dired-recursive-deletes' and `dired-recursive-copies' 47** The values of `dired-recursive-deletes' and `dired-recursive-copies'
44have been changed to `top'. This means that the user is asked once, 48have been changed to `top'. This means that the user is asked once,
45before deleting/copying the indicated directory recursively. 49before deleting/copying the indicated directory recursively.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 8daf2daf71f..028fe5d2db5 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,318 @@
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
1992007-08-16 Vinicius Jose Latorre <viniciusjl@ig.com.br>
200
201 * ps-print.el (ps-header-font-size, ps-header-title-font-size)
202 (ps-footer-font-size, ps-line-number-font-size, ps-line-spacing)
203 (ps-paragraph-spacing): 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.
315
12007-08-13 Nick Roberts <nickrob@snap.net.nz> 3162007-08-13 Nick Roberts <nickrob@snap.net.nz>
2 317
3 * progmodes/gdb-ui.el (gdb-send): Handle CTRL-D more carefully. 318 * progmodes/gdb-ui.el (gdb-send): Handle CTRL-D more carefully.
@@ -19,8 +334,8 @@
19 * pcvs-util.el (cvs-qtypedesc-strings): Use new names 334 * pcvs-util.el (cvs-qtypedesc-strings): Use new names
20 combine-and-quote-strings and split-string-and-unquote. 335 combine-and-quote-strings and split-string-and-unquote.
21 336
22 * subr.el (combine-and-quote-strings): Renamed from strings->string. 337 * subr.el (combine-and-quote-strings): Rename from strings->string.
23 (split-string-and-unquote): Renamed from string->strings. 338 (split-string-and-unquote): Rename from string->strings.
24 339
252007-08-10 Stefan Monnier <monnier@iro.umontreal.ca> 3402007-08-10 Stefan Monnier <monnier@iro.umontreal.ca>
26 341
@@ -156,6 +471,24 @@
156 * help.el (resize-temp-buffer-window): Use window-full-width-p 471 * help.el (resize-temp-buffer-window): Use window-full-width-p
157 instead of comparing frame-width and window-width. 472 instead of comparing frame-width and window-width.
158 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
1592007-08-13 Stefan Monnier <monnier@iro.umontreal.ca> 4922007-08-13 Stefan Monnier <monnier@iro.umontreal.ca>
160 493
161 * emacs-lisp/autoload.el (autoload-print-form): Use print-quoted. 494 * emacs-lisp/autoload.el (autoload-print-form): Use print-quoted.
@@ -184,7 +517,7 @@
184 (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
185 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.
186 519
1872007-08-09 Edward O'Connor <hober0@gmail.com> (tiny change) 5202007-08-09 Edward O'Connor <hober0@gmail.com> (tiny change)
188 521
189 * url/url-auth.el (url-basic-auth): When prompting for username 522 * url/url-auth.el (url-basic-auth): When prompting for username
190 and password, default to the username and password in the URL. 523 and password, default to the username and password in the URL.
@@ -265,15 +598,6 @@
265 It calls comment-line-break-function if there are comments. 598 It calls comment-line-break-function if there are comments.
266 (do-auto-fill): Use that. 599 (do-auto-fill): Use that.
267 600
2682007-08-07 Ivan Kanis <apple@kanis.eu>
269
270 * time.el (display-time-world-mode, display-time-world-display)
271 (display-time-world, display-time-world-list)
272 (display-time-world-time-format, display-time-world-buffer-name)
273 (display-time-world-timer-enable)
274 (display-time-world-timer-second, display-time-world-mode-map):
275 New.
276
2772007-08-07 Sean O'Rourke <sorourke@cs.ucsd.edu> 6012007-08-07 Sean O'Rourke <sorourke@cs.ucsd.edu>
278 602
279 * complete.el (PC-lisp-complete-symbol): Complete symbol around point. 603 * complete.el (PC-lisp-complete-symbol): Complete symbol around point.
@@ -328,10 +652,9 @@
328 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
329 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.
330 654
3312007-08-05 Jay Belanger <belanger@localhost.localdomain> 6552007-08-05 Jay Belanger <jay.p.belanger@gmail.com>
332 656
333 * calc/calc-nlfit.el (math-nlfit-curve): 657 * calc/calc-nlfit.el (math-nlfit-curve): Remove unnecessary variables.
334 Remove unnecessary variables.
335 (math-nlfit-givens): Let bind free variables. 658 (math-nlfit-givens): Let bind free variables.
336 659
3372007-08-05 Vinicius Jose Latorre <viniciusig@ig.com.br> 6602007-08-05 Vinicius Jose Latorre <viniciusig@ig.com.br>
@@ -344,7 +667,7 @@
344 * files.el (set-auto-mode): Handle also remote files wrt 667 * files.el (set-auto-mode): Handle also remote files wrt
345 `auto-mode-alist'. 668 `auto-mode-alist'.
346 669
3472007-08-04 Jay Belanger <belanger@localhost.localdomain> 6702007-08-04 Jay Belanger <jay.p.belanger@gmail.com>
348 671
349 * calc/calcalg3.el (calc-curve-fit): Add support for nonlinear 672 * calc/calcalg3.el (calc-curve-fit): Add support for nonlinear
350 curves and plotting. 673 curves and plotting.
@@ -382,7 +705,7 @@
382 705
3832007-08-03 Jay Belanger <jay.p.belanger@gmail.com> 7062007-08-03 Jay Belanger <jay.p.belanger@gmail.com>
384 707
385 * calc/calc-ext.el (math-get-value,math-get-sdev) 708 * calc/calc-ext.el (math-get-value, math-get-sdev)
386 (math-contains-sdev): New functions. 709 (math-contains-sdev): New functions.
387 710
388 * calc/calc-graph.el (calc-graph-format-data) 711 * calc/calc-graph.el (calc-graph-format-data)
@@ -437,8 +760,8 @@
437 760
438 * 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.
439 762
440 * progmodes/fortran.el (fortran-font-lock-syntactic-keywords): Fix 763 * progmodes/fortran.el (fortran-font-lock-syntactic-keywords):
441 off-by-one error in previous change. 764 Fix off-by-one error in previous change.
442 765
4432007-08-03 Drew Adams <drew.adams@oracle.com> 7662007-08-03 Drew Adams <drew.adams@oracle.com>
444 767
@@ -447,8 +770,8 @@
447 770
4482007-08-01 Jay Belanger <jay.p.belanger@gmail.com> 7712007-08-01 Jay Belanger <jay.p.belanger@gmail.com>
449 772
450 * calc/calc-math.el (math-sqrt-raw,math-sin-raw-2) 773 * calc/calc-math.el (math-sqrt-raw, math-sin-raw-2)
451 (math-cos-raw-2,math-arctan-raw,math-ln-raw): 774 (math-cos-raw-2, math-arctan-raw, math-ln-raw):
452 Use native Emacs functions, when appropriate. 775 Use native Emacs functions, when appropriate.
453 776
4542007-08-01 Dan Nicolaescu <dann@ics.uci.edu> 7772007-08-01 Dan Nicolaescu <dann@ics.uci.edu>
@@ -586,7 +909,7 @@
5862007-07-28 Masatake YAMATO <jet@gyve.org> 9092007-07-28 Masatake YAMATO <jet@gyve.org>
587 910
588 * 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.
589 Use backend name as the menu label Suggested by David Kastrup. 912 Use backend name as the menu label. Suggested by David Kastrup.
590 913
5912007-07-28 Alan Mackenzie <acm@muc.de> 9142007-07-28 Alan Mackenzie <acm@muc.de>
592 915
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 490bde95d35..7cd947dc921 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -90,12 +90,12 @@ $(lisp)/cus-load.el:
90custom-deps: $(lisp)/subdirs.el $(lisp)/loaddefs.el $(lisp)/cus-load.el doit 90custom-deps: $(lisp)/subdirs.el $(lisp)/loaddefs.el $(lisp)/cus-load.el doit
91 wd=$(lisp); $(setwins_almost); \ 91 wd=$(lisp); $(setwins_almost); \
92 echo Directories: $$wins; \ 92 echo Directories: $$wins; \
93 $(EMACS) $(EMACSOPT) -l cus-dep --eval '(setq generated-custom-dependencies-file "$(lisp)/cus-load.el")' -f custom-make-dependencies $$wins 93 $(emacs) -l cus-dep --eval '(setq generated-custom-dependencies-file "$(lisp)/cus-load.el")' -f custom-make-dependencies $$wins
94 94
95finder-data: $(lisp)/subdirs.el $(lisp)/loaddefs.el doit 95finder-data: $(lisp)/subdirs.el $(lisp)/loaddefs.el doit
96 wd=$(lisp); $(setwins_almost); \ 96 wd=$(lisp); $(setwins_almost); \
97 echo Directories: $$wins; \ 97 echo Directories: $$wins; \
98 $(EMACS) $(EMACSOPT) -l finder --eval '(setq generated-finder-keywords-file "$(lisp)/finder-inf.el")' -f finder-compile-keywords-make-dist $$wins 98 $(emacs) -l finder --eval '(setq generated-finder-keywords-file "$(lisp)/finder-inf.el")' -f finder-compile-keywords-make-dist $$wins
99 99
100$(lisp)/loaddefs.el: 100$(lisp)/loaddefs.el:
101 echo ";;; loaddefs.el --- automatically extracted autoloads" >> $@ 101 echo ";;; loaddefs.el --- automatically extracted autoloads" >> $@
@@ -110,7 +110,7 @@ $(lisp)/loaddefs.el:
110autoloads: $(lisp)/subdirs.el $(lisp)/loaddefs.el doit 110autoloads: $(lisp)/subdirs.el $(lisp)/loaddefs.el doit
111 wd=$(lisp); $(setwins_almost); \ 111 wd=$(lisp); $(setwins_almost); \
112 echo Directories: $$wins; \ 112 echo Directories: $$wins; \
113 $(EMACS) $(EMACSOPT) -l autoload --eval '(setq generated-autoload-file "$(lisp)/loaddefs.el")' -f batch-update-autoloads $$wins 113 $(emacs) -l autoload --eval '(setq generated-autoload-file "$(lisp)/loaddefs.el")' -f batch-update-autoloads $$wins
114 114
115$(lisp)/subdirs.el: 115$(lisp)/subdirs.el:
116 $(MAKE) $(MFLAGS) update-subdirs 116 $(MAKE) $(MFLAGS) update-subdirs
@@ -210,7 +210,7 @@ compile-after-backup: backup-compiled-files compile-always
210# new ones. 210# new ones.
211 211
212recompile: doit mh-autoloads $(lisp)/progmodes/cc-mode.elc 212recompile: doit mh-autoloads $(lisp)/progmodes/cc-mode.elc
213 $(EMACS) $(EMACSOPT) --eval "(batch-byte-recompile-directory 0)" $(lisp) 213 $(emacs) --eval "(batch-byte-recompile-directory 0)" $(lisp)
214 214
215# CC Mode uses a compile time macro system which causes a compile time 215# CC Mode uses a compile time macro system which causes a compile time
216# dependency in cc-mode.elc on the macros in cc-langs.el and the 216# dependency in cc-mode.elc on the macros in cc-langs.el and the
@@ -219,7 +219,7 @@ $(lisp)/progmodes/cc-mode.elc: \
219 $(lisp)/progmodes/cc-mode.el \ 219 $(lisp)/progmodes/cc-mode.el \
220 $(lisp)/progmodes/cc-langs.el \ 220 $(lisp)/progmodes/cc-langs.el \
221 $(lisp)/progmodes/cc-defs.el 221 $(lisp)/progmodes/cc-defs.el
222 $(EMACS) $(EMACSOPT) -f batch-byte-compile $(lisp)/progmodes/cc-mode.el 222 $(emacs) -f batch-byte-compile $(lisp)/progmodes/cc-mode.el
223 223
224# Update MH-E internal autoloads. These are not to be confused with 224# Update MH-E internal autoloads. These are not to be confused with
225# the autoloads for the MH-E entry points, which are already in 225# the autoloads for the MH-E entry points, which are already in
@@ -256,7 +256,7 @@ $(lisp)/mh-e/mh-loaddefs.el: $(lisp)/subdirs.el $(MH_E_SRC)
256 echo ";; no-update-autoloads: t" >> $@ 256 echo ";; no-update-autoloads: t" >> $@
257 echo ";; End:" >> $@ 257 echo ";; End:" >> $@
258 echo ";;; mh-loaddefs.el ends here" >> $@ 258 echo ";;; mh-loaddefs.el ends here" >> $@
259 $(EMACS) $(EMACSOPT) \ 259 $(emacs) \
260 -l autoload \ 260 -l autoload \
261 --eval "(setq generate-autoload-cookie \";;;###mh-autoload\")" \ 261 --eval "(setq generate-autoload-cookie \";;;###mh-autoload\")" \
262 --eval "(setq generated-autoload-file \"$(lisp)/mh-e/mh-loaddefs.el\")" \ 262 --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 a1264940d41..2a4b69d2afc 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 8543bad2f4e..cc392a36f04 100644
--- a/lisp/emacs-lisp/copyright.el
+++ b/lisp/emacs-lisp/copyright.el
@@ -59,6 +59,7 @@ The second \\( \\) construct must match the years."
59Only copyright lines where the name matches this regexp will be updated. 59Only copyright lines where the name matches this regexp will be updated.
60This allows you to avoid adding yars to a copyright notice belonging to 60This allows you to avoid adding yars to a copyright notice belonging to
61someone else or to a group for which you do not work." 61someone else or to a group for which you do not work."
62 :group 'copyright
62 :type 'regexp) 63 :type 'regexp)
63 64
64(defcustom copyright-years-regexp 65(defcustom copyright-years-regexp
@@ -89,13 +90,16 @@ When this is `function', only ask when called non-interactively."
89(defvar copyright-current-year (substring (current-time-string) -4) 90(defvar copyright-current-year (substring (current-time-string) -4)
90 "String representing the current year.") 91 "String representing the current year.")
91 92
93(defsubst copyright-limit () ; re-search-forward BOUND
94 (and copyright-limit (+ (point) copyright-limit)))
95
92(defun copyright-update-year (replace noquery) 96(defun copyright-update-year (replace noquery)
93 (when 97 (when
94 (condition-case err 98 (condition-case err
95 (re-search-forward (concat "\\(" copyright-regexp 99 (re-search-forward (concat "\\(" copyright-regexp
96 "\\)\\([ \t]*\n\\)?.*\\(?:" 100 "\\)\\([ \t]*\n\\)?.*\\(?:"
97 copyright-names-regexp "\\)") 101 copyright-names-regexp "\\)")
98 (if copyright-limit (+ (point) copyright-limit)) 102 (copyright-limit)
99 t) 103 t)
100 ;; In case the regexp is rejected. This is useful because 104 ;; In case the regexp is rejected. This is useful because
101 ;; copyright-update is typically called from before-save-hook where 105 ;; copyright-update is typically called from before-save-hook where
@@ -181,7 +185,7 @@ interactively."
181 "\\(the Free Software Foundation;\ 185 "\\(the Free Software Foundation;\
182 either \\|; a\\^u eldono \\([0-9]+\\)a, ? a\\^u (la\\^u via \\)\ 186 either \\|; a\\^u eldono \\([0-9]+\\)a, ? a\\^u (la\\^u via \\)\
183version \\([0-9]+\\), or (at" 187version \\([0-9]+\\), or (at"
184 (if copyright-limit (+ (point) copyright-limit)) t) 188 (copyright-limit) t)
185 (not (string= (match-string 3) copyright-current-gpl-version)) 189 (not (string= (match-string 3) copyright-current-gpl-version))
186 (or noquery 190 (or noquery
187 (y-or-n-p (concat "Replace GPL version by " 191 (y-or-n-p (concat "Replace GPL version by "
@@ -203,8 +207,7 @@ Uses heuristic: year >= 50 means 19xx, < 50 means 20xx."
203 (interactive) 207 (interactive)
204 (widen) 208 (widen)
205 (goto-char (point-min)) 209 (goto-char (point-min))
206 (if (re-search-forward copyright-regexp 210 (if (re-search-forward copyright-regexp (copyright-limit) t)
207 (if copyright-limit (+ (point) copyright-limit)) t)
208 (let ((s (match-beginning 2)) 211 (let ((s (match-beginning 2))
209 (e (copy-marker (1+ (match-end 2)))) 212 (e (copy-marker (1+ (match-end 2))))
210 (p (make-marker)) 213 (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 337be13e2e5..323cad15276 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 df5445da412..70c976a154d 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 ee990f2fdd3..429d85a7fed 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 ea41cea1d0f..502f52b9b57 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 cfef0eedfe4..f2feff595bb 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/ps-print.el b/lisp/ps-print.el
index f7abe472fe5..f3f9e45fb87 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -2869,7 +2869,8 @@ uses the fonts resident in your printer."
2869 :group 'ps-print-font) 2869 :group 'ps-print-font)
2870 2870
2871(defcustom ps-font-size '(7 . 8.5) 2871(defcustom ps-font-size '(7 . 8.5)
2872 "*Font size, in points, for ordinary text, when generating PostScript." 2872 "*Font size, in points, for ordinary text, when generating PostScript.
2873Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
2873 :type '(choice :menu-tag "Ordinary Text Font Size" 2874 :type '(choice :menu-tag "Ordinary Text Font Size"
2874 :tag "Ordinary Text Font Size" 2875 :tag "Ordinary Text Font Size"
2875 (number :tag "Text Size") 2876 (number :tag "Text Size")
@@ -2886,7 +2887,8 @@ uses the fonts resident in your printer."
2886 :group 'ps-print-font) 2887 :group 'ps-print-font)
2887 2888
2888(defcustom ps-header-font-size '(10 . 12) 2889(defcustom ps-header-font-size '(10 . 12)
2889 "*Font size, in points, for text in the header, when generating PostScript." 2890 "*Font size, in points, for text in the header, when generating PostScript.
2891Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
2890 :type '(choice :menu-tag "Header Font Size" 2892 :type '(choice :menu-tag "Header Font Size"
2891 :tag "Header Font Size" 2893 :tag "Header Font Size"
2892 (number :tag "Header Size") 2894 (number :tag "Header Size")
@@ -2897,7 +2899,8 @@ uses the fonts resident in your printer."
2897 :group 'ps-print-font) 2899 :group 'ps-print-font)
2898 2900
2899(defcustom ps-header-title-font-size '(12 . 14) 2901(defcustom ps-header-title-font-size '(12 . 14)
2900 "*Font size, in points, for the top line of text in header, in PostScript." 2902 "*Font size, in points, for the top line of text in header, in PostScript.
2903Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
2901 :type '(choice :menu-tag "Header Title Font Size" 2904 :type '(choice :menu-tag "Header Title Font Size"
2902 :tag "Header Title Font Size" 2905 :tag "Header Title Font Size"
2903 (number :tag "Header Title Size") 2906 (number :tag "Header Title Size")
@@ -2914,7 +2917,8 @@ uses the fonts resident in your printer."
2914 :group 'ps-print-font) 2917 :group 'ps-print-font)
2915 2918
2916(defcustom ps-footer-font-size '(10 . 12) 2919(defcustom ps-footer-font-size '(10 . 12)
2917 "*Font size, in points, for text in the footer, when generating PostScript." 2920 "*Font size, in points, for text in the footer, when generating PostScript.
2921Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
2918 :type '(choice :menu-tag "Footer Font Size" 2922 :type '(choice :menu-tag "Footer Font Size"
2919 :tag "Footer Font Size" 2923 :tag "Footer Font Size"
2920 (number :tag "Footer Size") 2924 (number :tag "Footer Size")
@@ -2946,7 +2950,8 @@ uses the fonts resident in your printer."
2946 :group 'ps-print-miscellany) 2950 :group 'ps-print-miscellany)
2947 2951
2948(defcustom ps-line-number-font-size 6 2952(defcustom ps-line-number-font-size 6
2949 "*Font size, in points, for line number, when generating PostScript." 2953 "*Font size, in points, for line number, when generating PostScript.
2954Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
2950 :type '(choice :menu-tag "Line Number Font Size" 2955 :type '(choice :menu-tag "Line Number Font Size"
2951 :tag "Line Number Font Size" 2956 :tag "Line Number Font Size"
2952 (number :tag "Font Size") 2957 (number :tag "Font Size")
@@ -3357,6 +3362,8 @@ By default, this directory is the same as in the variable `data-directory'."
3357(defcustom ps-line-spacing 0 3362(defcustom ps-line-spacing 0
3358 "*Specify line spacing, in points, for ordinary text. 3363 "*Specify line spacing, in points, for ordinary text.
3359 3364
3365Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE).
3366
3360See also `ps-paragraph-spacing' and `ps-paragraph-regexp'. 3367See also `ps-paragraph-spacing' and `ps-paragraph-regexp'.
3361 3368
3362To get all lines with some spacing set both `ps-line-spacing' and 3369To get all lines with some spacing set both `ps-line-spacing' and
@@ -3373,6 +3380,8 @@ To get all lines with some spacing set both `ps-line-spacing' and
3373(defcustom ps-paragraph-spacing 0 3380(defcustom ps-paragraph-spacing 0
3374 "*Specify paragraph spacing, in points, for ordinary text. 3381 "*Specify paragraph spacing, in points, for ordinary text.
3375 3382
3383Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE).
3384
3376See also `ps-line-spacing' and `ps-paragraph-regexp'. 3385See also `ps-line-spacing' and `ps-paragraph-regexp'.
3377 3386
3378To get all lines with some spacing set both `ps-line-spacing' and 3387To get all lines with some spacing set both `ps-line-spacing' and
diff --git a/lisp/simple.el b/lisp/simple.el
index 82081c1679a..d865147dc36 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -5810,6 +5810,57 @@ works by saving the value of `buffer-invisibility-spec' and setting it to nil."
5810; 'insert-in-front-hooks '(minibuffer-prompt-insertion))) 5810; 'insert-in-front-hooks '(minibuffer-prompt-insertion)))
5811; 5811;
5812 5812
5813
5814;;;; Problematic external packages.
5815
5816;; rms says this should be done by specifying symbols that define
5817;; versions together with bad values. This is therefore not as
5818;; flexible as it could be. See the thread:
5819;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00300.html
5820(defconst bad-packages-alist
5821 ;; Not sure exactly which semantic versions have problems.
5822 ;; Definitely 2.0pre3, probably all 2.0pre's before this.
5823 '((semantic semantic-version "2\\.0pre[1-3]"
5824 "The version of `semantic' loaded does not work in Emacs 22.
5825It can cause constant high CPU load. Upgrade to at least 2.0pre4.")
5826 ;; CUA-mode does not work with GNU Emacs version 22.1 and newer.
5827 ;; Except for version 1.2, all of the 1.x and 2.x version of cua-mode
5828 ;; provided the `CUA-mode' feature. Since this is no longer true,
5829 ;; we can warn the user if the `CUA-mode' feature is ever provided.
5830 (CUA-mode t nil
5831"CUA-mode is now part of the standard GNU Emacs distribution,
5832so you can now enable CUA via the Options menu or by customizing `cua-mode'.
5833
5834You have loaded an older version of CUA-mode which does not work
5835correctly with this version of Emacs. You should remove the old
5836version and use the one distributed with Emacs."))
5837 "Alist of packages known to cause problems in this version of Emacs.
5838Each element has the form (PACKAGE SYMBOL REGEXP STRING).
5839PACKAGE is either a regular expression to match file names, or a
5840symbol (a feature name); see the documentation of
5841`after-load-alist', to which this variable adds functions.
5842SYMBOL is either the name of a string variable, or `t'. Upon
5843loading PACKAGE, if SYMBOL is t or matches REGEXP, display a
5844warning using STRING as the message.")
5845
5846(defun bad-package-check (package)
5847 "Run a check using the element from `bad-packages-alist' matching PACKAGE."
5848 (condition-case nil
5849 (let* ((list (assoc package bad-packages-alist))
5850 (symbol (nth 1 list)))
5851 (and list
5852 (boundp symbol)
5853 (or (eq symbol t)
5854 (and (stringp (setq symbol (eval symbol)))
5855 (string-match (nth 2 list) symbol)))
5856 (display-warning :warning (nth 3 list))))
5857 (error nil)))
5858
5859(mapc (lambda (elem)
5860 (eval-after-load (car elem) `(bad-package-check ',(car elem))))
5861 bad-packages-alist)
5862
5863
5813(provide 'simple) 5864(provide 'simple)
5814 5865
5815;; arch-tag: 24af67c0-2a49-44f6-b3b1-312d8b570dfd 5866;; 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 453567556f5..b5a5a225739 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -45,7 +45,20 @@ The value is nil if the selected frame is on a text-only-terminal.")
45 45
46(defgroup initialization nil 46(defgroup initialization nil
47 "Emacs start-up procedure." 47 "Emacs start-up procedure."
48 :group 'internal) 48 :group 'environment)
49
50(defcustom initial-buffer-choice nil
51 "Buffer to show after starting Emacs.
52If the value is nil and `inhibit-splash-screen' is nil, show the
53startup screen. If the value is string, visit the specified file or
54directory using `find-file'. If t, open the `*scratch*' buffer."
55 :type '(choice
56 (const :tag "Splash screen" nil)
57 (directory :tag "Directory" :value "~/")
58 (file :tag "File" :value "~/file.txt")
59 (const :tag "Lisp scratch buffer" t))
60 :version "23.1"
61 :group 'initialization)
49 62
50(defcustom inhibit-splash-screen nil 63(defcustom inhibit-splash-screen nil
51 "Non-nil inhibits the startup screen. 64 "Non-nil inhibits the startup screen.
@@ -1062,10 +1075,7 @@ opening the first frame (e.g. open a connection to an X server).")
1062 (if (get-buffer "*scratch*") 1075 (if (get-buffer "*scratch*")
1063 (with-current-buffer "*scratch*" 1076 (with-current-buffer "*scratch*"
1064 (if (eq major-mode 'fundamental-mode) 1077 (if (eq major-mode 'fundamental-mode)
1065 (funcall initial-major-mode)) 1078 (funcall initial-major-mode))))
1066 ;; Don't lose text that users type in *scratch*.
1067 (setq buffer-offer-save t)
1068 (auto-save-mode 1)))
1069 1079
1070 ;; Load library for our terminal type. 1080 ;; Load library for our terminal type.
1071 ;; User init file can set term-file-prefix to nil to prevent this. 1081 ;; User init file can set term-file-prefix to nil to prevent this.
@@ -1115,6 +1125,8 @@ regardless of the value of this variable."
1115 '((:face (variable-pitch :weight bold) 1125 '((:face (variable-pitch :weight bold)
1116 "Important Help menu items:\n" 1126 "Important Help menu items:\n"
1117 :face variable-pitch 1127 :face variable-pitch
1128 :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial)))
1129 "\tLearn how to use Emacs efficiently"
1118 (lambda () 1130 (lambda ()
1119 (let* ((en "TUTORIAL") 1131 (let* ((en "TUTORIAL")
1120 (tut (or (get-language-info current-language-environment 1132 (tut (or (get-language-info current-language-environment
@@ -1128,47 +1140,47 @@ regardless of the value of this variable."
1128 (buffer-substring (point-min) (1- (point)))))) 1140 (buffer-substring (point-min) (1- (point))))))
1129 ;; If there is a specific tutorial for the current language 1141 ;; If there is a specific tutorial for the current language
1130 ;; environment and it is not English, append its title. 1142 ;; environment and it is not English, append its title.
1131 (concat 1143 (if (string= en tut)
1132 "Emacs Tutorial\t\tLearn how to use Emacs efficiently" 1144 ""
1133 (if (string= en tut) 1145 (concat " (" title ")"))))
1134 "" 1146 "\n"
1135 (concat " (" title ")")) 1147 :face variable-pitch
1136 "\n"))) 1148 :link ("Emacs FAQ" (lambda (button) (view-emacs-FAQ)))
1137 :face variable-pitch "\ 1149 "\tFrequently asked questions and answers\n"
1138Emacs FAQ\t\tFrequently asked questions and answers 1150 :link ("View Emacs Manual" (lambda (button) (info-emacs-manual)))
1139View Emacs Manual\t\tView the Emacs manual using Info 1151 "\tView the Emacs manual using Info\n"
1140Absence of Warranty\tGNU Emacs comes with " 1152 :link ("Absence of Warranty" (lambda (button) (describe-no-warranty)))
1153 "\tGNU Emacs comes with "
1141 :face (variable-pitch :slant oblique) 1154 :face (variable-pitch :slant oblique)
1142 "ABSOLUTELY NO WARRANTY\n" 1155 "ABSOLUTELY NO WARRANTY\n"
1143 :face variable-pitch 1156 :face variable-pitch
1144 "\ 1157 :link ("Copying Conditions" (lambda (button) (describe-copying)))
1145Copying Conditions\t\tConditions for redistributing and changing Emacs 1158 "\tConditions for redistributing and changing Emacs\n"
1146Getting New Versions\tHow to obtain the latest version of Emacs 1159 :link ("Getting New Versions" (lambda (button) (describe-distribution)))
1147More Manuals / Ordering Manuals Buying printed manuals from the FSF\n") 1160 "\tHow to obtain the latest version of Emacs\n"
1148 (:face variable-pitch 1161 :link ("More Manuals / Ordering Manuals" (lambda (button) (view-order-manuals)))
1149 "\nTo quit a partially entered command, type " 1162 " Buying printed manuals from the FSF\n")
1150 :face default 1163 (:face (variable-pitch :weight bold)
1151 "Control-g" 1164 "Useful tasks:\n"
1152 :face variable-pitch
1153 ".
1154
1155Emacs Guided Tour\t\tSee http://www.gnu.org/software/emacs/tour/
1156
1157"
1158 :face (variable-pitch :weight bold)
1159 "Useful File menu items:\n"
1160 :face variable-pitch 1165 :face variable-pitch
1161 "Exit Emacs\t\t(Or type " 1166 :link ("Visit New File"
1162 :face default 1167 (lambda (button) (call-interactively 'find-file)))
1163 "Control-x" 1168 "\tSpecify a new file's name, to edit the file\n"
1164 :face variable-pitch 1169 :link ("Open Home Directory"
1165 " followed by " 1170 (lambda (button) (dired "~")))
1166 :face default 1171 "\tOpen your home directory, to operate on its files\n"
1167 "Control-c" 1172 :link ("Open *scratch* buffer"
1168 :face variable-pitch 1173 (lambda (button) (switch-to-buffer (get-buffer-create "*scratch*"))))
1169 ") 1174 "\tOpen buffer for notes you don't want to save\n"
1170Recover Crashed Session\tRecover files you were editing before a crash\n" 1175 :link ("Customize Startup"
1171 )) 1176 (lambda (button) (customize-group 'initialization)))
1177 "\tChange initialization settings including this screen\n"
1178
1179 "\nEmacs Guided Tour\tSee "
1180 :link ("http://www.gnu.org/software/emacs/tour/"
1181 (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/")))
1182
1183 ))
1172 "A list of texts to show in the middle part of splash screens. 1184 "A list of texts to show in the middle part of splash screens.
1173Each element in the list should be a list of strings or pairs 1185Each element in the list should be a list of strings or pairs
1174`:face FACE', like `fancy-splash-insert' accepts them.") 1186`:face FACE', like `fancy-splash-insert' accepts them.")
@@ -1200,13 +1212,22 @@ Values less than twice `fancy-splash-delay' are ignored."
1200 (file :tag "File"))) 1212 (file :tag "File")))
1201 1213
1202 1214
1215(defvar splash-screen-keymap
1216 (let ((map (make-sparse-keymap)))
1217 (suppress-keymap map)
1218 (set-keymap-parent map button-buffer-map)
1219 (define-key map "\C-?" 'scroll-down)
1220 (define-key map " " 'scroll-up)
1221 (define-key map "q" 'exit-splash-screen)
1222 map)
1223 "Keymap for splash screen buffer.")
1224
1203;; These are temporary storage areas for the splash screen display. 1225;; These are temporary storage areas for the splash screen display.
1204 1226
1205(defvar fancy-current-text nil) 1227(defvar fancy-current-text nil)
1206(defvar fancy-splash-help-echo nil) 1228(defvar fancy-splash-help-echo nil)
1207(defvar fancy-splash-stop-time nil) 1229(defvar fancy-splash-stop-time nil)
1208(defvar fancy-splash-outer-buffer nil) 1230(defvar fancy-splash-outer-buffer nil)
1209(defvar fancy-splash-last-input-event nil)
1210 1231
1211(defun fancy-splash-insert (&rest args) 1232(defun fancy-splash-insert (&rest args)
1212 "Insert text into the current buffer, with faces. 1233 "Insert text into the current buffer, with faces.
@@ -1216,14 +1237,21 @@ where FACE is a valid face specification, as it can be used with
1216`put-text-property'." 1237`put-text-property'."
1217 (let ((current-face nil)) 1238 (let ((current-face nil))
1218 (while args 1239 (while args
1219 (if (eq (car args) :face) 1240 (cond ((eq (car args) :face)
1220 (setq args (cdr args) current-face (car args)) 1241 (setq args (cdr args) current-face (car args)))
1221 (insert (propertize (let ((it (car args))) 1242 ((eq (car args) :link)
1222 (if (functionp it) 1243 (setq args (cdr args))
1223 (funcall it) 1244 (let ((spec (car args)))
1224 it)) 1245 (insert-button (car spec)
1225 'face current-face 1246 'face (list 'link current-face)
1226 'help-echo fancy-splash-help-echo))) 1247 'action (cadr spec)
1248 'follow-link t)))
1249 (t (insert (propertize (let ((it (car args)))
1250 (if (functionp it)
1251 (funcall it)
1252 it))
1253 'face current-face
1254 'help-echo fancy-splash-help-echo))))
1227 (setq args (cdr args))))) 1255 (setq args (cdr args)))))
1228 1256
1229 1257
@@ -1253,18 +1281,12 @@ where FACE is a valid face specification, as it can be used with
1253 (eq (frame-parameter nil 'background-mode) 'dark)) 1281 (eq (frame-parameter nil 'background-mode) 'dark))
1254 (setq img (append img '(:color-symbols (("#000000" . "gray30")))))) 1282 (setq img (append img '(:color-symbols (("#000000" . "gray30"))))))
1255 1283
1256 ;; Insert the image with a help-echo and a keymap. 1284 ;; Insert the image with a help-echo and a link.
1257 (let ((map (make-sparse-keymap)) 1285 (make-button (prog1 (point) (insert-image img)) (point)
1258 (help-echo "mouse-2: browse http://www.gnu.org/")) 1286 'face 'default
1259 (define-key map [mouse-2] 1287 'help-echo "mouse-2: browse http://www.gnu.org/"
1260 (lambda () 1288 'action (lambda (button) (browse-url "http://www.gnu.org/"))
1261 (interactive) 1289 'follow-link t)
1262 (browse-url "http://www.gnu.org/")
1263 (throw 'exit nil)))
1264 (define-key map [down-mouse-2] 'ignore)
1265 (define-key map [up-mouse-2] 'ignore)
1266 (insert-image img (propertize "xxx" 'help-echo help-echo
1267 'keymap map)))
1268 (insert "\n")))) 1290 (insert "\n"))))
1269 (fancy-splash-insert 1291 (fancy-splash-insert
1270 :face '(variable-pitch :foreground "red") 1292 :face '(variable-pitch :foreground "red")
@@ -1275,19 +1297,22 @@ where FACE is a valid face specification, as it can be used with
1275 (fancy-splash-insert 1297 (fancy-splash-insert
1276 :face 'variable-pitch 1298 :face 'variable-pitch
1277 "You can do basic editing with the menu bar and scroll bar \ 1299 "You can do basic editing with the menu bar and scroll bar \
1278using the mouse.\n\n") 1300using the mouse.\n"
1301 :face 'variable-pitch
1302 "To quit a partially entered command, type "
1303 :face 'default
1304 "Control-g"
1305 :face 'variable-pitch
1306 "."
1307 "\n\n")
1279 (when fancy-splash-outer-buffer 1308 (when fancy-splash-outer-buffer
1280 (fancy-splash-insert 1309 (fancy-splash-insert
1281 :face 'variable-pitch 1310 :face 'variable-pitch
1282 "Type " 1311 "Type "
1283 :face 'default 1312 :face 'default
1284 "Control-l" 1313 "`q'"
1285 :face 'variable-pitch 1314 :face 'variable-pitch
1286 " to begin editing" 1315 " to exit from this screen.\n")))
1287 (if (equal (buffer-name fancy-splash-outer-buffer)
1288 "*scratch*")
1289 ".\n"
1290 " your file.\n"))))
1291 1316
1292(defun fancy-splash-tail () 1317(defun fancy-splash-tail ()
1293 "Insert the tail part of the splash screen into the current buffer." 1318 "Insert the tail part of the splash screen into the current buffer."
@@ -1319,7 +1344,7 @@ using the mouse.\n\n")
1319 "Meta-x recover-session RET" 1344 "Meta-x recover-session RET"
1320 :face '(variable-pitch :foreground "red") 1345 :face '(variable-pitch :foreground "red")
1321 "\nto recover" 1346 "\nto recover"
1322 " the files you were editing.")))) 1347 " the files you were editing.\n"))))
1323 1348
1324(defun fancy-splash-screens-1 (buffer) 1349(defun fancy-splash-screens-1 (buffer)
1325 "Timer function displaying a splash screen." 1350 "Timer function displaying a splash screen."
@@ -1327,7 +1352,8 @@ using the mouse.\n\n")
1327 (throw 'stop-splashing nil)) 1352 (throw 'stop-splashing nil))
1328 (unless fancy-current-text 1353 (unless fancy-current-text
1329 (setq fancy-current-text fancy-splash-text)) 1354 (setq fancy-current-text fancy-splash-text))
1330 (let ((text (car fancy-current-text))) 1355 (let ((text (car fancy-current-text))
1356 (inhibit-read-only t))
1331 (set-buffer buffer) 1357 (set-buffer buffer)
1332 (erase-buffer) 1358 (erase-buffer)
1333 (if pure-space-overflow 1359 (if pure-space-overflow
@@ -1359,32 +1385,30 @@ mouse."
1359 (push last-command-event unread-command-events)) 1385 (push last-command-event unread-command-events))
1360 (throw 'exit nil)) 1386 (throw 'exit nil))
1361 1387
1362(defun fancy-splash-exit () 1388(defun exit-splash-screen ()
1363 "Exit the splash screen." 1389 "Exit the splash screen."
1364 (if (get-buffer "GNU Emacs") 1390 (if (get-buffer "*About GNU Emacs*")
1365 (throw 'stop-splashing nil))) 1391 (throw 'stop-splashing nil)
1392 (quit-window t)))
1366 1393
1367(defun fancy-splash-delete-frame (frame) 1394(defun fancy-splash-delete-frame (frame)
1368 "Exit the splash screen after the frame is deleted." 1395 "Exit the splash screen after the frame is deleted."
1369 ;; We can not throw from `delete-frame-events', so we set up a timer 1396 ;; We can not throw from `delete-frame-events', so we set up a timer
1370 ;; to exit the recursive edit as soon as Emacs is idle again. 1397 ;; to exit the recursive edit as soon as Emacs is idle again.
1371 (if (frame-live-p frame) 1398 (if (frame-live-p frame)
1372 (run-at-time 0 nil 'fancy-splash-exit))) 1399 (run-at-time 0 nil 'exit-splash-screen)))
1373 1400
1374(defun fancy-splash-screens (&optional hide-on-input) 1401(defun fancy-splash-screens (&optional static)
1375 "Display fancy splash screens when Emacs starts." 1402 "Display fancy splash screens when Emacs starts."
1376 (if hide-on-input 1403 (if (not static)
1377 (let ((old-hourglass display-hourglass) 1404 (let ((old-hourglass display-hourglass)
1378 (fancy-splash-outer-buffer (current-buffer)) 1405 (fancy-splash-outer-buffer (current-buffer))
1379 splash-buffer 1406 splash-buffer
1380 (old-minor-mode-map-alist minor-mode-map-alist)
1381 (old-emulation-mode-map-alists emulation-mode-map-alists)
1382 (old-special-event-map special-event-map)
1383 (frame (fancy-splash-frame)) 1407 (frame (fancy-splash-frame))
1384 timer) 1408 timer)
1385 (save-selected-window 1409 (save-selected-window
1386 (select-frame frame) 1410 (select-frame frame)
1387 (switch-to-buffer " GNU Emacs") 1411 (switch-to-buffer "*About GNU Emacs*")
1388 (make-local-variable 'cursor-type) 1412 (make-local-variable 'cursor-type)
1389 (setq splash-buffer (current-buffer)) 1413 (setq splash-buffer (current-buffer))
1390 (catch 'stop-splashing 1414 (catch 'stop-splashing
@@ -1416,8 +1440,6 @@ mouse."
1416 'fancy-splash-special-event-action))) 1440 'fancy-splash-special-event-action)))
1417 old-special-event-map) 1441 old-special-event-map)
1418 (setq display-hourglass nil 1442 (setq display-hourglass nil
1419 minor-mode-map-alist nil
1420 emulation-mode-map-alists nil
1421 buffer-undo-list t 1443 buffer-undo-list t
1422 mode-line-format (propertize "---- %b %-" 1444 mode-line-format (propertize "---- %b %-"
1423 'face 'mode-line-buffer-id) 1445 'face 'mode-line-buffer-id)
@@ -1426,7 +1448,10 @@ mouse."
1426 timer (run-with-timer 0 fancy-splash-delay 1448 timer (run-with-timer 0 fancy-splash-delay
1427 #'fancy-splash-screens-1 1449 #'fancy-splash-screens-1
1428 splash-buffer)) 1450 splash-buffer))
1451 (use-local-map splash-screen-keymap)
1452 (setq tab-width 22)
1429 (message "%s" (startup-echo-area-message)) 1453 (message "%s" (startup-echo-area-message))
1454 (setq buffer-read-only t)
1430 (recursive-edit)) 1455 (recursive-edit))
1431 (cancel-timer timer) 1456 (cancel-timer timer)
1432 (setq display-hourglass old-hourglass 1457 (setq display-hourglass old-hourglass
@@ -1447,7 +1472,7 @@ mouse."
1447 (if (or (window-minibuffer-p) 1472 (if (or (window-minibuffer-p)
1448 (window-dedicated-p (selected-window))) 1473 (window-dedicated-p (selected-window)))
1449 (pop-to-buffer (current-buffer)) 1474 (pop-to-buffer (current-buffer))
1450 (switch-to-buffer "*About GNU Emacs*")) 1475 (switch-to-buffer "*GNU Emacs*"))
1451 (setq buffer-read-only nil) 1476 (setq buffer-read-only nil)
1452 (erase-buffer) 1477 (erase-buffer)
1453 (if pure-space-overflow 1478 (if pure-space-overflow
@@ -1463,6 +1488,8 @@ Warning Warning!!! Pure space overflow !!!Warning Warning
1463 (delete-region (point) (point-max)) 1488 (delete-region (point) (point-max))
1464 (insert "\n") 1489 (insert "\n")
1465 (fancy-splash-tail) 1490 (fancy-splash-tail)
1491 (use-local-map splash-screen-keymap)
1492 (setq tab-width 22)
1466 (set-buffer-modified-p nil) 1493 (set-buffer-modified-p nil)
1467 (setq buffer-read-only t) 1494 (setq buffer-read-only t)
1468 (if (and view-read-only (not view-mode)) 1495 (if (and view-read-only (not view-mode))
@@ -1510,15 +1537,15 @@ we put it on this frame."
1510 (> frame-height (+ image-height 19))))))) 1537 (> frame-height (+ image-height 19)))))))
1511 1538
1512 1539
1513(defun normal-splash-screen (&optional hide-on-input) 1540(defun normal-splash-screen (&optional static)
1514 "Display splash screen when Emacs starts." 1541 "Display splash screen when Emacs starts."
1515 (let ((prev-buffer (current-buffer))) 1542 (let ((prev-buffer (current-buffer)))
1516 (unwind-protect 1543 (unwind-protect
1517 (with-current-buffer (get-buffer-create "GNU Emacs") 1544 (with-current-buffer (get-buffer-create "*About GNU Emacs*")
1518 (setq buffer-read-only nil) 1545 (setq buffer-read-only nil)
1519 (erase-buffer) 1546 (erase-buffer)
1520 (set (make-local-variable 'tab-width) 8) 1547 (set (make-local-variable 'tab-width) 8)
1521 (if hide-on-input 1548 (if (not static)
1522 (set (make-local-variable 'mode-line-format) 1549 (set (make-local-variable 'mode-line-format)
1523 (propertize "---- %b %-" 'face 'mode-line-buffer-id))) 1550 (propertize "---- %b %-" 'face 'mode-line-buffer-id)))
1524 1551
@@ -1536,13 +1563,10 @@ Warning Warning!!! Pure space overflow !!!Warning Warning
1536 ", one component of the GNU/Linux operating system.\n" 1563 ", one component of the GNU/Linux operating system.\n"
1537 ", a part of the GNU operating system.\n")) 1564 ", a part of the GNU operating system.\n"))
1538 1565
1539 (if hide-on-input 1566 (if (not static)
1540 (insert (substitute-command-keys 1567 (insert (substitute-command-keys
1541 (concat 1568 (concat
1542 "\nType \\[recenter] to begin editing" 1569 "\nType \\[recenter] to quit from this screen.\n"))))
1543 (if (equal (buffer-name prev-buffer) "*scratch*")
1544 ".\n"
1545 " your file.\n")))))
1546 1570
1547 (if (display-mouse-p) 1571 (if (display-mouse-p)
1548 ;; The user can use the mouse to activate menus 1572 ;; The user can use the mouse to activate menus
@@ -1550,22 +1574,58 @@ Warning Warning!!! Pure space overflow !!!Warning Warning
1550 (progn 1574 (progn
1551 (insert "\ 1575 (insert "\
1552You can do basic editing with the menu bar and scroll bar using the mouse. 1576You can do basic editing with the menu bar and scroll bar using the mouse.
1553To quit a partially entered command, type Control-g. 1577To quit a partially entered command, type Control-g.\n")
1554 1578
1555Useful File menu items: 1579 (insert "\nImportant Help menu items:\n")
1556Exit Emacs (or type Control-x followed by Control-c) 1580 (insert-button "Emacs Tutorial"
1557Recover Crashed Session Recover files you were editing before a crash 1581 'action (lambda (button) (help-with-tutorial))
1558 1582 'follow-link t)
1559Important Help menu items: 1583 (insert "\t\tLearn how to use Emacs efficiently\n")
1560Emacs Tutorial Learn how to use Emacs efficiently 1584 (insert-button "Emacs FAQ"
1561Emacs FAQ Frequently asked questions and answers 1585 'action (lambda (button) (view-emacs-FAQ))
1562Read the Emacs Manual View the Emacs manual using Info 1586 'follow-link t)
1563\(Non)Warranty GNU Emacs comes with ABSOLUTELY NO WARRANTY 1587 (insert "\t\tFrequently asked questions and answers\n")
1564Copying Conditions Conditions for redistributing and changing Emacs 1588 (insert-button "Read the Emacs Manual"
1565Getting New Versions How to obtain the latest version of Emacs 1589 'action (lambda (button) (info-emacs-manual))
1566More Manuals / Ordering Manuals How to order printed manuals from the FSF 1590 'follow-link t)
1567") 1591 (insert "\tView the Emacs manual using Info\n")
1568 (insert "\n\n" (emacs-version) 1592 (insert-button "\(Non)Warranty"
1593 'action (lambda (button) (describe-no-warranty))
1594 'follow-link t)
1595 (insert "\t\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n")
1596 (insert-button "Copying Conditions"
1597 'action (lambda (button) (describe-copying))
1598 'follow-link t)
1599 (insert "\tConditions for redistributing and changing Emacs\n")
1600 (insert-button "Getting New Versions"
1601 'action (lambda (button) (describe-distribution))
1602 'follow-link t)
1603 (insert "\tHow to obtain the latest version of Emacs\n")
1604 (insert-button "More Manuals / Ordering Manuals"
1605 'action (lambda (button) (view-order-manuals))
1606 'follow-link t)
1607 (insert " How to order printed manuals from the FSF\n")
1608
1609 (insert "\nUseful tasks:\n")
1610 (insert-button "Visit New File"
1611 'action (lambda (button) (call-interactively 'find-file))
1612 'follow-link t)
1613 (insert "\t\tSpecify a new file's name, to edit the file\n")
1614 (insert-button "Open Home Directory"
1615 'action (lambda (button) (dired "~"))
1616 'follow-link t)
1617 (insert "\tOpen your home directory, to operate on its files\n")
1618 (insert-button "Open *scratch* buffer"
1619 'action (lambda (button) (switch-to-buffer
1620 (get-buffer-create "*scratch*")))
1621 'follow-link t)
1622 (insert "\tOpen buffer for notes you don't want to save\n")
1623 (insert-button "Customize Startup"
1624 'action (lambda (button) (customize-group 'initialization))
1625 'follow-link t)
1626 (insert "\tChange initialization settings including this screen\n")
1627
1628 (insert "\n" (emacs-version)
1569 "\n" emacs-copyright)) 1629 "\n" emacs-copyright))
1570 1630
1571 ;; No mouse menus, so give help using kbd commands. 1631 ;; No mouse menus, so give help using kbd commands.
@@ -1579,57 +1639,139 @@ More Manuals / Ordering Manuals How to order printed manuals from the FSF
1579 (eq (key-binding "\C-hi") 'info) 1639 (eq (key-binding "\C-hi") 'info)
1580 (eq (key-binding "\C-hr") 'info-emacs-manual) 1640 (eq (key-binding "\C-hr") 'info-emacs-manual)
1581 (eq (key-binding "\C-h\C-n") 'view-emacs-news)) 1641 (eq (key-binding "\C-h\C-n") 'view-emacs-news))
1582 (insert " 1642 (progn
1643 (insert "
1583Get help C-h (Hold down CTRL and press h) 1644Get help C-h (Hold down CTRL and press h)
1584Emacs manual C-h r 1645")
1585Emacs tutorial C-h t Undo changes C-x u 1646 (insert-button "Emacs manual"
1586Buy manuals C-h C-m Exit Emacs C-x C-c 1647 'action (lambda (button) (info-emacs-manual))
1587Browse manuals C-h i") 1648 'follow-link t)
1649 (insert " C-h r\t")
1650 (insert-button "Browse manuals"
1651 'action (lambda (button) (Info-directory))
1652 'follow-link t)
1653 (insert "\t C-h i
1654")
1655 (insert-button "Emacs tutorial"
1656 'action (lambda (button) (help-with-tutorial))
1657 'follow-link t)
1658 (insert " C-h t\tUndo changes\t C-x u
1659")
1660 (insert-button "Buy manuals"
1661 'action (lambda (button) (view-order-manuals))
1662 'follow-link t)
1663 (insert "\t C-h C-m\tExit Emacs\t C-x C-c"))
1588 1664
1589 (insert (substitute-command-keys 1665 (insert (substitute-command-keys
1590 (format "\n 1666 (format "\n
1591Get help %s 1667Get help %s
1592Emacs manual \\[info-emacs-manual] 1668"
1593Emacs tutorial \\[help-with-tutorial]\tUndo changes\t\\[advertised-undo] 1669 (let ((where (where-is-internal
1594Buy manuals \\[view-order-manuals]\tExit Emacs\t\\[save-buffers-kill-terminal] 1670 'help-command nil t)))
1595Browse manuals \\[info]" 1671 (if where
1596 (let ((where (where-is-internal 1672 (key-description where)
1597 'help-command nil t))) 1673 "M-x help"))))
1598 (if where 1674 (insert-button "Emacs manual"
1599 (key-description where) 1675 'action (lambda (button) (info-emacs-manual))
1600 "M-x help")))))) 1676 'follow-link t)
1601 1677 (insert (substitute-command-keys" \\[info-emacs-manual]\t"))
1602 ;; Say how to use the menu bar with the keyboard. 1678 (insert-button "Browse manuals"
1603 (if (and (eq (key-binding "\M-`") 'tmm-menubar) 1679 'action (lambda (button) (Info-directory))
1604 (eq (key-binding [f10]) 'tmm-menubar)) 1680 'follow-link t)
1605 (insert " 1681 (insert (substitute-command-keys "\t \\[info]
1606Activate menubar F10 or ESC ` or M-`") 1682"))
1607 (insert (substitute-command-keys " 1683 (insert-button "Emacs tutorial"
1608Activate menubar \\[tmm-menubar]"))) 1684 'action (lambda (button) (help-with-tutorial))
1685 'follow-link t)
1686 (insert (substitute-command-keys
1687 " \\[help-with-tutorial]\tUndo changes\t \\[advertised-undo]
1688"))
1689 (insert-button "Buy manuals"
1690 'action (lambda (button) (view-order-manuals))
1691 'follow-link t)
1692 (insert (substitute-command-keys
1693 "\t \\[view-order-manuals]\tExit Emacs\t \\[save-buffers-kill-emacs]")))
1694
1695 ;; Say how to use the menu bar with the keyboard.
1696 (insert "\n")
1697 (insert-button "Activate menubar"
1698 'action (lambda (button) (tmm-menubar))
1699 'follow-link t)
1700 (if (and (eq (key-binding "\M-`") 'tmm-menubar)
1701 (eq (key-binding [f10]) 'tmm-menubar))
1702 (insert " F10 or ESC ` or M-`")
1703 (insert (substitute-command-keys " \\[tmm-menubar]")))
1609 1704
1610 ;; Many users seem to have problems with these. 1705 ;; Many users seem to have problems with these.
1611 (insert " 1706 (insert "
1612\(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key. 1707\(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key.
1613If you have no Meta key, you may instead type ESC followed by the character.)") 1708If you have no Meta key, you may instead type ESC followed by the character.)")
1614 1709
1615 (insert "\n\n" (emacs-version) 1710 ;; Insert links to useful tasks
1711 (insert "\nUseful tasks:\n")
1712
1713 (insert-button "Visit New File"
1714 'action (lambda (button) (call-interactively 'find-file))
1715 'follow-link t)
1716 (insert "\t\t\t")
1717 (insert-button "Open Home Directory"
1718 'action (lambda (button) (dired "~"))
1719 'follow-link t)
1720 (insert "\n")
1721
1722 (insert-button "Customize Startup"
1723 'action (lambda (button) (customize-group 'initialization))
1724 'follow-link t)
1725 (insert "\t\t")
1726 (insert-button "Open *scratch* buffer"
1727 'action (lambda (button) (switch-to-buffer
1728 (get-buffer-create "*scratch*")))
1729 'follow-link t)
1730 (insert "\n")
1731
1732 (insert "\n" (emacs-version)
1616 "\n" emacs-copyright) 1733 "\n" emacs-copyright)
1617 1734
1618 (if (and (eq (key-binding "\C-h\C-c") 'describe-copying) 1735 (if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
1619 (eq (key-binding "\C-h\C-d") 'describe-distribution) 1736 (eq (key-binding "\C-h\C-d") 'describe-distribution)
1620 (eq (key-binding "\C-h\C-w") 'describe-no-warranty)) 1737 (eq (key-binding "\C-h\C-w") 'describe-no-warranty))
1621 (insert 1738 (progn
1622 "\n 1739 (insert
1623GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details. 1740 "\n
1741GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for ")
1742 (insert-button "full details"
1743 'action (lambda (button) (describe-no-warranty))
1744 'follow-link t)
1745 (insert ".
1624Emacs is Free Software--Free as in Freedom--so you can redistribute copies 1746Emacs is Free Software--Free as in Freedom--so you can redistribute copies
1625of Emacs and modify it; type C-h C-c to see the conditions. 1747of Emacs and modify it; type C-h C-c to see ")
1626Type C-h C-d for information on getting the latest version.") 1748 (insert-button "the conditions"
1627 (insert (substitute-command-keys 1749 'action (lambda (button) (describe-copying))
1628 "\n 1750 'follow-link t)
1629GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details. 1751 (insert ".
1752Type C-h C-d for information on ")
1753 (insert-button "getting the latest version"
1754 'action (lambda (button) (describe-distribution))
1755 'follow-link t)
1756 (insert "."))
1757 (insert (substitute-command-keys
1758 "\n
1759GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for "))
1760 (insert-button "full details"
1761 'action (lambda (button) (describe-no-warranty))
1762 'follow-link t)
1763 (insert (substitute-command-keys ".
1630Emacs is Free Software--Free as in Freedom--so you can redistribute copies 1764Emacs is Free Software--Free as in Freedom--so you can redistribute copies
1631of Emacs and modify it; type \\[describe-copying] to see the conditions. 1765of Emacs and modify it; type \\[describe-copying] to see "))
1632Type \\[describe-distribution] for information on getting the latest version.")))) 1766 (insert-button "the conditions"
1767 'action (lambda (button) (describe-copying))
1768 'follow-link t)
1769 (insert (substitute-command-keys".
1770Type \\[describe-distribution] for information on "))
1771 (insert-button "getting the latest version"
1772 'action (lambda (button) (describe-distribution))
1773 'follow-link t)
1774 (insert ".")))
1633 1775
1634 ;; The rest of the startup screen is the same on all 1776 ;; The rest of the startup screen is the same on all
1635 ;; kinds of terminals. 1777 ;; kinds of terminals.
@@ -1650,7 +1792,9 @@ Type \\[describe-distribution] for information on getting the latest version."))
1650 t) 1792 t)
1651 (insert "\n\nIf an Emacs session crashed recently, " 1793 (insert "\n\nIf an Emacs session crashed recently, "
1652 "type Meta-x recover-session RET\nto recover" 1794 "type Meta-x recover-session RET\nto recover"
1653 " the files you were editing.")) 1795 " the files you were editing.\n"))
1796
1797 (use-local-map splash-screen-keymap)
1654 1798
1655 ;; Display the input that we set up in the buffer. 1799 ;; Display the input that we set up in the buffer.
1656 (set-buffer-modified-p nil) 1800 (set-buffer-modified-p nil)
@@ -1671,10 +1815,10 @@ Type \\[describe-distribution] for information on getting the latest version."))
1671 (condition-case nil 1815 (condition-case nil
1672 (switch-to-buffer (current-buffer)))))) 1816 (switch-to-buffer (current-buffer))))))
1673 ;; Unwind ... ensure splash buffer is killed 1817 ;; Unwind ... ensure splash buffer is killed
1674 (if hide-on-input 1818 (if (not static)
1675 (kill-buffer "GNU Emacs") 1819 (kill-buffer "*About GNU Emacs*")
1676 (switch-to-buffer "GNU Emacs") 1820 (switch-to-buffer "*About GNU Emacs*")
1677 (rename-buffer "*About GNU Emacs*" t))))) 1821 (rename-buffer "*GNU Emacs*" t)))))
1678 1822
1679 1823
1680(defun startup-echo-area-message () 1824(defun startup-echo-area-message ()
@@ -1728,14 +1872,14 @@ Type \\[describe-distribution] for information on getting the latest version."))
1728 (message "%s" (startup-echo-area-message)))))) 1872 (message "%s" (startup-echo-area-message))))))
1729 1873
1730 1874
1731(defun display-splash-screen (&optional hide-on-input) 1875(defun display-splash-screen (&optional static)
1732 "Display splash screen according to display. 1876 "Display splash screen according to display.
1733Fancy splash screens are used on graphic displays, 1877Fancy splash screens are used on graphic displays,
1734normal otherwise. 1878normal otherwise.
1735With a prefix argument, any user input hides the splash screen." 1879With a prefix argument, any user input hides the splash screen."
1736 (interactive "P") 1880 (interactive "P")
1737 ;; Prevent recursive calls from server-process-filter. 1881 ;; Prevent recursive calls from server-process-filter.
1738 (if (not (get-buffer "GNU Emacs")) 1882 (if (not (get-buffer "*About GNU Emacs*"))
1739 (if (use-fancy-splash-screens-p) 1883 (if (use-fancy-splash-screens-p)
1740 (fancy-splash-screens hide-on-input) 1884 (fancy-splash-screens hide-on-input)
1741 (normal-splash-screen hide-on-input)))) 1885 (normal-splash-screen hide-on-input))))
@@ -1960,8 +2104,15 @@ With a prefix argument, any user input hides the splash screen."
1960 (or (get-buffer-window first-file-buffer) 2104 (or (get-buffer-window first-file-buffer)
1961 (list-buffers))))) 2105 (list-buffers)))))
1962 2106
2107 (when initial-buffer-choice
2108 (cond ((eq initial-buffer-choice t)
2109 (switch-to-buffer (get-buffer-create "*scratch*")))
2110 ((stringp initial-buffer-choice)
2111 (find-file initial-buffer-choice))))
2112
1963 ;; Maybe display a startup screen. 2113 ;; Maybe display a startup screen.
1964 (unless (or inhibit-startup-message 2114 (unless (or inhibit-startup-message
2115 initial-buffer-choice
1965 noninteractive 2116 noninteractive
1966 emacs-quick-startup) 2117 emacs-quick-startup)
1967 ;; Display a startup screen, after some preparations. 2118 ;; Display a startup screen, after some preparations.
diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el
index f7be9fd73fd..d9660fd9f06 100644
--- a/lisp/term/mac-win.el
+++ b/lisp/term/mac-win.el
@@ -1794,7 +1794,7 @@ Currently the `mailto' scheme is supported."
1794 1794
1795(define-key mac-apple-event-map [internet-event get-url] 'mac-ae-get-url) 1795(define-key mac-apple-event-map [internet-event get-url] 'mac-ae-get-url)
1796 1796
1797(define-key mac-apple-event-map [hi-command about] 'display-splash-screen) 1797(define-key mac-apple-event-map [hi-command about] 'about-emacs)
1798 1798
1799;;; Converted Carbon Events 1799;;; Converted Carbon Events
1800(defun mac-handle-toolbar-switch-mode (event) 1800(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
diff --git a/lispref/ChangeLog b/lispref/ChangeLog
index 75d40dbd19c..ea3e18da52b 100644
--- a/lispref/ChangeLog
+++ b/lispref/ChangeLog
@@ -1,3 +1,8 @@
12007-08-16 Richard Stallman <rms@gnu.org>
2
3 * processes.texi (Asynchronous Processes): Clarify
4 doc of start-file-process.
5
12007-08-08 Martin Rudalics <rudalics@gmx.at> 62007-08-08 Martin Rudalics <rudalics@gmx.at>
2 7
3 * modes.texi (Example Major Modes): Fix typo. 8 * modes.texi (Example Major Modes): Fix typo.
diff --git a/lispref/processes.texi b/lispref/processes.texi
index 535c8c3f256..f7be990b85e 100644
--- a/lispref/processes.texi
+++ b/lispref/processes.texi
@@ -503,23 +503,25 @@ Process my-process finished
503 503
504@defun start-file-process name buffer-or-name program &rest args 504@defun start-file-process name buffer-or-name program &rest args
505Like @code{start-process}, this function starts a new asynchronous 505Like @code{start-process}, this function starts a new asynchronous
506subprocess running @var{program} in it. The corresponding process 506subprocess running @var{program} in it, and returns its process
507object is returned. 507object---when @code{default-directory} is not a magic file name.
508 508
509If @code{default-directory} corresponds to a file handler, that 509If @code{default-directory} is magic, the function invokes its file
510handler is invoked. @var{program} runs then on a remote host which is 510handler instead. This handler ought to run @var{program}, perhaps on
511identified by @code{default-directory}. The local part of 511the local host, perhaps on a remote host that corresponds to
512@code{default-directory} is the working directory of the subprocess. 512@code{default-directory}. In the latter case, the local part of
513@code{default-directory} becomes the working directory of the process.
513 514
514@var{program} and @var{program-args} might be file names. They are not 515This function does not try to invoke file name handlers for
515objects of file handler invocation. 516@var{program} or for the @var{program-args}.
516 517
517Depending on the implementation of the file handler, it might not be 518Depending on the implementation of the file handler, it might not be
518possible to apply @code{process-filter} or @code{process-sentinel} to 519possible to apply @code{process-filter} or @code{process-sentinel} to
519the resulting process object (@pxref{Filter Functions}, @pxref{Sentinels}). 520the resulting process object (@pxref{Filter Functions}, @pxref{Sentinels}).
520 521
521Some file handlers may not support @code{start-file-process} (for 522Some file handlers may not support @code{start-file-process} (for
522example @code{ange-ftp-hook-function}). It returns then @code{nil}. 523example @code{ange-ftp-hook-function}). In such cases, the function
524does nothing and returns @code{nil}.
523@end defun 525@end defun
524 526
525@defun start-process-shell-command name buffer-or-name command &rest command-args 527@defun start-process-shell-command name buffer-or-name command &rest command-args
diff --git a/lispref/text.texi b/lispref/text.texi
index b3cd6cb4a92..430c48133ee 100644
--- a/lispref/text.texi
+++ b/lispref/text.texi
@@ -4278,35 +4278,6 @@ because it may lead to inefficient behavior for some change hook
4278functions. 4278functions.
4279@end defmac 4279@end defmac
4280 4280
4281The two variables above are temporarily bound to @code{nil} during the
4282time that any of these functions is running. This means that if one of
4283these functions changes the buffer, that change won't run these
4284functions. If you do want a hook function to make changes that run
4285these functions, make it bind these variables back to their usual
4286values.
4287
4288One inconvenient result of this protective feature is that you cannot
4289have a function in @code{after-change-functions} or
4290@code{before-change-functions} which changes the value of that variable.
4291But that's not a real limitation. If you want those functions to change
4292the list of functions to run, simply add one fixed function to the hook,
4293and code that function to look in another variable for other functions
4294to call. Here is an example:
4295
4296@example
4297(setq my-own-after-change-functions nil)
4298(defun indirect-after-change-function (beg end len)
4299 (let ((list my-own-after-change-functions))
4300 (while list
4301 (funcall (car list) beg end len)
4302 (setq list (cdr list)))))
4303
4304@group
4305(add-hooks 'after-change-functions
4306 'indirect-after-change-function)
4307@end group
4308@end example
4309
4310@defvar first-change-hook 4281@defvar first-change-hook
4311This variable is a normal hook that is run whenever a buffer is changed 4282This variable is a normal hook that is run whenever a buffer is changed
4312that was previously in the unmodified state. 4283that was previously in the unmodified state.
@@ -4318,6 +4289,13 @@ disabled; none of them run. This affects all the hook variables
4318described above in this section, as well as the hooks attached to 4289described above in this section, as well as the hooks attached to
4319certain special text properties (@pxref{Special Properties}) and overlay 4290certain special text properties (@pxref{Special Properties}) and overlay
4320properties (@pxref{Overlay Properties}). 4291properties (@pxref{Overlay Properties}).
4292
4293Also, this variable is bound to non-@code{nil} while running those
4294same hook variables, so that by default modifying the buffer from
4295a modification hook does not cause other modification hooks to be run.
4296If you do want modification hooks to be run in a particular piece of
4297code that is itself run from a modification hook, then rebind locally
4298@code{inhibit-modification-hooks} to @code{nil}.
4321@end defvar 4299@end defvar
4322 4300
4323@ignore 4301@ignore
diff --git a/man/ChangeLog b/man/ChangeLog
index 2395e82fdbb..7438fbad338 100644
--- a/man/ChangeLog
+++ b/man/ChangeLog
@@ -1,3 +1,29 @@
12007-08-17 Eli Zaretskii <eliz@gnu.org>
2
3 * basic.texi (Position Info): Add index entry for face at point.
4 Mention that character faces are also displayed by "C-u C-x =".
5
62007-08-17 Jay Belanger <jay.p.belanger@gmail.com>
7
8 * calc.texi: Move contents to beginning of file.
9 (Algebraic Entry): Fix the formatting of an example.
10
112007-08-15 Jay Belanger <jay.p.belanger@gmail.com>
12
13 * calc.texi (Basic Operations on Units): Mention exact versus
14 inexact conversions.
15
162007-08-14 Jay Belanger <jay.p.belanger@gmail.com>
17
18 * calc.texi (Basic Operations on Units): Mention default
19 values for new units.
20 (Quick Calculator Mode): Mention that binary format will
21 be displayed.
22
232007-08-14 Katsumi Yamaoka <yamaoka@jpl.org>
24
25 * gnus.texi (Selecting a Group): Mention gnus-maximum-newsgroup.
26
12007-08-10 Katsumi Yamaoka <yamaoka@jpl.org> 272007-08-10 Katsumi Yamaoka <yamaoka@jpl.org>
2 28
3 * gnus.texi (NNTP): Mention nntp-xref-number-is-evil. 29 * gnus.texi (NNTP): Mention nntp-xref-number-is-evil.
diff --git a/man/basic.texi b/man/basic.texi
index 6d19281b089..333985e4a4a 100644
--- a/man/basic.texi
+++ b/man/basic.texi
@@ -596,6 +596,7 @@ point=36169 of 36168 (EOB) column=0
596@cindex character set of character at point 596@cindex character set of character at point
597@cindex font of character at point 597@cindex font of character at point
598@cindex text properties at point 598@cindex text properties at point
599@cindex face at point
599 @w{@kbd{C-u C-x =}} displays the following additional information about a 600 @w{@kbd{C-u C-x =}} displays the following additional information about a
600character. 601character.
601 602
@@ -623,7 +624,8 @@ terminal, the code(s) sent to the terminal.
623 624
624@item 625@item
625The character's text properties (@pxref{Text Properties,,, 626The character's text properties (@pxref{Text Properties,,,
626elisp, the Emacs Lisp Reference Manual}), and any overlays containing it 627elisp, the Emacs Lisp Reference Manual}), including any non-default
628faces used to display the character, and any overlays containing it
627(@pxref{Overlays,,, elisp, the same manual}). 629(@pxref{Overlays,,, elisp, the same manual}).
628@end itemize 630@end itemize
629 631
diff --git a/man/calc.texi b/man/calc.texi
index e13dd9097d6..685f945789f 100644
--- a/man/calc.texi
+++ b/man/calc.texi
@@ -123,6 +123,13 @@ Copyright @copyright{} 1990, 1991, 2001, 2002, 2003, 2004,
123@insertcopying 123@insertcopying
124@end titlepage 124@end titlepage
125 125
126
127@summarycontents
128
129@c [end]
130
131@contents
132
126@c [begin] 133@c [begin]
127@ifnottex 134@ifnottex
128@node Top, Getting Started, (dir), (dir) 135@node Top, Getting Started, (dir), (dir)
@@ -10013,11 +10020,18 @@ During numeric entry, the only editing key available is @key{DEL}.
10013@cindex Algebraic notation 10020@cindex Algebraic notation
10014@cindex Formulas, entering 10021@cindex Formulas, entering
10015Calculations can also be entered in algebraic form. This is accomplished 10022Calculations can also be entered in algebraic form. This is accomplished
10016by typing the apostrophe key, @kbd{'}, followed by the expression in 10023by typing the apostrophe key, ', followed by the expression in
10017standard format: @kbd{@key{'} 2+3*4 @key{RET}} computes 10024standard format:
10025
10026@example
10027' 2+3*4 @key{RET}.
10028@end example
10029
10030@noindent
10031This will compute
10018@texline @math{2+(3\times4) = 14} 10032@texline @math{2+(3\times4) = 14}
10019@infoline @expr{2+(3*4) = 14} 10033@infoline @expr{2+(3*4) = 14}
10020and pushes that on the stack. If you wish you can 10034and push it on the stack. If you wish you can
10021ignore the RPN aspect of Calc altogether and simply enter algebraic 10035ignore the RPN aspect of Calc altogether and simply enter algebraic
10022expressions in this way. You may want to use @key{DEL} every so often to 10036expressions in this way. You may want to use @key{DEL} every so often to
10023clear previous results off the stack. 10037clear previous results off the stack.
@@ -10166,8 +10180,8 @@ then the result of the evaluation is stored in that Calc variable.
10166@xref{Store and Recall}. 10180@xref{Store and Recall}.
10167 10181
10168If the result is an integer and the current display radix is decimal, 10182If the result is an integer and the current display radix is decimal,
10169the number will also be displayed in hex and octal formats. If the 10183the number will also be displayed in hex, octal and binary formats. If
10170integer is in the range from 1 to 126, it will also be displayed as 10184the integer is in the range from 1 to 126, it will also be displayed as
10171an ASCII character. 10185an ASCII character.
10172 10186
10173For example, the quoted character @samp{"x"} produces the vector 10187For example, the quoted character @samp{"x"} produces the vector
@@ -27436,14 +27450,29 @@ of angle are evaluated, regardless of the current angular mode.
27436The @kbd{u c} (@code{calc-convert-units}) command converts a units 27450The @kbd{u c} (@code{calc-convert-units}) command converts a units
27437expression to new, compatible units. For example, given the units 27451expression to new, compatible units. For example, given the units
27438expression @samp{55 mph}, typing @kbd{u c m/s @key{RET}} produces 27452expression @samp{55 mph}, typing @kbd{u c m/s @key{RET}} produces
27439@samp{24.5872 m/s}. If the units you request are inconsistent with 27453@samp{24.5872 m/s}. If you have previously converted a units expression
27440the original units, the number will be converted into your units 27454with the same type of units (in this case, distance over time), you will
27441times whatever ``remainder'' units are left over. For example, 27455be offered the previous choice of new units as a default. Continuing
27442converting @samp{55 mph} into acres produces @samp{6.08e-3 acre / m s}. 27456the above example, entering the units expression @samp{100 km/hr} and
27443(Recall that multiplication binds more strongly than division in Calc 27457typing @kbd{u c @key{RET}} (without specifying new units) produces
27444formulas, so the units here are acres per meter-second.) Remainder 27458@samp{27.7777777778 m/s}.
27445units are expressed in terms of ``fundamental'' units like @samp{m} and 27459
27446@samp{s}, regardless of the input units. 27460While many of Calc's conversion factors are exact, some are necessarily
27461approximate. If Calc is in fraction mode (@pxref{Fraction Mode}), then
27462unit conversions will try to give exact, rational conversions, but it
27463isn't always possible. Given @samp{55 mph} in fraction mode, typing
27464@kbd{u c m/s @key{RET}} produces @samp{15367:625 m/s}, for example,
27465while typing @kbd{u c au/yr @key{RET}} produces
27466@samp{5.18665819999e-3 au/yr}.
27467
27468If the units you request are inconsistent with the original units, the
27469number will be converted into your units times whatever ``remainder''
27470units are left over. For example, converting @samp{55 mph} into acres
27471produces @samp{6.08e-3 acre / m s}. (Recall that multiplication binds
27472more strongly than division in Calc formulas, so the units here are
27473acres per meter-second.) Remainder units are expressed in terms of
27474``fundamental'' units like @samp{m} and @samp{s}, regardless of the
27475input units.
27447 27476
27448One special exception is that if you specify a single unit name, and 27477One special exception is that if you specify a single unit name, and
27449a compatible unit appears somewhere in the units expression, then 27478a compatible unit appears somewhere in the units expression, then
@@ -36149,11 +36178,6 @@ the corresponding full Lisp name is derived by adding a prefix of
36149 36178
36150@printindex fn 36179@printindex fn
36151 36180
36152@summarycontents
36153
36154@c [end]
36155
36156@contents
36157@bye 36181@bye
36158 36182
36159 36183
diff --git a/man/gnus.texi b/man/gnus.texi
index 94144b65e3f..7cabf674102 100644
--- a/man/gnus.texi
+++ b/man/gnus.texi
@@ -2153,6 +2153,24 @@ most recently will be fetched.
2153@code{gnus-large-newsgroup}, but is only used for ephemeral 2153@code{gnus-large-newsgroup}, but is only used for ephemeral
2154newsgroups. 2154newsgroups.
2155 2155
2156@vindex gnus-maximum-newsgroup
2157In groups in some news servers, there might be a big gap between a few
2158very old articles that will never be expired and the recent ones. In
2159such a case, the server will return the data like @code{(1 . 30000000)}
2160for the @code{LIST ACTIVE group} command, for example. Even if there
2161are actually only the articles 1-10 and 29999900-30000000, Gnus doesn't
2162know it at first and prepares for getting 30000000 articles. However,
2163it will consume hundreds megabytes of memories and might make Emacs get
2164stuck as the case may be. If you use such news servers, set the
2165variable @code{gnus-maximum-newsgroup} to a positive number. The value
2166means that Gnus ignores articles other than this number of the latest
2167ones in every group. For instance, the value 10000 makes Gnus get only
2168the articles 29990001-30000000 (if the latest article number is 30000000
2169in a group). Note that setting this variable to a number might prevent
2170you from reading very old articles. The default value of the variable
2171@code{gnus-maximum-newsgroup} is @code{nil}, which means Gnus never
2172ignores old articles.
2173
2156@vindex gnus-select-group-hook 2174@vindex gnus-select-group-hook
2157@vindex gnus-auto-select-first 2175@vindex gnus-auto-select-first
2158@vindex gnus-auto-select-subject 2176@vindex gnus-auto-select-subject
diff --git a/nt/ChangeLog b/nt/ChangeLog
index deea04bff17..82771f836c6 100644
--- a/nt/ChangeLog
+++ b/nt/ChangeLog
@@ -1,3 +1,7 @@
12007-08-14 Dhuvra Krishnamurthy <dhuvrakm@gmail.com> (tiny change)
2
3 * makefile.w32-in (bootstrap-nmake): Change directories once more.
4
12007-07-25 Glenn Morris <rgm@gnu.org> 52007-07-25 Glenn Morris <rgm@gnu.org>
2 6
3 * Relicense all FSF files to GPLv3 or later. 7 * Relicense all FSF files to GPLv3 or later.
diff --git a/nt/makefile.w32-in b/nt/makefile.w32-in
index e7a10698ea2..05e9a665879 100644
--- a/nt/makefile.w32-in
+++ b/nt/makefile.w32-in
@@ -153,6 +153,7 @@ bootstrap-nmake: addsection cmdproxy
153 cd ..\src 153 cd ..\src
154 $(MAKE) $(MFLAGS) bootstrap 154 $(MAKE) $(MFLAGS) bootstrap
155 $(MAKE) $(MFLAGS) bootstrap-clean 155 $(MAKE) $(MFLAGS) bootstrap-clean
156 cd ..\nt
156 $(CP) $(BLD)/cmdproxy.exe ../bin 157 $(CP) $(BLD)/cmdproxy.exe ../bin
157 cd ..\lisp 158 cd ..\lisp
158 $(MAKE) $(MFLAGS) SHELL=$(SHELLTYPE) bootstrap 159 $(MAKE) $(MFLAGS) SHELL=$(SHELLTYPE) bootstrap
diff --git a/src/ChangeLog b/src/ChangeLog
index e3c212924b3..3962c174970 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,29 @@
12007-08-19 Richard Stallman <rms@gnu.org>
2
3 * eval.c (Ffunction, Fquote): Signal error if not 1 argument.
4
52007-08-19 Andreas Schwab <schwab@suse.de>
6
7 * alloc.c (pure): Round PURESIZE up.
8
92007-08-17 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
10
11 * xterm.c (handle_one_xevent): Remove check that mouse click is in
12 active frame.
13
142007-08-16 Richard Stallman <rms@gnu.org>
15
16 * eval.c (Fcommandp): Add parens to clarify.
17
18 * minibuf.c (Fall_completions): Use enum for type of table.
19
20 * emacs.c (USAGE2): Improve text.
21
222007-08-15 Philippe Waroquiers <philippe.waroquiers@eurocontrol.int>
23
24 * term.c (tty_default_color_capabilities): Declare static
25 variables in file scope, to avoid HPUX compiler problem.
26
12007-08-13 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> 272007-08-13 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
2 28
3 * gtkutil.c (update_frame_tool_bar): Use -1 as index 29 * gtkutil.c (update_frame_tool_bar): Use -1 as index
diff --git a/src/alloc.c b/src/alloc.c
index 3f081491e85..8aea81a0f72 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -266,7 +266,7 @@ Lisp_Object Vmemory_full;
266 remapping on more recent systems because this is less important 266 remapping on more recent systems because this is less important
267 nowadays than in the days of small memories and timesharing. */ 267 nowadays than in the days of small memories and timesharing. */
268 268
269EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = {1,}; 269EMACS_INT pure[(PURESIZE + sizeof (EMACS_INT) - 1) / sizeof (EMACS_INT)] = {1,};
270#define PUREBEG (char *) pure 270#define PUREBEG (char *) pure
271 271
272#else /* HAVE_SHM */ 272#else /* HAVE_SHM */
diff --git a/src/emacs.c b/src/emacs.c
index e23f8083a31..55475e57799 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -281,9 +281,8 @@ Initialization options:\n\
281Action options:\n\ 281Action options:\n\
282\n\ 282\n\
283FILE visit FILE using find-file\n\ 283FILE visit FILE using find-file\n\
284+LINE FILE visit FILE using find-file, then go to line LINE\n\ 284+LINE go to line LINE in next FILE\n\
285+LINE:COLUMN FILE visit FILE using find-file, then go to line LINE,\n\ 285+LINE:COLUMN go to line LINE, column COLUMN, in next FILE\n\
286 column COLUMN\n\
287--directory, -L DIR add DIR to variable load-path\n\ 286--directory, -L DIR add DIR to variable load-path\n\
288--eval EXPR evaluate Emacs Lisp expression EXPR\n\ 287--eval EXPR evaluate Emacs Lisp expression EXPR\n\
289--execute EXPR evaluate Emacs Lisp expression EXPR\n\ 288--execute EXPR evaluate Emacs Lisp expression EXPR\n\
diff --git a/src/eval.c b/src/eval.c
index 13ea0ba7ebf..830476a61bc 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -202,6 +202,8 @@ Lisp_Object Vmacro_declaration_function;
202 202
203extern Lisp_Object Qrisky_local_variable; 203extern Lisp_Object Qrisky_local_variable;
204 204
205extern Lisp_Object Qfunction;
206
205static Lisp_Object funcall_lambda P_ ((Lisp_Object, int, Lisp_Object*)); 207static Lisp_Object funcall_lambda P_ ((Lisp_Object, int, Lisp_Object*));
206static void unwind_to_catch P_ ((struct catchtag *, Lisp_Object)) NO_RETURN; 208static void unwind_to_catch P_ ((struct catchtag *, Lisp_Object)) NO_RETURN;
207 209
@@ -539,7 +541,7 @@ usage: (setq [SYM VAL]...) */)
539 register Lisp_Object val, sym; 541 register Lisp_Object val, sym;
540 struct gcpro gcpro1; 542 struct gcpro gcpro1;
541 543
542 if (NILP(args)) 544 if (NILP (args))
543 return Qnil; 545 return Qnil;
544 546
545 args_left = args; 547 args_left = args;
@@ -564,6 +566,8 @@ usage: (quote ARG) */)
564 (args) 566 (args)
565 Lisp_Object args; 567 Lisp_Object args;
566{ 568{
569 if (!NILP (Fcdr (args)))
570 xsignal2 (Qwrong_number_of_arguments, Qquote, Flength (args));
567 return Fcar (args); 571 return Fcar (args);
568} 572}
569 573
@@ -575,6 +579,8 @@ usage: (function ARG) */)
575 (args) 579 (args)
576 Lisp_Object args; 580 Lisp_Object args;
577{ 581{
582 if (!NILP (Fcdr (args)))
583 xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args));
578 return Fcar (args); 584 return Fcar (args);
579} 585}
580 586
@@ -2083,7 +2089,7 @@ then strings and vectors are not accepted. */)
2083 2089
2084 /* Strings and vectors are keyboard macros. */ 2090 /* Strings and vectors are keyboard macros. */
2085 if (STRINGP (fun) || VECTORP (fun)) 2091 if (STRINGP (fun) || VECTORP (fun))
2086 return NILP (for_call_interactively) ? Qt : Qnil; 2092 return (NILP (for_call_interactively) ? Qt : Qnil);
2087 2093
2088 /* Lists may represent commands. */ 2094 /* Lists may represent commands. */
2089 if (!CONSP (fun)) 2095 if (!CONSP (fun))
diff --git a/src/insdel.c b/src/insdel.c
index 19823623091..cd8e2738f9a 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -2138,10 +2138,11 @@ prepare_to_modify_buffer (start, end, preserve_ptr)
2138 (! NILP (end_marker) ? Fmarker_position (end_marker) : end) 2138 (! NILP (end_marker) ? Fmarker_position (end_marker) : end)
2139 2139
2140/* Set a variable to nil if an error occurred. 2140/* Set a variable to nil if an error occurred.
2141 VAL is a cons-cell whose car is the variable name, and whose cdr is 2141 Don't change the variable if there was no error.
2142 either nil (to mean that there was indeed an error), or non-nil to mean 2142 VAL is a cons-cell (VARIABLE . NO-ERROR-FLAG).
2143 that the was no error (which thus causes this function to do 2143 VARIABLE is the variable to maybe set to nil.
2144 nothing). */ 2144 NO-ERROR-FLAG is nil if there was an error,
2145 anything else meaning no error (so this function does nothing). */
2145Lisp_Object 2146Lisp_Object
2146reset_var_on_error (val) 2147reset_var_on_error (val)
2147 Lisp_Object val; 2148 Lisp_Object val;
diff --git a/src/minibuf.c b/src/minibuf.c
index c84c83c1c8e..489c714fcb4 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1294,11 +1294,14 @@ is used to further constrain the set of candidates. */)
1294 int bestmatchsize = 0; 1294 int bestmatchsize = 0;
1295 /* These are in bytes, too. */ 1295 /* These are in bytes, too. */
1296 int compare, matchsize; 1296 int compare, matchsize;
1297 int type = (HASH_TABLE_P (collection) ? 3 1297 enum { function_table, list_table, obarray_table, hash_table}
1298 : VECTORP (collection) ? 2 1298 type = (HASH_TABLE_P (collection) ? hash_table
1299 : NILP (collection) || (CONSP (collection) 1299 : VECTORP (collection) ? obarray_table
1300 && (!SYMBOLP (XCAR (collection)) 1300 : ((NILP (collection)
1301 || NILP (XCAR (collection))))); 1301 || (CONSP (collection)
1302 && (!SYMBOLP (XCAR (collection))
1303 || NILP (XCAR (collection)))))
1304 ? list_table : function_table));
1302 int index = 0, obsize = 0; 1305 int index = 0, obsize = 0;
1303 int matchcount = 0; 1306 int matchcount = 0;
1304 int bindcount = -1; 1307 int bindcount = -1;
@@ -1306,7 +1309,7 @@ is used to further constrain the set of candidates. */)
1306 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; 1309 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1307 1310
1308 CHECK_STRING (string); 1311 CHECK_STRING (string);
1309 if (type == 0) 1312 if (type == function_table)
1310 return call3 (collection, string, predicate, Qnil); 1313 return call3 (collection, string, predicate, Qnil);
1311 1314
1312 bestmatch = bucket = Qnil; 1315 bestmatch = bucket = Qnil;
@@ -1314,7 +1317,7 @@ is used to further constrain the set of candidates. */)
1314 1317
1315 /* If COLLECTION is not a list, set TAIL just for gc pro. */ 1318 /* If COLLECTION is not a list, set TAIL just for gc pro. */
1316 tail = collection; 1319 tail = collection;
1317 if (type == 2) 1320 if (type == obarray_table)
1318 { 1321 {
1319 collection = check_obarray (collection); 1322 collection = check_obarray (collection);
1320 obsize = XVECTOR (collection)->size; 1323 obsize = XVECTOR (collection)->size;
@@ -1328,7 +1331,7 @@ is used to further constrain the set of candidates. */)
1328 /* elt gets the alist element or symbol. 1331 /* elt gets the alist element or symbol.
1329 eltstring gets the name to check as a completion. */ 1332 eltstring gets the name to check as a completion. */
1330 1333
1331 if (type == 1) 1334 if (type == list_table)
1332 { 1335 {
1333 if (!CONSP (tail)) 1336 if (!CONSP (tail))
1334 break; 1337 break;
@@ -1336,7 +1339,7 @@ is used to further constrain the set of candidates. */)
1336 eltstring = CONSP (elt) ? XCAR (elt) : elt; 1339 eltstring = CONSP (elt) ? XCAR (elt) : elt;
1337 tail = XCDR (tail); 1340 tail = XCDR (tail);
1338 } 1341 }
1339 else if (type == 2) 1342 else if (type == obarray_table)
1340 { 1343 {
1341 if (!EQ (bucket, zero)) 1344 if (!EQ (bucket, zero))
1342 { 1345 {
@@ -1357,7 +1360,7 @@ is used to further constrain the set of candidates. */)
1357 continue; 1360 continue;
1358 } 1361 }
1359 } 1362 }
1360 else /* if (type == 3) */ 1363 else /* if (type == hash_table) */
1361 { 1364 {
1362 while (index < HASH_TABLE_SIZE (XHASH_TABLE (collection)) 1365 while (index < HASH_TABLE_SIZE (XHASH_TABLE (collection))
1363 && NILP (HASH_HASH (XHASH_TABLE (collection), index))) 1366 && NILP (HASH_HASH (XHASH_TABLE (collection), index)))
@@ -1411,15 +1414,17 @@ is used to further constrain the set of candidates. */)
1411 tem = Fcommandp (elt, Qnil); 1414 tem = Fcommandp (elt, Qnil);
1412 else 1415 else
1413 { 1416 {
1414 if (bindcount >= 0) { 1417 if (bindcount >= 0)
1415 unbind_to (bindcount, Qnil); 1418 {
1416 bindcount = -1; 1419 unbind_to (bindcount, Qnil);
1417 } 1420 bindcount = -1;
1421 }
1418 GCPRO4 (tail, string, eltstring, bestmatch); 1422 GCPRO4 (tail, string, eltstring, bestmatch);
1419 tem = type == 3 1423 tem = (type == hash_table
1420 ? call2 (predicate, elt, 1424 ? call2 (predicate, elt,
1421 HASH_VALUE (XHASH_TABLE (collection), index - 1)) 1425 HASH_VALUE (XHASH_TABLE (collection),
1422 : call1 (predicate, elt); 1426 index - 1))
1427 : call1 (predicate, elt));
1423 UNGCPRO; 1428 UNGCPRO;
1424 } 1429 }
1425 if (NILP (tem)) continue; 1430 if (NILP (tem)) continue;
diff --git a/src/term.c b/src/term.c
index 5d8e0f2a61f..c906e1eb15a 100644
--- a/src/term.c
+++ b/src/term.c
@@ -1967,14 +1967,21 @@ is not on a tty device. */)
1967 1967
1968#ifndef WINDOWSNT 1968#ifndef WINDOWSNT
1969 1969
1970/* Declare here rather than in the function, as in the rest of Emacs,
1971 to work around an HPUX compiler bug (?). See
1972 http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00410.html */
1973static int default_max_colors;
1974static int default_max_pairs;
1975static int default_no_color_video;
1976static char *default_orig_pair;
1977static char *default_set_foreground;
1978static char *default_set_background;
1979
1970/* Save or restore the default color-related capabilities of this 1980/* Save or restore the default color-related capabilities of this
1971 terminal. */ 1981 terminal. */
1972static void 1982static void
1973tty_default_color_capabilities (struct tty_display_info *tty, int save) 1983tty_default_color_capabilities (struct tty_display_info *tty, int save)
1974{ 1984{
1975 static char
1976 *default_orig_pair, *default_set_foreground, *default_set_background;
1977 static int default_max_colors, default_max_pairs, default_no_color_video;
1978 1985
1979 if (save) 1986 if (save)
1980 { 1987 {
diff --git a/src/xterm.c b/src/xterm.c
index 1ced63932e5..0e56b04c1b0 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -6866,27 +6866,23 @@ handle_one_xevent (dpyinfo, eventp, finish, hold_quit)
6866 } 6866 }
6867 6867
6868 if (!tool_bar_p) 6868 if (!tool_bar_p)
6869 if (!dpyinfo->x_focus_frame
6870 || f == dpyinfo->x_focus_frame)
6871 {
6872#if defined (USE_X_TOOLKIT) || defined (USE_GTK) 6869#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
6873 if (! popup_activated ()) 6870 if (! popup_activated ())
6874#endif 6871#endif
6875 { 6872 {
6876 if (ignore_next_mouse_click_timeout) 6873 if (ignore_next_mouse_click_timeout)
6877 { 6874 {
6878 if (event.type == ButtonPress 6875 if (event.type == ButtonPress
6879 && (int)(event.xbutton.time - ignore_next_mouse_click_timeout) > 0) 6876 && (int)(event.xbutton.time - ignore_next_mouse_click_timeout) > 0)
6880 { 6877 {
6881 ignore_next_mouse_click_timeout = 0; 6878 ignore_next_mouse_click_timeout = 0;
6882 construct_mouse_click (&inev.ie, &event.xbutton, f); 6879 construct_mouse_click (&inev.ie, &event.xbutton, f);
6883 } 6880 }
6884 if (event.type == ButtonRelease) 6881 if (event.type == ButtonRelease)
6885 ignore_next_mouse_click_timeout = 0; 6882 ignore_next_mouse_click_timeout = 0;
6886 } 6883 }
6887 else 6884 else
6888 construct_mouse_click (&inev.ie, &event.xbutton, f); 6885 construct_mouse_click (&inev.ie, &event.xbutton, f);
6889 }
6890 } 6886 }
6891 } 6887 }
6892 else 6888 else
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-18 02:55:41 +0000