aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorMiles Bader2005-02-02 01:54:00 +0000
committerMiles Bader2005-02-02 01:54:00 +0000
commitf3d3402885646e6fa79f1ad59fb8a1f9017851d7 (patch)
tree0d381cd0e2eb41edd55d4473bcaaab4053e69468 /lisp
parent0d2e792ea9c1a983937e016f7f97cc64f2013603 (diff)
parentf2433a30c5c6fa307ae1358c15e65e484989e5b4 (diff)
downloademacs-f3d3402885646e6fa79f1ad59fb8a1f9017851d7.tar.gz
emacs-f3d3402885646e6fa79f1ad59fb8a1f9017851d7.zip
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-10
Merge from emacs--cvs-trunk--0 Patches applied: * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-59 - miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-68 Update from CVS
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog152
-rw-r--r--lisp/calc/calc-aent.el55
-rw-r--r--lisp/calc/calc-embed.el6
-rw-r--r--lisp/calc/calc-ext.el13
-rw-r--r--lisp/calc/calc-help.el2
-rw-r--r--lisp/calc/calc-lang.el95
-rw-r--r--lisp/calc/calc-prog.el9
-rw-r--r--lisp/calc/calc.el14
-rw-r--r--lisp/calc/calccomp.el116
-rw-r--r--lisp/comint.el4
-rw-r--r--lisp/cus-edit.el31
-rw-r--r--lisp/dired.el4
-rw-r--r--lisp/files.el9
-rw-r--r--lisp/gnus/ChangeLog28
-rw-r--r--lisp/gnus/gnus-art.el2
-rw-r--r--lisp/man.el1
-rw-r--r--lisp/progmodes/compile.el6
-rw-r--r--lisp/progmodes/gdb-ui.el290
-rw-r--r--lisp/rect.el10
-rw-r--r--lisp/ses.el79
-rw-r--r--lisp/simple.el113
-rw-r--r--lisp/textmodes/ispell.el201
-rw-r--r--lisp/wid-edit.el34
23 files changed, 948 insertions, 326 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 6a70d138b0d..5722db8f6b1 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,8 +1,158 @@
12005-01-31 Jay Belanger <belanger@truman.edu>
2
3 * calc/calc-embed.el (calc-embedded-find-bounds): Set the formula
4 bound on the line with the formula.
5
62005-01-31 Kim F. Storm <storm@cua.dk>
7
8 * ses.el (ses-create-cell-variable-range)
9 (ses-destroy-cell-variable-range, ses-reset-header-string)
10 (ses-set-with-undo, ses-unset-with-undo, ses-aset-with-undo)
11 (ses-insert-row): Fix format of apply undo entries.
12
132005-01-31 Jay Belanger <belanger@truman.edu>
14
15 * calc/calc-aent.el (math-read-token): Separate the TeX and LaTeX
16 parts.
17
18 * calc/calc-embed.el (calc-embedded-open-formula)
19 (calc-embedded-close-formula): Ignore matrix environments.
20
21 * calc/calc-ext.el (math-read-big-expr): Make LaTeX the default
22 TeX mode.
23
24 * calc/calc-lang.el (math-function-table, math-oper-table)
25 (math-variable-table): Adjust the LaTeX portions.
26
27 * calc/calc.el (math-tex-ignore-words): Remove LaTeX portion.
28 (math-latex-ignore-words): New constant.
29
302005-01-31 Richard M. Stallman <rms@gnu.org>
31
32 * textmodes/ispell.el (ispell-local-dictionary-overridden): New var.
33 (ispell-local-dictionary): Doc fix.
34 (ispell-dictionary-alist): Don't include ispell-local-dictionary-alist.
35 Don't reinitialize at run time. Don't defcustom.
36 All uses changed to append ispell-local-dictionary-alist,
37 or check it first.
38 (ispell-current-dictionary): New variable for dictionary in use.
39 (ispell-dictionary): Now used only for global default.
40 (ispell-start-process): Set ispell-current-dictionary,
41 not ispell-dictionary.
42 (ispell-change-dictionary): Use this only for setting
43 user preferences.
44 (ispell-internal-change-dictionary): New function
45 to change the current dictionary in use.
46 (ispell-region, ispell-process-line, ispell-buffer-local-dict):
47 Use ispell-current-dictionary.
48 Handle ispell-local-dictionary-overridden.
49 (ispell-buffer-local-dict): Call ispell-internal-change-dictionary.
50
512005-01-31 Jay Belanger <belanger@truman.edu>
52
53 * calc/calc-aent.el (math-read-token): Add support for LaTeX.
54
55 * calc/calc-ext.el: Add calc-latex-language to autoloads.
56 (calc-mode-map): Add calc-latex-language.
57
58 * calc/calc-lang.el (calc-latex-language, math-latex-parse-frac)
59 (math-latex-print-frac): New functions.
60 (math-oper-table, math-function-table, math-variable-table)
61 (math-complex-format, math-input-filter): Add latex properties.
62 (calc-set-language): Set math-expr-special-function-mapping.
63
64 * calc/calc-prog.el (calc-edit-user-syntax, calc-fix-token-name)
65 (calc-write-parse-table-part): Add LaTeX support.
66
67 * calc/calc.el (calc-language): Adjust docstring.
68 (calc-set-mode-line): Add LaTeX support.
69 (math-expr-special-function-mapping): New variable.
70 (math-tex-ignore-words): Add to list.
71
72 * calc/calccomp.el (math-compose-expr, math-compose-rows):
73 Add LaTeX support.
74 (math-compose-expr): Add support for special functions.
75
76 * calc/calc-help.el (calc-d-prefix-help): Add LaTeX.
77
782005-01-31 Nick Roberts <nickrob@snap.net.nz>
79
80 * progmodes/gdb-ui.el (gdb-memory-address)
81 (gdb-memory-repeat-count, gdb-memory-format, gdb-memory-unit)
82 (gdb-memory-mode-map, gdb-memory-format-keymap)
83 (gdb-memory-format-menu, gdb-memory-unit-keymap)
84 (gdb-memory-unit-menu): New variables for a buffer
85 that lets the user examine program memory.
86 (gdb-memory-set-address, gdb-memory-set-repeat-count)
87 (gdb-memory-format-binary, gdb-memory-format-octal)
88 (gdb-memory-format-unsigned, gdb-memory-format-signed)
89 (gdb-memory-format-hexadecimal, gdb-memory-format-menu)
90 (gdb-memory-format-menu-1, gdb-memory-unit-giant)
91 (gdb-memory-unit-word, gdb-memory-unit-halfword)
92 (gdb-memory-unit-byte, gdb-memory-unit-menu)
93 (gdb-memory-unit-menu-1, gdb-make-header-line-mouse-map)
94 (gdb-memory-mode, gdb-memory-buffer-name)
95 (gdb-display-memory-buffer, gdb-frame-memory-buffer):
96 New functions for above buffer.
97
982005-01-30 Richard M. Stallman <rms@gnu.org>
99
100 * cus-edit.el (custom-bury-buffer): Function deleted.
101 (custom-buffer-done-function): Option deleted.
102 (custom-buffer-done-kill): New (replacement option.
103 (Custom-buffer-done): Call quit-window.
104 (custom-buffer-create-internal): Update for above changes.
105
1062005-01-29 Luc Teirlinck <teirllm@auburn.edu>
107
108 * simple.el (undo-ask-before-discard): New var.
109 (undo-outer-limit-truncate): Implement it.
110 (undo-extra-outer-limit): Doc update.
111
1122005-01-29 Richard M. Stallman <rms@gnu.org>
113
114 * ses.el (undo-more): defadvice deleted.
115 (ses-begin-change): Doc fix.
116
117 * dired.el (dired-mode-map): Remap `undo' and `advertised-undo'
118 instead of rebinding C-x u and C-_.
119
120 * files.el (normal-backup-enable-predicate): Return nil for files
121 in /tmp, regardless of temporary-file-directory.
122
123 * man.el (Man-getpage-in-background): Disable undo in Man buffer.
124
125 * rect.el (delete-rectangle-line, delete-extract-rectangle-line)
126 (open-rectangle, delete-whitespace-rectangle-line)
127 (clear-rectangle-line): If FILL, pass t instead of FILL
128 for move-to-column's 2nd arg.
129
130 * simple.el (undo): Fix the test for continuing a series of undos.
131 (undo-more): Set pending-undo-list to t when we reach end.
132 (pending-undo-list): defvar moved up.
133
134 * wid-edit.el (widget-button-click):
135 Shorten the range of the track-mouse binding.
136
137 * comint.el (comint-insert-input): Undo previous changes;
138 use last-input-event in interactive spec.
139
1402005-01-29 Eli Zaretskii <eliz@gnu.org>
141
142 * progmodes/compile.el (compilation-start): Bind buffer-read-only
143 to nil before invoking call-process. Reset buffer's modified flag
144 after fontifying it in the no-async branch.
145
146 * wid-edit.el (widget-specify-button): If mouse pointer shape
147 cannot be changed, use mouse face instead.
148
12005-01-29 Nick Roberts <nickrob@snap.net.nz> 1492005-01-29 Nick Roberts <nickrob@snap.net.nz>
2 150
3 * progmodes/gdb-ui.el (gdb-info-breakpoints-custom) 151 * progmodes/gdb-ui.el (gdb-info-breakpoints-custom)
4 (gdb-goto-breakpoint): Make breakpoint handling work on template 152 (gdb-goto-breakpoint): Make breakpoint handling work on template
5 functions in C++. Reported by Martin Reed <mjreed@essex.ac.uk> 153 functions in C++. Reported by Martin Reed <mjreed@essex.ac.uk>
154 (gdb-assembler-custom): Update to recognise breakpoint information
155 added on 2005-01-19.
6 156
72005-01-28 Eli Zaretskii <eliz@gnu.org> 1572005-01-28 Eli Zaretskii <eliz@gnu.org>
8 158
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el
index 2210435036c..9a693a18466 100644
--- a/lisp/calc/calc-aent.el
+++ b/lisp/calc/calc-aent.el
@@ -690,7 +690,7 @@ in Calc algebraic input.")
690 math-exp-pos) 690 math-exp-pos)
691 (or (eq math-exp-pos 0) 691 (or (eq math-exp-pos 0)
692 (and (memq calc-language '(nil flat big unform 692 (and (memq calc-language '(nil flat big unform
693 tex eqn)) 693 tex latex eqn))
694 (eq (string-match "[^])}\"a-zA-Z0-9'$]_" 694 (eq (string-match "[^])}\"a-zA-Z0-9'$]_"
695 math-exp-str (1- math-exp-pos)) 695 math-exp-str (1- math-exp-pos))
696 (1- math-exp-pos)))))) 696 (1- math-exp-pos))))))
@@ -756,6 +756,34 @@ in Calc algebraic input.")
756 math-exp-pos (match-end 0) 756 math-exp-pos (match-end 0)
757 math-expr-data (math-restore-dashes 757 math-expr-data (math-restore-dashes
758 (math-match-substring math-exp-str 1))) 758 (math-match-substring math-exp-str 1)))
759 (let ((code (assoc math-expr-data math-latex-ignore-words)))
760 (cond ((null code))
761 ((null (cdr code))
762 (math-read-token))
763 ((eq (nth 1 code) 'punc)
764 (setq math-exp-token 'punc
765 math-expr-data (nth 2 code)))
766 ((and (eq (nth 1 code) 'mat)
767 (string-match " *{" math-exp-str math-exp-pos))
768 (setq math-exp-pos (match-end 0)
769 math-exp-token 'punc
770 math-expr-data "[")
771 (let ((right (string-match "}" math-exp-str math-exp-pos)))
772 (and right
773 (setq math-exp-str (copy-sequence math-exp-str))
774 (aset math-exp-str right ?\])))))))
775 ((and (= ch ?\\) (eq calc-language 'latex)
776 (< math-exp-pos (1- (length math-exp-str))))
777 (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}"
778 math-exp-str math-exp-pos)
779 (string-match "\\\\text *{\\([a-zA-Z0-9]+\\)}"
780 math-exp-str math-exp-pos)
781 (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)"
782 math-exp-str math-exp-pos))
783 (setq math-exp-token 'symbol
784 math-exp-pos (match-end 0)
785 math-expr-data (math-restore-dashes
786 (math-match-substring math-exp-str 1)))
759 (let ((code (assoc math-expr-data math-tex-ignore-words))) 787 (let ((code (assoc math-expr-data math-tex-ignore-words)))
760 (cond ((null code)) 788 (cond ((null code))
761 ((null (cdr code)) 789 ((null (cdr code))
@@ -763,8 +791,23 @@ in Calc algebraic input.")
763 ((eq (nth 1 code) 'punc) 791 ((eq (nth 1 code) 'punc)
764 (setq math-exp-token 'punc 792 (setq math-exp-token 'punc
765 math-expr-data (nth 2 code))) 793 math-expr-data (nth 2 code)))
766 ((and (eq (nth 1 code) 'mat) 794 ((and (eq (nth 1 code) 'begenv)
767 (string-match " *{" math-exp-str math-exp-pos)) 795 (string-match " *{\\([^}]*\\)}" math-exp-str math-exp-pos))
796 (setq math-exp-pos (match-end 0)
797 envname (match-string 1 math-exp-str)
798 math-exp-token 'punc
799 math-expr-data "[")
800 (cond ((or (string= envname "matrix")
801 (string= envname "bmatrix")
802 (string= envname "smallmatrix")
803 (string= envname "pmatrix"))
804 (if (setq j (string-match (concat "\\\\end{" envname "}")
805 math-exp-str math-exp-pos))
806 (setq math-exp-str
807 (replace-match "]" t t math-exp-str))
808 (error "%s" (concat "No closing \\end{" envname "}"))))))
809 ((and (eq (nth 1 code) 'mat)
810 (string-match " *{" math-exp-str math-exp-pos))
768 (setq math-exp-pos (match-end 0) 811 (setq math-exp-pos (match-end 0)
769 math-exp-token 'punc 812 math-exp-token 'punc
770 math-expr-data "[") 813 math-expr-data "[")
@@ -800,11 +843,11 @@ in Calc algebraic input.")
800 (setq math-exp-pos (match-end 0)) 843 (setq math-exp-pos (match-end 0))
801 (math-read-token)) 844 (math-read-token))
802 (t 845 (t
803 (if (and (eq ch ?\{) (memq calc-language '(tex eqn))) 846 (if (and (eq ch ?\{) (memq calc-language '(tex latex eqn)))
804 (setq ch ?\()) 847 (setq ch ?\())
805 (if (and (eq ch ?\}) (memq calc-language '(tex eqn))) 848 (if (and (eq ch ?\}) (memq calc-language '(tex latex eqn)))
806 (setq ch ?\))) 849 (setq ch ?\)))
807 (if (and (eq ch ?\&) (eq calc-language 'tex)) 850 (if (and (eq ch ?\&) (memq calc-language '(tex latex)))
808 (setq ch ?\,)) 851 (setq ch ?\,))
809 (setq math-exp-token 'punc 852 (setq math-exp-token 'punc
810 math-expr-data (char-to-string ch) 853 math-expr-data (char-to-string ch)
diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el
index db1acfcb145..4c6311c9a5b 100644
--- a/lisp/calc/calc-embed.el
+++ b/lisp/calc/calc-embed.el
@@ -48,11 +48,11 @@
48(defvar calc-embedded-some-active nil) 48(defvar calc-embedded-some-active nil)
49(make-variable-buffer-local 'calc-embedded-some-active) 49(make-variable-buffer-local 'calc-embedded-some-active)
50 50
51(defvar calc-embedded-open-formula "\\`\\|^\n\\|\\$\\$?\\|\\\\\\[\\|^\\\\begin.*\n\\|^@.*\n\\|^\\.EQ.*\n\\|\\\\(\\|^%\n\\|^\\.\\\\\"\n" 51(defvar calc-embedded-open-formula "\\`\\|^\n\\|\\$\\$?\\|\\\\\\[\\|^\\\\begin[^{].*\n\\|^\\\\begin{.*[^x]}.*\n\\|^@.*\n\\|^\\.EQ.*\n\\|\\\\(\\|^%\n\\|^\\.\\\\\"\n"
52 "*A regular expression for the opening delimiter of a formula used by 52 "*A regular expression for the opening delimiter of a formula used by
53calc-embedded.") 53calc-embedded.")
54 54
55(defvar calc-embedded-close-formula "\\'\\|\n$\\|\\$\\$?\\|\\\\]\\|^\\\\end.*\n\\|^@.*\n\\|^\\.EN.*\n\\|\\\\)\\|\n%\n\\|^\\.\\\\\"\n" 55(defvar calc-embedded-close-formula "\\'\\|\n$\\|\\$\\$?\\|\\\\]\\|^\\\\end[^{].*\n\\|^\\\\end{.*[^x]}.*\n\\|^@.*\n\\|^\\.EN.*\n\\|\\\\)\\|\n%\n\\|^\\.\\\\\"\n"
56 "*A regular expression for the closing delimiter of a formula used by 56 "*A regular expression for the closing delimiter of a formula used by
57calc-embedded.") 57calc-embedded.")
58 58
@@ -417,6 +417,8 @@ With any prefix argument, marks only the formula itself."
417 (forward-char -1)) 417 (forward-char -1))
418 (setq calc-embed-outer-top (point)) 418 (setq calc-embed-outer-top (point))
419 (goto-char (match-end 0)) 419 (goto-char (match-end 0))
420 (if (looking-at "[ \t]*$")
421 (end-of-line))
420 (if (eq (following-char) ?\n) 422 (if (eq (following-char) ?\n)
421 (forward-char 1)) 423 (forward-char 1))
422 (or (bolp) 424 (or (bolp)
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 8d3be3b8505..374e89ec1f1 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -217,6 +217,7 @@
217 (define-key calc-mode-map "dO" 'calc-flat-language) 217 (define-key calc-mode-map "dO" 'calc-flat-language)
218 (define-key calc-mode-map "dP" 'calc-pascal-language) 218 (define-key calc-mode-map "dP" 'calc-pascal-language)
219 (define-key calc-mode-map "dT" 'calc-tex-language) 219 (define-key calc-mode-map "dT" 'calc-tex-language)
220 (define-key calc-mode-map "dL" 'calc-latex-language)
220 (define-key calc-mode-map "dU" 'calc-unformatted-language) 221 (define-key calc-mode-map "dU" 'calc-unformatted-language)
221 (define-key calc-mode-map "dW" 'calc-maple-language) 222 (define-key calc-mode-map "dW" 'calc-maple-language)
222 (define-key calc-mode-map "d[" 'calc-truncate-up) 223 (define-key calc-mode-map "d[" 'calc-truncate-up)
@@ -998,7 +999,7 @@ calc-keypad-press)
998 ("calc-lang" calc-big-language calc-c-language calc-eqn-language 999 ("calc-lang" calc-big-language calc-c-language calc-eqn-language
999calc-flat-language calc-fortran-language calc-maple-language 1000calc-flat-language calc-fortran-language calc-maple-language
1000calc-mathematica-language calc-normal-language calc-pascal-language 1001calc-mathematica-language calc-normal-language calc-pascal-language
1001calc-tex-language calc-unformatted-language) 1002calc-tex-language calc-latex-language calc-unformatted-language)
1002 1003
1003 ("calc-map" calc-accumulate calc-apply calc-inner-product calc-map 1004 ("calc-map" calc-accumulate calc-apply calc-inner-product calc-map
1004calc-map-equation calc-map-stack calc-outer-product calc-reduce) 1005calc-map-equation calc-map-stack calc-outer-product calc-reduce)
@@ -2946,13 +2947,13 @@ calc-kill calc-kill-region calc-yank))))
2946 (setq str (concat (substring str 0 (match-beginning 0)) 2947 (setq str (concat (substring str 0 (match-beginning 0))
2947 (substring str (match-end 0))))) 2948 (substring str (match-end 0)))))
2948 (if (string-match "\\\\[^ \n|]" str) 2949 (if (string-match "\\\\[^ \n|]" str)
2949 (if (eq calc-language 'tex) 2950 (if (eq calc-language 'latex)
2950 (math-read-expr str) 2951 (math-read-expr str)
2951 (let ((calc-language 'tex) 2952 (let ((calc-language 'latex)
2952 (calc-language-option nil) 2953 (calc-language-option nil)
2953 (math-expr-opers (get 'tex 'math-oper-table)) 2954 (math-expr-opers (get 'latex 'math-oper-table))
2954 (math-expr-function-mapping (get 'tex 'math-function-table)) 2955 (math-expr-function-mapping (get 'latex 'math-function-table))
2955 (math-expr-variable-mapping (get 'tex 'math-variable-table))) 2956 (math-expr-variable-mapping (get 'latex 'math-variable-table)))
2956 (math-read-expr str))) 2957 (math-read-expr str)))
2957 (let ((math-read-big-lines nil) 2958 (let ((math-read-big-lines nil)
2958 (pos 0) 2959 (pos 0)
diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el
index eb0cba79cd8..dc7f0b17c1d 100644
--- a/lisp/calc/calc-help.el
+++ b/lisp/calc/calc-help.el
@@ -593,7 +593,7 @@ C-w Describe how there is no warranty for Calc."
593 "Why; Line-nums, line-Breaks; <, =, > (justify); Plain" 593 "Why; Line-nums, line-Breaks; <, =, > (justify); Plain"
594 "\" (strings); Truncate, [, ]; SPC (refresh), RET, @" 594 "\" (strings); Truncate, [, ]; SPC (refresh), RET, @"
595 "SHIFT + language: Normal, One-line, Big, Unformatted" 595 "SHIFT + language: Normal, One-line, Big, Unformatted"
596 "SHIFT + language: C, Pascal, Fortran; TeX, Eqn" 596 "SHIFT + language: C, Pascal, Fortran; TeX, LaTeX, Eqn"
597 "SHIFT + language: Mathematica, W=Maple") 597 "SHIFT + language: Mathematica, W=Maple")
598 "display" ?d)) 598 "display" ?d))
599 599
diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el
index cfbe3313d8e..d91d78fc461 100644
--- a/lisp/calc/calc-lang.el
+++ b/lisp/calc/calc-lang.el
@@ -36,6 +36,7 @@
36(defun calc-set-language (lang &optional option no-refresh) 36(defun calc-set-language (lang &optional option no-refresh)
37 (setq math-expr-opers (or (get lang 'math-oper-table) math-standard-opers) 37 (setq math-expr-opers (or (get lang 'math-oper-table) math-standard-opers)
38 math-expr-function-mapping (get lang 'math-function-table) 38 math-expr-function-mapping (get lang 'math-function-table)
39 math-expr-special-function-mapping (get lang 'math-special-function-table)
39 math-expr-variable-mapping (get lang 'math-variable-table) 40 math-expr-variable-mapping (get lang 'math-variable-table)
40 calc-language-input-filter (get lang 'math-input-filter) 41 calc-language-input-filter (get lang 'math-input-filter)
41 calc-language-output-filter (get lang 'math-output-filter) 42 calc-language-output-filter (get lang 'math-output-filter)
@@ -296,6 +297,26 @@
296 "TeX language mode with \\func{\\hbox{var}}") 297 "TeX language mode with \\func{\\hbox{var}}")
297 "TeX language mode")))) 298 "TeX language mode"))))
298 299
300(defun calc-latex-language (n)
301 (interactive "P")
302 (calc-wrapper
303 (and n (setq n (prefix-numeric-value n)))
304 (calc-set-language 'latex n)
305 (cond ((not n)
306 (message "LaTeX language mode"))
307 ((= n 0)
308 (message "LaTeX language mode with multiline matrices"))
309 ((= n 1)
310 (message "LaTeX language mode with \\text{func}(\\text{var})"))
311 ((> n 1)
312 (message
313 "LaTeX language mode with \\text{func}(\\text{var}) and multiline matrices"))
314 ((= n -1)
315 (message "LaTeX language mode with \\func(\\text{var})"))
316 ((< n -1)
317 (message
318 "LaTeX language mode with \\func(\\text{var}) and multiline matrices")))))
319
299(put 'tex 'math-oper-table 320(put 'tex 'math-oper-table
300 '( ( "u+" ident -1 1000 ) 321 '( ( "u+" ident -1 1000 )
301 ( "u-" neg -1 1000 ) 322 ( "u-" neg -1 1000 )
@@ -406,6 +427,80 @@
406 str) 427 str)
407(put 'tex 'math-input-filter 'math-tex-input-filter) 428(put 'tex 'math-input-filter 'math-tex-input-filter)
408 429
430(put 'latex 'math-oper-table
431 (append (get 'tex 'math-oper-table)
432 '(( "\\Hat" calcFunc-Hat -1 950 )
433 ( "\\Check" calcFunc-Check -1 950 )
434 ( "\\Tilde" calcFunc-Tilde -1 950 )
435 ( "\\Acute" calcFunc-Acute -1 950 )
436 ( "\\Grave" calcFunc-Grave -1 950 )
437 ( "\\Dot" calcFunc-Dot -1 950 )
438 ( "\\Ddot" calcFunc-Dotdot -1 950 )
439 ( "\\Breve" calcFunc-Breve -1 950 )
440 ( "\\Bar" calcFunc-Bar -1 950 )
441 ( "\\Vec" calcFunc-VEC -1 950 )
442 ( "\\dddot" calcFunc-dddot -1 950 )
443 ( "\\ddddot" calcFunc-ddddot -1 950 )
444 ( "\div" / 170 171 )
445 ( "\\le" calcFunc-leq 160 161 )
446 ( "\\leqq" calcFunc-leq 160 161 )
447 ( "\\leqsland" calcFunc-leq 160 161 )
448 ( "\\ge" calcFunc-geq 160 161 )
449 ( "\\geqq" calcFunc-geq 160 161 )
450 ( "\\geqslant" calcFunc-geq 160 161 )
451 ( "=" calcFunc-eq 160 161 )
452 ( "\\neq" calcFunc-neq 160 161 )
453 ( "\\ne" calcFunc-neq 160 161 )
454 ( "\\lnot" calcFunc-lnot -1 121 )
455 ( "\\land" calcFunc-land 110 111 )
456 ( "\\lor" calcFunc-lor 100 101 )
457 ( "?" (math-read-if) 91 90 )
458 ( "!!!" calcFunc-pnot -1 85 )
459 ( "&&&" calcFunc-pand 80 81 )
460 ( "|||" calcFunc-por 75 76 )
461 ( "\\gets" calcFunc-assign 51 50 )
462 ( ":=" calcFunc-assign 51 50 )
463 ( "::" calcFunc-condition 45 46 )
464 ( "\\to" calcFunc-evalto 40 41 )
465 ( "\\to" calcFunc-evalto 40 -1 )
466 ( "=>" calcFunc-evalto 40 41 )
467 ( "=>" calcFunc-evalto 40 -1 ))))
468
469(put 'latex 'math-function-table
470 (append
471 (get 'tex 'math-function-table)
472 '(( \\frac . (math-latex-parse-frac /))
473 ( \\tfrac . (math-latex-parse-frac /))
474 ( \\dfrac . (math-latex-parse-frac /))
475 ( \\binom . (math-latex-parse-frac calcFunc-choose))
476 ( \\tbinom . (math-latex-parse-frac calcFunc-choose))
477 ( \\dbinom . (math-latex-parse-frac calcFunc-choose))
478 ( \\phi . calcFunc-totient )
479 ( \\mu . calcFunc-moebius ))))
480
481(put 'latex 'math-special-function-table
482 '((/ . (math-latex-print-frac "\\frac"))
483 (calcFunc-choose . (math-latex-print-frac "\\binom"))))
484
485(put 'latex 'math-variable-table
486 (get 'tex 'math-variable-table))
487
488(put 'latex 'math-complex-format 'i)
489
490(defun math-latex-parse-frac (f val)
491 (let (numer denom)
492 (setq args (math-read-expr-list))
493 (math-read-token)
494 (setq margs (math-read-factor))
495 (list (nth 2 f) (car args) margs)))
496
497(defun math-latex-print-frac (a fn)
498 (list 'horiz (nth 1 fn) "{" (math-compose-expr (nth 1 a) -1)
499 "}{"
500 (math-compose-expr (nth 2 a) -1)
501 "}"))
502
503(put 'latex 'math-input-filter 'math-tex-input-filter)
409 504
410(defun calc-eqn-language (n) 505(defun calc-eqn-language (n)
411 (interactive "P") 506 (interactive "P")
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index a37f3c5cedd..d5d9123d04d 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -477,6 +477,7 @@
477 (format "Editing %s-Mode Syntax Table. " 477 (format "Editing %s-Mode Syntax Table. "
478 (cond ((null lang) "Normal") 478 (cond ((null lang) "Normal")
479 ((eq lang 'tex) "TeX") 479 ((eq lang 'tex) "TeX")
480 ((eq lang 'latex) "LaTeX")
480 (t (capitalize (symbol-name lang)))))) 481 (t (capitalize (symbol-name lang))))))
481 (calc-write-parse-table (cdr (assq lang calc-user-parse-tables)) 482 (calc-write-parse-table (cdr (assq lang calc-user-parse-tables))
482 lang))) 483 lang)))
@@ -519,7 +520,7 @@
519 (cond ((stringp (car p)) 520 (cond ((stringp (car p))
520 (let ((s (car p))) 521 (let ((s (car p)))
521 (if (and (string-match "\\`\\\\dots\\>" s) 522 (if (and (string-match "\\`\\\\dots\\>" s)
522 (not (eq calc-lang 'tex))) 523 (not (eq calc-lang '(tex latex))))
523 (setq s (concat ".." (substring s 5)))) 524 (setq s (concat ".." (substring s 5))))
524 (if (or (and (string-match 525 (if (or (and (string-match
525 "[a-zA-Z0-9\"{}]\\|\\`:=\\'\\|\\`#\\|\\`%%" s) 526 "[a-zA-Z0-9\"{}]\\|\\`:=\\'\\|\\`#\\|\\`%%" s)
@@ -582,11 +583,11 @@
582(defun calc-fix-token-name (name &optional unquoted) 583(defun calc-fix-token-name (name &optional unquoted)
583 (cond ((string-match "\\`\\.\\." name) 584 (cond ((string-match "\\`\\.\\." name)
584 (concat "\\dots" (substring name 2))) 585 (concat "\\dots" (substring name 2)))
585 ((and (equal name "{") (memq calc-lang '(tex eqn))) 586 ((and (equal name "{") (memq calc-lang '(tex latex eqn)))
586 "(") 587 "(")
587 ((and (equal name "}") (memq calc-lang '(tex eqn))) 588 ((and (equal name "}") (memq calc-lang '(tex latex eqn)))
588 ")") 589 ")")
589 ((and (equal name "&") (eq calc-lang 'tex)) 590 ((and (equal name "&") (eq calc-lang '(tex latex)))
590 ",") 591 ",")
591 ((equal name "#") 592 ((equal name "#")
592 (search-backward "#") 593 (search-backward "#")
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index ba5cda831e1..99857ce05a0 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -405,6 +405,7 @@ If `C' is present, display outer brackets for matrices (centered).")
405 pascal Use Pascal language notation. 405 pascal Use Pascal language notation.
406 fortran Use Fortran language notation. 406 fortran Use Fortran language notation.
407 tex Use TeX notation. 407 tex Use TeX notation.
408 latex Use LaTeX notation.
408 eqn Use eqn notation. 409 eqn Use eqn notation.
409 math Use Mathematica(tm) notation. 410 math Use Mathematica(tm) notation.
410 maple Use Maple notation.") 411 maple Use Maple notation.")
@@ -704,6 +705,7 @@ If nil, selections displayed but ignored.")
704(defvar math-eval-rules-cache-tag t) 705(defvar math-eval-rules-cache-tag t)
705(defvar math-radix-explicit-format t) 706(defvar math-radix-explicit-format t)
706(defvar math-expr-function-mapping nil) 707(defvar math-expr-function-mapping nil)
708(defvar math-expr-special-function-mapping nil)
707(defvar math-expr-variable-mapping nil) 709(defvar math-expr-variable-mapping nil)
708(defvar math-read-expr-quotes nil) 710(defvar math-read-expr-quotes nil)
709(defvar math-working-step nil) 711(defvar math-working-step nil)
@@ -1368,6 +1370,7 @@ See calc-keypad for details."
1368 (if calc-leading-zeros "Zero " "") 1370 (if calc-leading-zeros "Zero " "")
1369 (cond ((null calc-language) "") 1371 (cond ((null calc-language) "")
1370 ((eq calc-language 'tex) "TeX ") 1372 ((eq calc-language 'tex) "TeX ")
1373 ((eq calc-language 'latex) "LaTeX ")
1371 (t (concat 1374 (t (concat
1372 (capitalize (symbol-name calc-language)) 1375 (capitalize (symbol-name calc-language))
1373 " "))) 1376 " ")))
@@ -3218,9 +3221,13 @@ See calc-keypad for details."
3218 ("\\cal") ("\\mit") ("\\Cal") ("\\Bbb") ("\\frak") ("\\goth") 3221 ("\\cal") ("\\mit") ("\\Cal") ("\\Bbb") ("\\frak") ("\\goth")
3219 ("\\evalto") 3222 ("\\evalto")
3220 ("\\matrix" mat) ("\\bmatrix" mat) ("\\pmatrix" mat) 3223 ("\\matrix" mat) ("\\bmatrix" mat) ("\\pmatrix" mat)
3224 ("\\begin" begenv)
3221 ("\\cr" punc ";") ("\\\\" punc ";") ("\\*" punc "*") 3225 ("\\cr" punc ";") ("\\\\" punc ";") ("\\*" punc "*")
3222 ("\\{" punc "[") ("\\}" punc "]") 3226 ("\\{" punc "[") ("\\}" punc "]")))
3223)) 3227
3228(defconst math-latex-ignore-words
3229 (append math-tex-ignore-words
3230 '(("\\begin" begenv))))
3224 3231
3225(defconst math-eqn-ignore-words 3232(defconst math-eqn-ignore-words
3226 '( ("roman") ("bold") ("italic") ("mark") ("lineup") ("evalto") 3233 '( ("roman") ("bold") ("italic") ("mark") ("lineup") ("evalto")
@@ -3228,8 +3235,7 @@ See calc-keypad for details."
3228 ("right" ("floor") ("ceil")) 3235 ("right" ("floor") ("ceil"))
3229 ("arc" ("sin") ("cos") ("tan") ("sinh") ("cosh") ("tanh")) 3236 ("arc" ("sin") ("cos") ("tan") ("sinh") ("cosh") ("tanh"))
3230 ("size" n) ("font" n) ("fwd" n) ("back" n) ("up" n) ("down" n) 3237 ("size" n) ("font" n) ("fwd" n) ("back" n) ("up" n) ("down" n)
3231 ("above" punc ",") 3238 ("above" punc ",")))
3232))
3233 3239
3234(defconst math-standard-opers 3240(defconst math-standard-opers
3235 '( ( "_" calcFunc-subscr 1200 1201 ) 3241 '( ( "_" calcFunc-subscr 1200 1201 )
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el
index e76b3a34e09..dc46159b09b 100644
--- a/lisp/calc/calccomp.el
+++ b/lisp/calc/calccomp.el
@@ -79,7 +79,8 @@
79 79
80 80
81(defun math-compose-expr (a prec) 81(defun math-compose-expr (a prec)
82 (let ((math-compose-level (1+ math-compose-level))) 82 (let ((math-compose-level (1+ math-compose-level))
83 spfn)
83 (cond 84 (cond
84 ((or (and (eq a math-comp-selected) a) 85 ((or (and (eq a math-comp-selected) a)
85 (and math-comp-tagged 86 (and math-comp-tagged
@@ -89,10 +90,13 @@
89 (list 'tag a (math-compose-expr a prec)))) 90 (list 'tag a (math-compose-expr a prec))))
90 ((and (not (consp a)) (not (integerp a))) 91 ((and (not (consp a)) (not (integerp a)))
91 (concat "'" (prin1-to-string a))) 92 (concat "'" (prin1-to-string a)))
93 ((setq spfn (assq (car-safe a) math-expr-special-function-mapping))
94 (setq spfn (cdr spfn))
95 (funcall (car spfn) a spfn))
92 ((math-scalarp a) 96 ((math-scalarp a)
93 (if (or (eq (car-safe a) 'frac) 97 (if (or (eq (car-safe a) 'frac)
94 (and (nth 1 calc-frac-format) (Math-integerp a))) 98 (and (nth 1 calc-frac-format) (Math-integerp a)))
95 (if (memq calc-language '(tex eqn math maple c fortran pascal)) 99 (if (memq calc-language '(tex latex eqn math maple c fortran pascal))
96 (let ((aa (math-adjust-fraction a)) 100 (let ((aa (math-adjust-fraction a))
97 (calc-frac-format nil)) 101 (calc-frac-format nil))
98 (math-compose-expr (list '/ 102 (math-compose-expr (list '/
@@ -265,34 +269,44 @@
265 (append '(horiz "\\matrix{ ") 269 (append '(horiz "\\matrix{ ")
266 (math-compose-tex-matrix (cdr a)) 270 (math-compose-tex-matrix (cdr a))
267 '(" }")) 271 '(" }"))
268 (if (and (eq calc-language 'eqn) 272 (if (and (eq calc-language 'latex)
269 (math-matrixp a)) 273 (math-matrixp a))
270 (append '(horiz "matrix { ") 274 (if (memq calc-language-option '(-2 0 2))
271 (math-compose-eqn-matrix 275 (append '(vleft 0 "\\begin{pmatrix}")
272 (cdr (math-transpose a))) 276 (math-compose-tex-matrix (cdr a))
273 '("}")) 277 '("\\end{pmatrix}"))
274 (if (and (eq calc-language 'maple) 278 (append '(horiz "\\begin{pmatrix} ")
275 (math-matrixp a)) 279 (math-compose-tex-matrix (cdr a))
276 (list 'horiz 280 '(" \\end{pmatrix}")))
277 "matrix(" 281 (if (and (eq calc-language 'eqn)
278 math-comp-left-bracket 282 (math-matrixp a))
279 (math-compose-vector (cdr a) 283 (append '(horiz "matrix { ")
284 (math-compose-eqn-matrix
285 (cdr (math-transpose a)))
286 '("}"))
287 (if (and (eq calc-language 'maple)
288 (math-matrixp a))
289 (list 'horiz
290 "matrix("
291 math-comp-left-bracket
292 (math-compose-vector (cdr a)
293 (concat math-comp-comma " ")
294 math-comp-vector-prec)
295 math-comp-right-bracket
296 ")")
297 (list 'horiz
298 math-comp-left-bracket
299 (math-compose-vector (cdr a)
280 (concat math-comp-comma " ") 300 (concat math-comp-comma " ")
281 math-comp-vector-prec) 301 math-comp-vector-prec)
282 math-comp-right-bracket 302 math-comp-right-bracket)))))
283 ")")
284 (list 'horiz
285 math-comp-left-bracket
286 (math-compose-vector (cdr a)
287 (concat math-comp-comma " ")
288 math-comp-vector-prec)
289 math-comp-right-bracket))))
290 (list 'horiz 303 (list 'horiz
291 math-comp-left-bracket 304 math-comp-left-bracket
292 (math-compose-vector (list (nth 1 a) (nth 2 a) (nth 3 a)) 305 (math-compose-vector (list (nth 1 a) (nth 2 a) (nth 3 a))
293 (concat math-comp-comma " ") 306 (concat math-comp-comma " ")
294 math-comp-vector-prec) 307 math-comp-vector-prec)
295 math-comp-comma (if (eq calc-language 'tex) " \\ldots" " ...") 308 math-comp-comma (if (memq calc-language '(tex latex))
309 " \\ldots" " ...")
296 math-comp-comma " " 310 math-comp-comma " "
297 (list 'break math-compose-level) 311 (list 'break math-compose-level)
298 (math-compose-expr (nth (1- (length a)) a) 312 (math-compose-expr (nth (1- (length a)) a)
@@ -326,12 +340,14 @@
326 (let ((v (rassq (nth 2 a) math-expr-variable-mapping))) 340 (let ((v (rassq (nth 2 a) math-expr-variable-mapping)))
327 (if v 341 (if v
328 (symbol-name (car v)) 342 (symbol-name (car v))
329 (if (and (eq calc-language 'tex) 343 (if (and (memq calc-language '(tex latex))
330 calc-language-option 344 calc-language-option
331 (not (= calc-language-option 0)) 345 (not (= calc-language-option 0))
332 (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" 346 (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'"
333 (symbol-name (nth 1 a)))) 347 (symbol-name (nth 1 a))))
334 (format "\\hbox{%s}" (symbol-name (nth 1 a))) 348 (if (eq calc-language 'latex)
349 (format "\\text{%s}" (symbol-name (nth 1 a)))
350 (format "\\hbox{%s}" (symbol-name (nth 1 a))))
335 (if (and math-compose-hash-args 351 (if (and math-compose-hash-args
336 (let ((p calc-arg-values)) 352 (let ((p calc-arg-values))
337 (setq v 1) 353 (setq v 1)
@@ -359,7 +375,7 @@
359 (if (eq calc-language 'maple) "" 375 (if (eq calc-language 'maple) ""
360 (if (memq (nth 1 a) '(0 1)) "(" "[")) 376 (if (memq (nth 1 a) '(0 1)) "(" "["))
361 (math-compose-expr (nth 2 a) 0) 377 (math-compose-expr (nth 2 a) 0)
362 (if (eq calc-language 'tex) " \\ldots " 378 (if (memq calc-language '(tex latex)) " \\ldots "
363 (if (eq calc-language 'eqn) " ... " " .. ")) 379 (if (eq calc-language 'eqn) " ... " " .. "))
364 (math-compose-expr (nth 3 a) 0) 380 (math-compose-expr (nth 3 a) 0)
365 (if (eq calc-language 'maple) "" 381 (if (eq calc-language 'maple) ""
@@ -404,7 +420,7 @@
404 (math-compose-expr (nth 2 a) 0) 420 (math-compose-expr (nth 2 a) 0)
405 "]]")) 421 "]]"))
406 ((and (eq (car a) 'calcFunc-sqrt) 422 ((and (eq (car a) 'calcFunc-sqrt)
407 (eq calc-language 'tex)) 423 (memq calc-language '(tex latex)))
408 (list 'horiz 424 (list 'horiz
409 "\\sqrt{" 425 "\\sqrt{"
410 (math-compose-expr (nth 1 a) 0) 426 (math-compose-expr (nth 1 a) 0)
@@ -440,7 +456,7 @@
440 (math-comp-height a1) 456 (math-comp-height a1)
441 a1 '(rule ?-) a2))) 457 a1 '(rule ?-) a2)))
442 ((and (memq (car a) '(calcFunc-sum calcFunc-prod)) 458 ((and (memq (car a) '(calcFunc-sum calcFunc-prod))
443 (eq calc-language 'tex) 459 (memq calc-language '(tex latex))
444 (= (length a) 5)) 460 (= (length a) 5))
445 (list 'horiz (if (eq (car a) 'calcFunc-sum) "\\sum" "\\prod") 461 (list 'horiz (if (eq (car a) 'calcFunc-sum) "\\sum" "\\prod")
446 "_{" (math-compose-expr (nth 2 a) 0) 462 "_{" (math-compose-expr (nth 2 a) 0)
@@ -495,7 +511,7 @@
495 (integerp (nth 2 a))) 511 (integerp (nth 2 a)))
496 (let ((c (math-compose-expr (nth 1 a) -1))) 512 (let ((c (math-compose-expr (nth 1 a) -1)))
497 (if (> prec (nth 2 a)) 513 (if (> prec (nth 2 a))
498 (if (eq calc-language 'tex) 514 (if (memq calc-language '(tex latex))
499 (list 'horiz "\\left( " c " \\right)") 515 (list 'horiz "\\left( " c " \\right)")
500 (if (eq calc-language 'eqn) 516 (if (eq calc-language 'eqn)
501 (list 'horiz "{left ( " c " right )}") 517 (list 'horiz "{left ( " c " right )}")
@@ -633,13 +649,13 @@
633 (make-list (nth 1 a) c)))))) 649 (make-list (nth 1 a) c))))))
634 ((and (eq (car a) 'calcFunc-evalto) 650 ((and (eq (car a) 'calcFunc-evalto)
635 (setq calc-any-evaltos t) 651 (setq calc-any-evaltos t)
636 (memq calc-language '(tex eqn)) 652 (memq calc-language '(tex latex eqn))
637 (= math-compose-level (if math-comp-tagged 2 1)) 653 (= math-compose-level (if math-comp-tagged 2 1))
638 (= (length a) 3)) 654 (= (length a) 3))
639 (list 'horiz 655 (list 'horiz
640 (if (eq calc-language 'tex) "\\evalto " "evalto ") 656 (if (memq calc-language '(tex latex)) "\\evalto " "evalto ")
641 (math-compose-expr (nth 1 a) 0) 657 (math-compose-expr (nth 1 a) 0)
642 (if (eq calc-language 'tex) " \\to " " -> ") 658 (if (memq calc-language '(tex latex)) " \\to " " -> ")
643 (math-compose-expr (nth 2 a) 0))) 659 (math-compose-expr (nth 2 a) 0)))
644 (t 660 (t
645 (let ((op (and (not (eq calc-language 'unform)) 661 (let ((op (and (not (eq calc-language 'unform))
@@ -651,7 +667,7 @@
651 (/= (nth 3 op) -1)) 667 (/= (nth 3 op) -1))
652 (cond 668 (cond
653 ((> prec (or (nth 4 op) (min (nth 2 op) (nth 3 op)))) 669 ((> prec (or (nth 4 op) (min (nth 2 op) (nth 3 op))))
654 (if (and (eq calc-language 'tex) 670 (if (and (memq calc-language '(tex latex))
655 (not (math-tex-expr-is-flat a))) 671 (not (math-tex-expr-is-flat a)))
656 (if (eq (car-safe a) '/) 672 (if (eq (car-safe a) '/)
657 (list 'horiz "{" (math-compose-expr a -1) "}") 673 (list 'horiz "{" (math-compose-expr a -1) "}")
@@ -668,7 +684,7 @@
668 (math-compose-expr a -1) 684 (math-compose-expr a -1)
669 " right )}"))) 685 " right )}")))
670 (list 'horiz "(" (math-compose-expr a 0) ")")))) 686 (list 'horiz "(" (math-compose-expr a 0) ")"))))
671 ((and (eq calc-language 'tex) 687 ((and (memq calc-language '(tex latex))
672 (memq (car a) '(/ calcFunc-choose calcFunc-evalto)) 688 (memq (car a) '(/ calcFunc-choose calcFunc-evalto))
673 (>= prec 0)) 689 (>= prec 0))
674 (list 'horiz "{" (math-compose-expr a -1) "}")) 690 (list 'horiz "{" (math-compose-expr a -1) "}"))
@@ -694,7 +710,7 @@
694 (and (equal (car op) "^") 710 (and (equal (car op) "^")
695 (eq (math-comp-first-char lhs) ?-) 711 (eq (math-comp-first-char lhs) ?-)
696 (setq lhs (list 'horiz "(" lhs ")"))) 712 (setq lhs (list 'horiz "(" lhs ")")))
697 (and (eq calc-language 'tex) 713 (and (memq calc-language '(tex latex))
698 (or (equal (car op) "^") (equal (car op) "_")) 714 (or (equal (car op) "^") (equal (car op) "_"))
699 (not (and (stringp rhs) (= (length rhs) 1))) 715 (not (and (stringp rhs) (= (length rhs) 1)))
700 (setq rhs (list 'horiz "{" rhs "}"))) 716 (setq rhs (list 'horiz "{" rhs "}")))
@@ -761,7 +777,7 @@
761 ((or (> prec (or (nth 4 op) (nth 2 op))) 777 ((or (> prec (or (nth 4 op) (nth 2 op)))
762 (and (not (eq (assoc (car op) math-expr-opers) op)) 778 (and (not (eq (assoc (car op) math-expr-opers) op))
763 (> prec 0))) ; don't write x% + y 779 (> prec 0))) ; don't write x% + y
764 (if (and (eq calc-language 'tex) 780 (if (and (memq calc-language '(tex latex))
765 (not (math-tex-expr-is-flat a))) 781 (not (math-tex-expr-is-flat a)))
766 (list 'horiz "\\left( " 782 (list 'horiz "\\left( "
767 (math-compose-expr a -1) 783 (math-compose-expr a -1)
@@ -786,7 +802,7 @@
786 ((and op (= (length a) 2) (= (nth 2 op) -1)) 802 ((and op (= (length a) 2) (= (nth 2 op) -1))
787 (cond 803 (cond
788 ((eq (nth 3 op) 0) 804 ((eq (nth 3 op) 0)
789 (let ((lr (and (eq calc-language 'tex) 805 (let ((lr (and (memq calc-language '(tex latex))
790 (not (math-tex-expr-is-flat (nth 1 a)))))) 806 (not (math-tex-expr-is-flat (nth 1 a))))))
791 (list 'horiz 807 (list 'horiz
792 (if lr "\\left" "") 808 (if lr "\\left" "")
@@ -799,7 +815,7 @@
799 (if lr "\\right" "") 815 (if lr "\\right" "")
800 (car (nth 1 (memq op math-expr-opers)))))) 816 (car (nth 1 (memq op math-expr-opers))))))
801 ((> prec (or (nth 4 op) (nth 3 op))) 817 ((> prec (or (nth 4 op) (nth 3 op)))
802 (if (and (eq calc-language 'tex) 818 (if (and (memq calc-language '(tex latex))
803 (not (math-tex-expr-is-flat a))) 819 (not (math-tex-expr-is-flat a)))
804 (list 'horiz "\\left( " 820 (list 'horiz "\\left( "
805 (math-compose-expr a -1) 821 (math-compose-expr a -1)
@@ -836,6 +852,7 @@
836 ( pascal . math-compose-pascal ) 852 ( pascal . math-compose-pascal )
837 ( fortran . math-compose-fortran ) 853 ( fortran . math-compose-fortran )
838 ( tex . math-compose-tex ) 854 ( tex . math-compose-tex )
855 ( latex . math-compose-latex )
839 ( eqn . math-compose-eqn ) 856 ( eqn . math-compose-eqn )
840 ( math . math-compose-math ) 857 ( math . math-compose-math )
841 ( maple . math-compose-maple )))) 858 ( maple . math-compose-maple ))))
@@ -866,20 +883,22 @@
866 (symbol-name func)))) 883 (symbol-name func))))
867 (if (memq calc-language '(c fortran pascal maple)) 884 (if (memq calc-language '(c fortran pascal maple))
868 (setq func (math-to-underscores func))) 885 (setq func (math-to-underscores func)))
869 (if (and (eq calc-language 'tex) 886 (if (and (memq calc-language '(tex latex))
870 calc-language-option 887 calc-language-option
871 (not (= calc-language-option 0)) 888 (not (= calc-language-option 0))
872 (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" func)) 889 (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" func))
873 (if (< (prefix-numeric-value calc-language-option) 0) 890 (if (< (prefix-numeric-value calc-language-option) 0)
874 (setq func (format "\\%s" func)) 891 (setq func (format "\\%s" func))
875 (setq func (format "\\hbox{%s}" func)))) 892 (setq func (if (eq calc-language 'latex)
893 (format "\\text{%s}" func)
894 (format "\\hbox{%s}" func)))))
876 (if (and (eq calc-language 'eqn) 895 (if (and (eq calc-language 'eqn)
877 (string-match "[^']'+\\'" func)) 896 (string-match "[^']'+\\'" func))
878 (let ((n (- (length func) (match-beginning 0) 1))) 897 (let ((n (- (length func) (match-beginning 0) 1)))
879 (setq func (substring func 0 (- n))) 898 (setq func (substring func 0 (- n)))
880 (while (>= (setq n (1- n)) 0) 899 (while (>= (setq n (1- n)) 0)
881 (setq func (concat func " prime"))))) 900 (setq func (concat func " prime")))))
882 (cond ((and (eq calc-language 'tex) 901 (cond ((and (eq calc-language '(tex latex))
883 (or (> (length a) 2) 902 (or (> (length a) 2)
884 (not (math-tex-expr-is-flat (nth 1 a))))) 903 (not (math-tex-expr-is-flat (nth 1 a)))))
885 (setq left "\\left( " 904 (setq left "\\left( "
@@ -889,11 +908,13 @@
889 (not (math-tex-expr-is-flat (nth 1 a))))) 908 (not (math-tex-expr-is-flat (nth 1 a)))))
890 (setq left "{left ( " 909 (setq left "{left ( "
891 right " right )}")) 910 right " right )}"))
892 ((and (or (and (eq calc-language 'tex) 911 ((and (or (and (memq calc-language '(tex latex))
893 (eq (aref func 0) ?\\)) 912 (eq (aref func 0) ?\\))
894 (and (eq calc-language 'eqn) 913 (and (eq calc-language 'eqn)
895 (memq (car a) math-eqn-special-funcs))) 914 (memq (car a) math-eqn-special-funcs)))
896 (not (string-match "\\hbox{" func)) 915 (not (or
916 (string-match "\\hbox{" func)
917 (string-match "\\text{" func)))
897 (= (length a) 2) 918 (= (length a) 2)
898 (or (Math-realp (nth 1 a)) 919 (or (Math-realp (nth 1 a))
899 (memq (car (nth 1 a)) '(var *)))) 920 (memq (car (nth 1 a)) '(var *))))
@@ -968,7 +989,7 @@
968 (if (<= count 0) 989 (if (<= count 0)
969 (if (< count 0) 990 (if (< count 0)
970 (math-compose-rows (cdr a) -1 nil) 991 (math-compose-rows (cdr a) -1 nil)
971 (cons (concat (if (eq calc-language 'tex) " \\ldots" " ...") 992 (cons (concat (if (memq calc-language '(tex latex)) " \\ldots" " ...")
972 math-comp-comma) 993 math-comp-comma)
973 (math-compose-rows (cdr a) -1 nil))) 994 (math-compose-rows (cdr a) -1 nil)))
974 (cons (list 'horiz 995 (cons (list 'horiz
@@ -983,9 +1004,8 @@
983 1004
984(defun math-compose-tex-matrix (a) 1005(defun math-compose-tex-matrix (a)
985 (if (cdr a) 1006 (if (cdr a)
986 (cons (math-compose-vector (cdr (car a)) " & " 0) 1007 (cons (append (math-compose-vector (cdr (car a)) " & " 0) '(" \\\\ "))
987 (cons " \\\\ " 1008 (math-compose-tex-matrix (cdr a)))
988 (math-compose-tex-matrix (cdr a))))
989 (list (math-compose-vector (cdr (car a)) " & " 0)))) 1009 (list (math-compose-vector (cdr (car a)) " & " 0))))
990 1010
991(defun math-compose-eqn-matrix (a) 1011(defun math-compose-eqn-matrix (a)
diff --git a/lisp/comint.el b/lisp/comint.el
index 9f93fe75b1f..f96da7fa0fd 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -788,7 +788,9 @@ buffer. The hook `comint-exec-hook' is run after each exec."
788 788
789(defun comint-insert-input (&optional event) 789(defun comint-insert-input (&optional event)
790 "In a Comint buffer, set the current input to the previous input at point." 790 "In a Comint buffer, set the current input to the previous input at point."
791 (interactive "e") 791 ;; This doesn't use "e" because it is supposed to work
792 ;; for events without parameters.
793 (interactive (list last-input-event))
792 (if event (mouse-set-point event)) 794 (if event (mouse-set-point event))
793 (let ((pos (point))) 795 (let ((pos (point)))
794 (if (not (eq (get-char-property pos 'field) 'input)) 796 (if (not (eq (get-char-property pos 'field) 'input))
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 989a9f16840..30d831ff039 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1180,19 +1180,10 @@ links: groups have links to subgroups."
1180 (const links)) 1180 (const links))
1181 :group 'custom-buffer) 1181 :group 'custom-buffer)
1182 1182
1183;; If we pass BUFFER to `bury-buffer', the buffer isn't removed from 1183(defcustom custom-buffer-done-kill nil
1184;; the window. 1184 "*Non-nil means exiting a Custom buffer should kill it."
1185(defun custom-bury-buffer (buffer) 1185 :type 'boolean
1186 (with-current-buffer buffer 1186 :version "21.4"
1187 (bury-buffer)))
1188
1189(defcustom custom-buffer-done-function 'custom-bury-buffer
1190 "*Function called to remove a Custom buffer when the user is done with it.
1191Called with one argument, the buffer to remove."
1192 :type '(choice (function-item :tag "Bury buffer" custom-bury-buffer)
1193 (function-item :tag "Kill buffer" kill-buffer)
1194 (function :tag "Other"))
1195 :version "21.1"
1196 :group 'custom-buffer) 1187 :group 'custom-buffer)
1197 1188
1198(defcustom custom-buffer-indent 3 1189(defcustom custom-buffer-indent 3
@@ -1262,9 +1253,9 @@ This button will have a menu with all three reset operations."
1262 :group 'custom-buffer) 1253 :group 'custom-buffer)
1263 1254
1264(defun Custom-buffer-done (&rest ignore) 1255(defun Custom-buffer-done (&rest ignore)
1265 "Remove current buffer by calling `custom-buffer-done-function'." 1256 "Exit current Custom buffer according to `custom-buffer-done-kill'."
1266 (interactive) 1257 (interactive)
1267 (funcall custom-buffer-done-function (current-buffer))) 1258 (quit-window custom-buffer-done-kill))
1268 1259
1269(defcustom custom-raised-buttons (not (equal (face-valid-attribute-values :box) 1260(defcustom custom-raised-buttons (not (equal (face-valid-attribute-values :box)
1270 '(("unspecified" . unspecified)))) 1261 '(("unspecified" . unspecified))))
@@ -1350,13 +1341,9 @@ Un-customize all values in this buffer. They get their standard settings."
1350 :tag "Finish" 1341 :tag "Finish"
1351 :help-echo 1342 :help-echo
1352 (lambda (&rest ignore) 1343 (lambda (&rest ignore)
1353 (cond 1344 (if custom-buffer-done-kill
1354 ((eq custom-buffer-done-function 1345 "Kill this buffer"
1355 'custom-bury-buffer) 1346 "Bury this buffer"))
1356 "Bury this buffer")
1357 ((eq custom-buffer-done-function 'kill-buffer)
1358 "Kill this buffer")
1359 (t "Finish with this buffer")))
1360 :action #'Custom-buffer-done) 1347 :action #'Custom-buffer-done)
1361 (widget-insert "\n\n") 1348 (widget-insert "\n\n")
1362 (message "Creating customization items...") 1349 (message "Creating customization items...")
diff --git a/lisp/dired.el b/lisp/dired.el
index 0341214a98e..461546ddac5 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1197,8 +1197,8 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
1197 ;; misc 1197 ;; misc
1198 (define-key map "?" 'dired-summary) 1198 (define-key map "?" 'dired-summary)
1199 (define-key map "\177" 'dired-unmark-backward) 1199 (define-key map "\177" 'dired-unmark-backward)
1200 (define-key map "\C-_" 'dired-undo) 1200 (define-key map [remap undo] 'dired-undo)
1201 (define-key map "\C-xu" 'dired-undo) 1201 (define-key map [remap advertised-undo] 'dired-undo)
1202 1202
1203 ;; Make menu bar items. 1203 ;; Make menu bar items.
1204 1204
diff --git a/lisp/files.el b/lisp/files.el
index 841332b957a..045958bf9c5 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2844,13 +2844,18 @@ ignored."
2844 2844
2845(defun normal-backup-enable-predicate (name) 2845(defun normal-backup-enable-predicate (name)
2846 "Default `backup-enable-predicate' function. 2846 "Default `backup-enable-predicate' function.
2847Checks for files in `temporary-file-directory' or 2847Checks for files in `temporary-file-directory',
2848`small-temporary-file-directory'." 2848`small-temporary-file-directory', and /tmp."
2849 (not (or (let ((comp (compare-strings temporary-file-directory 0 nil 2849 (not (or (let ((comp (compare-strings temporary-file-directory 0 nil
2850 name 0 nil))) 2850 name 0 nil)))
2851 ;; Directory is under temporary-file-directory. 2851 ;; Directory is under temporary-file-directory.
2852 (and (not (eq comp t)) 2852 (and (not (eq comp t))
2853 (< comp (- (length temporary-file-directory))))) 2853 (< comp (- (length temporary-file-directory)))))
2854 (let ((comp (compare-strings "/tmp" 0 nil
2855 name 0 nil)))
2856 ;; Directory is under /tmp.
2857 (and (not (eq comp t))
2858 (< comp (- (length "/tmp")))))
2854 (if small-temporary-file-directory 2859 (if small-temporary-file-directory
2855 (let ((comp (compare-strings small-temporary-file-directory 2860 (let ((comp (compare-strings small-temporary-file-directory
2856 0 nil 2861 0 nil
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 2fbab6bea54..eb761d10b27 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,7 @@
12005-01-30 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * gnus-art.el (gnus-article-mode): Turn off the "\ " non-break space.
4
12005-01-28 Stefan Monnier <monnier@iro.umontreal.ca> 52005-01-28 Stefan Monnier <monnier@iro.umontreal.ca>
2 6
3 * message.el (message-beginning-of-line): Change the behavior when 7 * message.el (message-beginning-of-line): Change the behavior when
@@ -11,8 +15,8 @@
11 15
122005-01-28 Katsumi Yamaoka <yamaoka@jpl.org> 162005-01-28 Katsumi Yamaoka <yamaoka@jpl.org>
13 17
14 * gnus-art.el (gnus-article-prepare): Remove 18 * gnus-art.el (gnus-article-prepare):
15 message-strip-forbidden-properties from the local hook. 19 Remove message-strip-forbidden-properties from the local hook.
16 20
172005-01-24 Katsumi Yamaoka <yamaoka@jpl.org> 212005-01-24 Katsumi Yamaoka <yamaoka@jpl.org>
18 22
@@ -33,9 +37,9 @@
33 37
342004-12-27 Simon Josefsson <jas@extundo.com> 382004-12-27 Simon Josefsson <jas@extundo.com>
35 39
36 * mm-bodies.el (mm-body-encoding): Don't permit 7-bit to be used 40 * mm-bodies.el (mm-body-encoding): Don't permit 7-bit to be used when
37 when mm-use-ultra-safe-encoding is enabled (e.g., for PGP/MIME) 41 mm-use-ultra-safe-encoding is enabled (e.g., for PGP/MIME) and we have
38 and we have trailing white space. Reported by Werner Koch <wk@gnupg.org>. 42 trailing white space. Reported by Werner Koch <wk@gnupg.org>.
39 43
402004-12-17 Kim F. Storm <storm@cua.dk> 442004-12-17 Kim F. Storm <storm@cua.dk>
41 45
@@ -408,11 +412,10 @@
408 412
4092004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> 4132004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
410 414
411 * gnus-agent.el (gnus-agent-possibly-synchronize-flags): Ignore 415 * gnus-agent.el (gnus-agent-possibly-synchronize-flags): Ignore servers
412 servers that are offline. Avoids having gnus-agent-toggle-plugged 416 that are offline. Avoids having gnus-agent-toggle-plugged first ask if
413 first ask if you want to open a server and then, even when you 417 you want to open a server and then, even when you responded with no,
414 responded with no, asking if you want to synchronize the server's 418 asking if you want to synchronize the server's flags.
415 flags.
416 (gnus-agent-synchronize-flags-server): Rewrite read loop to handle 419 (gnus-agent-synchronize-flags-server): Rewrite read loop to handle
417 multi-line expressions. 420 multi-line expressions.
418 (gnus-agent-synchronize-group-flags): New internal function. 421 (gnus-agent-synchronize-group-flags): New internal function.
@@ -560,9 +563,8 @@
560 563
5612004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> 5642004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
562 565
563 * gnus-start.el (gnus-convert-old-newsrc): Only write the 566 * gnus-start.el (gnus-convert-old-newsrc): Only write the conversion
564 conversion message to newsrc-dribble when an actual conversion is 567 message to newsrc-dribble when an actual conversion is performed.
565 performed.
566 568
5672004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> 5692004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
568 570
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 8a81176a5f6..3f8e172c1a8 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -3711,6 +3711,8 @@ commands:
3711 (make-local-variable 'gnus-article-image-alist) 3711 (make-local-variable 'gnus-article-image-alist)
3712 (make-local-variable 'gnus-article-charset) 3712 (make-local-variable 'gnus-article-charset)
3713 (make-local-variable 'gnus-article-ignored-charsets) 3713 (make-local-variable 'gnus-article-ignored-charsets)
3714 ;; Prevent recent Emacsen from displaying non-break space as "\ ".
3715 (set (make-local-variable 'show-nonbreak-escape) nil)
3714 (gnus-set-default-directory) 3716 (gnus-set-default-directory)
3715 (buffer-disable-undo) 3717 (buffer-disable-undo)
3716 (setq buffer-read-only t) 3718 (setq buffer-read-only t)
diff --git a/lisp/man.el b/lisp/man.el
index e9503ca883a..02661c55517 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -697,6 +697,7 @@ all sections related to a subject, put something appropriate into the
697 (setq buffer (generate-new-buffer bufname)) 697 (setq buffer (generate-new-buffer bufname))
698 (save-excursion 698 (save-excursion
699 (set-buffer buffer) 699 (set-buffer buffer)
700 (setq buffer-undo-list t)
700 (setq Man-original-frame (selected-frame)) 701 (setq Man-original-frame (selected-frame))
701 (setq Man-arguments man-args)) 702 (setq Man-arguments man-args))
702 (let ((process-environment (copy-sequence process-environment)) 703 (let ((process-environment (copy-sequence process-environment))
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 601eb03946e..7b401da794e 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -985,8 +985,9 @@ Returns the compilation buffer created."
985 (setq mode-line-process ":run") 985 (setq mode-line-process ":run")
986 (force-mode-line-update) 986 (force-mode-line-update)
987 (sit-for 0) ; Force redisplay 987 (sit-for 0) ; Force redisplay
988 (let ((status (call-process shell-file-name nil outbuf nil "-c" 988 (let* ((buffer-read-only nil) ; call-process needs to modify outbuf
989 command))) 989 (status (call-process shell-file-name nil outbuf nil "-c"
990 command)))
990 (cond ((numberp status) 991 (cond ((numberp status)
991 (compilation-handle-exit 'exit status 992 (compilation-handle-exit 'exit status
992 (if (zerop status) 993 (if (zerop status)
@@ -1003,6 +1004,7 @@ exited abnormally with code %d\n"
1003 ;; fontified, so fontify it now. 1004 ;; fontified, so fontify it now.
1004 (let ((font-lock-verbose nil)) ; shut up font-lock messages 1005 (let ((font-lock-verbose nil)) ; shut up font-lock messages
1005 (font-lock-fontify-buffer)) 1006 (font-lock-fontify-buffer))
1007 (set-buffer-modified-p nil)
1006 (message "Executing `%s'...done" command))) 1008 (message "Executing `%s'...done" command)))
1007 ;; Now finally cd to where the shell started make/grep/... 1009 ;; Now finally cd to where the shell started make/grep/...
1008 (setq default-directory thisdir)) 1010 (setq default-directory thisdir))
diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el
index a89f4b1694f..54c43d1df36 100644
--- a/lisp/progmodes/gdb-ui.el
+++ b/lisp/progmodes/gdb-ui.el
@@ -53,8 +53,14 @@
53;; Known Bugs: 53;; Known Bugs:
54;; 54;;
55;; TODO: 55;; TODO:
56;; Use tree-widget.el instead of the speedbar for watch-expressions? 56;; 1) Use MI command -data-read-memory for memory window.
57;; Mark breakpoint locations on scroll-bar of source buffer? 57;; 2) Highlight changed register values (use MI commands
58;; -data-list-register-values and -data-list-changed-registers instead
59;; of 'info registers'.
60;; 3) Use tree-widget.el instead of the speedbar for watch-expressions?
61;; 4) Mark breakpoint locations on scroll-bar of source buffer?
62;; 5) After release of 21.4 use '-var-list-children --all-values'
63;; and '-stack-list-locals 2' which need GDB 6.1 onwards.
58 64
59;;; Code: 65;;; Code:
60 66
@@ -62,6 +68,7 @@
62 68
63(defvar gdb-current-address "main" "Initialisation for Assembler buffer.") 69(defvar gdb-current-address "main" "Initialisation for Assembler buffer.")
64(defvar gdb-previous-address nil) 70(defvar gdb-previous-address nil)
71(defvar gdb-memory-address "main")
65(defvar gdb-previous-frame nil) 72(defvar gdb-previous-frame nil)
66(defvar gdb-current-frame nil) 73(defvar gdb-current-frame nil)
67(defvar gdb-current-stack-level nil) 74(defvar gdb-current-stack-level nil)
@@ -227,6 +234,7 @@ detailed description of this mode.
227 ;; (re-)initialize 234 ;; (re-)initialize
228 (setq gdb-current-address "main") 235 (setq gdb-current-address "main")
229 (setq gdb-previous-address nil) 236 (setq gdb-previous-address nil)
237 (setq gdb-memory-address "main")
230 (setq gdb-previous-frame nil) 238 (setq gdb-previous-frame nil)
231 (setq gdb-current-frame nil) 239 (setq gdb-current-frame nil)
232 (setq gdb-current-stack-level nil) 240 (setq gdb-current-stack-level nil)
@@ -840,6 +848,7 @@ happens to be appropriate."
840 (gdb-invalidate-breakpoints) 848 (gdb-invalidate-breakpoints)
841 (gdb-invalidate-assembler) 849 (gdb-invalidate-assembler)
842 (gdb-invalidate-registers) 850 (gdb-invalidate-registers)
851 (gdb-invalidate-memory)
843 (gdb-invalidate-locals) 852 (gdb-invalidate-locals)
844 (gdb-invalidate-threads) 853 (gdb-invalidate-threads)
845 (unless (eq system-type 'darwin) ;Breaks on Darwin's GDB-5.3. 854 (unless (eq system-type 'darwin) ;Breaks on Darwin's GDB-5.3.
@@ -1521,8 +1530,268 @@ static char *magick[] = {
1521 (let ((special-display-regexps (append special-display-regexps '(".*"))) 1530 (let ((special-display-regexps (append special-display-regexps '(".*")))
1522 (special-display-frame-alist gdb-frame-parameters)) 1531 (special-display-frame-alist gdb-frame-parameters))
1523 (display-buffer (gdb-get-create-buffer 'gdb-registers-buffer)))) 1532 (display-buffer (gdb-get-create-buffer 'gdb-registers-buffer))))
1524 1533
1534;; Memory buffer.
1525;; 1535;;
1536(defcustom gdb-memory-repeat-count 32
1537 "Number of data items in memory window."
1538 :type 'integer
1539 :group 'gud
1540 :version "21.4")
1541
1542(defcustom gdb-memory-format "x"
1543 "Display format of data items in memory window."
1544 :type '(choice (const :tag "Hexadecimal" "x")
1545 (const :tag "Signed decimal" "d")
1546 (const :tag "Unsigned decimal" "u")
1547 (const :tag "Octal" "o")
1548 (const :tag "Binary" "t"))
1549 :group 'gud
1550 :version "21.4")
1551
1552(defcustom gdb-memory-unit "w"
1553 "Unit size of data items in memory window."
1554 :type '(choice (const :tag "Byte" "b")
1555 (const :tag "Halfword" "h")
1556 (const :tag "Word" "w")
1557 (const :tag "Giant word" "g"))
1558 :group 'gud
1559 :version "21.4")
1560
1561(gdb-set-buffer-rules 'gdb-memory-buffer
1562 'gdb-memory-buffer-name
1563 'gdb-memory-mode)
1564
1565(def-gdb-auto-updated-buffer gdb-memory-buffer
1566 gdb-invalidate-memory
1567 (concat gdb-server-prefix "x/" (number-to-string gdb-memory-repeat-count)
1568 gdb-memory-format gdb-memory-unit " " gdb-memory-address "\n")
1569 gdb-read-memory-handler
1570 gdb-read-memory-custom)
1571
1572(defun gdb-read-memory-custom ())
1573
1574(defvar gdb-memory-mode-map
1575 (let ((map (make-sparse-keymap)))
1576 (suppress-keymap map)
1577 (define-key map "q" 'kill-this-buffer)
1578 map))
1579
1580(defun gdb-memory-set-address (event)
1581 "Set the start memory address."
1582 (interactive "e")
1583 (save-selected-window
1584 (select-window (posn-window (event-start event)))
1585 (let ((arg (read-from-minibuffer "Memory address: ")))
1586 (setq gdb-memory-address arg))
1587 (gdb-invalidate-memory)))
1588
1589(defun gdb-memory-set-repeat-count (event)
1590 "Set the number of data items in memory window."
1591 (interactive "e")
1592 (save-selected-window
1593 (select-window (posn-window (event-start event)))
1594 (let* ((arg (read-from-minibuffer "Repeat count: "))
1595 (count (string-to-int arg)))
1596 (if (< count 0)
1597 (error "Non-negative numbers only")
1598 (customize-set-variable 'gdb-memory-repeat-count count)
1599 (gdb-invalidate-memory)))))
1600
1601(defun gdb-memory-format-binary ()
1602 "Set the display format to binary."
1603 (interactive)
1604 (customize-set-variable 'gdb-memory-format "t")
1605 (gdb-invalidate-memory))
1606
1607(defun gdb-memory-format-octal ()
1608 "Set the display format to octal."
1609 (interactive)
1610 (customize-set-variable 'gdb-memory-format "o")
1611 (gdb-invalidate-memory))
1612
1613(defun gdb-memory-format-unsigned ()
1614 "Set the display format to unsigned decimal."
1615 (interactive)
1616 (customize-set-variable 'gdb-memory-format "u")
1617 (gdb-invalidate-memory))
1618
1619(defun gdb-memory-format-signed ()
1620 "Set the display format to decimal."
1621 (interactive)
1622 (customize-set-variable 'gdb-memory-format "d")
1623 (gdb-invalidate-memory))
1624
1625(defun gdb-memory-format-hexadecimal ()
1626 "Set the display format to hexadecimal."
1627 (interactive)
1628 (customize-set-variable 'gdb-memory-format "x")
1629 (gdb-invalidate-memory))
1630
1631(defvar gdb-memory-format-keymap
1632 (let ((map (make-sparse-keymap)))
1633 (define-key map [header-line down-mouse-3] 'gdb-memory-format-menu-1)
1634 map)
1635 "Keymap to select format in the header line.")
1636
1637(defvar gdb-memory-format-menu (make-sparse-keymap "Format")
1638 "Menu of display formats in the header line.")
1639
1640(define-key gdb-memory-format-menu [binary]
1641 '(menu-item "Binary" gdb-memory-format-binary
1642 :button (:radio . (equal gdb-memory-format "t"))))
1643(define-key gdb-memory-format-menu [octal]
1644 '(menu-item "Octal" gdb-memory-format-octal
1645 :button (:radio . (equal gdb-memory-format "o"))))
1646(define-key gdb-memory-format-menu [unsigned]
1647 '(menu-item "Unsigned Decimal" gdb-memory-format-unsigned
1648 :button (:radio . (equal gdb-memory-format "u"))))
1649(define-key gdb-memory-format-menu [signed]
1650 '(menu-item "Signed Decimal" gdb-memory-format-signed
1651 :button (:radio . (equal gdb-memory-format "d"))))
1652(define-key gdb-memory-format-menu [hexadecimal]
1653 '(menu-item "Hexadecimal" gdb-memory-format-hexadecimal
1654 :button (:radio . (equal gdb-memory-format "x"))))
1655
1656(defun gdb-memory-format-menu (event)
1657 (interactive "@e")
1658 (x-popup-menu event gdb-memory-format-menu))
1659
1660(defun gdb-memory-format-menu-1 (event)
1661 (interactive "e")
1662 (save-selected-window
1663 (select-window (posn-window (event-start event)))
1664 (let* ((selection (gdb-memory-format-menu event))
1665 (binding (and selection (lookup-key gdb-memory-format-menu
1666 (vector (car selection))))))
1667 (if binding (call-interactively binding)))))
1668
1669(defun gdb-memory-unit-giant ()
1670 "Set the unit size to giant words (eight bytes)."
1671 (interactive)
1672 (customize-set-variable 'gdb-memory-unit "g")
1673 (gdb-invalidate-memory))
1674
1675(defun gdb-memory-unit-word ()
1676 "Set the unit size to words (four bytes)."
1677 (interactive)
1678 (customize-set-variable 'gdb-memory-unit "w")
1679 (gdb-invalidate-memory))
1680
1681(defun gdb-memory-unit-halfword ()
1682 "Set the unit size to halfwords (two bytes)."
1683 (interactive)
1684 (customize-set-variable 'gdb-memory-unit "h")
1685 (gdb-invalidate-memory))
1686
1687(defun gdb-memory-unit-byte ()
1688 "Set the unit size to bytes."
1689 (interactive)
1690 (customize-set-variable 'gdb-memory-unit "b")
1691 (gdb-invalidate-memory))
1692
1693(defvar gdb-memory-unit-keymap
1694 (let ((map (make-sparse-keymap)))
1695 (define-key map [header-line down-mouse-3] 'gdb-memory-unit-menu-1)
1696 map)
1697 "Keymap to select units in the header line.")
1698
1699(defvar gdb-memory-unit-menu (make-sparse-keymap "Unit")
1700 "Menu of units in the header line.")
1701
1702(define-key gdb-memory-unit-menu [giantwords]
1703 '(menu-item "Giant words" gdb-memory-unit-giant
1704 :button (:radio . (equal gdb-memory-unit "g"))))
1705(define-key gdb-memory-unit-menu [words]
1706 '(menu-item "Words" gdb-memory-unit-word
1707 :button (:radio . (equal gdb-memory-unit "w"))))
1708(define-key gdb-memory-unit-menu [halfwords]
1709 '(menu-item "Halfwords" gdb-memory-unit-halfword
1710 :button (:radio . (equal gdb-memory-unit "h"))))
1711(define-key gdb-memory-unit-menu [bytes]
1712 '(menu-item "Bytes" gdb-memory-unit-byte
1713 :button (:radio . (equal gdb-memory-unit "b"))))
1714
1715(defun gdb-memory-unit-menu (event)
1716 (interactive "@e")
1717 (x-popup-menu event gdb-memory-unit-menu))
1718
1719(defun gdb-memory-unit-menu-1 (event)
1720 (interactive "e")
1721 (save-selected-window
1722 (select-window (posn-window (event-start event)))
1723 (let* ((selection (gdb-memory-unit-menu event))
1724 (binding (and selection (lookup-key gdb-memory-unit-menu
1725 (vector (car selection))))))
1726 (if binding (call-interactively binding)))))
1727
1728;;from make-mode-line-mouse-map
1729(defun gdb-make-header-line-mouse-map (mouse function) "\
1730Return a keymap with single entry for mouse key MOUSE on the header line.
1731MOUSE is defined to run function FUNCTION with no args in the buffer
1732corresponding to the mode line clicked."
1733 (let ((map (make-sparse-keymap)))
1734 (define-key map (vector 'header-line mouse) function)
1735 (define-key map (vector 'header-line 'down-mouse-1) 'ignore)
1736 map))
1737
1738(defun gdb-memory-mode ()
1739 "Major mode for examining memory.
1740
1741\\{gdb-memory-mode-map}"
1742 (kill-all-local-variables)
1743 (setq major-mode 'gdb-memory-mode)
1744 (setq mode-name "Memory")
1745 (setq buffer-read-only t)
1746 (use-local-map gdb-memory-mode-map)
1747 (setq header-line-format
1748 '(:eval
1749 (concat
1750 "Read address: "
1751 (propertize gdb-memory-address
1752 'face font-lock-warning-face
1753 'help-echo (purecopy "mouse-1: Set memory address")
1754 'local-map (purecopy (gdb-make-header-line-mouse-map
1755 'mouse-1
1756 #'gdb-memory-set-address)))
1757 " Repeat Count: "
1758 (propertize (number-to-string gdb-memory-repeat-count)
1759 'face font-lock-warning-face
1760 'help-echo (purecopy "mouse-1: Set repeat count")
1761 'local-map (purecopy (gdb-make-header-line-mouse-map
1762 'mouse-1
1763 #'gdb-memory-set-repeat-count)))
1764 " Display Format: "
1765 (propertize gdb-memory-format
1766 'face font-lock-warning-face
1767 'help-echo (purecopy "mouse-3: Select display format")
1768 'local-map gdb-memory-format-keymap)
1769 " Unit Size: "
1770 (propertize gdb-memory-unit
1771 'face font-lock-warning-face
1772 'help-echo (purecopy "mouse-3: Select unit size")
1773 'local-map gdb-memory-unit-keymap))))
1774 (run-mode-hooks 'gdb-memory-mode-hook)
1775 'gdb-invalidate-memory)
1776
1777(defun gdb-memory-buffer-name ()
1778 (with-current-buffer gud-comint-buffer
1779 (concat "*memory of " (gdb-get-target-string) "*")))
1780
1781(defun gdb-display-memory-buffer ()
1782 "Display memory contents."
1783 (interactive)
1784 (gdb-display-buffer
1785 (gdb-get-create-buffer 'gdb-memory-buffer)))
1786
1787(defun gdb-frame-memory-buffer ()
1788 "Display memory contents in a new frame."
1789 (interactive)
1790 (let ((special-display-regexps (append special-display-regexps '(".*")))
1791 (special-display-frame-alist gdb-frame-parameters))
1792 (display-buffer (gdb-get-create-buffer 'gdb-memory-buffer))))
1793
1794
1526;; Locals buffer. 1795;; Locals buffer.
1527;; 1796;;
1528(gdb-set-buffer-rules 'gdb-locals-buffer 1797(gdb-set-buffer-rules 'gdb-locals-buffer
@@ -1633,6 +1902,7 @@ static char *magick[] = {
1633 `(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba))) 1902 `(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba)))
1634 (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer)) 1903 (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))
1635 (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer)) 1904 (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
1905 (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer))
1636 (define-key menu [assembler] '("Machine" . gdb-frame-assembler-buffer)) 1906 (define-key menu [assembler] '("Machine" . gdb-frame-assembler-buffer))
1637 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer)) 1907 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
1638 (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer)) 1908 (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
@@ -1643,8 +1913,9 @@ static char *magick[] = {
1643 (define-key gud-menu-map [displays] 1913 (define-key gud-menu-map [displays]
1644 `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdba))) 1914 `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdba)))
1645 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer)) 1915 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
1646 (define-key menu [assembler] '("Machine" . gdb-display-assembler-buffer))
1647 (define-key menu [threads] '("Threads" . gdb-display-threads-buffer)) 1916 (define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
1917 (define-key menu [memory] '("Memory" . gdb-display-memory-buffer))
1918 (define-key menu [assembler] '("Machine" . gdb-display-assembler-buffer))
1648 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer)) 1919 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
1649 (define-key menu [locals] '("Locals" . gdb-display-locals-buffer)) 1920 (define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
1650 (define-key menu [frames] '("Stack" . gdb-display-stack-buffer)) 1921 (define-key menu [frames] '("Stack" . gdb-display-stack-buffer))
@@ -1902,7 +2173,7 @@ BUFFER nil or omitted means use the current buffer."
1902 2173
1903(defun gdb-assembler-custom () 2174(defun gdb-assembler-custom ()
1904 (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer)) 2175 (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer))
1905 (pos 1) (address) (flag)) 2176 (pos 1) (address) (flag) (bptno))
1906 (with-current-buffer buffer 2177 (with-current-buffer buffer
1907 (if (not (equal gdb-current-address "main")) 2178 (if (not (equal gdb-current-address "main"))
1908 (progn 2179 (progn
@@ -1924,16 +2195,17 @@ BUFFER nil or omitted means use the current buffer."
1924 (if (looking-at "[^\t].*breakpoint") 2195 (if (looking-at "[^\t].*breakpoint")
1925 (progn 2196 (progn
1926 (looking-at 2197 (looking-at
1927 "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*0x\\(\\S-*\\)") 2198 "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)\\s-+0x\\(\\S-+\\)")
1928 (setq flag (char-after (match-beginning 1))) 2199 (setq bptno (match-string 1))
1929 (setq address (match-string 2)) 2200 (setq flag (char-after (match-beginning 2)))
2201 (setq address (match-string 3))
1930 ;; remove leading 0s from output of info break. 2202 ;; remove leading 0s from output of info break.
1931 (if (string-match "^0+\\(.*\\)" address) 2203 (if (string-match "^0+\\(.*\\)" address)
1932 (setq address (match-string 1 address))) 2204 (setq address (match-string 1 address)))
1933 (with-current-buffer buffer 2205 (with-current-buffer buffer
1934 (goto-char (point-min)) 2206 (goto-char (point-min))
1935 (if (re-search-forward address nil t) 2207 (if (re-search-forward address nil t)
1936 (gdb-put-breakpoint-icon (eq flag ?y)))))))) 2208 (gdb-put-breakpoint-icon (eq flag ?y) bptno)))))))
1937 (if (not (equal gdb-current-address "main")) 2209 (if (not (equal gdb-current-address "main"))
1938 (set-window-point (get-buffer-window buffer 0) pos)))) 2210 (set-window-point (get-buffer-window buffer 0) pos))))
1939 2211
diff --git a/lisp/rect.el b/lisp/rect.el
index 6d9cd6a2aaa..e53198bc753 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -127,14 +127,14 @@ the function is called."
127 )) 127 ))
128 128
129(defun delete-rectangle-line (startcol endcol fill) 129(defun delete-rectangle-line (startcol endcol fill)
130 (when (= (move-to-column startcol (or fill 'coerce)) startcol) 130 (when (= (move-to-column startcol (if fill t 'coerce)) startcol)
131 (delete-region (point) 131 (delete-region (point)
132 (progn (move-to-column endcol 'coerce) 132 (progn (move-to-column endcol 'coerce)
133 (point))))) 133 (point)))))
134 134
135(defun delete-extract-rectangle-line (startcol endcol lines fill) 135(defun delete-extract-rectangle-line (startcol endcol lines fill)
136 (let ((pt (point-at-eol))) 136 (let ((pt (point-at-eol)))
137 (if (< (move-to-column startcol (or fill 'coerce)) startcol) 137 (if (< (move-to-column startcol (if fill t 'coerce)) startcol)
138 (setcdr lines (cons (spaces-string (- endcol startcol)) 138 (setcdr lines (cons (spaces-string (- endcol startcol))
139 (cdr lines))) 139 (cdr lines)))
140 ;; else 140 ;; else
@@ -284,13 +284,13 @@ on the right side of the rectangle."
284 (goto-char start)) 284 (goto-char start))
285 285
286(defun open-rectangle-line (startcol endcol fill) 286(defun open-rectangle-line (startcol endcol fill)
287 (when (= (move-to-column startcol (or fill 'coerce)) startcol) 287 (when (= (move-to-column startcol (if fill t 'coerce)) startcol)
288 (unless (and (not fill) 288 (unless (and (not fill)
289 (= (point) (point-at-eol))) 289 (= (point) (point-at-eol)))
290 (indent-to endcol)))) 290 (indent-to endcol))))
291 291
292(defun delete-whitespace-rectangle-line (startcol endcol fill) 292(defun delete-whitespace-rectangle-line (startcol endcol fill)
293 (when (= (move-to-column startcol (or fill 'coerce)) startcol) 293 (when (= (move-to-column startcol (if fill t 'coerce)) startcol)
294 (unless (= (point) (point-at-eol)) 294 (unless (= (point) (point-at-eol))
295 (delete-region (point) (progn (skip-syntax-forward " ") (point)))))) 295 (delete-region (point) (progn (skip-syntax-forward " ") (point))))))
296 296
@@ -371,7 +371,7 @@ rectangle which were empty."
371 371
372(defun clear-rectangle-line (startcol endcol fill) 372(defun clear-rectangle-line (startcol endcol fill)
373 (let ((pt (point-at-eol))) 373 (let ((pt (point-at-eol)))
374 (when (= (move-to-column startcol (or fill 'coerce)) startcol) 374 (when (= (move-to-column startcol (if fill t 'coerce)) startcol)
375 (if (and (not fill) 375 (if (and (not fill)
376 (<= (save-excursion (goto-char pt) (current-column)) endcol)) 376 (<= (save-excursion (goto-char pt) (current-column)) endcol))
377 (delete-region (point) pt) 377 (delete-region (point) pt)
diff --git a/lisp/ses.el b/lisp/ses.el
index 49d4f49d94a..c2239327e1c 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -515,7 +515,7 @@ for this spreadsheet."
515 515
516(defun ses-create-cell-variable-range (minrow maxrow mincol maxcol) 516(defun ses-create-cell-variable-range (minrow maxrow mincol maxcol)
517 "Create buffer-local variables for cells. This is undoable." 517 "Create buffer-local variables for cells. This is undoable."
518 (push `(ses-destroy-cell-variable-range ,minrow ,maxrow ,mincol ,maxcol) 518 (push `(apply ses-destroy-cell-variable-range ,minrow ,maxrow ,mincol ,maxcol)
519 buffer-undo-list) 519 buffer-undo-list)
520 (let (sym xrow xcol) 520 (let (sym xrow xcol)
521 (dotimes (row (1+ (- maxrow minrow))) 521 (dotimes (row (1+ (- maxrow minrow)))
@@ -536,16 +536,16 @@ for this spreadsheet."
536 (dotimes (col (1+ (- maxcol mincol))) 536 (dotimes (col (1+ (- maxcol mincol)))
537 (setq sym (ses-create-cell-symbol (+ row minrow) (+ col mincol))) 537 (setq sym (ses-create-cell-symbol (+ row minrow) (+ col mincol)))
538 (if (boundp sym) 538 (if (boundp sym)
539 (push `(ses-set-with-undo ,sym ,(symbol-value sym)) 539 (push `(apply ses-set-with-undo ,sym ,(symbol-value sym))
540 buffer-undo-list)) 540 buffer-undo-list))
541 (kill-local-variable sym)))) 541 (kill-local-variable sym))))
542 (push `(ses-create-cell-variable-range ,minrow ,maxrow ,mincol ,maxcol) 542 (push `(apply ses-create-cell-variable-range ,minrow ,maxrow ,mincol ,maxcol)
543 buffer-undo-list)) 543 buffer-undo-list))
544 544
545(defun ses-reset-header-string () 545(defun ses-reset-header-string ()
546 "Flags the header string for update. Upon undo, the header string will be 546 "Flags the header string for update. Upon undo, the header string will be
547updated again." 547updated again."
548 (push '(ses-reset-header-string) buffer-undo-list) 548 (push '(apply ses-reset-header-string) buffer-undo-list)
549 (setq ses--header-hscroll -1)) 549 (setq ses--header-hscroll -1))
550 550
551;;Split this code off into a function to avoid coverage-testing difficulties 551;;Split this code off into a function to avoid coverage-testing difficulties
@@ -1279,38 +1279,39 @@ to each symbol."
1279;; Undo control 1279;; Undo control
1280;;---------------------------------------------------------------------------- 1280;;----------------------------------------------------------------------------
1281 1281
1282(defadvice undo-more (around ses-undo-more activate preactivate) 1282;; This should be unnecessary, because the feature is now built in.
1283 "Define a meaning for conses in buffer-undo-list whose car is a symbol 1283
1284other than t or nil. To undo these, apply the car--a function--to the 1284;;; (defadvice undo-more (around ses-undo-more activate preactivate)
1285cdr--its arglist." 1285;;; "Define a meaning for conses in buffer-undo-list whose car is a symbol
1286 (let ((ses-count (ad-get-arg 0))) 1286;;; other than t or nil. To undo these, apply the car--a function--to the
1287 (catch 'undo 1287;;; cdr--its arglist."
1288 (dolist (ses-x pending-undo-list) 1288;;; (let ((ses-count (ad-get-arg 0)))
1289 (unless ses-x 1289;;; (catch 'undo
1290 ;;End of undo boundary 1290;;; (dolist (ses-x pending-undo-list)
1291 (setq ses-count (1- ses-count)) 1291;;; (unless ses-x
1292 (if (<= ses-count 0) 1292;;; ;;End of undo boundary
1293 ;;We've seen enough boundaries - stop undoing 1293;;; (setq ses-count (1- ses-count))
1294 (throw 'undo nil))) 1294;;; (if (<= ses-count 0)
1295 (and (consp ses-x) (symbolp (car ses-x)) (fboundp (car ses-x)) 1295;;; ;;We've seen enough boundaries - stop undoing
1296 ;;Undo using apply 1296;;; (throw 'undo nil)))
1297 (apply (car ses-x) (cdr ses-x))))) 1297;;; (and (consp ses-x) (symbolp (car ses-x)) (fboundp (car ses-x))
1298 (if (not (eq major-mode 'ses-mode)) 1298;;; ;;Undo using apply
1299 ad-do-it 1299;;; (apply (car ses-x) (cdr ses-x)))))
1300 ;;Here is some extra code for SES mode. 1300;;; (if (not (eq major-mode 'ses-mode))
1301 (setq ses--deferred-narrow 1301;;; ad-do-it
1302 (or ses--deferred-narrow (ses-narrowed-p))) 1302;;; ;;Here is some extra code for SES mode.
1303 (widen) 1303;;; (setq ses--deferred-narrow
1304 (condition-case x 1304;;; (or ses--deferred-narrow (ses-narrowed-p)))
1305 ad-do-it 1305;;; (widen)
1306 (error 1306;;; (condition-case x
1307 ;;Restore narrow if appropriate 1307;;; ad-do-it
1308 (ses-command-hook) 1308;;; (error
1309 (signal (car x) (cdr x))))))) 1309;;; ;;Restore narrow if appropriate
1310;;; (ses-command-hook)
1311;;; (signal (car x) (cdr x)))))))
1310 1312
1311(defun ses-begin-change () 1313(defun ses-begin-change ()
1312 "For undo, remember current buffer-position before we start changing hidden 1314 "For undo, remember point before we start changing hidden stuff."
1313stuff."
1314 (let ((inhibit-read-only t)) 1315 (let ((inhibit-read-only t))
1315 (insert-and-inherit "X") 1316 (insert-and-inherit "X")
1316 (delete-region (1- (point)) (point)))) 1317 (delete-region (1- (point)) (point))))
@@ -1324,8 +1325,8 @@ stuff."
1324 (equal (symbol-value sym) newval) 1325 (equal (symbol-value sym) newval)
1325 (not (stringp newval))) 1326 (not (stringp newval)))
1326 (push (if (boundp sym) 1327 (push (if (boundp sym)
1327 `(ses-set-with-undo ,sym ,(symbol-value sym)) 1328 `(apply ses-set-with-undo ,sym ,(symbol-value sym))
1328 `(ses-unset-with-undo ,sym)) 1329 `(apply ses-unset-with-undo ,sym))
1329 buffer-undo-list) 1330 buffer-undo-list)
1330 (set sym newval) 1331 (set sym newval)
1331 t)) 1332 t))
@@ -1333,13 +1334,13 @@ stuff."
1333(defun ses-unset-with-undo (sym) 1334(defun ses-unset-with-undo (sym)
1334 "Set SYM to be unbound. This is undoable." 1335 "Set SYM to be unbound. This is undoable."
1335 (when (1value (boundp sym)) ;;Always bound, except after a programming error 1336 (when (1value (boundp sym)) ;;Always bound, except after a programming error
1336 (push `(ses-set-with-undo ,sym ,(symbol-value sym)) buffer-undo-list) 1337 (push `(apply ses-set-with-undo ,sym ,(symbol-value sym)) buffer-undo-list)
1337 (makunbound sym))) 1338 (makunbound sym)))
1338 1339
1339(defun ses-aset-with-undo (array idx newval) 1340(defun ses-aset-with-undo (array idx newval)
1340 "Like aset, but undoable. Result is t if element has changed" 1341 "Like aset, but undoable. Result is t if element has changed"
1341 (unless (equal (aref array idx) newval) 1342 (unless (equal (aref array idx) newval)
1342 (push `(ses-aset-with-undo ,array ,idx ,(aref array idx)) buffer-undo-list) 1343 (push `(apply ses-aset-with-undo ,array ,idx ,(aref array idx)) buffer-undo-list)
1343 (aset array idx newval) 1344 (aset array idx newval)
1344 t)) 1345 t))
1345 1346
@@ -2065,7 +2066,7 @@ before current one."
2065 (dotimes (col ses--numcols) 2066 (dotimes (col ses--numcols)
2066 (aset newrow col (ses-make-cell))) 2067 (aset newrow col (ses-make-cell)))
2067 (setq ses--cells (ses-vector-insert ses--cells row newrow)) 2068 (setq ses--cells (ses-vector-insert ses--cells row newrow))
2068 (push `(ses-vector-delete ses--cells ,row 1) buffer-undo-list) 2069 (push `(apply ses-vector-delete ses--cells ,row 1) buffer-undo-list)
2069 (insert ses--blank-line)) 2070 (insert ses--blank-line))
2070 ;;Insert empty lines in cell data area (will be replaced by 2071 ;;Insert empty lines in cell data area (will be replaced by
2071 ;;ses-relocate-all) 2072 ;;ses-relocate-all)
diff --git a/lisp/simple.el b/lisp/simple.el
index db7ae23bf41..67e93c86230 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1235,6 +1235,10 @@ Return 0 if current buffer is not a mini-buffer."
1235(defvar undo-no-redo nil 1235(defvar undo-no-redo nil
1236 "If t, `undo' doesn't go through redo entries.") 1236 "If t, `undo' doesn't go through redo entries.")
1237 1237
1238(defvar pending-undo-list nil
1239 "Within a run of consecutive undo commands, list remaining to be undone.
1240t if we undid all the way to the end of it.")
1241
1238(defun undo (&optional arg) 1242(defun undo (&optional arg)
1239 "Undo some previous changes. 1243 "Undo some previous changes.
1240Repeat this command to undo more changes. 1244Repeat this command to undo more changes.
@@ -1258,14 +1262,15 @@ as an argument limits undo to changes within the current region."
1258 (setq this-command 'undo-start) 1262 (setq this-command 'undo-start)
1259 1263
1260 (unless (and (eq last-command 'undo) 1264 (unless (and (eq last-command 'undo)
1261 ;; If something (a timer or filter?) changed the buffer 1265 (or (eq pending-undo-list t)
1262 ;; since the previous command, don't continue the undo seq. 1266 ;; If something (a timer or filter?) changed the buffer
1263 (let ((list buffer-undo-list)) 1267 ;; since the previous command, don't continue the undo seq.
1264 (while (eq (car list) nil) 1268 (let ((list buffer-undo-list))
1265 (setq list (cdr list))) 1269 (while (eq (car list) nil)
1266 ;; If the last undo record made was made by undo 1270 (setq list (cdr list)))
1267 ;; it shows nothing else happened in between. 1271 ;; If the last undo record made was made by undo
1268 (gethash list undo-equiv-table))) 1272 ;; it shows nothing else happened in between.
1273 (gethash list undo-equiv-table))))
1269 (setq undo-in-region 1274 (setq undo-in-region
1270 (if transient-mark-mode mark-active (and arg (not (numberp arg))))) 1275 (if transient-mark-mode mark-active (and arg (not (numberp arg)))))
1271 (if undo-in-region 1276 (if undo-in-region
@@ -1340,9 +1345,6 @@ Contrary to `undo', this will not redo a previous undo."
1340;; no idea whereas to bind it. Any suggestion welcome. -stef 1345;; no idea whereas to bind it. Any suggestion welcome. -stef
1341;; (define-key ctl-x-map "U" 'undo-only) 1346;; (define-key ctl-x-map "U" 'undo-only)
1342 1347
1343(defvar pending-undo-list nil
1344 "Within a run of consecutive undo commands, list remaining to be undone.")
1345
1346(defvar undo-in-progress nil 1348(defvar undo-in-progress nil
1347 "Non-nil while performing an undo. 1349 "Non-nil while performing an undo.
1348Some change-hooks test this variable to do something different.") 1350Some change-hooks test this variable to do something different.")
@@ -1351,12 +1353,14 @@ Some change-hooks test this variable to do something different.")
1351 "Undo back N undo-boundaries beyond what was already undone recently. 1353 "Undo back N undo-boundaries beyond what was already undone recently.
1352Call `undo-start' to get ready to undo recent changes, 1354Call `undo-start' to get ready to undo recent changes,
1353then call `undo-more' one or more times to undo them." 1355then call `undo-more' one or more times to undo them."
1354 (or pending-undo-list 1356 (or (listp pending-undo-list)
1355 (error (format "No further undo information%s" 1357 (error (format "No further undo information%s"
1356 (if (and transient-mark-mode mark-active) 1358 (if (and transient-mark-mode mark-active)
1357 " for region" "")))) 1359 " for region" ""))))
1358 (let ((undo-in-progress t)) 1360 (let ((undo-in-progress t))
1359 (setq pending-undo-list (primitive-undo count pending-undo-list)))) 1361 (setq pending-undo-list (primitive-undo count pending-undo-list))
1362 (if (null pending-undo-list)
1363 (setq pending-undo-list t))))
1360 1364
1361;; Deep copy of a list 1365;; Deep copy of a list
1362(defun undo-copy-list (list) 1366(defun undo-copy-list (list)
@@ -1521,33 +1525,76 @@ is not *inside* the region START...END."
1521 '(0 . 0))) 1525 '(0 . 0)))
1522 '(0 . 0))) 1526 '(0 . 0)))
1523 1527
1528(defcustom undo-ask-before-discard t
1529 "If non-nil ask about discarding undo info for the current command.
1530Normally, Emacs discards the undo info for the current command if
1531it exceeds `undo-outer-limit'. But if you set this option
1532non-nil, it asks in the echo area whether to discard the info.
1533If you answer no, there a slight risk that Emacs might crash, so
1534only do it if you really want to undo the command.
1535
1536This option is mainly intended for debugging. You have to be
1537careful if you use it for other purposes. Garbage collection is
1538inhibited while the question is asked, meaning that Emacs might
1539leak memory. So you should make sure that you do not wait
1540excessively long before answering the question."
1541 :type 'boolean
1542 :group 'undo
1543 :version "21.4")
1544
1524(defvar undo-extra-outer-limit nil 1545(defvar undo-extra-outer-limit nil
1525 "If non-nil, an extra level of size that's ok in an undo item. 1546 "If non-nil, an extra level of size that's ok in an undo item.
1526We don't ask the user about truncating the undo list until the 1547We don't ask the user about truncating the undo list until the
1527current item gets bigger than this amount.") 1548current item gets bigger than this amount.
1549
1550This variable only matters if `undo-ask-before-discard' is non-nil.")
1528(make-variable-buffer-local 'undo-extra-outer-limit) 1551(make-variable-buffer-local 'undo-extra-outer-limit)
1529 1552
1530;; When the first undo batch in an undo list is longer than undo-outer-limit, 1553;; When the first undo batch in an undo list is longer than
1531;; this function gets called to ask the user what to do. 1554;; undo-outer-limit, this function gets called to warn the user that
1532;; Garbage collection is inhibited around the call, 1555;; the undo info for the current command was discarded. Garbage
1533;; so it had better not do a lot of consing. 1556;; collection is inhibited around the call, so it had better not do a
1557;; lot of consing.
1534(setq undo-outer-limit-function 'undo-outer-limit-truncate) 1558(setq undo-outer-limit-function 'undo-outer-limit-truncate)
1535(defun undo-outer-limit-truncate (size) 1559(defun undo-outer-limit-truncate (size)
1536 (when (or (null undo-extra-outer-limit) 1560 (if undo-ask-before-discard
1537 (> size undo-extra-outer-limit)) 1561 (when (or (null undo-extra-outer-limit)
1538 ;; Don't ask the question again unless it gets even bigger. 1562 (> size undo-extra-outer-limit))
1539 ;; This applies, in particular, if the user quits from the question. 1563 ;; Don't ask the question again unless it gets even bigger.
1540 ;; Such a quit quits out of GC, but something else will call GC 1564 ;; This applies, in particular, if the user quits from the question.
1541 ;; again momentarily. It will call this function again, 1565 ;; Such a quit quits out of GC, but something else will call GC
1542 ;; but we don't want to ask the question again. 1566 ;; again momentarily. It will call this function again,
1543 (setq undo-extra-outer-limit (+ size 50000)) 1567 ;; but we don't want to ask the question again.
1544 (if (let (use-dialog-box) 1568 (setq undo-extra-outer-limit (+ size 50000))
1545 (yes-or-no-p (format "Buffer %s undo info is %d bytes long; discard it? " 1569 (if (let (use-dialog-box track-mouse executing-kbd-macro )
1546 (buffer-name) size))) 1570 (yes-or-no-p (format "Buffer %s undo info is %d bytes long; discard it? "
1547 (progn (setq buffer-undo-list nil) 1571 (buffer-name) size)))
1548 (setq undo-extra-outer-limit nil) 1572 (progn (setq buffer-undo-list nil)
1549 t) 1573 (setq undo-extra-outer-limit nil)
1550 nil))) 1574 t)
1575 nil))
1576 (display-warning '(undo discard-info)
1577 (concat
1578 (format "Buffer %s undo info was %d bytes long.\n"
1579 (buffer-name) size)
1580 "The undo info was discarded because it exceeded \
1581`undo-outer-limit'.
1582
1583This is normal if you executed a command that made a huge change
1584to the buffer. In that case, to prevent similar problems in the
1585future, set `undo-outer-limit' to a value that is large enough to
1586cover the maximum size of normal changes you expect a single
1587command to make, but not so large that it might exceed the
1588maximum memory allotted to Emacs.
1589
1590If you did not execute any such command, the situation is
1591probably due to a bug and you should report it.
1592
1593You can disable the popping up of this buffer by adding the entry
1594\(undo discard-info) to the user option `warning-suppress-types'.\n")
1595 :warning)
1596 (setq buffer-undo-list nil)
1597 t))
1551 1598
1552(defvar shell-command-history nil 1599(defvar shell-command-history nil
1553 "History list for some commands that read shell commands.") 1600 "History list for some commands that read shell commands.")
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index c554b74cf0c..3f3529f2aa5 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -44,8 +44,8 @@
44;; country and language. 44;; country and language.
45;; Most dictionary changes should be made in this file so all users can 45;; Most dictionary changes should be made in this file so all users can
46;; enjoy them. Local or modified dictionaries are supported in your .emacs 46;; enjoy them. Local or modified dictionaries are supported in your .emacs
47;; file. Modify the variable `ispell-local-dictionary-alist' to include 47;; file. Use the variable `ispell-local-dictionary-alist' to specify
48;; these dictionaries, and they will be installed when ispell.el is loaded. 48;; your own dictionaries.
49 49
50;; Depending on the mail system you use, you may want to include these: 50;; Depending on the mail system you use, you may want to include these:
51;; (add-hook 'news-inews-hook 'ispell-message) 51;; (add-hook 'news-inews-hook 'ispell-message)
@@ -428,29 +428,27 @@ where DICTNAME is the name of your default dictionary."
428 :type 'boolean 428 :type 'boolean
429 :group 'ispell) 429 :group 'ispell)
430 430
431;;; This is the local dictionary to use. When nil the default dictionary will 431(defvar ispell-local-dictionary-overridden nil
432;;; be used. Change set-default call to use a new default dictionary. 432 "Non-nil means the user has explicitly set this buffer's Ispell dictionary.")
433(make-variable-buffer-local 'ispell-local-dictionary)
434
433(defcustom ispell-local-dictionary nil 435(defcustom ispell-local-dictionary nil
434 "If non-nil, the dictionary to be used for Ispell commands. 436 "If non-nil, the dictionary to be used for Ispell commands in this buffer.
435The value must be a string dictionary name in `ispell-dictionary-alist'. 437The value must be a string dictionary name,
438or nil, which means use the global setting in `ispell-dictionary'.
439Dictionary names are defined in `ispell-local-dictionary-alist'
440and `ispell-dictionary-alist',
436 441
437Setting `ispell-local-dictionary' to a value has the same effect as 442Setting `ispell-local-dictionary' to a value has the same effect as
438calling \\[ispell-change-dictionary] with that value. This variable 443calling \\[ispell-change-dictionary] with that value. This variable
439is automatically set when defined in the file with either 444is automatically set when defined in the file with either
440`ispell-dictionary-keyword' or the Local Variable syntax. 445`ispell-dictionary-keyword' or the Local Variable syntax."
441
442To create a non-standard default dictionary (not from `ispell-dictionary-alist')
443call function `set-default' with the new dictionary name."
444 :type '(choice string 446 :type '(choice string
445 (const :tag "default" nil)) 447 (const :tag "default" nil))
446 :group 'ispell) 448 :group 'ispell)
447 449
448(make-variable-buffer-local 'ispell-local-dictionary) 450(make-variable-buffer-local 'ispell-local-dictionary)
449 451
450;; Call this function set up the default dictionary if not English.
451;;(set-default 'ispell-local-dictionary nil)
452
453
454(defcustom ispell-extra-args nil 452(defcustom ispell-extra-args nil
455 "*If non-nil, a list of extra switches to pass to the Ispell program. 453 "*If non-nil, a list of extra switches to pass to the Ispell program.
456For example, (\"-W\" \"3\") to cause it to accept all 1-3 character 454For example, (\"-W\" \"3\") to cause it to accept all 1-3 character
@@ -473,17 +471,14 @@ buffer's major mode."
473(make-variable-buffer-local 'ispell-skip-html) 471(make-variable-buffer-local 'ispell-skip-html)
474 472
475 473
476;;; Define definitions here only for personal dictionaries.
477;;;###autoload 474;;;###autoload
478(defcustom ispell-local-dictionary-alist nil 475(defcustom ispell-local-dictionary-alist nil
479 "*Contains local or customized dictionary definitions. 476 "*List of local or customized dictionary definitions.
477These can override the values in `ispell-dictionary-alist'.
480 478
481These will override the values in `ispell-dictionary-alist'. 479To make permanent changes to your dictionary definitions, you
482 480will need to make your changes in this variable, save, and then
483Customization changes made to `ispell-dictionary-alist' will not operate 481re-start emacs."
484over emacs sessions. To make permanent changes to your dictionary
485definitions, you will need to make your changes in this variable, save,
486and then re-start emacs."
487 :type '(repeat (list (choice :tag "Dictionary" 482 :type '(repeat (list (choice :tag "Dictionary"
488 (string :tag "Dictionary name") 483 (string :tag "Dictionary name")
489 (const :tag "default" nil)) 484 (const :tag "default" nil))
@@ -646,9 +641,8 @@ and then re-start emacs."
646 641
647 642
648;;;###autoload 643;;;###autoload
649(defcustom ispell-dictionary-alist 644(defvar ispell-dictionary-alist
650 (append ispell-local-dictionary-alist ; dictionary customizations 645 (append ispell-dictionary-alist-1 ispell-dictionary-alist-2
651 ispell-dictionary-alist-1 ispell-dictionary-alist-2
652 ispell-dictionary-alist-3 ispell-dictionary-alist-4 646 ispell-dictionary-alist-3 ispell-dictionary-alist-4
653 ispell-dictionary-alist-5 ispell-dictionary-alist-6) 647 ispell-dictionary-alist-5 ispell-dictionary-alist-6)
654 "An alist of dictionaries and their associated parameters. 648 "An alist of dictionaries and their associated parameters.
@@ -696,33 +690,7 @@ CHARACTER-SET used for languages with multibyte characters.
696 690
697Note that the CASECHARS and OTHERCHARS slots of the alist should 691Note that the CASECHARS and OTHERCHARS slots of the alist should
698contain the same character set as casechars and otherchars in the 692contain the same character set as casechars and otherchars in the
699LANGUAGE.aff file \(e.g., english.aff\)." 693LANGUAGE.aff file \(e.g., english.aff\).")
700 :type '(repeat (list (choice :tag "Dictionary"
701 (string :tag "Dictionary name")
702 (const :tag "default" nil))
703 (regexp :tag "Case characters")
704 (regexp :tag "Non case characters")
705 (regexp :tag "Other characters")
706 (boolean :tag "Many other characters")
707 (repeat :tag "Ispell command line args"
708 (string :tag "Arg"))
709 (choice :tag "Extended character mode"
710 (const "~tex") (const "~plaintex")
711 (const "~nroff") (const "~list")
712 (const "~latin1") (const "~latin3")
713 (const :tag "default" nil))
714 (choice :tag "Coding System"
715 (const iso-8859-1)
716 (const iso-8859-2)
717 (const koi8-r))))
718 :group 'ispell)
719
720;;; update the dictionaries at load time
721(setq ispell-dictionary-alist
722 (append ispell-local-dictionary-alist ; dictionary customizations
723 ispell-dictionary-alist-1 ispell-dictionary-alist-2
724 ispell-dictionary-alist-3 ispell-dictionary-alist-4
725 ispell-dictionary-alist-5 ispell-dictionary-alist-6))
726 694
727(defvar ispell-really-aspell nil) ; Non-nil if aspell extensions should be used 695(defvar ispell-really-aspell nil) ; Non-nil if aspell extensions should be used
728 696
@@ -877,7 +845,7 @@ and added as a submenu of the \"Edit\" menu.")
877(defun ispell-valid-dictionary-list () 845(defun ispell-valid-dictionary-list ()
878 "Returns a list of valid dictionaries. 846 "Returns a list of valid dictionaries.
879The variable `ispell-library-directory' defines the library location." 847The variable `ispell-library-directory' defines the library location."
880 (let ((dicts ispell-dictionary-alist) 848 (let ((dicts (append ispell-local-dictionary-alist ispell-dictionary-alist))
881 (dict-list (cons "default" nil)) 849 (dict-list (cons "default" nil))
882 name load-dict) 850 name load-dict)
883 (dolist (dict dicts) 851 (dolist (dict dicts)
@@ -899,11 +867,12 @@ The variable `ispell-library-directory' defines the library location."
899 (setq dict-list (cons name dict-list)))) 867 (setq dict-list (cons name dict-list))))
900 dict-list)) 868 dict-list))
901 869
902
903;;;###autoload 870;;;###autoload
904(if ispell-menu-map-needed 871(if ispell-menu-map-needed
905 (let ((dicts (if (fboundp 'ispell-valid-dictionary-list) 872 (let ((dicts (if (fboundp 'ispell-valid-dictionary-list)
906 (ispell-valid-dictionary-list) 873 (ispell-valid-dictionary-list)
874 ;; This case is used in loaddefs.el
875 ;; since ispell-valid-dictionary-list isn't defined then.
907 (mapcar (lambda (x) (or (car x) "default")) 876 (mapcar (lambda (x) (or (car x) "default"))
908 ispell-dictionary-alist))) 877 ispell-dictionary-alist)))
909 (dict-map (make-sparse-keymap "Dictionaries"))) 878 (dict-map (make-sparse-keymap "Dictionaries")))
@@ -1054,14 +1023,14 @@ The variable `ispell-library-directory' defines the library location."
1054 1023
1055 1024
1056;;; This variable contains the current dictionary being used if the ispell 1025;;; This variable contains the current dictionary being used if the ispell
1057;;; process is running. Otherwise it contains the global default. 1026;;; process is running.
1058(defvar ispell-dictionary nil 1027(defvar ispell-current-dictionary nil
1059 "The name of the current dictionary, or nil for the default. 1028 "The name of the current dictionary, or nil for the default.
1060When `ispell-local-dictionary' is nil, `ispell-dictionary' is used to select
1061the dictionary for new buffers.
1062
1063This is passed to the ispell process using the `-d' switch and is 1029This is passed to the ispell process using the `-d' switch and is
1064used as key in `ispell-dictionary-alist' (which see).") 1030used as key in `ispell-local-dictionary-alist' and `ispell-dictionary-alist'.")
1031
1032(defvar ispell-dictionary nil
1033 "Default dictionary to use if `ispell-local-dictionary' is nil.")
1065 1034
1066(defun ispell-decode-string (str) 1035(defun ispell-decode-string (str)
1067 "Decodes multibyte character strings. 1036 "Decodes multibyte character strings.
@@ -1076,7 +1045,9 @@ Protects against bogus binding of `enable-multibyte-characters' in XEmacs."
1076 1045
1077;; Return a string decoded from Nth element of the current dictionary. 1046;; Return a string decoded from Nth element of the current dictionary.
1078(defun ispell-get-decoded-string (n) 1047(defun ispell-get-decoded-string (n)
1079 (let* ((slot (assoc ispell-dictionary ispell-dictionary-alist)) 1048 (let* ((slot (or
1049 (assoc ispell-current-dictionary ispell-local-dictionary-alist)
1050 (assoc ispell-current-dictionary ispell-dictionary-alist)))
1080 (str (nth n slot))) 1051 (str (nth n slot)))
1081 (when (and (> (length str) 0) 1052 (when (and (> (length str) 0)
1082 (not (multibyte-string-p str))) 1053 (not (multibyte-string-p str)))
@@ -1093,13 +1064,17 @@ Protects against bogus binding of `enable-multibyte-characters' in XEmacs."
1093(defun ispell-get-otherchars () 1064(defun ispell-get-otherchars ()
1094 (ispell-get-decoded-string 3)) 1065 (ispell-get-decoded-string 3))
1095(defun ispell-get-many-otherchars-p () 1066(defun ispell-get-many-otherchars-p ()
1096 (nth 4 (assoc ispell-dictionary ispell-dictionary-alist))) 1067 (nth 4 (or (assoc ispell-current-dictionary ispell-local-dictionary-alist)
1068 (assoc ispell-current-dictionary ispell-dictionary-alist))))
1097(defun ispell-get-ispell-args () 1069(defun ispell-get-ispell-args ()
1098 (nth 5 (assoc ispell-dictionary ispell-dictionary-alist))) 1070 (nth 5 (or (assoc ispell-current-dictionary ispell-local-dictionary-alist)
1071 (assoc ispell-current-dictionary ispell-dictionary-alist))))
1099(defun ispell-get-extended-character-mode () 1072(defun ispell-get-extended-character-mode ()
1100 (nth 6 (assoc ispell-dictionary ispell-dictionary-alist))) 1073 (nth 6 (or (assoc ispell-current-dictionary ispell-local-dictionary-alist)
1074 (assoc ispell-current-dictionary ispell-dictionary-alist))))
1101(defun ispell-get-coding-system () 1075(defun ispell-get-coding-system ()
1102 (nth 7 (assoc ispell-dictionary ispell-dictionary-alist))) 1076 (nth 7 (or (assoc ispell-current-dictionary ispell-local-dictionary-alist)
1077 (assoc ispell-current-dictionary ispell-dictionary-alist))))
1103 1078
1104 1079
1105(defvar ispell-pdict-modified-p nil 1080(defvar ispell-pdict-modified-p nil
@@ -1151,8 +1126,9 @@ There can be multiple of these keywords in the file.")
1151 1126
1152(defconst ispell-dictionary-keyword "Local IspellDict: " 1127(defconst ispell-dictionary-keyword "Local IspellDict: "
1153 "The keyword for a local dictionary to use. 1128 "The keyword for a local dictionary to use.
1154The keyword must be followed by a correct dictionary name in 1129The keyword must be followed by a valid dictionary name, defined in
1155`ispell-dictionary-alist'. When multiple occurrences exist, the last keyword 1130`ispell-local-dictionary-alist' or `ispell-dictionary-alist'.
1131When multiple occurrences exist, the last keyword
1156definition is used.") 1132definition is used.")
1157 1133
1158(defconst ispell-pdict-keyword "Local IspellPersDict: " 1134(defconst ispell-pdict-keyword "Local IspellPersDict: "
@@ -1409,7 +1385,8 @@ when called interactively, non-corrective messages are suppressed.
1409With a prefix argument (or if CONTINUE is non-nil), 1385With a prefix argument (or if CONTINUE is non-nil),
1410resume interrupted spell-checking of a buffer or region. 1386resume interrupted spell-checking of a buffer or region.
1411 1387
1412Word syntax described by `ispell-dictionary-alist' (which see). 1388Word syntax is controlled by the definition of the chosen dictionary,
1389which is in `ispell-local-dictionary-alist' or `ispell-dictionary-alist'.
1413 1390
1414This will check or reload the dictionary. Use \\[ispell-change-dictionary] 1391This will check or reload the dictionary. Use \\[ispell-change-dictionary]
1415or \\[ispell-region] to update the Ispell process. 1392or \\[ispell-region] to update the Ispell process.
@@ -1519,7 +1496,8 @@ is non-nil when called interactively, then the following word
1519Optional second argument contains otherchars that can be included in word 1496Optional second argument contains otherchars that can be included in word
1520many times. 1497many times.
1521 1498
1522Word syntax described by `ispell-dictionary-alist' (which see)." 1499Word syntax is controlled by the definition of the chosen dictionary,
1500which is in `ispell-local-dictionary-alist' or `ispell-dictionary-alist'."
1523 (let* ((ispell-casechars (ispell-get-casechars)) 1501 (let* ((ispell-casechars (ispell-get-casechars))
1524 (ispell-not-casechars (ispell-get-not-casechars)) 1502 (ispell-not-casechars (ispell-get-not-casechars))
1525 (ispell-otherchars (ispell-get-otherchars)) 1503 (ispell-otherchars (ispell-get-otherchars))
@@ -2279,13 +2257,13 @@ When asynchronous processes are not supported, `run' is always returned."
2279Keeps argument list for future ispell invocations for no async support." 2257Keeps argument list for future ispell invocations for no async support."
2280 (let (args) 2258 (let (args)
2281 ;; Local dictionary becomes the global dictionary in use. 2259 ;; Local dictionary becomes the global dictionary in use.
2282 (if ispell-local-dictionary 2260 (setq ispell-current-dictionary
2283 (setq ispell-dictionary ispell-local-dictionary)) 2261 (or ispell-local-dictionary ispell-dictionary))
2284 (setq args (ispell-get-ispell-args)) 2262 (setq args (ispell-get-ispell-args))
2285 (if (and ispell-dictionary ; use specified dictionary 2263 (if (and ispell-current-dictionary ; use specified dictionary
2286 (not (member "-d" args))) ; only define if not overridden 2264 (not (member "-d" args))) ; only define if not overridden
2287 (setq args 2265 (setq args
2288 (append (list "-d" ispell-dictionary) args))) 2266 (append (list "-d" ispell-current-dictionary) args)))
2289 (if ispell-personal-dictionary ; use specified pers dict 2267 (if ispell-personal-dictionary ; use specified pers dict
2290 (setq args 2268 (setq args
2291 (append args 2269 (append args
@@ -2401,9 +2379,7 @@ With NO-ERROR, just return non-nil if there was no Ispell running."
2401 2379
2402;;;###autoload 2380;;;###autoload
2403(defun ispell-change-dictionary (dict &optional arg) 2381(defun ispell-change-dictionary (dict &optional arg)
2404 "Change `ispell-dictionary' (q.v.) to DICT and kill old Ispell process. 2382 "Change to dictionary DICT for Ispell.
2405A new one will be started as soon as necessary.
2406
2407By just answering RET you can find out what the current dictionary is. 2383By just answering RET you can find out what the current dictionary is.
2408 2384
2409With prefix argument, set the default dictionary." 2385With prefix argument, set the default dictionary."
@@ -2411,39 +2387,42 @@ With prefix argument, set the default dictionary."
2411 (list (completing-read 2387 (list (completing-read
2412 "Use new dictionary (RET for current, SPC to complete): " 2388 "Use new dictionary (RET for current, SPC to complete): "
2413 (and (fboundp 'ispell-valid-dictionary-list) 2389 (and (fboundp 'ispell-valid-dictionary-list)
2414 (mapcar (lambda (x)(cons x nil)) (ispell-valid-dictionary-list))) 2390 (mapcar 'list (ispell-valid-dictionary-list)))
2415 nil t) 2391 nil t)
2416 current-prefix-arg)) 2392 current-prefix-arg))
2393 (unless arg (ispell-accept-buffer-local-defs))
2417 (if (equal dict "default") (setq dict nil)) 2394 (if (equal dict "default") (setq dict nil))
2418 ;; This relies on completing-read's bug of returning "" for no match 2395 ;; This relies on completing-read's bug of returning "" for no match
2419 (cond ((equal dict "") 2396 (cond ((equal dict "")
2420 (message "Using %s dictionary" 2397 (message "Using %s dictionary"
2421 (or ispell-local-dictionary ispell-dictionary "default"))) 2398 (or ispell-local-dictionary ispell-dictionary "default")))
2422 ((and (equal dict ispell-dictionary) 2399 ((equal dict (or ispell-local-dictionary
2423 (or (null ispell-local-dictionary) 2400 ispell-dictionary "default"))
2424 (equal dict ispell-local-dictionary)))
2425 ;; Specified dictionary is the default already. No-op 2401 ;; Specified dictionary is the default already. No-op
2426 (and (interactive-p) 2402 (and (interactive-p)
2427 (message "No change, using %s dictionary" (or dict "default")))) 2403 (message "No change, using %s dictionary" dict)))
2428 (t ; reset dictionary! 2404 (t ; reset dictionary!
2429 (if (assoc dict ispell-dictionary-alist) 2405 (if (or (assoc dict ispell-local-dictionary-alist)
2430 (progn 2406 (assoc dict ispell-dictionary-alist))
2431 (if (or arg (null dict)) ; set default dictionary 2407 (if arg
2432 (setq ispell-dictionary dict)) 2408 ;; set default dictionary
2433 (if (null arg) ; set local dictionary 2409 (setq ispell-dictionary dict)
2434 (setq ispell-local-dictionary dict))) 2410 ;; set local dictionary
2411 (setq ispell-local-dictionary dict)
2412 (setq ispell-local-dictionary-overridden t))
2435 (error "Undefined dictionary: %s" dict)) 2413 (error "Undefined dictionary: %s" dict))
2436 (ispell-kill-ispell t) 2414 (message "%s Ispell dictionary set to %s"
2437 (message "(Next %sIspell command will use %s dictionary)" 2415 (if arg "Global" "Local")
2438 (cond ((equal ispell-local-dictionary ispell-dictionary) 2416 dict))))
2439 "") 2417
2440 (arg "global ") 2418(defun ispell-internal-change-dictionary ()
2441 (t "local ")) 2419 "Update the dictionary actually used by Ispell.
2442 (or (if (or (equal ispell-local-dictionary ispell-dictionary) 2420This may kill the Ispell process; if so,
2443 (null arg)) 2421a new one will be started when needed."
2444 ispell-local-dictionary 2422 (let ((dict (or ispell-local-dictionary ispell-dictionary "default")))
2445 ispell-dictionary) 2423 (unless (equal ispell-current-dictionary dict)
2446 "default"))))) 2424 (setq ispell-current-dictionary dict)
2425 (ispell-kill-ispell t))))
2447 2426
2448 2427
2449;;; Spelling of comments are checked when ispell-check-comments is non-nil. 2428;;; Spelling of comments are checked when ispell-check-comments is non-nil.
@@ -2463,7 +2442,7 @@ Return nil if spell session is quit,
2463 (message "Spell checking %s using %s dictionary..." 2442 (message "Spell checking %s using %s dictionary..."
2464 (if (and (= reg-start (point-min)) (= reg-end (point-max))) 2443 (if (and (= reg-start (point-min)) (= reg-end (point-max)))
2465 (buffer-name) "region") 2444 (buffer-name) "region")
2466 (or ispell-dictionary "default")) 2445 (or ispell-current-dictionary "default"))
2467 ;; Returns cursor to original location. 2446 ;; Returns cursor to original location.
2468 (save-window-excursion 2447 (save-window-excursion
2469 (goto-char reg-start) 2448 (goto-char reg-start)
@@ -2481,7 +2460,7 @@ Return nil if spell session is quit,
2481 (goto-char reg-start))) 2460 (goto-char reg-start)))
2482 (let (message-log-max) 2461 (let (message-log-max)
2483 (message "Continuing spelling check using %s dictionary..." 2462 (message "Continuing spelling check using %s dictionary..."
2484 (or ispell-dictionary "default"))) 2463 (or ispell-current-dictionary "default")))
2485 (set-marker rstart reg-start) 2464 (set-marker rstart reg-start)
2486 (set-marker ispell-region-end reg-end) 2465 (set-marker ispell-region-end reg-end)
2487 (while (and (not ispell-quit) 2466 (while (and (not ispell-quit)
@@ -2911,7 +2890,7 @@ Returns the sum shift due to changes in word replacements."
2911 (if (not ispell-quit) 2890 (if (not ispell-quit)
2912 (let (message-log-max) 2891 (let (message-log-max)
2913 (message "Continuing spelling check using %s dictionary..." 2892 (message "Continuing spelling check using %s dictionary..."
2914 (or ispell-dictionary "default")))) 2893 (or ispell-current-dictionary "default"))))
2915 (sit-for 0) 2894 (sit-for 0)
2916 (setq start (marker-position line-start) 2895 (setq start (marker-position line-start)
2917 end (marker-position line-end)) 2896 end (marker-position line-end))
@@ -3481,14 +3460,15 @@ Both should not be used to define a buffer-local dictionary."
3481 ;; Override the local variable definition. 3460 ;; Override the local variable definition.
3482 ;; Uses last occurrence of ispell-dictionary-keyword. 3461 ;; Uses last occurrence of ispell-dictionary-keyword.
3483 (goto-char (point-max)) 3462 (goto-char (point-max))
3484 (if (search-backward ispell-dictionary-keyword nil t) 3463 (unless ispell-local-dictionary-overridden
3485 (progn 3464 (if (search-backward ispell-dictionary-keyword nil t)
3486 (search-forward ispell-dictionary-keyword) 3465 (progn
3487 (setq end (save-excursion (end-of-line) (point))) 3466 (search-forward ispell-dictionary-keyword)
3488 (if (re-search-forward " *\\([^ \"]+\\)" end t) 3467 (setq end (save-excursion (end-of-line) (point)))
3489 (setq ispell-local-dictionary 3468 (if (re-search-forward " *\\([^ \"]+\\)" end t)
3490 (buffer-substring-no-properties (match-beginning 1) 3469 (setq ispell-local-dictionary
3491 (match-end 1)))))) 3470 (buffer-substring-no-properties (match-beginning 1)
3471 (match-end 1)))))))
3492 (goto-char (point-max)) 3472 (goto-char (point-max))
3493 (if (search-backward ispell-pdict-keyword nil t) 3473 (if (search-backward ispell-pdict-keyword nil t)
3494 (progn 3474 (progn
@@ -3505,8 +3485,7 @@ Both should not be used to define a buffer-local dictionary."
3505 (ispell-kill-ispell t) 3485 (ispell-kill-ispell t)
3506 (setq ispell-personal-dictionary ispell-local-pdict))) 3486 (setq ispell-personal-dictionary ispell-local-pdict)))
3507 ;; Reload if new dictionary defined. 3487 ;; Reload if new dictionary defined.
3508 (if (not (equal ispell-local-dictionary ispell-dictionary)) 3488 (ispell-internal-change-dictionary))
3509 (ispell-change-dictionary ispell-local-dictionary)))
3510 3489
3511 3490
3512(defun ispell-buffer-local-words () 3491(defun ispell-buffer-local-words ()
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 6c985bbf265..58236e4225f 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -391,7 +391,11 @@ new value.")
391 (overlay-put overlay 'evaporate t) 391 (overlay-put overlay 'evaporate t)
392 ;; We want to avoid the face with image buttons. 392 ;; We want to avoid the face with image buttons.
393 (unless (widget-get widget :suppress-face) 393 (unless (widget-get widget :suppress-face)
394 (overlay-put overlay 'face (widget-apply widget :button-face-get))) 394 (overlay-put overlay 'face (widget-apply widget :button-face-get))
395 ; Text terminals cannot change mouse pointer shape, so use mouse
396 ; face instead.
397 (or (display-graphic-p)
398 (overlay-put overlay 'mouse-face widget-mouse-face)))
395 (overlay-put overlay 'pointer 'hand) 399 (overlay-put overlay 'pointer 'hand)
396 (overlay-put overlay 'follow-link follow-link) 400 (overlay-put overlay 'follow-link follow-link)
397 (overlay-put overlay 'help-echo help-echo))) 401 (overlay-put overlay 'help-echo help-echo)))
@@ -911,14 +915,14 @@ Recommended as a parent keymap for modes using widgets.")
911 ;; until we receive a release event. Highlight/ 915 ;; until we receive a release event. Highlight/
912 ;; unhighlight the button the mouse was initially 916 ;; unhighlight the button the mouse was initially
913 ;; on when we move over it. 917 ;; on when we move over it.
914 (let ((track-mouse t)) 918 (save-excursion
915 (save-excursion 919 (when face ; avoid changing around image
916 (when face ; avoid changing around image 920 (overlay-put overlay
917 (overlay-put overlay 921 'face widget-button-pressed-face)
918 'face widget-button-pressed-face) 922 (overlay-put overlay
919 (overlay-put overlay 923 'mouse-face widget-button-pressed-face))
920 'mouse-face widget-button-pressed-face)) 924 (unless (widget-apply button :mouse-down-action event)
921 (unless (widget-apply button :mouse-down-action event) 925 (let ((track-mouse t))
922 (while (not (widget-button-release-event-p event)) 926 (while (not (widget-button-release-event-p event))
923 (setq event (read-event) 927 (setq event (read-event)
924 pos (widget-event-point event)) 928 pos (widget-event-point event))
@@ -933,13 +937,13 @@ Recommended as a parent keymap for modes using widgets.")
933 'mouse-face 937 'mouse-face
934 widget-button-pressed-face)) 938 widget-button-pressed-face))
935 (overlay-put overlay 'face face) 939 (overlay-put overlay 'face face)
936 (overlay-put overlay 'mouse-face mouse-face)))) 940 (overlay-put overlay 'mouse-face mouse-face)))))
937 941
938 ;; When mouse is released over the button, run 942 ;; When mouse is released over the button, run
939 ;; its action function. 943 ;; its action function.
940 (when (and pos 944 (when (and pos
941 (eq (get-char-property pos 'button) button)) 945 (eq (get-char-property pos 'button) button))
942 (widget-apply-action button event)))) 946 (widget-apply-action button event)))
943 (overlay-put overlay 'face face) 947 (overlay-put overlay 'face face)
944 (overlay-put overlay 'mouse-face mouse-face)))) 948 (overlay-put overlay 'mouse-face mouse-face))))
945 949
generated by cgit v1.2.1 (git 2.18.0) at 2026-04-02 08:34:51 +0000