aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorKenichi Handa2010-05-19 10:10:29 +0900
committerKenichi Handa2010-05-19 10:10:29 +0900
commit134d1bcded02e066727ece838f14ffc767f76419 (patch)
tree2187c2ac9748400146394bdaefd59f314598685d /lisp
parent2833d9158d6315b59415173df5d47515faac5310 (diff)
parent1fc0ce04bc651fe8adbe822515e4ea7a4e904249 (diff)
downloademacs-134d1bcded02e066727ece838f14ffc767f76419.tar.gz
emacs-134d1bcded02e066727ece838f14ffc767f76419.zip
merge trunk
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog129
-rw-r--r--lisp/Makefile.in9
-rw-r--r--lisp/bindings.el4
-rw-r--r--lisp/calc/README2
-rw-r--r--lisp/calc/calc-aent.el21
-rw-r--r--lisp/calc/calc-bin.el2
-rw-r--r--lisp/calc/calc-ext.el5
-rw-r--r--lisp/calc/calc-lang.el24
-rw-r--r--lisp/calc/calc-store.el2
-rw-r--r--lisp/calc/calc-units.el22
-rw-r--r--lisp/calc/calc-vec.el71
-rw-r--r--lisp/calc/calc.el3
-rw-r--r--lisp/calc/calccomp.el8
-rw-r--r--lisp/dos-fns.el35
-rw-r--r--lisp/emacs-lisp/lisp-mode.el6
-rw-r--r--lisp/emacs-lisp/smie.el688
-rw-r--r--lisp/files.el26
-rw-r--r--lisp/gnus/ChangeLog5
-rw-r--r--lisp/gnus/gnus-sum.el8
-rw-r--r--lisp/international/mule-cmds.el2
-rw-r--r--lisp/language/hebrew.el4
-rw-r--r--lisp/org/org-docview.el5
-rw-r--r--lisp/pcomplete.el17
-rw-r--r--lisp/progmodes/asm-mode.el12
-rw-r--r--lisp/progmodes/prolog.el135
-rw-r--r--lisp/progmodes/sh-script.el125
-rw-r--r--lisp/progmodes/sql.el32
-rw-r--r--lisp/simple.el19
-rw-r--r--lisp/subr.el25
-rw-r--r--lisp/version.el6
-rw-r--r--lisp/w32-fns.el13
31 files changed, 1172 insertions, 293 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 21d0e827f67..d0fc357c4ea 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -4,10 +4,127 @@
4 composition-function-table only for combining characters (Mn, Mc, 4 composition-function-table only for combining characters (Mn, Mc,
5 Me). 5 Me).
6 6
72010-05-18 Juanma Barranquero <lekktu@gmail.com>
8
9 * progmodes/prolog.el (smie-indent-basic): Declare for byte-compiler.
10
11 * emacs-lisp/smie.el (smie-precs-precedence-table, smie-backward-sexp)
12 (smie-forward-sexp, smie-indent-calculate): Fix typos in docstrings.
13
142010-05-17 Stefan Monnier <monnier@iro.umontreal.ca>
15
16 Provide a simple generic indentation engine and use it for Prolog.
17 * emacs-lisp/smie.el: New file.
18 * progmodes/prolog.el (prolog-smie-op-levels)
19 (prolog-smie-indent-rules): New var.
20 (prolog-mode-variables): Use them to configure SMIE.
21 (prolog-indent-line, prolog-indent-level): Remove.
22
232010-05-17 Jay Belanger <jay.p.belanger@gmail.com>
24
25 * calc/calc-vec.el (math-vector-avg): Put the vector elements in
26 order before computing the averages.
27
282010-05-16 Jay Belanger <jay.p.belanger@gmail.com>
29
30 * calc/calc-vec.el (calc-histogram):
31 (calcFunc-histogram): Allow vectors as inputs.
32 (math-vector-avg): New function.
33
34 * calc/calc-ext.el (math-group-float): Have the number of digits
35 being grouped depend on the radix (Bug#6189).
36
372010-05-15 Ken Raeburn <raeburn@raeburn.org>
38
39 * version.el (emacs-copyright, emacs-version): Don't define here,
40 now that emacs.c defines it.
41
422010-05-15 Eli Zaretskii <eliz@gnu.org>
43
44 * international/mule-cmds.el (mule-menu-keymap): Fix definition of
45 "Describe Language Environment" menu item.
46
47 * language/hebrew.el ("Hebrew", "Windows-1255"): Doc fix.
48
49 Bidi-sensitive movement with arrow keys.
50 * subr.el (right-arrow-command, left-arrow-command): New functions.
51
52 * bindings.el (global-map): Bind them to right and left arrow keys.
53
54 Don't override standard definition of convert-standard-filename.
55 * files.el (convert-standard-filename): Call
56 w32-convert-standard-filename and dos-convert-standard-filename on
57 the corresponding systems.
58
59 * w32-fns.el (w32-convert-standard-filename): Rename from
60 convert-standard-filename. Doc fix.
61
62 * dos-fns.el (dos-convert-standard-filename): Doc fix.
63 (convert-standard-filename): Don't defalias.
64 (register-name-alist, make-register, register-value)
65 (set-register-value, intdos): Obsolete aliases for the
66 corresponding dos-* functions and variables.
67 (dos-intdos): Add a doc string.
68
692010-05-15 Jay Belanger <jay.p.belanger@gmail.com>
70
71 * calc/calc-aent.el (math-read-token, math-find-user-tokens):
72 * calc/calc-lang.el (math-read-big-rec, math-lang-read-symbol):
73 (math-compose-tex-func):
74 * calc/calccomp.el (math-compose-expr):
75 * calc/calc-ext.el (math-format-flat-expr-fancy):
76 * calc/calc-store.el (calc-read-var-name):
77 * calc/calc-units.el (calc-explain-units-rec): Allow Greek letters.
78
79 * calc/calc.el (var-π, var-φ, var-γ): New variables.
80 * calc/calc-aent.el (math-read-replacement-list): Add "micro" symbol.
81 * calc/calc-units.el (math-unit-prefixes): Add mu for micro.
82 (math-standard-units): Add units.
83
842010-05-15 Stefan Monnier <monnier@iro.umontreal.ca>
85
86 * progmodes/asm-mode.el (asm-mode):
87 * progmodes/prolog.el (prolog-mode): Use define-derived-mode.
88
89 * pcomplete.el (pcomplete-completions-at-point): New function,
90 extracted from pcomplete-std-complete.
91 (pcomplete-std-complete): Use it.
92
932010-05-15 Glenn Morris <rgm@gnu.org>
94
95 * Makefile.in (setwins, setwins_almost, setwins_for_subdirs):
96 Remove references to CVS, RCS and Old directories.
97
982010-05-14 Jay Belanger <jay.p.belanger@gmail.com>
99
100 * calc/calc-bin.el (math-format-twos-complement): Group digits when
101 appropriate.
102
1032010-05-14 Stefan Monnier <monnier@iro.umontreal.ca>
104
105 * progmodes/sh-script.el (sh-mode-default-syntax-table): Remove.
106 (sh-mode-syntax-table): Give it a default value instead.
107 (sh-header-marker): Make buffer-local.
108 (sh-mode): Move make-local-variable to the corresponding setq.
109 (sh-add-completer): Avoid gratuitously let-binding a buffer-local var.
110 Use complete-with-action.
111
112 * simple.el (prog-mode): New (abstract) major mode.
113 * emacs-lisp/lisp-mode.el (emacs-lisp-mode, lisp-mode): Use it.
114 * progmodes/sh-script.el (sh-mode): Remove redundant var assignment.
115
1162010-05-14 Juanma Barranquero <lekktu@gmail.com>
117
118 * progmodes/sql.el (sql-oracle-program): Reflow docstring.
119 (sql-oracle-scan-on, sql-sybase-program, sql-product-font-lock)
120 (sql-add-product-keywords, sql-highlight-product, sql-set-product)
121 (sql-make-alternate-buffer-name, sql-placeholders-filter)
122 (sql-escape-newlines-filter, sql-input-sender)
123 (sql-send-magic-terminator, sql-sybase): Fix typos in docstrings.
124
72010-05-13 Chong Yidong <cyd@stupidchicken.com> 1252010-05-13 Chong Yidong <cyd@stupidchicken.com>
8 126
9 Add TeX open-block and close-block keybindings to SGML, and vice 127 Add TeX open-block and close-block keybindings to SGML, and vice versa.
10 versa.
11 128
12 * textmodes/tex-mode.el (tex-mode-map): Bind C-c C-t to 129 * textmodes/tex-mode.el (tex-mode-map): Bind C-c C-t to
13 latex-open-block and C-c / to latex-close-block. 130 latex-open-block and C-c / to latex-close-block.
@@ -21,8 +138,8 @@
21 only when the message would be displayed. Handled nested calls. 138 only when the message would be displayed. Handled nested calls.
22 (tramp-handle-load, tramp-handle-file-local-copy) 139 (tramp-handle-load, tramp-handle-file-local-copy)
23 (tramp-handle-insert-file-contents, tramp-handle-write-region) 140 (tramp-handle-insert-file-contents, tramp-handle-write-region)
24 (tramp-maybe-send-script, tramp-find-shell): Use 141 (tramp-maybe-send-script, tramp-find-shell):
25 `with-progress-reporter'. 142 Use `with-progress-reporter'.
26 (tramp-handle-dired-compress-file, tramp-maybe-open-connection): 143 (tramp-handle-dired-compress-file, tramp-maybe-open-connection):
27 Fix message text. 144 Fix message text.
28 145
@@ -313,7 +430,7 @@
313 430
314 * Version 23.2 released. 431 * Version 23.2 released.
315 432
3162010-05-07 Deniz Dogan <deniz.a.m.dogan@gmail.com> (tiny change) 4332010-05-07 Deniz Dogan <deniz.a.m.dogan@gmail.com> (tiny change)
317 Stefan Monnier <monnier@iro.umontreal.ca> 434 Stefan Monnier <monnier@iro.umontreal.ca>
318 435
319 Highlight vendor specific properties. 436 Highlight vendor specific properties.
@@ -334,7 +451,7 @@
334 * simple.el (auto-save-mode): Move from files.el. 451 * simple.el (auto-save-mode): Move from files.el.
335 * minibuffer.el (completion--common-suffix): Fix copy&paste error. 452 * minibuffer.el (completion--common-suffix): Fix copy&paste error.
336 453
3372010-05-07 Christian von Roques <roques@mti.ag> (tiny change) 4542010-05-07 Christian von Roques <roques@mti.ag> (tiny change)
338 455
339 * lisp/epg.el (epg-key-capablity-alist): Add "D" flag (Bug#5592). 456 * lisp/epg.el (epg-key-capablity-alist): Add "D" flag (Bug#5592).
340 457
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index fe7dcfa4e99..4effdddff6a 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -84,28 +84,25 @@ COMPILE_FIRST = \
84emacs = EMACSLOADPATH=$(lisp) LC_ALL=C $(EMACS) $(EMACSOPT) 84emacs = EMACSLOADPATH=$(lisp) LC_ALL=C $(EMACS) $(EMACSOPT)
85 85
86# Common command to find subdirectories 86# Common command to find subdirectories
87
88setwins=subdirs=`(find . -type d -print)`; \ 87setwins=subdirs=`(find . -type d -print)`; \
89 for file in $$subdirs; do \ 88 for file in $$subdirs; do \
90 case $$file in */Old | */RCS | */CVS | */CVS/* | */.* | */.*/* | */=* ) ;; \ 89 case $$file in */.* | */.*/* | */=* ) ;; \
91 *) wins="$$wins $$file" ;; \ 90 *) wins="$$wins $$file" ;; \
92 esac; \ 91 esac; \
93 done 92 done
94 93
95# Find all subdirectories except `obsolete' and `term'. 94# Find all subdirectories except `obsolete' and `term'.
96
97setwins_almost=subdirs=`(find . -type d -print)`; \ 95setwins_almost=subdirs=`(find . -type d -print)`; \
98 for file in $$subdirs; do \ 96 for file in $$subdirs; do \
99 case $$file in */Old | */RCS | */CVS | */CVS/* | */.* | */.*/* | */=* | */obsolete | */term ) ;; \ 97 case $$file in */.* | */.*/* | */=* | */obsolete | */term ) ;; \
100 *) wins="$$wins $$file" ;; \ 98 *) wins="$$wins $$file" ;; \
101 esac; \ 99 esac; \
102 done 100 done
103 101
104# Find all subdirectories in which we might want to create subdirs.el 102# Find all subdirectories in which we might want to create subdirs.el
105
106setwins_for_subdirs=subdirs=`(find . -type d -print)`; \ 103setwins_for_subdirs=subdirs=`(find . -type d -print)`; \
107 for file in $$subdirs; do \ 104 for file in $$subdirs; do \
108 case $$file in */Old | */RCS | */CVS | */CVS/* | */.* | */.*/* | */=* | */cedet* ) ;; \ 105 case $$file in */.* | */.*/* | */=* | */cedet* ) ;; \
109 *) wins="$$wins $$file" ;; \ 106 *) wins="$$wins $$file" ;; \
110 esac; \ 107 esac; \
111 done 108 done
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 05a0ac8bc11..14cebfeda8f 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -828,9 +828,9 @@ is okay. See `mode-line-format'.")
828(define-key global-map [C-home] 'beginning-of-buffer) 828(define-key global-map [C-home] 'beginning-of-buffer)
829(define-key global-map [M-home] 'beginning-of-buffer-other-window) 829(define-key global-map [M-home] 'beginning-of-buffer-other-window)
830(define-key esc-map [home] 'beginning-of-buffer-other-window) 830(define-key esc-map [home] 'beginning-of-buffer-other-window)
831(define-key global-map [left] 'backward-char) 831(define-key global-map [left] 'left-arrow-command)
832(define-key global-map [up] 'previous-line) 832(define-key global-map [up] 'previous-line)
833(define-key global-map [right] 'forward-char) 833(define-key global-map [right] 'right-arrow-command)
834(define-key global-map [down] 'next-line) 834(define-key global-map [down] 'next-line)
835(define-key global-map [prior] 'scroll-down-command) 835(define-key global-map [prior] 'scroll-down-command)
836(define-key global-map [next] 'scroll-up-command) 836(define-key global-map [next] 'scroll-up-command)
diff --git a/lisp/calc/README b/lisp/calc/README
index 3e3acaebb27..4b32ada63ad 100644
--- a/lisp/calc/README
+++ b/lisp/calc/README
@@ -74,6 +74,8 @@ Summary of changes to "Calc"
74 74
75Emacs 24.1 75Emacs 24.1
76 76
77* Gave `calc-histogram' the option of using a vector to determine the bins.
78
77* Added "O" option prefix. 79* Added "O" option prefix.
78 80
79* Used "O" prefix to "d r" (`calc-radix') to turn on twos-complement mode. 81* Used "O" prefix to "d r" (`calc-radix') to turn on twos-complement mode.
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el
index 58e30a237f9..77a02b58c73 100644
--- a/lisp/calc/calc-aent.el
+++ b/lisp/calc/calc-aent.el
@@ -510,6 +510,7 @@ The value t means abort and give an error message.")
510 ("≥" ">=") 510 ("≥" ">=")
511 ("≦" "<=") 511 ("≦" "<=")
512 ("≧" ">=") 512 ("≧" ">=")
513 ("µ" "μ")
513 ;; fractions 514 ;; fractions
514 ("¼" "(1:4)") ; 1/4 515 ("¼" "(1:4)") ; 1/4
515 ("½" "(1:2)") ; 1/2 516 ("½" "(1:2)") ; 1/2
@@ -675,11 +676,11 @@ in Calc algebraic input.")
675 (cond ((and (stringp (car p)) 676 (cond ((and (stringp (car p))
676 (or (> (length (car p)) 1) (equal (car p) "$") 677 (or (> (length (car p)) 1) (equal (car p) "$")
677 (equal (car p) "\"")) 678 (equal (car p) "\""))
678 (string-match "[^a-zA-Z0-9]" (car p))) 679 (string-match "[^a-zA-Zα-ωΑ-Ω0-9]" (car p)))
679 (let ((s (regexp-quote (car p)))) 680 (let ((s (regexp-quote (car p))))
680 (if (string-match "\\`[a-zA-Z0-9]" s) 681 (if (string-match "\\`[a-zA-Zα-ωΑ-Ω0-9]" s)
681 (setq s (concat "\\<" s))) 682 (setq s (concat "\\<" s)))
682 (if (string-match "[a-zA-Z0-9]\\'" s) 683 (if (string-match "[a-zA-Zα-ωΑ-Ω0-9]\\'" s)
683 (setq s (concat s "\\>"))) 684 (setq s (concat s "\\>")))
684 (or (assoc s math-toks) 685 (or (assoc s math-toks)
685 (progn 686 (progn
@@ -718,15 +719,17 @@ in Calc algebraic input.")
718 math-expr-data (math-match-substring math-exp-str 0) 719 math-expr-data (math-match-substring math-exp-str 0)
719 math-exp-pos (match-end 0))) 720 math-exp-pos (match-end 0)))
720 ((or (and (>= ch ?a) (<= ch ?z)) 721 ((or (and (>= ch ?a) (<= ch ?z))
721 (and (>= ch ?A) (<= ch ?Z))) 722 (and (>= ch ?A) (<= ch ?Z))
723 (and (>= ch ?α) (<= ch ?ω))
724 (and (>= ch ?Α) (<= ch ?Ω)))
722 (string-match 725 (string-match
723 (cond 726 (cond
724 ((and (memq calc-language calc-lang-allow-underscores) 727 ((and (memq calc-language calc-lang-allow-underscores)
725 (memq calc-language calc-lang-allow-percentsigns)) 728 (memq calc-language calc-lang-allow-percentsigns))
726 "[a-zA-Z0-9_'#]*") 729 "[a-zA-Zα-ωΑ-Ω0-9_'#]*")
727 ((memq calc-language calc-lang-allow-underscores) 730 ((memq calc-language calc-lang-allow-underscores)
728 "[a-zA-Z0-9_#]*") 731 "[a-zA-Zα-ωΑ-Ω0-9_#]*")
729 (t "[a-zA-Z0-9'#]*")) 732 (t "[a-zA-Zα-ωΑ-Ω0-9'#]*"))
730 math-exp-str math-exp-pos) 733 math-exp-str math-exp-pos)
731 (setq math-exp-token 'symbol 734 (setq math-exp-token 'symbol
732 math-exp-pos (match-end 0) 735 math-exp-pos (match-end 0)
@@ -744,12 +747,12 @@ in Calc algebraic input.")
744 (or (eq math-exp-pos 0) 747 (or (eq math-exp-pos 0)
745 (and (not (memq calc-language 748 (and (not (memq calc-language
746 calc-lang-allow-underscores)) 749 calc-lang-allow-underscores))
747 (eq (string-match "[^])}\"a-zA-Z0-9'$]_" 750 (eq (string-match "[^])}\"a-zA-Zα-ωΑ-Ω0-9'$]_"
748 math-exp-str (1- math-exp-pos)) 751 math-exp-str (1- math-exp-pos))
749 (1- math-exp-pos)))))) 752 (1- math-exp-pos))))))
750 (or (and (memq calc-language calc-lang-c-type-hex) 753 (or (and (memq calc-language calc-lang-c-type-hex)
751 (string-match "0[xX][0-9a-fA-F]+" math-exp-str math-exp-pos)) 754 (string-match "0[xX][0-9a-fA-F]+" math-exp-str math-exp-pos))
752 (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\(0*\\([2-9]\\|1[0-4]\\)\\(#[#]?\\|\\^\\^\\)[0-9a-dA-D.]+[eE][-+_]?[0-9]+\\|0*\\([2-9]\\|[0-2][0-9]\\|3[0-6]\\)\\(#[#]?\\|\\^\\^\\)[0-9a-zA-Z:.]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?" 755 (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\(0*\\([2-9]\\|1[0-4]\\)\\(#[#]?\\|\\^\\^\\)[0-9a-dA-D.]+[eE][-+_]?[0-9]+\\|0*\\([2-9]\\|[0-2][0-9]\\|3[0-6]\\)\\(#[#]?\\|\\^\\^\\)[0-9a-zA-Zα-ωΑ-Ω:.]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?"
753 math-exp-str math-exp-pos)) 756 math-exp-str math-exp-pos))
754 (setq math-exp-token 'number 757 (setq math-exp-token 'number
755 math-expr-data (math-match-substring math-exp-str 0) 758 math-expr-data (math-match-substring math-exp-str 0)
diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el
index 0e31fbe681c..4ab698ea640 100644
--- a/lisp/calc/calc-bin.el
+++ b/lisp/calc/calc-bin.el
@@ -845,6 +845,8 @@ the size of a Calc bignum digit.")
845 (len (length num))) 845 (len (length num)))
846 (if (< len digs) 846 (if (< len digs)
847 (setq num (concat (make-string (- digs len) ?0) num)))) 847 (setq num (concat (make-string (- digs len) ?0) num))))
848 (when calc-group-digits
849 (setq num (math-group-float num)))
848 (concat 850 (concat
849 (number-to-string calc-number-radix) 851 (number-to-string calc-number-radix)
850 "##" 852 "##"
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index f6f8e3d03d9..17dc9293237 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -3283,7 +3283,7 @@ If X is not an error form, return 1."
3283 (concat "-" (math-format-flat-expr (nth 1 a) 1000))) 3283 (concat "-" (math-format-flat-expr (nth 1 a) 1000)))
3284 (t 3284 (t
3285 (concat (math-remove-dashes 3285 (concat (math-remove-dashes
3286 (if (string-match "\\`calcFunc-\\([a-zA-Z0-9']+\\)\\'" 3286 (if (string-match "\\`calcFunc-\\([a-zA-Zα-ωΑ-Ω0-9']+\\)\\'"
3287 (symbol-name (car a))) 3287 (symbol-name (car a)))
3288 (math-match-substring (symbol-name (car a)) 1) 3288 (math-match-substring (symbol-name (car a)) 1)
3289 (symbol-name (car a)))) 3289 (symbol-name (car a))))
@@ -3469,7 +3469,8 @@ If X is not an error form, return 1."
3469 3469
3470(defun math-group-float (str) ; [X X] 3470(defun math-group-float (str) ; [X X]
3471 (let* ((pt (or (string-match "[^0-9a-zA-Z]" str) (length str))) 3471 (let* ((pt (or (string-match "[^0-9a-zA-Z]" str) (length str)))
3472 (g (if (integerp calc-group-digits) (math-abs calc-group-digits) 3)) 3472 (g (if (integerp calc-group-digits) (math-abs calc-group-digits)
3473 (if (memq calc-number-radix '(2 16)) 4 3)))
3473 (i pt)) 3474 (i pt))
3474 (if (and (integerp calc-group-digits) (< calc-group-digits 0)) 3475 (if (and (integerp calc-group-digits) (< calc-group-digits 0))
3475 (while (< (setq i (+ (1+ i) g)) (length str)) 3476 (while (< (setq i (+ (1+ i) g)) (length str))
diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el
index cd30232feee..0ebf1a18fef 100644
--- a/lisp/calc/calc-lang.el
+++ b/lisp/calc/calc-lang.el
@@ -214,7 +214,7 @@
214(put 'pascal 'math-lang-read-symbol 214(put 'pascal 'math-lang-read-symbol
215 '((?\$ 215 '((?\$
216 (eq (string-match 216 (eq (string-match
217 "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Z]\\)" 217 "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Zα-ωΑ-Ω]\\)"
218 math-exp-str math-exp-pos) 218 math-exp-str math-exp-pos)
219 math-exp-pos) 219 math-exp-pos)
220 (setq math-exp-token 'number 220 (setq math-exp-token 'number
@@ -312,7 +312,7 @@
312 312
313(put 'fortran 'math-lang-read-symbol 313(put 'fortran 'math-lang-read-symbol
314 '((?\. 314 '((?\.
315 (eq (string-match "\\.[a-zA-Z][a-zA-Z][a-zA-Z]?\\." 315 (eq (string-match "\\.[a-zA-Zα-ωΑ-Ω][a-zA-Zα-ωΑ-Ω][a-zA-Zα-ωΑ-Ω]?\\."
316 math-exp-str math-exp-pos) math-exp-pos) 316 math-exp-str math-exp-pos) math-exp-pos)
317 (setq math-exp-token 'punc 317 (setq math-exp-token 'punc
318 math-expr-data (upcase (math-match-substring math-exp-str 0)) 318 math-expr-data (upcase (math-match-substring math-exp-str 0))
@@ -603,9 +603,9 @@
603 '((?\\ 603 '((?\\
604 (< math-exp-pos (1- (length math-exp-str))) 604 (< math-exp-pos (1- (length math-exp-str)))
605 (progn 605 (progn
606 (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}" 606 (or (string-match "\\\\hbox *{\\([a-zA-Zα-ωΑ-Ω0-9]+\\)}"
607 math-exp-str math-exp-pos) 607 math-exp-str math-exp-pos)
608 (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)" 608 (string-match "\\(\\\\\\([a-zA-Zα-ωΑ-Ω]+\\|[^a-zA-Zα-ωΑ-Ω]\\)\\)"
609 math-exp-str math-exp-pos)) 609 math-exp-str math-exp-pos))
610 (setq math-exp-token 'symbol 610 (setq math-exp-token 'symbol
611 math-exp-pos (match-end 0) 611 math-exp-pos (match-end 0)
@@ -691,7 +691,7 @@
691(defun math-compose-tex-var (a prec) 691(defun math-compose-tex-var (a prec)
692 (if (and calc-language-option 692 (if (and calc-language-option
693 (not (= calc-language-option 0)) 693 (not (= calc-language-option 0))
694 (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" 694 (string-match "\\`[a-zA-Zα-ωΑ-Ω][a-zA-Zα-ωΑ-Ω0-9]+\\'"
695 (symbol-name (nth 1 a)))) 695 (symbol-name (nth 1 a))))
696 (if (eq calc-language 'latex) 696 (if (eq calc-language 'latex)
697 (format "\\text{%s}" (symbol-name (nth 1 a))) 697 (format "\\text{%s}" (symbol-name (nth 1 a)))
@@ -702,7 +702,7 @@
702 (let (left right) 702 (let (left right)
703 (if (and calc-language-option 703 (if (and calc-language-option
704 (not (= calc-language-option 0)) 704 (not (= calc-language-option 0))
705 (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" func)) 705 (string-match "\\`[a-zA-Zα-ωΑ-Ω][a-zA-Zα-ωΑ-Ω0-9]+\\'" func))
706 (if (< (prefix-numeric-value calc-language-option) 0) 706 (if (< (prefix-numeric-value calc-language-option) 0)
707 (setq func (format "\\%s" func)) 707 (setq func (format "\\%s" func))
708 (setq func (if (eq calc-language 'latex) 708 (setq func (if (eq calc-language 'latex)
@@ -824,11 +824,11 @@
824 '((?\\ 824 '((?\\
825 (< math-exp-pos (1- (length math-exp-str))) 825 (< math-exp-pos (1- (length math-exp-str)))
826 (progn 826 (progn
827 (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}" 827 (or (string-match "\\\\hbox *{\\([a-zA-Zα-ωΑ-Ω0-9]+\\)}"
828 math-exp-str math-exp-pos) 828 math-exp-str math-exp-pos)
829 (string-match "\\\\text *{\\([a-zA-Z0-9]+\\)}" 829 (string-match "\\\\text *{\\([a-zA-Zα-ωΑ-Ω0-9]+\\)}"
830 math-exp-str math-exp-pos) 830 math-exp-str math-exp-pos)
831 (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)" 831 (string-match "\\(\\\\\\([a-zA-Zα-ωΑ-Ω]+\\|[^a-zA-Zα-ωΑ-Ω]\\)\\)"
832 math-exp-str math-exp-pos)) 832 math-exp-str math-exp-pos))
833 (setq math-exp-token 'symbol 833 (setq math-exp-token 'symbol
834 math-exp-pos (match-end 0) 834 math-exp-pos (match-end 0)
@@ -2301,9 +2301,11 @@ order to Calc's."
2301 2301
2302 ;; Variable name or function call. 2302 ;; Variable name or function call.
2303 ((or (and (>= other-char ?a) (<= other-char ?z)) 2303 ((or (and (>= other-char ?a) (<= other-char ?z))
2304 (and (>= other-char ?A) (<= other-char ?Z))) 2304 (and (>= other-char ?A) (<= other-char ?Z))
2305 (and (>= other-char ?α) (<= other-char ?ω))
2306 (and (>= other-char ?Α) (<= other-char ?Ω)))
2305 (setq line (nth v math-read-big-lines)) 2307 (setq line (nth v math-read-big-lines))
2306 (string-match "\\([a-zA-Z'_]+\\) *" line math-rb-h1) 2308 (string-match "\\([a-zA-Zα-ωΑ-Ω'_]+\\) *" line math-rb-h1)
2307 (setq h (match-end 1) 2309 (setq h (match-end 1)
2308 widest (match-end 0) 2310 widest (match-end 0)
2309 p (math-match-substring line 1)) 2311 p (math-match-substring line 1))
diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el
index 5ec21eee887..8f73e71b0f9 100644
--- a/lisp/calc/calc-store.el
+++ b/lisp/calc/calc-store.el
@@ -202,7 +202,7 @@
202 'calc-read-var-name-history))))) 202 'calc-read-var-name-history)))))
203 (setq calc-aborted-prefix "") 203 (setq calc-aborted-prefix "")
204 (and (not (equal var "var-")) 204 (and (not (equal var "var-"))
205 (if (string-match "\\`\\([-a-zA-Z0-9]+\\) *:?=" var) 205 (if (string-match "\\`\\([-a-zA-Zα-ωΑ-Ω0-9]+\\) *:?=" var)
206 (if (null calc-given-value-flag) 206 (if (null calc-given-value-flag)
207 (error "Assignment is not allowed in this command") 207 (error "Assignment is not allowed in this command")
208 (let ((svar (intern (substring var 0 (match-end 1))))) 208 (let ((svar (intern (substring var 0 (match-end 1)))))
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index 6dd3e4911b7..6881db3fb12 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -36,13 +36,13 @@
36 36
37;;; Units table last updated 9-Jan-91 by Ulrich Mueller (ulm@vsnhd1.cern.ch) 37;;; Units table last updated 9-Jan-91 by Ulrich Mueller (ulm@vsnhd1.cern.ch)
38;;; with some additions by Przemek Klosowski (przemek@rrdstrad.nist.gov) 38;;; with some additions by Przemek Klosowski (przemek@rrdstrad.nist.gov)
39;;; Updated April 2002 by Jochen Küpper 39;;; Updated April 2002 by Jochen Küpper
40 40
41;;; Updated August 2007, using 41;;; Updated August 2007, using
42;;; CODATA (http://physics.nist.gov/cuu/Constants/index.html) 42;;; CODATA (http://physics.nist.gov/cuu/Constants/index.html)
43;;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html) 43;;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html)
44;;; ESUWM (Encyclopaedia of Scientific Units, Weights and 44;;; ESUWM (Encyclopaedia of Scientific Units, Weights and
45;;; Measures, by François Cardarelli) 45;;; Measures, by François Cardarelli)
46;;; All conversions are exact unless otherwise noted. 46;;; All conversions are exact unless otherwise noted.
47 47
48(defvar math-standard-units 48(defvar math-standard-units
@@ -210,6 +210,7 @@
210 "1.602176487 10^-19 C (*)") ;;(approx) CODATA 210 "1.602176487 10^-19 C (*)") ;;(approx) CODATA
211 ( V "W/A" "Volt" ) 211 ( V "W/A" "Volt" )
212 ( ohm "V/A" "Ohm" ) 212 ( ohm "V/A" "Ohm" )
213 ( Ω "ohm" "Ohm" )
213 ( mho "A/V" "Mho" ) 214 ( mho "A/V" "Mho" )
214 ( S "A/V" "Siemens" ) 215 ( S "A/V" "Siemens" )
215 ( F "C/V" "Farad" ) 216 ( F "C/V" "Farad" )
@@ -259,7 +260,9 @@
259 "6.62606896 10^-34 J s (*)") 260 "6.62606896 10^-34 J s (*)")
260 ( hbar "h / (2 pi)" "Planck's constant" ) ;; Exact 261 ( hbar "h / (2 pi)" "Planck's constant" ) ;; Exact
261 ( mu0 "4 pi 10^(-7) H/m" "Permeability of vacuum") ;; Exact 262 ( mu0 "4 pi 10^(-7) H/m" "Permeability of vacuum") ;; Exact
263 ( μ0 "mu0" "Permeability of vacuum") ;; Exact
262 ( eps0 "1 / (mu0 c^2)" "Permittivity of vacuum" ) 264 ( eps0 "1 / (mu0 c^2)" "Permittivity of vacuum" )
265 ( ε0 "eps0" "Permittivity of vacuum" )
263 ( G "6.67428*10^(-11) m^3/(kg s^2)" "Gravitational constant" nil 266 ( G "6.67428*10^(-11) m^3/(kg s^2)" "Gravitational constant" nil
264 "6.67428 10^-11 m^3/(kg s^2) (*)") 267 "6.67428 10^-11 m^3/(kg s^2) (*)")
265 ( Nav "6.02214179*10^(23) / mol" "Avogadro's constant" nil 268 ( Nav "6.02214179*10^(23) / mol" "Avogadro's constant" nil
@@ -272,12 +275,16 @@
272 "1.674927211 10^-27 kg (*)") 275 "1.674927211 10^-27 kg (*)")
273 ( mmu "1.88353130*10^(-28) kg" "Muon rest mass" nil 276 ( mmu "1.88353130*10^(-28) kg" "Muon rest mass" nil
274 "1.88353130 10^-28 kg (*)") 277 "1.88353130 10^-28 kg (*)")
278 ( mμ "mmu" "Muon rest mass" nil
279 "1.88353130 10^-28 kg (*)")
275 ( Ryd "10973731.568527 /m" "Rydberg's constant" nil 280 ( Ryd "10973731.568527 /m" "Rydberg's constant" nil
276 "10973731.568527 /m (*)") 281 "10973731.568527 /m (*)")
277 ( k "1.3806504*10^(-23) J/K" "Boltzmann's constant" nil 282 ( k "1.3806504*10^(-23) J/K" "Boltzmann's constant" nil
278 "1.3806504 10^-23 J/K (*)") 283 "1.3806504 10^-23 J/K (*)")
279 ( alpha "7.2973525376*10^(-3)" "Fine structure constant" nil 284 ( alpha "7.2973525376*10^(-3)" "Fine structure constant" nil
280 "7.2973525376 10^-3 (*)") 285 "7.2973525376 10^-3 (*)")
286 ( α "alpha" "Fine structure constant" nil
287 "7.2973525376 10^-3 (*)")
281 ( muB "927.400915*10^(-26) J/T" "Bohr magneton" nil 288 ( muB "927.400915*10^(-26) J/T" "Bohr magneton" nil
282 "927.400915 10^-26 J/T (*)") 289 "927.400915 10^-26 J/T (*)")
283 ( muN "5.05078324*10^(-27) J/T" "Nuclear magneton" nil 290 ( muN "5.05078324*10^(-27) J/T" "Nuclear magneton" nil
@@ -316,6 +323,7 @@ that the combined units table will be rebuilt.")
316 ( ?c (^ 10 -2) "Centi" ) 323 ( ?c (^ 10 -2) "Centi" )
317 ( ?m (^ 10 -3) "Milli" ) 324 ( ?m (^ 10 -3) "Milli" )
318 ( ?u (^ 10 -6) "Micro" ) 325 ( ?u (^ 10 -6) "Micro" )
326 ( ?μ (^ 10 -6) "Micro" )
319 ( ?n (^ 10 -9) "Nano" ) 327 ( ?n (^ 10 -9) "Nano" )
320 ( ?p (^ 10 -12) "Pico" ) 328 ( ?p (^ 10 -12) "Pico" )
321 ( ?f (^ 10 -15) "Femto" ) 329 ( ?f (^ 10 -15) "Femto" )
@@ -581,8 +589,8 @@ If EXPR is nil, return nil."
581 (let ((name (or (nth 2 u) (symbol-name (car u))))) 589 (let ((name (or (nth 2 u) (symbol-name (car u)))))
582 (if (eq (aref name 0) ?\*) 590 (if (eq (aref name 0) ?\*)
583 (setq name (substring name 1))) 591 (setq name (substring name 1)))
584 (if (string-match "[^a-zA-Z0-9']" name) 592 (if (string-match "[^a-zA-Zα-ωΑ-Ω0-9']" name)
585 (if (string-match "^[a-zA-Z0-9' ()]*$" name) 593 (if (string-match "^[a-zA-Zα-ωΑ-Ω0-9' ()]*$" name)
586 (while (setq pos (string-match "[ ()]" name)) 594 (while (setq pos (string-match "[ ()]" name))
587 (setq name (concat (substring name 0 pos) 595 (setq name (concat (substring name 0 pos)
588 (if (eq (aref name pos) 32) "-" "") 596 (if (eq (aref name pos) 32) "-" "")
@@ -592,7 +600,7 @@ If EXPR is nil, return nil."
592 (setq name (concat (nth 2 (assq (aref (symbol-name 600 (setq name (concat (nth 2 (assq (aref (symbol-name
593 (nth 1 expr)) 0) 601 (nth 1 expr)) 0)
594 math-unit-prefixes)) 602 math-unit-prefixes))
595 (if (and (string-match "[^a-zA-Z0-9']" name) 603 (if (and (string-match "[^a-zA-Zα-ωΑ-Ω0-9']" name)
596 (not (memq (car u) '(mHg gf)))) 604 (not (memq (car u) '(mHg gf))))
597 (concat "-" name) 605 (concat "-" name)
598 (downcase name))))) 606 (downcase name)))))
@@ -1540,9 +1548,5 @@ If EXPR is nil, return nil."
1540 1548
1541(provide 'calc-units) 1549(provide 'calc-units)
1542 1550
1543;; Local Variables:
1544;; coding: iso-latin-1
1545;; End:
1546
1547;; arch-tag: e993314f-3adc-4191-be61-4ef8874881c4 1551;; arch-tag: e993314f-3adc-4191-be61-4ef8874881c4
1548;;; calc-units.el ends here 1552;;; calc-units.el ends here
diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el
index c4de362ab36..5b807a55491 100644
--- a/lisp/calc/calc-vec.el
+++ b/lisp/calc/calc-vec.el
@@ -451,16 +451,18 @@
451 (calc-enter-result 1 "grad" (list 'calcFunc-grade (calc-top-n 1)))))) 451 (calc-enter-result 1 "grad" (list 'calcFunc-grade (calc-top-n 1))))))
452 452
453(defun calc-histogram (n) 453(defun calc-histogram (n)
454 (interactive "NNumber of bins: ") 454 (interactive "P")
455 (unless (natnump n)
456 (setq n (math-read-expr (read-string "Centers of bins: "))))
455 (calc-slow-wrapper 457 (calc-slow-wrapper
456 (if calc-hyperbolic-flag 458 (if calc-hyperbolic-flag
457 (calc-enter-result 2 "hist" (list 'calcFunc-histogram 459 (calc-enter-result 2 "hist" (list 'calcFunc-histogram
458 (calc-top-n 2) 460 (calc-top-n 2)
459 (calc-top-n 1) 461 (calc-top-n 1)
460 (prefix-numeric-value n))) 462 n))
461 (calc-enter-result 1 "hist" (list 'calcFunc-histogram 463 (calc-enter-result 1 "hist" (list 'calcFunc-histogram
462 (calc-top-n 1) 464 (calc-top-n 1)
463 (prefix-numeric-value n)))))) 465 n)))))
464 466
465(defun calc-transpose (arg) 467(defun calc-transpose (arg)
466 (interactive "P") 468 (interactive "P")
@@ -1135,22 +1137,53 @@
1135 (if (Math-vectorp wts) 1137 (if (Math-vectorp wts)
1136 (or (= (length vec) (length wts)) 1138 (or (= (length vec) (length wts))
1137 (math-dimension-error))) 1139 (math-dimension-error)))
1138 (or (natnump n) 1140 (cond ((natnump n)
1139 (math-reject-arg n 'fixnatnump)) 1141 (let ((res (make-vector n 0))
1140 (let ((res (make-vector n 0)) 1142 (vp vec)
1141 (vp vec) 1143 (wvec (Math-vectorp wts))
1142 (wvec (Math-vectorp wts)) 1144 (wp wts)
1143 (wp wts) 1145 bin)
1144 bin) 1146 (while (setq vp (cdr vp))
1145 (while (setq vp (cdr vp)) 1147 (setq bin (car vp))
1146 (setq bin (car vp)) 1148 (or (natnump bin)
1147 (or (natnump bin) 1149 (setq bin (math-floor bin)))
1148 (setq bin (math-floor bin))) 1150 (and (natnump bin)
1149 (and (natnump bin) 1151 (< bin n)
1150 (< bin n) 1152 (aset res bin
1151 (aset res bin (math-add (aref res bin) 1153 (math-add (aref res bin)
1152 (if wvec (car (setq wp (cdr wp))) wts))))) 1154 (if wvec (car (setq wp (cdr wp))) wts)))))
1153 (cons 'vec (append res nil)))) 1155 (cons 'vec (append res nil))))
1156 ((Math-vectorp n) ;; n is a vector of midpoints
1157 (let* ((bds (math-vector-avg n))
1158 (res (make-vector (1- (length n)) 0))
1159 (vp (cdr vec))
1160 (wvec (Math-vectorp wts))
1161 (wp wts)
1162 num)
1163 (while vp
1164 (setq num (car vp))
1165 (let ((tbds (cdr bds))
1166 (i 0))
1167 (while (and tbds (Math-lessp (car tbds) num))
1168 (setq i (1+ i))
1169 (setq tbds (cdr tbds)))
1170 (aset res i
1171 (math-add (aref res i)
1172 (if wvec (car (setq wp (cdr wp))) wts))))
1173 (setq vp (cdr vp)))
1174 (cons 'vec (append res nil))))
1175 (t
1176 (math-reject-arg n "*Expecting an integer or vector"))))
1177
1178;;; Replace a vector [a b c ...] with a vector of averages
1179;;; [(a+b)/2 (b+c)/2 ...]
1180(defun math-vector-avg (vec)
1181 (let ((vp (sort (copy-sequence (cdr vec)) 'math-beforep))
1182 (res nil))
1183 (while (and vp (cdr vp))
1184 (setq res (cons (math-div (math-add (car vp) (cadr vp)) 2) res)
1185 vp (cdr vp)))
1186 (cons 'vec (reverse res))))
1154 1187
1155 1188
1156;;; Set operations. 1189;;; Set operations.
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 07fa4414dda..73a865cab1a 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -999,9 +999,12 @@ Used by `calc-user-invocation'.")
999(defvar math-working-step-2 nil) 999(defvar math-working-step-2 nil)
1000(defvar var-i '(special-const (math-imaginary 1))) 1000(defvar var-i '(special-const (math-imaginary 1)))
1001(defvar var-pi '(special-const (math-pi))) 1001(defvar var-pi '(special-const (math-pi)))
1002(defvar var-Ï€ '(special-const (math-pi)))
1002(defvar var-e '(special-const (math-e))) 1003(defvar var-e '(special-const (math-e)))
1003(defvar var-phi '(special-const (math-phi))) 1004(defvar var-phi '(special-const (math-phi)))
1005(defvar var-φ '(special-const (math-phi)))
1004(defvar var-gamma '(special-const (math-gamma-const))) 1006(defvar var-gamma '(special-const (math-gamma-const)))
1007(defvar var-γ '(special-const (math-gamma-const)))
1005(defvar var-Modes '(special-const (math-get-modes-vec))) 1008(defvar var-Modes '(special-const (math-get-modes-vec)))
1006 1009
1007(mapc (lambda (v) (or (boundp v) (set v nil))) 1010(mapc (lambda (v) (or (boundp v) (set v nil)))
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el
index c7d3469abe0..c8efded9270 100644
--- a/lisp/calc/calccomp.el
+++ b/lisp/calc/calccomp.el
@@ -663,6 +663,8 @@
663 (and prevc nextc 663 (and prevc nextc
664 (or (and (>= nextc ?a) (<= nextc ?z)) 664 (or (and (>= nextc ?a) (<= nextc ?z))
665 (and (>= nextc ?A) (<= nextc ?Z)) 665 (and (>= nextc ?A) (<= nextc ?Z))
666 (and (>= nextc ?α) (<= nextc ?ω))
667 (and (>= nextc ?Α) (<= nextc ?Ω))
666 (and (>= nextc ?0) (<= nextc ?9)) 668 (and (>= nextc ?0) (<= nextc ?9))
667 (memq nextc '(?. ?_ ?# 669 (memq nextc '(?. ?_ ?#
668 ?\( ?\[ ?\{)) 670 ?\( ?\[ ?\{))
@@ -732,7 +734,7 @@
732 (not (math-tex-expr-is-flat (nth 1 a)))))) 734 (not (math-tex-expr-is-flat (nth 1 a))))))
733 (list 'horiz 735 (list 'horiz
734 (if lr "\\left" "") 736 (if lr "\\left" "")
735 (if (string-match "\\`u\\([^a-zA-Z]\\)\\'" (car op)) 737 (if (string-match "\\`u\\([^a-zA-Zα-ωΑ-Ω]\\)\\'" (car op))
736 (substring (car op) 1) 738 (substring (car op) 1)
737 (car op)) 739 (car op))
738 (if (or lr (> (length (car op)) 2)) " " "") 740 (if (or lr (> (length (car op)) 2)) " " "")
@@ -758,7 +760,7 @@
758 (t 760 (t
759 (let ((rhs (math-compose-expr (nth 1 a) (nth 3 op)))) 761 (let ((rhs (math-compose-expr (nth 1 a) (nth 3 op))))
760 (list 'horiz 762 (list 'horiz
761 (let ((ops (if (string-match "\\`u\\([^a-zA-Z]\\)\\'" 763 (let ((ops (if (string-match "\\`u\\([^a-zA-Zα-ωΑ-Ω]\\)\\'"
762 (car op)) 764 (car op))
763 (substring (car op) 1) 765 (substring (car op) 1)
764 (car op)))) 766 (car op))))
@@ -806,7 +808,7 @@
806 (setq func (car func2))) 808 (setq func (car func2)))
807 (setq func (math-remove-dashes 809 (setq func (math-remove-dashes
808 (if (string-match 810 (if (string-match
809 "\\`calcFunc-\\([a-zA-Z0-9']+\\)\\'" 811 "\\`calcFunc-\\([a-zA-Zα-ωΑ-Ω0-9']+\\)\\'"
810 (symbol-name func)) 812 (symbol-name func))
811 (math-match-substring (symbol-name func) 1) 813 (math-match-substring (symbol-name func) 1)
812 (symbol-name func)))) 814 (symbol-name func))))
diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el
index 5834afae8bc..e343446a366 100644
--- a/lisp/dos-fns.el
+++ b/lisp/dos-fns.el
@@ -30,16 +30,16 @@
30(declare-function int86 "dosfns.c") 30(declare-function int86 "dosfns.c")
31(declare-function msdos-long-file-names "msdos.c") 31(declare-function msdos-long-file-names "msdos.c")
32 32
33;; This overrides a trivial definition in files.el. 33;; See convert-standard-filename in files.el.
34(defun dos-convert-standard-filename (filename) 34(defun dos-convert-standard-filename (filename)
35 "Convert a standard file's name to something suitable for the current OS. 35 "Convert a standard file's name to something suitable for MS-DOS.
36This means to guarantee valid names and perhaps to canonicalize 36This means to guarantee valid names and perhaps to canonicalize
37certain patterns. 37certain patterns.
38 38
39This function is called by `convert-standard-filename'.
40
39On Windows and DOS, replace invalid characters. On DOS, make 41On Windows and DOS, replace invalid characters. On DOS, make
40sure to obey the 8.3 limitations. On Windows, turn Cygwin names 42sure to obey the 8.3 limitations."
41into native names, and also turn slashes into backslashes if the
42shell requires it (see `w32-shell-dos-semantics')."
43 (if (or (not (stringp filename)) 43 (if (or (not (stringp filename))
44 ;; This catches the case where FILENAME is "x:" or "x:/" or 44 ;; This catches the case where FILENAME is "x:" or "x:/" or
45 ;; "/", thus preventing infinite recursion. 45 ;; "/", thus preventing infinite recursion.
@@ -128,11 +128,6 @@ shell requires it (see `w32-shell-dos-semantics')."
128 (dos-convert-standard-filename dir)) 128 (dos-convert-standard-filename dir))
129 string)))))) 129 string))))))
130 130
131;; Only redirect convert-standard-filename if it has a chance of working,
132;; otherwise loading dos-fns.el might make your non-DOS Emacs misbehave.
133(when (fboundp 'msdos-long-file-names)
134 (defalias 'convert-standard-filename 'dos-convert-standard-filename))
135
136(defun dos-8+3-filename (filename) 131(defun dos-8+3-filename (filename)
137 "Truncate FILENAME to DOS 8+3 limits." 132 "Truncate FILENAME to DOS 8+3 limits."
138 (if (or (not (stringp filename)) 133 (if (or (not (stringp filename))
@@ -243,9 +238,14 @@ returned unaltered."
243 (al . (0 . 0)) (bl . (1 . 0)) (cl . (2 . 0)) (dl . (3 . 0)) 238 (al . (0 . 0)) (bl . (1 . 0)) (cl . (2 . 0)) (dl . (3 . 0))
244 (ah . (0 . 1)) (bh . (1 . 1)) (ch . (2 . 1)) (dh . (3 . 1)))) 239 (ah . (0 . 1)) (bh . (1 . 1)) (ch . (2 . 1)) (dh . (3 . 1))))
245 240
241(define-obsolete-variable-alias
242 'register-name-alist 'dos-register-name-alist "24.1")
243
246(defun dos-make-register () 244(defun dos-make-register ()
247 (make-vector 8 0)) 245 (make-vector 8 0))
248 246
247(define-obsolete-function-alias 'make-register 'dos-make-register "24.1")
248
249(defun dos-register-value (regs name) 249(defun dos-register-value (regs name)
250 (let ((where (cdr (assoc name dos-register-name-alist)))) 250 (let ((where (cdr (assoc name dos-register-name-alist))))
251 (cond ((consp where) 251 (cond ((consp where)
@@ -257,6 +257,8 @@ returned unaltered."
257 (aref regs where)) 257 (aref regs where))
258 (t nil)))) 258 (t nil))))
259 259
260(define-obsolete-function-alias 'register-value 'dos-register-value "24.1")
261
260(defun dos-set-register-value (regs name value) 262(defun dos-set-register-value (regs name value)
261 (and (numberp value) 263 (and (numberp value)
262 (>= value 0) 264 (>= value 0)
@@ -273,9 +275,18 @@ returned unaltered."
273 (aset regs where (logand value 65535)))))) 275 (aset regs where (logand value 65535))))))
274 regs) 276 regs)
275 277
278(define-obsolete-function-alias
279 'set-register-value 'dos-set-register-value "24.1")
280
276(defsubst dos-intdos (regs) 281(defsubst dos-intdos (regs)
282 "Issue the DOS Int 21h with registers REGS.
283
284REGS should be a vector produced by `dos-make-register'
285and `dos-set-register-value', which see."
277 (int86 33 regs)) 286 (int86 33 regs))
278 287
288(define-obsolete-function-alias 'intdos 'dos-intdos "24.1")
289
279;; Backward compatibility for obsolescent functions which 290;; Backward compatibility for obsolescent functions which
280;; set screen size. 291;; set screen size.
281 292
@@ -284,6 +295,8 @@ returned unaltered."
284 (interactive) 295 (interactive)
285 (set-frame-size (selected-frame) 80 25)) 296 (set-frame-size (selected-frame) 80 25))
286 297
298(define-obsolete-function-alias 'mode25 'dos-mode25 "24.1")
299
287(defun dos-mode4350 () 300(defun dos-mode4350 ()
288 "Changes the number of rows to 43 or 50. 301 "Changes the number of rows to 43 or 50.
289Emacs always tries to set the screen height to 50 rows first. 302Emacs always tries to set the screen height to 50 rows first.
@@ -295,6 +308,8 @@ that your video hardware might not support 50-line mode."
295 nil ; the original built-in function returned nil 308 nil ; the original built-in function returned nil
296 (set-frame-size (selected-frame) 80 43))) 309 (set-frame-size (selected-frame) 80 43)))
297 310
311(define-obsolete-function-alias 'mode4350 'dos-mode4350 "24.1")
312
298(provide 'dos-fns) 313(provide 'dos-fns)
299 314
300;; arch-tag: 00b03579-8ebb-4a02-8762-5c5a929774ad 315;; arch-tag: 00b03579-8ebb-4a02-8762-5c5a929774ad
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 4a7f59e26fb..02477baf74f 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -221,8 +221,6 @@ font-lock keywords will not be case sensitive."
221 ;;(set (make-local-variable 'adaptive-fill-mode) nil) 221 ;;(set (make-local-variable 'adaptive-fill-mode) nil)
222 (make-local-variable 'indent-line-function) 222 (make-local-variable 'indent-line-function)
223 (setq indent-line-function 'lisp-indent-line) 223 (setq indent-line-function 'lisp-indent-line)
224 (make-local-variable 'parse-sexp-ignore-comments)
225 (setq parse-sexp-ignore-comments t)
226 (make-local-variable 'outline-regexp) 224 (make-local-variable 'outline-regexp)
227 (setq outline-regexp ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(") 225 (setq outline-regexp ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(")
228 (make-local-variable 'outline-level) 226 (make-local-variable 'outline-level)
@@ -431,7 +429,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map.")
431 :type 'hook 429 :type 'hook
432 :group 'lisp) 430 :group 'lisp)
433 431
434(define-derived-mode emacs-lisp-mode nil "Emacs-Lisp" 432(define-derived-mode emacs-lisp-mode prog-mode "Emacs-Lisp"
435 "Major mode for editing Lisp code to run in Emacs. 433 "Major mode for editing Lisp code to run in Emacs.
436Commands: 434Commands:
437Delete converts tabs to spaces as it moves back. 435Delete converts tabs to spaces as it moves back.
@@ -466,7 +464,7 @@ if that value is non-nil."
466 "Keymap for ordinary Lisp mode. 464 "Keymap for ordinary Lisp mode.
467All commands in `lisp-mode-shared-map' are inherited by this map.") 465All commands in `lisp-mode-shared-map' are inherited by this map.")
468 466
469(define-derived-mode lisp-mode nil "Lisp" 467(define-derived-mode lisp-mode prog-mode "Lisp"
470 "Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp. 468 "Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp.
471Commands: 469Commands:
472Delete converts tabs to spaces as it moves back. 470Delete converts tabs to spaces as it moves back.
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
new file mode 100644
index 00000000000..27ddeb762af
--- /dev/null
+++ b/lisp/emacs-lisp/smie.el
@@ -0,0 +1,688 @@
1;;; smie.el --- Simple Minded Indentation Engine
2
3;; Copyright (C) 2010 Free Software Foundation, Inc.
4
5;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
6;; Keywords: languages, lisp, internal, parsing, indentation
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with this program. If not, see <http://www.gnu.org/licenses/>.
22
23;;; Commentary:
24
25;; While working on the SML indentation code, the idea grew that maybe
26;; I could write something generic to do the same thing, and at the
27;; end of working on the SML code, I had a pretty good idea of what it
28;; could look like. That idea grew stronger after working on
29;; LaTeX indentation.
30;;
31;; So at some point I decided to try it out, by writing a new
32;; indentation code for Coq while trying to keep most of the code
33;; "table driven", where only the tables are Coq-specific. The result
34;; (which was used for Beluga-mode as well) turned out to be based on
35;; something pretty close to an operator precedence parser.
36
37;; So here is another rewrite, this time following the actual principles of
38;; operator precedence grammars. Why OPG? Even though they're among the
39;; weakest kinds of parsers, these parsers have some very desirable properties
40;; for Emacs:
41;; - most importantly for indentation, they work equally well in either
42;; direction, so you can use them to parse backward from the indentation
43;; point to learn the syntactic context;
44;; - they work locally, so there's no need to keep a cache of
45;; the parser's state;
46;; - because of that locality, indentation also works just fine when earlier
47;; parts of the buffer are syntactically incorrect since the indentation
48;; looks at "as little as possible" of the buffer make an indentation
49;; decision.
50;; - they typically have no error handling and can't even detect a parsing
51;; error, so we don't have to worry about what to do in case of a syntax
52;; error because the parser just automatically does something. Better yet,
53;; we can afford to use a sloppy grammar.
54
55;; The development (especially the parts building the 2D precedence
56;; tables and then computing the precedence levels from it) is largely
57;; inspired from page 187-194 of "Parsing techniques" by Dick Grune
58;; and Ceriel Jacobs (BookBody.pdf available at
59;; http://www.cs.vu.nl/~dick/PTAPG.html).
60;;
61;; OTOH we had to kill many chickens, read many coffee grounds, and practiced
62;; untold numbers of black magic spells.
63
64;;; Code:
65
66(eval-when-compile (require 'cl))
67
68;;; Building precedence level tables from BNF specs.
69
70(defun smie-set-prec2tab (table x y val &optional override)
71 (assert (and x y))
72 (let* ((key (cons x y))
73 (old (gethash key table)))
74 (if (and old (not (eq old val)))
75 (if (gethash key override)
76 ;; FIXME: The override is meant to resolve ambiguities,
77 ;; but it also hides real conflicts. It would be great to
78 ;; be able to distinguish the two cases so that overrides
79 ;; don't hide real conflicts.
80 (puthash key (gethash key override) table)
81 (display-warning 'smie (format "Conflict: %s %s/%s %s" x old val y)))
82 (puthash key val table))))
83
84(defun smie-precs-precedence-table (precs)
85 "Compute a 2D precedence table from a list of precedences.
86PRECS should be a list, sorted by precedence (e.g. \"+\" will
87come before \"*\"), of elements of the form \(left OP ...)
88or (right OP ...) or (nonassoc OP ...) or (assoc OP ...). All operators in
89one of those elements share the same precedence level and associativity."
90 (let ((prec2-table (make-hash-table :test 'equal)))
91 (dolist (prec precs)
92 (dolist (op (cdr prec))
93 (let ((selfrule (cdr (assq (car prec)
94 '((left . >) (right . <) (assoc . =))))))
95 (when selfrule
96 (dolist (other-op (cdr prec))
97 (smie-set-prec2tab prec2-table op other-op selfrule))))
98 (let ((op1 '<) (op2 '>))
99 (dolist (other-prec precs)
100 (if (eq prec other-prec)
101 (setq op1 '> op2 '<)
102 (dolist (other-op (cdr other-prec))
103 (smie-set-prec2tab prec2-table op other-op op2)
104 (smie-set-prec2tab prec2-table other-op op op1)))))))
105 prec2-table))
106
107(defun smie-merge-prec2s (tables)
108 (if (null (cdr tables))
109 (car tables)
110 (let ((prec2 (make-hash-table :test 'equal)))
111 (dolist (table tables)
112 (maphash (lambda (k v)
113 (smie-set-prec2tab prec2 (car k) (cdr k) v))
114 table))
115 prec2)))
116
117(defun smie-bnf-precedence-table (bnf &rest precs)
118 (let ((nts (mapcar 'car bnf)) ;Non-terminals
119 (first-ops-table ())
120 (last-ops-table ())
121 (first-nts-table ())
122 (last-nts-table ())
123 (prec2 (make-hash-table :test 'equal))
124 (override (smie-merge-prec2s
125 (mapcar 'smie-precs-precedence-table precs)))
126 again)
127 (dolist (rules bnf)
128 (let ((nt (car rules))
129 (last-ops ())
130 (first-ops ())
131 (last-nts ())
132 (first-nts ()))
133 (dolist (rhs (cdr rules))
134 (assert (consp rhs))
135 (if (not (member (car rhs) nts))
136 (pushnew (car rhs) first-ops)
137 (pushnew (car rhs) first-nts)
138 (when (consp (cdr rhs))
139 ;; If the first is not an OP we add the second (which
140 ;; should be an OP if BNF is an "operator grammar").
141 ;; Strictly speaking, this should only be done if the
142 ;; first is a non-terminal which can expand to a phrase
143 ;; without any OP in it, but checking doesn't seem worth
144 ;; the trouble, and it lets the writer of the BNF
145 ;; be a bit more sloppy by skipping uninteresting base
146 ;; cases which are terminals but not OPs.
147 (assert (not (member (cadr rhs) nts)))
148 (pushnew (cadr rhs) first-ops)))
149 (let ((shr (reverse rhs)))
150 (if (not (member (car shr) nts))
151 (pushnew (car shr) last-ops)
152 (pushnew (car shr) last-nts)
153 (when (consp (cdr shr))
154 (assert (not (member (cadr shr) nts)))
155 (pushnew (cadr shr) last-ops)))))
156 (push (cons nt first-ops) first-ops-table)
157 (push (cons nt last-ops) last-ops-table)
158 (push (cons nt first-nts) first-nts-table)
159 (push (cons nt last-nts) last-nts-table)))
160 ;; Compute all first-ops by propagating the initial ones we have
161 ;; now, according to first-nts.
162 (setq again t)
163 (while (prog1 again (setq again nil))
164 (dolist (first-nts first-nts-table)
165 (let* ((nt (pop first-nts))
166 (first-ops (assoc nt first-ops-table)))
167 (dolist (first-nt first-nts)
168 (dolist (op (cdr (assoc first-nt first-ops-table)))
169 (unless (member op first-ops)
170 (setq again t)
171 (push op (cdr first-ops))))))))
172 ;; Same thing for last-ops.
173 (setq again t)
174 (while (prog1 again (setq again nil))
175 (dolist (last-nts last-nts-table)
176 (let* ((nt (pop last-nts))
177 (last-ops (assoc nt last-ops-table)))
178 (dolist (last-nt last-nts)
179 (dolist (op (cdr (assoc last-nt last-ops-table)))
180 (unless (member op last-ops)
181 (setq again t)
182 (push op (cdr last-ops))))))))
183 ;; Now generate the 2D precedence table.
184 (dolist (rules bnf)
185 (dolist (rhs (cdr rules))
186 (while (cdr rhs)
187 (cond
188 ((member (car rhs) nts)
189 (dolist (last (cdr (assoc (car rhs) last-ops-table)))
190 (smie-set-prec2tab prec2 last (cadr rhs) '> override)))
191 ((member (cadr rhs) nts)
192 (dolist (first (cdr (assoc (cadr rhs) first-ops-table)))
193 (smie-set-prec2tab prec2 (car rhs) first '< override))
194 (if (and (cddr rhs) (not (member (car (cddr rhs)) nts)))
195 (smie-set-prec2tab prec2 (car rhs) (car (cddr rhs))
196 '= override)))
197 (t (smie-set-prec2tab prec2 (car rhs) (cadr rhs) '= override)))
198 (setq rhs (cdr rhs)))))
199 prec2))
200
201(defun smie-prec2-levels (prec2)
202 "Take a 2D precedence table and turn it into an alist of precedence levels.
203PREC2 is a table as returned by `smie-precs-precedence-table' or
204`smie-bnf-precedence-table'."
205 ;; For each operator, we create two "variables" (corresponding to
206 ;; the left and right precedence level), which are represented by
207 ;; cons cells. Those are the vary cons cells that appear in the
208 ;; final `table'. The value of each "variable" is kept in the `car'.
209 (let ((table ())
210 (csts ())
211 (eqs ())
212 tmp x y)
213 ;; From `prec2' we construct a list of constraints between
214 ;; variables (aka "precedence levels"). These can be either
215 ;; equality constraints (in `eqs') or `<' constraints (in `csts').
216 (maphash (lambda (k v)
217 (if (setq tmp (assoc (car k) table))
218 (setq x (cddr tmp))
219 (setq x (cons nil nil))
220 (push (cons (car k) (cons nil x)) table))
221 (if (setq tmp (assoc (cdr k) table))
222 (setq y (cdr tmp))
223 (setq y (cons nil (cons nil nil)))
224 (push (cons (cdr k) y) table))
225 (ecase v
226 (= (push (cons x y) eqs))
227 (< (push (cons x y) csts))
228 (> (push (cons y x) csts))))
229 prec2)
230 ;; First process the equality constraints.
231 (let ((eqs eqs))
232 (while eqs
233 (let ((from (caar eqs))
234 (to (cdar eqs)))
235 (setq eqs (cdr eqs))
236 (if (eq to from)
237 (debug) ;Can it happen?
238 (dolist (other-eq eqs)
239 (if (eq from (cdr other-eq)) (setcdr other-eq to))
240 (when (eq from (car other-eq))
241 ;; This can happen because of `assoc' settings in precs
242 ;; or because of a rhs like ("op" foo "op").
243 (setcar other-eq to)))
244 (dolist (cst csts)
245 (if (eq from (cdr cst)) (setcdr cst to))
246 (if (eq from (car cst)) (setcar cst to)))))))
247 ;; Then eliminate trivial constraints iteratively.
248 (let ((i 0))
249 (while csts
250 (let ((rhvs (mapcar 'cdr csts))
251 (progress nil))
252 (dolist (cst csts)
253 (unless (memq (car cst) rhvs)
254 (setq progress t)
255 (setcar (car cst) i)
256 (setq csts (delq cst csts))))
257 (unless progress
258 (error "Can't resolve the precedence table to precedence levels")))
259 (incf i))
260 ;; Propagate equalities back to their source.
261 (dolist (eq (nreverse eqs))
262 (assert (null (caar eq)))
263 (setcar (car eq) (cadr eq)))
264 ;; Finally, fill in the remaining vars (which only appeared on the
265 ;; right side of the < constraints).
266 ;; Tho leaving them at nil is not a bad choice, since it makes
267 ;; it clear that these don't bind at all.
268 ;; (dolist (x table)
269 ;; (unless (nth 1 x) (setf (nth 1 x) i))
270 ;; (unless (nth 2 x) (setf (nth 2 x) i)))
271 )
272 table))
273
274;;; Parsing using a precedence level table.
275
276(defvar smie-op-levels 'unset
277 "List of token parsing info.
278Each element is of the form (TOKEN LEFT-LEVEL RIGHT-LEVEL).
279Parsing is done using an operator precedence parser.")
280
281(defun smie-backward-token ()
282 ;; FIXME: This may be an OK default but probably needs a hook.
283 (buffer-substring (point)
284 (progn (if (zerop (skip-syntax-backward "."))
285 (skip-syntax-backward "w_'"))
286 (point))))
287
288(defun smie-forward-token ()
289 ;; FIXME: This may be an OK default but probably needs a hook.
290 (buffer-substring (point)
291 (progn (if (zerop (skip-syntax-forward "."))
292 (skip-syntax-forward "w_'"))
293 (point))))
294
295(defun smie-backward-sexp (&optional halfsexp)
296 "Skip over one sexp.
297HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the
298first token we see is an operator, skip over its left-hand-side argument.
299Possible return values:
300 (LEFT-LEVEL POS TOKEN): we couldn't skip TOKEN because its right-level
301 is too high. LEFT-LEVEL is the left-level of TOKEN,
302 POS is its start position in the buffer.
303 (t POS TOKEN): same thing but for an open-paren or the beginning of buffer.
304 (nil POS TOKEN): we skipped over a paren-like pair.
305 nil: we skipped over an identifier, matched parentheses, ..."
306 (if (bobp) (list t (point))
307 (catch 'return
308 (let ((levels ()))
309 (while
310 (let* ((pos (point))
311 (token (progn (forward-comment (- (point-max)))
312 (smie-backward-token)))
313 (toklevels (cdr (assoc token smie-op-levels))))
314
315 (cond
316 ((null toklevels)
317 (if (equal token "")
318 (condition-case err
319 (progn (goto-char pos) (backward-sexp 1) nil)
320 (scan-error (throw 'return (list t (caddr err)))))))
321 ((null (nth 1 toklevels))
322 ;; A token like a paren-close.
323 (assert (nth 0 toklevels)) ;Otherwise, why mention it?
324 (push (nth 0 toklevels) levels))
325 (t
326 (while (and levels (< (nth 1 toklevels) (car levels)))
327 (setq levels (cdr levels)))
328 (cond
329 ((null levels)
330 (if (and halfsexp (nth 0 toklevels))
331 (push (nth 0 toklevels) levels)
332 (throw 'return
333 (prog1 (list (or (car toklevels) t) (point) token)
334 (goto-char pos)))))
335 (t
336 (while (and levels (= (nth 1 toklevels) (car levels)))
337 (setq levels (cdr levels)))
338 (cond
339 ((null levels)
340 (cond
341 ((null (nth 0 toklevels))
342 (throw 'return (list nil (point) token)))
343 ((eq (nth 0 toklevels) (nth 1 toklevels))
344 (throw 'return
345 (prog1 (list (or (car toklevels) t) (point) token)
346 (goto-char pos))))
347 (t (debug)))) ;Not sure yet what to do here.
348 (t
349 (if (nth 0 toklevels)
350 (push (nth 0 toklevels) levels))))))))
351 levels)
352 (setq halfsexp nil))))))
353
354;; Mirror image, not used for indentation.
355(defun smie-forward-sexp (&optional halfsexp)
356 "Skip over one sexp.
357HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the
358first token we see is an operator, skip over its left-hand-side argument.
359Possible return values:
360 (RIGHT-LEVEL POS TOKEN): we couldn't skip TOKEN because its left-level
361 is too high. RIGHT-LEVEL is the right-level of TOKEN,
362 POS is its end position in the buffer.
363 (t POS TOKEN): same thing but for an open-paren or the beginning of buffer.
364 (nil POS TOKEN): we skipped over a paren-like pair.
365 nil: we skipped over an identifier, matched parentheses, ..."
366 (if (eobp) (list t (point))
367 (catch 'return
368 (let ((levels ()))
369 (while
370 (let* ((pos (point))
371 (token (progn (forward-comment (point-max))
372 (smie-forward-token)))
373 (toklevels (cdr (assoc token smie-op-levels))))
374
375 (cond
376 ((null toklevels)
377 (if (equal token "")
378 (condition-case err
379 (progn (goto-char pos) (forward-sexp 1) nil)
380 (scan-error (throw 'return (list t (caddr err)))))))
381 ((null (nth 0 toklevels))
382 ;; A token like a paren-close.
383 (assert (nth 1 toklevels)) ;Otherwise, why mention it?
384 (push (nth 1 toklevels) levels))
385 (t
386 (while (and levels (< (nth 0 toklevels) (car levels)))
387 (setq levels (cdr levels)))
388 (cond
389 ((null levels)
390 (if (and halfsexp (nth 1 toklevels))
391 (push (nth 1 toklevels) levels)
392 (throw 'return
393 (prog1 (list (or (nth 1 toklevels) t) (point) token)
394 (goto-char pos)))))
395 (t
396 (while (and levels (= (nth 0 toklevels) (car levels)))
397 (setq levels (cdr levels)))
398 (cond
399 ((null levels)
400 (cond
401 ((null (nth 1 toklevels))
402 (throw 'return (list nil (point) token)))
403 ((eq (nth 1 toklevels) (nth 0 toklevels))
404 (throw 'return
405 (prog1 (list (or (nth 1 toklevels) t) (point) token)
406 (goto-char pos))))
407 (t (debug)))) ;Not sure yet what to do here.
408 (t
409 (if (nth 1 toklevels)
410 (push (nth 1 toklevels) levels))))))))
411 levels)
412 (setq halfsexp nil))))))
413
414(defun smie-backward-sexp-command (&optional n)
415 "Move backward through N logical elements."
416 (interactive "p")
417 (if (< n 0)
418 (smie-forward-sexp-command (- n))
419 (let ((forward-sexp-function nil))
420 (while (> n 0)
421 (decf n)
422 (let ((pos (point))
423 (res (smie-backward-sexp 'halfsexp)))
424 (if (and (car res) (= pos (point)) (not (bolp)))
425 (signal 'scan-error
426 (list "Containing expression ends prematurely"
427 (cadr res) (cadr res)))
428 nil))))))
429
430(defun smie-forward-sexp-command (&optional n)
431 "Move forward through N logical elements."
432 (interactive "p")
433 (if (< n 0)
434 (smie-backward-sexp-command (- n))
435 (let ((forward-sexp-function nil))
436 (while (> n 0)
437 (decf n)
438 (let ((pos (point))
439 (res (smie-forward-sexp 'halfsexp)))
440 (if (and (car res) (= pos (point)) (not (bolp)))
441 (signal 'scan-error
442 (list "Containing expression ends prematurely"
443 (cadr res) (cadr res)))
444 nil))))))
445
446;;; The indentation engine.
447
448(defcustom smie-indent-basic 4
449 "Basic amount of indentation."
450 :type 'integer)
451
452(defvar smie-indent-rules 'unset
453 "Rules of the following form.
454\(TOK OFFSET) how to indent right after TOK.
455\(TOK O1 O2) how to indent right after TOK:
456 O1 is the default;
457 O2 is used if TOK is \"hanging\".
458\((T1 . T2) . OFFSET) how to indent token T2 w.r.t T1.
459\((t . TOK) . OFFSET) how to indent TOK with respect to its parent.
460\(list-intro . TOKENS) declare TOKENS as being followed by what may look like
461 a funcall but is just a sequence of expressions.
462\(t . OFFSET) basic indentation step.
463\(args . OFFSET) indentation of arguments.
464A nil offset defaults to `smie-indent-basic'.")
465
466(defun smie-indent-hanging-p ()
467 ;; A Hanging keyword is one that's at the end of a line except it's not at
468 ;; the beginning of a line.
469 (and (save-excursion (smie-forward-token)
470 (skip-chars-forward " \t") (eolp))
471 (save-excursion (skip-chars-backward " \t") (not (bolp)))))
472
473(defun smie-bolp ()
474 (save-excursion (skip-chars-backward " \t") (bolp)))
475
476(defun smie-indent-offset (elem)
477 (or (cdr (assq elem smie-indent-rules))
478 (cdr (assq t smie-indent-rules))
479 smie-indent-basic))
480
481(defun smie-indent-calculate (&optional virtual)
482 "Compute the indentation to use for point.
483If VIRTUAL is non-nil, it means we're not trying to indent point but just
484need to compute the column at which point should be indented
485in order to figure out the indentation of some other (further down) point.
486VIRTUAL can take two different non-nil values:
487- :bolp: means that the current indentation of point can be trusted
488 to be good only if it follows a line break.
489- :hanging: means that the current indentation of point can be
490 trusted to be good except if the following token is hanging."
491 ;; FIXME: This has accumulated a lot of rules, some of which aren't
492 ;; clearly orthogonal any more, so we should probably try and
493 ;; restructure it somewhat.
494 (or
495 ;; Trust pre-existing indentation on other lines.
496 (and virtual
497 (if (eq virtual :hanging) (not (smie-indent-hanging-p)) (smie-bolp))
498 (current-column))
499 ;; Align close paren with opening paren.
500 (save-excursion
501 ;; (forward-comment (point-max))
502 (when (looking-at "\\s)")
503 (while (not (zerop (skip-syntax-forward ")")))
504 (skip-chars-forward " \t"))
505 (condition-case nil
506 (progn
507 (backward-sexp 1)
508 (smie-indent-calculate :hanging))
509 (scan-error nil))))
510 ;; Align closing token with the corresponding opening one.
511 ;; (e.g. "of" with "case", or "in" with "let").
512 (save-excursion
513 (let* ((pos (point))
514 (token (smie-forward-token))
515 (toklevels (cdr (assoc token smie-op-levels))))
516 (when (car toklevels)
517 (let ((res (smie-backward-sexp 'halfsexp)) tmp)
518 ;; If we didn't move at all, that means we didn't really skip
519 ;; what we wanted.
520 (when (< (point) pos)
521 (cond
522 ((eq (car res) (car toklevels))
523 ;; We bumped into a same-level operator. align with it.
524 (goto-char (cadr res))
525 ;; Don't use (smie-indent-calculate :hanging) here, because we
526 ;; want to jump back over a sequence of same-level ops such as
527 ;; a -> b -> c
528 ;; -> d
529 ;; So as to align with the earliest appropriate place.
530 (smie-indent-calculate :bolp))
531 ((equal token (save-excursion
532 (forward-comment (- (point-max)))
533 (smie-backward-token)))
534 ;; in cases such as "fn x => fn y => fn z =>",
535 ;; jump back to the very first fn.
536 ;; FIXME: should we only do that for special tokens like "=>"?
537 (smie-indent-calculate :bolp))
538 ((setq tmp (assoc (cons (caddr res) token)
539 smie-indent-rules))
540 (goto-char (cadr res))
541 (+ (cdr tmp) (smie-indent-calculate :hanging)))
542 (t
543 (+ (or (cdr (assoc (cons t token) smie-indent-rules)) 0)
544 (current-column)))))))))
545 ;; Indentation of a comment.
546 (and (looking-at comment-start-skip)
547 (save-excursion
548 (forward-comment (point-max))
549 (skip-chars-forward " \t\r\n")
550 (smie-indent-calculate nil)))
551 ;; Indentation inside a comment.
552 (and (looking-at "\\*") (nth 4 (syntax-ppss))
553 (let ((ppss (syntax-ppss)))
554 (save-excursion
555 (forward-line -1)
556 (if (<= (point) (nth 8 ppss))
557 (progn (goto-char (1+ (nth 8 ppss))) (current-column))
558 (skip-chars-forward " \t")
559 (if (looking-at "\\*")
560 (current-column))))))
561 ;; Indentation right after a special keyword.
562 (save-excursion
563 (let* ((tok (progn (forward-comment (- (point-max)))
564 (smie-backward-token)))
565 (tokinfo (assoc tok smie-indent-rules))
566 (toklevel (assoc tok smie-op-levels)))
567 (when (or tokinfo (and toklevel (null (cadr toklevel))))
568 (if (or (smie-indent-hanging-p)
569 ;; If calculating the virtual indentation point, prefer
570 ;; looking up the virtual indentation of the alignment
571 ;; point as well. This is used for indentation after
572 ;; "fn x => fn y =>".
573 virtual)
574 (+ (smie-indent-calculate :bolp)
575 (or (caddr tokinfo) (cadr tokinfo) (smie-indent-offset t)))
576 (+ (current-column)
577 (or (cadr tokinfo) (smie-indent-offset t)))))))
578 ;; Main loop (FIXME: whatever that means!?).
579 (save-excursion
580 (let ((positions nil)
581 (begline nil)
582 arg)
583 (while (and (null (car (smie-backward-sexp)))
584 (push (point) positions)
585 (not (setq begline (smie-bolp)))))
586 (save-excursion
587 ;; Figure out if the atom we just skipped is an argument rather
588 ;; than a function.
589 (setq arg (or (null (car (smie-backward-sexp)))
590 (member (progn (forward-comment (- (point-max)))
591 (smie-backward-token))
592 (cdr (assoc 'list-intro smie-indent-rules))))))
593 (cond
594 ((and arg positions)
595 (goto-char (car positions))
596 (current-column))
597 ((and (null begline) (cdr positions))
598 ;; We skipped some args plus the function and bumped into something.
599 ;; Align with the first arg.
600 (goto-char (cadr positions))
601 (current-column))
602 ((and (null begline) positions)
603 ;; We're the first arg.
604 ;; FIXME: it might not be a funcall, in which case we might be the
605 ;; second element.
606 (goto-char (car positions))
607 (+ (smie-indent-offset 'args)
608 ;; We used to use (smie-indent-calculate :bolp), but that
609 ;; doesn't seem right since it might then indent args less than
610 ;; the function itself.
611 (current-column)))
612 ((and (null arg) (null positions))
613 ;; We're the function itself. Not sure what to do here yet.
614 (if virtual (current-column)
615 (save-excursion
616 (let* ((pos (point))
617 (tok (progn (forward-comment (- (point-max)))
618 (smie-backward-token)))
619 (toklevels (cdr (assoc tok smie-op-levels))))
620 (cond
621 ((numberp (car toklevels))
622 ;; We're right after an infix token. Let's skip over the
623 ;; lefthand side.
624 (goto-char pos)
625 (let (res)
626 (while (progn (setq res (smie-backward-sexp 'halfsexp))
627 (and (not (smie-bolp))
628 (equal (car res) (car toklevels)))))
629 ;; We should be right after a token of equal or
630 ;; higher precedence.
631 (cond
632 ((and (consp res) (memq (car res) '(t nil)))
633 ;; The token of higher-precedence is like an open-paren.
634 ;; Sample case for t: foo { bar, \n[TAB] baz }.
635 ;; Sample case for nil: match ... with \n[TAB] | toto ...
636 ;; (goto-char (cadr res))
637 (smie-indent-calculate :hanging))
638 ((and (consp res) (<= (car res) (car toklevels)))
639 ;; We stopped at a token of equal or higher precedence
640 ;; because we found a place with which to align.
641 (current-column))
642 )))
643 ;; For other cases.... hmm... we'll see when we get there.
644 )))))
645 ((null positions)
646 (smie-backward-token)
647 (+ (smie-indent-offset 'args) (smie-indent-calculate :bolp)))
648 ((car (smie-backward-sexp))
649 ;; No arg stands on its own line, but the function does:
650 (if (cdr positions)
651 (progn
652 (goto-char (cadr positions))
653 (current-column))
654 (goto-char (car positions))
655 (+ (current-column) (smie-indent-offset 'args))))
656 (t
657 ;; We've skipped to a previous arg on its own line: align.
658 (goto-char (car positions))
659 (current-column)))))))
660
661(defun smie-indent-line ()
662 "Indent current line using the SMIE indentation engine."
663 (interactive)
664 (let* ((savep (point))
665 (indent (condition-case nil
666 (save-excursion
667 (forward-line 0)
668 (skip-chars-forward " \t")
669 (if (>= (point) savep) (setq savep nil))
670 (or (smie-indent-calculate) 0))
671 (error 0))))
672 (if (not (numberp indent))
673 ;; If something funny is used (e.g. `noindent'), return it.
674 indent
675 (if (< indent 0) (setq indent 0)) ;Just in case.
676 (if savep
677 (save-excursion (indent-line-to indent))
678 (indent-line-to indent)))))
679
680;;;###autoload
681(defun smie-setup (op-levels indent-rules)
682 (set (make-local-variable 'smie-indent-rules) indent-rules)
683 (set (make-local-variable 'smie-op-levels) op-levels)
684 (set (make-local-variable 'indent-line-function) 'smie-indent-line))
685
686
687(provide 'smie)
688;;; smie.el ends here
diff --git a/lisp/files.el b/lisp/files.el
index 83ae91dd63a..d4c05bdc5d6 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -574,6 +574,9 @@ Runs the usual ange-ftp hook, but only for completion operations."
574 (inhibit-file-name-operation op)) 574 (inhibit-file-name-operation op))
575 (apply op args)))) 575 (apply op args))))
576 576
577(declare-function dos-convert-standard-filename "dos-fns.el" (filename))
578(declare-function w32-convert-standard-filename "w32-fns.el" (filename))
579
577(defun convert-standard-filename (filename) 580(defun convert-standard-filename (filename)
578 "Convert a standard file's name to something suitable for the OS. 581 "Convert a standard file's name to something suitable for the OS.
579This means to guarantee valid names and perhaps to canonicalize 582This means to guarantee valid names and perhaps to canonicalize
@@ -591,15 +594,20 @@ and also turn slashes into backslashes if the shell requires it (see
591`w32-shell-dos-semantics'). 594`w32-shell-dos-semantics').
592 595
593See Info node `(elisp)Standard File Names' for more details." 596See Info node `(elisp)Standard File Names' for more details."
594 (if (eq system-type 'cygwin) 597 (cond
595 (let ((name (copy-sequence filename)) 598 ((eq system-type 'cygwin)
596 (start 0)) 599 (let ((name (copy-sequence filename))
597 ;; Replace invalid filename characters with ! 600 (start 0))
598 (while (string-match "[?*:<>|\"\000-\037]" name start) 601 ;; Replace invalid filename characters with !
599 (aset name (match-beginning 0) ?!) 602 (while (string-match "[?*:<>|\"\000-\037]" name start)
600 (setq start (match-end 0))) 603 (aset name (match-beginning 0) ?!)
601 name) 604 (setq start (match-end 0)))
602 filename)) 605 name))
606 ((eq system-type 'windows-nt)
607 (w32-convert-standard-filename filename))
608 ((eq system-type 'ms-dos)
609 (dos-convert-standard-filename filename))
610 (t filename)))
603 611
604(defun read-directory-name (prompt &optional dir default-dirname mustmatch initial) 612(defun read-directory-name (prompt &optional dir default-dirname mustmatch initial)
605 "Read directory name, prompting with PROMPT and completing in directory DIR. 613 "Read directory name, prompting with PROMPT and completing in directory DIR.
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 0b7eaf7ed72..395cca72a93 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,8 @@
12010-05-14 Katsumi Yamaoka <yamaoka@jpl.org>
2
3 * gnus-sum.el (gnus-summary-save-article): Don't bother to re-fetch
4 article unless decoding article to be saved.
5
12010-05-13 Katsumi Yamaoka <yamaoka@jpl.org> 62010-05-13 Katsumi Yamaoka <yamaoka@jpl.org>
2 7
3 * mml1991.el (mml1991-mailcrypt-encrypt, mml1991-gpg-encrypt) 8 * mml1991.el (mml1991-mailcrypt-encrypt, mml1991-gpg-encrypt)
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 3a2c944ed2f..3626d0bd904 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -11664,12 +11664,8 @@ will not be marked as saved."
11664 (gnus-message 1 "Article %d is unsaveable" article)) 11664 (gnus-message 1 "Article %d is unsaveable" article))
11665 ;; This is a real article. 11665 ;; This is a real article.
11666 (save-window-excursion 11666 (save-window-excursion
11667 (let ((gnus-display-mime-function (when decode 11667 (gnus-summary-select-article decode decode nil article)
11668 gnus-display-mime-function)) 11668 (gnus-summary-goto-subject article))
11669 (gnus-article-prepare-hook (when decode
11670 gnus-article-prepare-hook)))
11671 (gnus-summary-select-article t t nil article)
11672 (gnus-summary-goto-subject article)))
11673 (with-current-buffer save-buffer 11669 (with-current-buffer save-buffer
11674 (erase-buffer) 11670 (erase-buffer)
11675 (insert-buffer-substring (if decode 11671 (insert-buffer-substring (if decode
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index fb13df54045..d97320da861 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -140,7 +140,7 @@
140 140
141 (define-key-after map [describe-language-environment] 141 (define-key-after map [describe-language-environment]
142 `(menu-item ,(purecopy "Describe Language Environment") 142 `(menu-item ,(purecopy "Describe Language Environment")
143 describe-language-environment-map 143 ,describe-language-environment-map
144 :help ,(purecopy "Show multilingual settings for a specific language"))) 144 :help ,(purecopy "Show multilingual settings for a specific language")))
145 (define-key-after map [describe-input-method] 145 (define-key-after map [describe-input-method]
146 `(menu-item ,(purecopy "Describe Input Method...") describe-input-method 146 `(menu-item ,(purecopy "Describe Input Method...") describe-input-method
diff --git a/lisp/language/hebrew.el b/lisp/language/hebrew.el
index 993df98b3a6..fd98fcfecb7 100644
--- a/lisp/language/hebrew.el
+++ b/lisp/language/hebrew.el
@@ -60,14 +60,14 @@
60 (input-method . "hebrew") 60 (input-method . "hebrew")
61 (unibyte-display . hebrew-iso-8bit) 61 (unibyte-display . hebrew-iso-8bit)
62 (sample-text . "Hebrew ,Hylem(B") 62 (sample-text . "Hebrew ,Hylem(B")
63 (documentation . "Right-to-left writing is not yet supported."))) 63 (documentation . "Bidirectional editing is supported.")))
64 64
65(set-language-info-alist 65(set-language-info-alist
66 "Windows-1255" '((coding-priority windows-1255) 66 "Windows-1255" '((coding-priority windows-1255)
67 (coding-system windows-1255) 67 (coding-system windows-1255)
68 (documentation . "\ 68 (documentation . "\
69Support for Windows-1255 encoding, e.g. for Yiddish. 69Support for Windows-1255 encoding, e.g. for Yiddish.
70Right-to-left writing is not yet supported."))) 70Bidirectional editing is supported.")))
71 71
72(define-coding-system 'windows-1255 72(define-coding-system 'windows-1255
73 "windows-1255 (Hebrew) encoding (MIME: WINDOWS-1255)" 73 "windows-1255 (Hebrew) encoding (MIME: WINDOWS-1255)"
diff --git a/lisp/org/org-docview.el b/lisp/org/org-docview.el
index 612d6cf053b..ad507546696 100644
--- a/lisp/org/org-docview.el
+++ b/lisp/org/org-docview.el
@@ -1,9 +1,8 @@
1;;; org-docview.el --- support for links to doc-view-mode buffers 1;;; org-docview.el --- support for links to doc-view-mode buffers
2 2
3;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 3;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
4;; Free Software Foundation, Inc.
5 4
6;; Author: Jan Böcker <jan.boecker at jboecker dot de> 5;; Author: Jan Böcker <jan.boecker at jboecker dot de>
7;; Keywords: outlines, hypermedia, calendar, wp 6;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org 7;; Homepage: http://orgmode.org
9;; Version: 6.35i 8;; Version: 6.35i
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 65c05ae7487..cf199e69a33 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -444,12 +444,14 @@ in the same way as TABLE completes strings of the form (concat S2 S)."
444;; I don't think such commands are usable before first setting up buffer-local 444;; I don't think such commands are usable before first setting up buffer-local
445;; variables to parse args, so there's no point autoloading it. 445;; variables to parse args, so there's no point autoloading it.
446;; ;;;###autoload 446;; ;;;###autoload
447(defun pcomplete-std-complete () 447(defun pcomplete-completions-at-point ()
448 "Provide standard completion using pcomplete's completion tables. 448 "Provide standard completion using pcomplete's completion tables.
449Same as `pcomplete' but using the standard completion UI." 449Same as `pcomplete' but using the standard completion UI."
450 (interactive)
451 ;; FIXME: it only completes the text before point, whereas the 450 ;; FIXME: it only completes the text before point, whereas the
452 ;; standard UI may also consider text after point. 451 ;; standard UI may also consider text after point.
452 ;; FIXME: the `pcomplete' UI may be used internally during
453 ;; pcomplete-completions and then throw to `pcompleted', thus
454 ;; imposing the pcomplete UI over the standard UI.
453 (catch 'pcompleted 455 (catch 'pcompleted
454 (let* ((pcomplete-stub) 456 (let* ((pcomplete-stub)
455 pcomplete-seen pcomplete-norm-func 457 pcomplete-seen pcomplete-norm-func
@@ -516,7 +518,7 @@ Same as `pcomplete' but using the standard completion UI."
516 (directory-file-name f)) 518 (directory-file-name f))
517 pcomplete-seen)))))) 519 pcomplete-seen))))))
518 520
519 (completion-in-region 521 (list
520 beg (point) 522 beg (point)
521 ;; Add a space at the end of completion. Use a terminator-regexp 523 ;; Add a space at the end of completion. Use a terminator-regexp
522 ;; that never matches since the terminator cannot appear 524 ;; that never matches since the terminator cannot appear
@@ -527,7 +529,14 @@ Same as `pcomplete' but using the standard completion UI."
527 (cons pcomplete-termination-string 529 (cons pcomplete-termination-string
528 "\\`a\\`") 530 "\\`a\\`")
529 table)) 531 table))
530 pred)))) 532 :predicate pred))))
533
534 ;; I don't think such commands are usable before first setting up buffer-local
535 ;; variables to parse args, so there's no point autoloading it.
536 ;; ;;;###autoload
537(defun pcomplete-std-complete ()
538 (let ((completion-at-point-functions '(pcomplete-completions-at-point)))
539 (completion-at-point)))
531 540
532;;; Pcomplete's native UI. 541;;; Pcomplete's native UI.
533 542
diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el
index 0ce7d780d1f..f5fef76a009 100644
--- a/lisp/progmodes/asm-mode.el
+++ b/lisp/progmodes/asm-mode.el
@@ -109,7 +109,7 @@
109 "Additional expressions to highlight in Assembler mode.") 109 "Additional expressions to highlight in Assembler mode.")
110 110
111;;;###autoload 111;;;###autoload
112(defun asm-mode () 112(define-derived-mode asm-mode prog-mode "Assembler"
113 "Major mode for editing typical assembler code. 113 "Major mode for editing typical assembler code.
114Features a private abbrev table and the following bindings: 114Features a private abbrev table and the following bindings:
115 115
@@ -128,13 +128,8 @@ Turning on Asm mode runs the hook `asm-mode-hook' at the end of initialization.
128 128
129Special commands: 129Special commands:
130\\{asm-mode-map}" 130\\{asm-mode-map}"
131 (interactive)
132 (kill-all-local-variables)
133 (setq mode-name "Assembler")
134 (setq major-mode 'asm-mode)
135 (setq local-abbrev-table asm-mode-abbrev-table) 131 (setq local-abbrev-table asm-mode-abbrev-table)
136 (make-local-variable 'font-lock-defaults) 132 (set (make-local-variable 'font-lock-defaults) '(asm-font-lock-keywords))
137 (setq font-lock-defaults '(asm-font-lock-keywords))
138 (set (make-local-variable 'indent-line-function) 'asm-indent-line) 133 (set (make-local-variable 'indent-line-function) 'asm-indent-line)
139 ;; Stay closer to the old TAB behavior (was tab-to-tab-stop). 134 ;; Stay closer to the old TAB behavior (was tab-to-tab-stop).
140 (set (make-local-variable 'tab-always-indent) nil) 135 (set (make-local-variable 'tab-always-indent) nil)
@@ -157,8 +152,7 @@ Special commands:
157 (setq comment-end-skip "[ \t]*\\(\\s>\\|\\*+/\\)") 152 (setq comment-end-skip "[ \t]*\\(\\s>\\|\\*+/\\)")
158 (make-local-variable 'comment-end) 153 (make-local-variable 'comment-end)
159 (setq comment-end "") 154 (setq comment-end "")
160 (setq fill-prefix "\t") 155 (setq fill-prefix "\t"))
161 (run-mode-hooks 'asm-mode-hook))
162 156
163(defun asm-indent-line () 157(defun asm-indent-line ()
164 "Auto-indent the current line." 158 "Auto-indent the current line."
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index 197b41506bd..64277dc4f82 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -31,6 +31,7 @@
31 31
32(defvar comint-prompt-regexp) 32(defvar comint-prompt-regexp)
33(defvar comint-process-echoes) 33(defvar comint-process-echoes)
34(defvar smie-indent-basic)
34 35
35(defgroup prolog nil 36(defgroup prolog nil
36 "Major mode for editing and running Prolog under Emacs." 37 "Major mode for editing and running Prolog under Emacs."
@@ -98,6 +99,61 @@ When nil, send actual operating system end of file."
98(defvar prolog-mode-abbrev-table nil) 99(defvar prolog-mode-abbrev-table nil)
99(define-abbrev-table 'prolog-mode-abbrev-table ()) 100(define-abbrev-table 'prolog-mode-abbrev-table ())
100 101
102(defconst prolog-smie-op-levels
103 ;; Rather than construct the operator levels table from the BNF,
104 ;; we directly provide the operator precedences from GNU Prolog's
105 ;; manual. The only problem is that GNU Prolog's manual uses
106 ;; precedence levels in the opposite sense (higher numbers bind less
107 ;; tightly) than SMIE, so we use negative numbers.
108 '(("." -10000 -10000)
109 (":-" -1200 -1200)
110 ("-->" -1200 -1200)
111 (";" -1100 -1100)
112 ("->" -1050 -1050)
113 ("," -1000 -1000)
114 ("\\+" -900 -900)
115 ("=" -700 -700)
116 ("\\=" -700 -700)
117 ("=.." -700 -700)
118 ("==" -700 -700)
119 ("\\==" -700 -700)
120 ("@<" -700 -700)
121 ("@=<" -700 -700)
122 ("@>" -700 -700)
123 ("@>=" -700 -700)
124 ("is" -700 -700)
125 ("=:=" -700 -700)
126 ("=\\=" -700 -700)
127 ("<" -700 -700)
128 ("=<" -700 -700)
129 (">" -700 -700)
130 (">=" -700 -700)
131 (":" -600 -600)
132 ("+" -500 -500)
133 ("-" -500 -500)
134 ("/\\" -500 -500)
135 ("\\/" -500 -500)
136 ("*" -400 -400)
137 ("/" -400 -400)
138 ("//" -400 -400)
139 ("rem" -400 -400)
140 ("mod" -400 -400)
141 ("<<" -400 -400)
142 (">>" -400 -400)
143 ("**" -200 -200)
144 ("^" -200 -200)
145 ;; Prefix
146 ;; ("+" 200 200)
147 ;; ("-" 200 200)
148 ;; ("\\" 200 200)
149 )
150 "Precedence levels of infix operators.")
151
152(defconst prolog-smie-indent-rules
153 '((":-")
154 ("->"))
155 "Prolog indentation rules.")
156
101(defun prolog-mode-variables () 157(defun prolog-mode-variables ()
102 (make-local-variable 'paragraph-separate) 158 (make-local-variable 'paragraph-separate)
103 (setq paragraph-separate (concat "%%\\|$\\|" page-delimiter)) ;'%%..' 159 (setq paragraph-separate (concat "%%\\|$\\|" page-delimiter)) ;'%%..'
@@ -105,8 +161,10 @@ When nil, send actual operating system end of file."
105 (setq paragraph-ignore-fill-prefix t) 161 (setq paragraph-ignore-fill-prefix t)
106 (make-local-variable 'imenu-generic-expression) 162 (make-local-variable 'imenu-generic-expression)
107 (setq imenu-generic-expression '((nil "^\\sw+" 0))) 163 (setq imenu-generic-expression '((nil "^\\sw+" 0)))
108 (make-local-variable 'indent-line-function) 164 (smie-setup prolog-smie-op-levels prolog-smie-indent-rules)
109 (setq indent-line-function 'prolog-indent-line) 165 (set (make-local-variable 'forward-sexp-function)
166 'smie-forward-sexp-command)
167 (set (make-local-variable 'smie-indent-basic) prolog-indent-width)
110 (make-local-variable 'comment-start) 168 (make-local-variable 'comment-start)
111 (setq comment-start "%") 169 (setq comment-start "%")
112 (make-local-variable 'comment-start-skip) 170 (make-local-variable 'comment-start-skip)
@@ -122,7 +180,7 @@ When nil, send actual operating system end of file."
122 (define-key map "\C-c\C-l" 'inferior-prolog-load-file) 180 (define-key map "\C-c\C-l" 'inferior-prolog-load-file)
123 (define-key map "\C-c\C-z" 'switch-to-prolog) 181 (define-key map "\C-c\C-z" 'switch-to-prolog)
124 map)) 182 map))
125 183
126(easy-menu-define prolog-mode-menu prolog-mode-map "Menu for Prolog mode." 184(easy-menu-define prolog-mode-menu prolog-mode-map "Menu for Prolog mode."
127 ;; Mostly copied from scheme-mode's menu. 185 ;; Mostly copied from scheme-mode's menu.
128 ;; Not tremendously useful, but it's a start. 186 ;; Not tremendously useful, but it's a start.
@@ -136,85 +194,18 @@ When nil, send actual operating system end of file."
136 )) 194 ))
137 195
138;;;###autoload 196;;;###autoload
139(defun prolog-mode () 197(define-derived-mode prolog-mode prog-mode "Prolog"
140 "Major mode for editing Prolog code for Prologs. 198 "Major mode for editing Prolog code for Prologs.
141Blank lines and `%%...' separate paragraphs. `%'s start comments. 199Blank lines and `%%...' separate paragraphs. `%'s start comments.
142Commands: 200Commands:
143\\{prolog-mode-map} 201\\{prolog-mode-map}
144Entry to this mode calls the value of `prolog-mode-hook' 202Entry to this mode calls the value of `prolog-mode-hook'
145if that value is non-nil." 203if that value is non-nil."
146 (interactive)
147 (kill-all-local-variables)
148 (use-local-map prolog-mode-map)
149 (set-syntax-table prolog-mode-syntax-table)
150 (setq major-mode 'prolog-mode)
151 (setq mode-name "Prolog")
152 (prolog-mode-variables) 204 (prolog-mode-variables)
153 (set (make-local-variable 'comment-add) 1) 205 (set (make-local-variable 'comment-add) 1)
154 ;; font lock
155 (setq font-lock-defaults '(prolog-font-lock-keywords 206 (setq font-lock-defaults '(prolog-font-lock-keywords
156 nil nil nil 207 nil nil nil
157 beginning-of-line)) 208 beginning-of-line)))
158 (run-mode-hooks 'prolog-mode-hook))
159
160(defun prolog-indent-line ()
161 "Indent current line as Prolog code.
162With argument, indent any additional lines of the same clause
163rigidly along with this one (not yet)."
164 (interactive "p")
165 (let ((indent (prolog-indent-level))
166 (pos (- (point-max) (point))))
167 (beginning-of-line)
168 (indent-line-to indent)
169 (if (> (- (point-max) pos) (point))
170 (goto-char (- (point-max) pos)))))
171
172(defun prolog-indent-level ()
173 "Compute Prolog indentation level."
174 (save-excursion
175 (beginning-of-line)
176 (skip-chars-forward " \t")
177 (cond
178 ((looking-at "%%%") 0) ;Large comment starts
179 ((looking-at "%[^%]") comment-column) ;Small comment starts
180 ((bobp) 0) ;Beginning of buffer
181 (t
182 (let ((empty t) ind more less)
183 (if (looking-at ")")
184 (setq less t) ;Find close
185 (setq less nil))
186 ;; See previous indentation
187 (while empty
188 (forward-line -1)
189 (beginning-of-line)
190 (if (bobp)
191 (setq empty nil)
192 (skip-chars-forward " \t")
193 (if (not (or (looking-at "%[^%]") (looking-at "\n")))
194 (setq empty nil))))
195 (if (bobp)
196 (setq ind 0) ;Beginning of buffer
197 (setq ind (current-column))) ;Beginning of clause
198 ;; See its beginning
199 (if (looking-at "%%[^%]")
200 ind
201 ;; Real prolog code
202 (if (looking-at "(")
203 (setq more t) ;Find open
204 (setq more nil))
205 ;; See its tail
206 (end-of-prolog-clause)
207 (or (bobp) (forward-char -1))
208 (cond ((looking-at "[,(;>]")
209 (if (and more (looking-at "[^,]"))
210 (+ ind prolog-indent-width) ;More indentation
211 (max tab-width ind))) ;Same indentation
212 ((looking-at "-") tab-width) ;TAB
213 ((or less (looking-at "[^.]"))
214 (max (- ind prolog-indent-width) 0)) ;Less indentation
215 (t 0)) ;No indentation
216 )))
217 )))
218 209
219(defun end-of-prolog-clause () 210(defun end-of-prolog-clause ()
220 "Go to end of clause in this line." 211 "Go to end of clause in this line."
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index eca6d5fbe7b..5f4028af89a 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -411,11 +411,7 @@ the car and cdr are the same symbol.")
411 (modify-syntax-entry (pop list) (pop list) table)) 411 (modify-syntax-entry (pop list) (pop list) table))
412 table) 412 table)
413 413
414(defvar sh-mode-syntax-table nil 414(defvar sh-mode-syntax-table
415 "The syntax table to use for Shell-Script mode.
416This is buffer-local in every such buffer.")
417
418(defvar sh-mode-default-syntax-table
419 (sh-mode-syntax-table () 415 (sh-mode-syntax-table ()
420 ?\# "<" 416 ?\# "<"
421 ?\n ">#" 417 ?\n ">#"
@@ -436,7 +432,8 @@ This is buffer-local in every such buffer.")
436 ?= "." 432 ?= "."
437 ?< "." 433 ?< "."
438 ?> ".") 434 ?> ".")
439 "Default syntax table for shell mode.") 435 "The syntax table to use for Shell-Script mode.
436This is buffer-local in every such buffer.")
440 437
441(defvar sh-mode-syntax-table-input 438(defvar sh-mode-syntax-table-input
442 '((sh . nil)) 439 '((sh . nil))
@@ -611,7 +608,7 @@ sign. See `sh-feature'."
611(defvar sh-header-marker nil 608(defvar sh-header-marker nil
612 "When non-nil is the end of header for prepending by \\[sh-execute-region]. 609 "When non-nil is the end of header for prepending by \\[sh-execute-region].
613That command is also used for setting this variable.") 610That command is also used for setting this variable.")
614 611(make-variable-buffer-local 'sh-header-marker)
615 612
616(defcustom sh-beginning-of-command 613(defcustom sh-beginning-of-command
617 "\\([;({`|&]\\|\\`\\|[^\\]\n\\)[ \t]*\\([/~[:alnum:]:]\\)" 614 "\\([;({`|&]\\|\\`\\|[^\\]\n\\)[ \t]*\\([/~[:alnum:]:]\\)"
@@ -1533,57 +1530,41 @@ indicate what shell it is use `sh-alias-alist' to translate.
1533 1530
1534If your shell gives error messages with line numbers, you can use \\[executable-interpret] 1531If your shell gives error messages with line numbers, you can use \\[executable-interpret]
1535with your script for an edit-interpret-debug cycle." 1532with your script for an edit-interpret-debug cycle."
1536 (make-local-variable 'skeleton-end-hook)
1537 (make-local-variable 'paragraph-start)
1538 (make-local-variable 'paragraph-separate)
1539 (make-local-variable 'comment-start)
1540 (make-local-variable 'comment-start-skip)
1541 (make-local-variable 'require-final-newline)
1542 (make-local-variable 'sh-header-marker)
1543 (make-local-variable 'sh-shell-file) 1533 (make-local-variable 'sh-shell-file)
1544 (make-local-variable 'sh-shell) 1534 (make-local-variable 'sh-shell)
1545 (make-local-variable 'skeleton-pair-alist) 1535
1546 (make-local-variable 'skeleton-pair-filter-function) 1536 (set (make-local-variable 'skeleton-pair-default-alist)
1547 (make-local-variable 'comint-dynamic-complete-functions) 1537 sh-skeleton-pair-default-alist)
1548 (make-local-variable 'comint-prompt-regexp) 1538 (set (make-local-variable 'skeleton-end-hook)
1549 (make-local-variable 'font-lock-defaults) 1539 (lambda () (or (eolp) (newline) (indent-relative))))
1550 (make-local-variable 'skeleton-filter-function) 1540
1551 (make-local-variable 'skeleton-newline-indent-rigidly) 1541 (set (make-local-variable 'paragraph-start) (concat page-delimiter "\\|$"))
1552 (make-local-variable 'sh-shell-variables) 1542 (set (make-local-variable 'paragraph-separate) paragraph-start)
1553 (make-local-variable 'sh-shell-variables-initialized) 1543 (set (make-local-variable 'comment-start) "# ")
1554 (make-local-variable 'imenu-generic-expression) 1544 (set (make-local-variable 'comment-start-skip) "#+[\t ]*")
1555 (make-local-variable 'sh-indent-supported-here) 1545 (set (make-local-variable 'local-abbrev-table) sh-mode-abbrev-table)
1556 (make-local-variable 'skeleton-pair-default-alist) 1546 (set (make-local-variable 'comint-dynamic-complete-functions)
1557 (setq skeleton-pair-default-alist sh-skeleton-pair-default-alist) 1547 sh-dynamic-complete-functions)
1558 (setq skeleton-end-hook (lambda () 1548 ;; we can't look if previous line ended with `\'
1559 (or (eolp) (newline) (indent-relative))) 1549 (set (make-local-variable 'comint-prompt-regexp) "^[ \t]*")
1560 paragraph-start (concat page-delimiter "\\|$") 1550 (set (make-local-variable 'imenu-case-fold-search) nil)
1561 paragraph-separate paragraph-start 1551 (set (make-local-variable 'font-lock-defaults)
1562 comment-start "# " 1552 `((sh-font-lock-keywords
1563 comment-start-skip "#+[\t ]*" 1553 sh-font-lock-keywords-1 sh-font-lock-keywords-2)
1564 local-abbrev-table sh-mode-abbrev-table 1554 nil nil
1565 comint-dynamic-complete-functions sh-dynamic-complete-functions 1555 ((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil
1566 ;; we can't look if previous line ended with `\' 1556 (font-lock-syntactic-keywords . sh-font-lock-syntactic-keywords)
1567 comint-prompt-regexp "^[ \t]*" 1557 (font-lock-syntactic-face-function
1568 imenu-case-fold-search nil 1558 . sh-font-lock-syntactic-face-function)))
1569 font-lock-defaults 1559 (set (make-local-variable 'skeleton-pair-alist) '((?` _ ?`)))
1570 `((sh-font-lock-keywords 1560 (set (make-local-variable 'skeleton-pair-filter-function) 'sh-quoted-p)
1571 sh-font-lock-keywords-1 sh-font-lock-keywords-2) 1561 (set (make-local-variable 'skeleton-further-elements)
1572 nil nil 1562 '((< '(- (min sh-indentation (current-column))))))
1573 ((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil 1563 (set (make-local-variable 'skeleton-filter-function) 'sh-feature)
1574 (font-lock-syntactic-keywords . sh-font-lock-syntactic-keywords) 1564 (set (make-local-variable 'skeleton-newline-indent-rigidly) t)
1575 (font-lock-syntactic-face-function 1565 (set (make-local-variable 'sh-indent-supported-here) nil)
1576 . sh-font-lock-syntactic-face-function))
1577 skeleton-pair-alist '((?` _ ?`))
1578 skeleton-pair-filter-function 'sh-quoted-p
1579 skeleton-further-elements '((< '(- (min sh-indentation
1580 (current-column)))))
1581 skeleton-filter-function 'sh-feature
1582 skeleton-newline-indent-rigidly t
1583 sh-indent-supported-here nil)
1584 (set (make-local-variable 'defun-prompt-regexp) 1566 (set (make-local-variable 'defun-prompt-regexp)
1585 (concat "^\\(function[ \t]\\|[[:alnum:]]+[ \t]+()[ \t]+\\)")) 1567 (concat "^\\(function[ \t]\\|[[:alnum:]]+[ \t]+()[ \t]+\\)"))
1586 (set (make-local-variable 'parse-sexp-ignore-comments) t)
1587 ;; Parse or insert magic number for exec, and set all variables depending 1568 ;; Parse or insert magic number for exec, and set all variables depending
1588 ;; on the shell thus determined. 1569 ;; on the shell thus determined.
1589 (sh-set-shell 1570 (sh-set-shell
@@ -1737,21 +1718,20 @@ Calls the value of `sh-set-shell-hook' if set."
1737 no-query-flag insert-flag))) 1718 no-query-flag insert-flag)))
1738 (let ((tem (sh-feature sh-require-final-newline))) 1719 (let ((tem (sh-feature sh-require-final-newline)))
1739 (if (eq tem t) 1720 (if (eq tem t)
1740 (setq require-final-newline mode-require-final-newline))) 1721 (set (make-local-variable 'require-final-newline)
1741 (setq 1722 mode-require-final-newline)))
1742 mode-line-process (format "[%s]" sh-shell) 1723 (setq mode-line-process (format "[%s]" sh-shell))
1743 sh-shell-variables nil 1724 (set (make-local-variable 'sh-shell-variables) nil)
1744 sh-shell-variables-initialized nil 1725 (set (make-local-variable 'sh-shell-variables-initialized) nil)
1745 imenu-generic-expression (sh-feature sh-imenu-generic-expression)) 1726 (set (make-local-variable 'imenu-generic-expression)
1746 (make-local-variable 'sh-mode-syntax-table) 1727 (sh-feature sh-imenu-generic-expression))
1747 (let ((tem (sh-feature sh-mode-syntax-table-input))) 1728 (let ((tem (sh-feature sh-mode-syntax-table-input)))
1748 (setq sh-mode-syntax-table 1729 (when tem
1749 (if tem (apply 'sh-mode-syntax-table tem) 1730 (set (make-local-variable 'sh-mode-syntax-table)
1750 sh-mode-default-syntax-table))) 1731 (apply 'sh-mode-syntax-table tem))
1751 (set-syntax-table sh-mode-syntax-table) 1732 (set-syntax-table sh-mode-syntax-table)))
1752 (dolist (var (sh-feature sh-variables)) 1733 (dolist (var (sh-feature sh-variables))
1753 (sh-remember-variable var)) 1734 (sh-remember-variable var))
1754 (make-local-variable 'indent-line-function)
1755 (if (setq sh-indent-supported-here (sh-feature sh-indent-supported)) 1735 (if (setq sh-indent-supported-here (sh-feature sh-indent-supported))
1756 (progn 1736 (progn
1757 (message "Setting up indent for shell type %s" sh-shell) 1737 (message "Setting up indent for shell type %s" sh-shell)
@@ -1764,7 +1744,7 @@ Calls the value of `sh-set-shell-hook' if set."
1764 (message "setting up indent stuff") 1744 (message "setting up indent stuff")
1765 ;; sh-mode has already made indent-line-function local 1745 ;; sh-mode has already made indent-line-function local
1766 ;; but do it in case this is called before that. 1746 ;; but do it in case this is called before that.
1767 (setq indent-line-function 'sh-indent-line) 1747 (set (make-local-variable 'indent-line-function) 'sh-indent-line)
1768 (if sh-make-vars-local 1748 (if sh-make-vars-local
1769 (sh-make-vars-local)) 1749 (sh-make-vars-local))
1770 (message "Indentation setup for shell type %s" sh-shell)) 1750 (message "Indentation setup for shell type %s" sh-shell))
@@ -3463,20 +3443,15 @@ CODE can be nil, t or `lambda'.
3463nil means to return the best completion of STRING, or nil if there is none. 3443nil means to return the best completion of STRING, or nil if there is none.
3464t means to return a list of all possible completions of STRING. 3444t means to return a list of all possible completions of STRING.
3465`lambda' means to return t if STRING is a valid completion as it stands." 3445`lambda' means to return t if STRING is a valid completion as it stands."
3466 (let ((sh-shell-variables 3446 (let ((vars
3467 (with-current-buffer sh-add-buffer 3447 (with-current-buffer sh-add-buffer
3468 (or sh-shell-variables-initialized 3448 (or sh-shell-variables-initialized
3469 (sh-shell-initialize-variables)) 3449 (sh-shell-initialize-variables))
3470 (nconc (mapcar (lambda (var) 3450 (nconc (mapcar (lambda (var)
3471 (let ((name 3451 (substring var 0 (string-match "=" var)))
3472 (substring var 0 (string-match "=" var))))
3473 (cons name name)))
3474 process-environment) 3452 process-environment)
3475 sh-shell-variables)))) 3453 sh-shell-variables))))
3476 (case code 3454 (complete-with-action code vars string predicate)))
3477 ((nil) (try-completion string sh-shell-variables predicate))
3478 (lambda (test-completion string sh-shell-variables predicate))
3479 (t (all-completions string sh-shell-variables predicate)))))
3480 3455
3481(defun sh-add (var delta) 3456(defun sh-add (var delta)
3482 "Insert an addition of VAR and prefix DELTA for Bourne (type) shell." 3457 "Insert an addition of VAR and prefix DELTA for Bourne (type) shell."
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 1f981e5a3d7..e4df102f542 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -663,9 +663,9 @@ is changed."
663 663
664Starts `sql-interactive-mode' after doing some setup. 664Starts `sql-interactive-mode' after doing some setup.
665 665
666On Windows, \"sqlplus\" usually starts the sqlplus \"GUI\". In order to 666On Windows, \"sqlplus\" usually starts the sqlplus \"GUI\". In order
667start the sqlplus console, use \"plus33\" or something similar. You 667to start the sqlplus console, use \"plus33\" or something similar.
668will find the file in your Orant\\bin directory." 668You will find the file in your Orant\\bin directory."
669 :type 'file 669 :type 'file
670 :group 'SQL) 670 :group 'SQL)
671 671
@@ -690,7 +690,7 @@ will find the file in your Orant\\bin directory."
690 690
691When non-nil, Emacs will scan text sent to sqlplus and prompt 691When non-nil, Emacs will scan text sent to sqlplus and prompt
692for replacement text for & placeholders as sqlplus does. This 692for replacement text for & placeholders as sqlplus does. This
693is needed on Windows where sqlplus output is buffer and the 693is needed on Windows where sqlplus output is buffered and the
694prompts are not shown until after the text is entered. 694prompts are not shown until after the text is entered.
695 695
696You will probably want to issue the following command in sqlplus 696You will probably want to issue the following command in sqlplus
@@ -772,10 +772,10 @@ Starts `sql-interactive-mode' after doing some setup."
772 :version "24.1" 772 :version "24.1"
773 :group 'SQL) 773 :group 'SQL)
774 774
775;; Customization for SyBase 775;; Customization for Sybase
776 776
777(defcustom sql-sybase-program "isql" 777(defcustom sql-sybase-program "isql"
778 "Command to start isql by SyBase. 778 "Command to start isql by Sybase.
779 779
780Starts `sql-interactive-mode' after doing some setup." 780Starts `sql-interactive-mode' after doing some setup."
781 :type 'file 781 :type 'file
@@ -2042,7 +2042,7 @@ See `sql-product-alist' for a list of products and supported features."
2042 (message "`%s' is not a known product; use `sql-add-product' to add it first." product)))) 2042 (message "`%s' is not a known product; use `sql-add-product' to add it first." product))))
2043 2043
2044(defun sql-product-font-lock (keywords-only imenu) 2044(defun sql-product-font-lock (keywords-only imenu)
2045 "Configures font-lock and imenu with product-specific settings. 2045 "Configure font-lock and imenu with product-specific settings.
2046 2046
2047The KEYWORDS-ONLY flag is passed to font-lock to specify whether 2047The KEYWORDS-ONLY flag is passed to font-lock to specify whether
2048only keywords should be hilighted and syntactic hilighting 2048only keywords should be hilighted and syntactic hilighting
@@ -2098,7 +2098,7 @@ also be configured."
2098(defun sql-add-product-keywords (product keywords &optional append) 2098(defun sql-add-product-keywords (product keywords &optional append)
2099 "Add highlighting KEYWORDS for SQL PRODUCT. 2099 "Add highlighting KEYWORDS for SQL PRODUCT.
2100 2100
2101PRODUCT should be a symbol, the name of a sql product, such as 2101PRODUCT should be a symbol, the name of a SQL product, such as
2102`oracle'. KEYWORDS should be a list; see the variable 2102`oracle'. KEYWORDS should be a list; see the variable
2103`font-lock-keywords'. By default they are added at the beginning 2103`font-lock-keywords'. By default they are added at the beginning
2104of the current highlighting list. If optional argument APPEND is 2104of the current highlighting list. If optional argument APPEND is
@@ -2131,7 +2131,7 @@ adds a fontification pattern to fontify identifiers ending in
2131;;; Functions to switch highlighting 2131;;; Functions to switch highlighting
2132 2132
2133(defun sql-highlight-product () 2133(defun sql-highlight-product ()
2134 "Turns on the font highlighting for the SQL product selected." 2134 "Turn on the font highlighting for the SQL product selected."
2135 (when (derived-mode-p 'sql-mode) 2135 (when (derived-mode-p 'sql-mode)
2136 ;; Setup font-lock 2136 ;; Setup font-lock
2137 (sql-product-font-lock nil t) 2137 (sql-product-font-lock nil t)
@@ -2141,7 +2141,7 @@ adds a fontification pattern to fontify identifiers ending in
2141 (symbol-name sql-product)) "]")))) 2141 (symbol-name sql-product)) "]"))))
2142 2142
2143(defun sql-set-product (product) 2143(defun sql-set-product (product)
2144 "Set `sql-product' to product and enable appropriate highlighting." 2144 "Set `sql-product' to PRODUCT and enable appropriate highlighting."
2145 (interactive 2145 (interactive
2146 (list (completing-read "SQL product: " 2146 (list (completing-read "SQL product: "
2147 (mapcar (lambda (info) (symbol-name (car info))) 2147 (mapcar (lambda (info) (symbol-name (car info)))
@@ -2416,7 +2416,7 @@ variable `sql-buffer'. See `sql-help' on how to create such a buffer."
2416 (message "Current SQLi buffer is %s." (buffer-name sql-buffer))))) 2416 (message "Current SQLi buffer is %s." (buffer-name sql-buffer)))))
2417 2417
2418(defun sql-make-alternate-buffer-name () 2418(defun sql-make-alternate-buffer-name ()
2419 "Returns a string that can be used to rename a SQLi buffer. 2419 "Return a string that can be used to rename a SQLi buffer.
2420 2420
2421This is used to set `sql-alternate-buffer-name' within 2421This is used to set `sql-alternate-buffer-name' within
2422`sql-interactive-mode'." 2422`sql-interactive-mode'."
@@ -2475,7 +2475,7 @@ Inserts SELECT or commas if appropriate."
2475 2475
2476(defun sql-placeholders-filter (string) 2476(defun sql-placeholders-filter (string)
2477 "Replace placeholders in STRING. 2477 "Replace placeholders in STRING.
2478Placeholders are words starting with and ampersand like &this." 2478Placeholders are words starting with an ampersand like &this."
2479 2479
2480 (when sql-oracle-scan-on 2480 (when sql-oracle-scan-on
2481 (while (string-match "&\\(\\sw+\\)" string) 2481 (while (string-match "&\\(\\sw+\\)" string)
@@ -2489,7 +2489,7 @@ Placeholders are words starting with and ampersand like &this."
2489;; Using DB2 interactively, newlines must be escaped with " \". 2489;; Using DB2 interactively, newlines must be escaped with " \".
2490;; The space before the backslash is relevant. 2490;; The space before the backslash is relevant.
2491(defun sql-escape-newlines-filter (string) 2491(defun sql-escape-newlines-filter (string)
2492 "Escapes newlines in STRING. 2492 "Escape newlines in STRING.
2493Every newline in STRING will be preceded with a space and a backslash." 2493Every newline in STRING will be preceded with a space and a backslash."
2494 (let ((result "") (start 0) mb me) 2494 (let ((result "") (start 0) mb me)
2495 (while (string-match "\n" string start) 2495 (while (string-match "\n" string start)
@@ -2508,7 +2508,7 @@ Every newline in STRING will be preceded with a space and a backslash."
2508;;; Input sender for SQLi buffers 2508;;; Input sender for SQLi buffers
2509 2509
2510(defun sql-input-sender (proc string) 2510(defun sql-input-sender (proc string)
2511 "Sends STRING to PROC after applying filters." 2511 "Send STRING to PROC after applying filters."
2512 2512
2513 (let* ((product (with-current-buffer (process-buffer proc) sql-product)) 2513 (let* ((product (with-current-buffer (process-buffer proc) sql-product))
2514 (filter (sql-get-product-feature product :input-filter))) 2514 (filter (sql-get-product-feature product :input-filter)))
@@ -2575,7 +2575,7 @@ Every newline in STRING will be preceded with a space and a backslash."
2575 (sql-send-region (point-min) (point-max))) 2575 (sql-send-region (point-min) (point-max)))
2576 2576
2577(defun sql-send-magic-terminator (buf str terminator) 2577(defun sql-send-magic-terminator (buf str terminator)
2578 "Sends TERMINATOR to buffer BUF if its not present in STR." 2578 "Send TERMINATOR to buffer BUF if its not present in STR."
2579 (let (pat term) 2579 (let (pat term)
2580 ;; If flag is merely on(t), get product-specific terminator 2580 ;; If flag is merely on(t), get product-specific terminator
2581 (if (eq terminator t) 2581 (if (eq terminator t)
@@ -2961,7 +2961,7 @@ The default comes from `process-coding-system-alist' and
2961 2961
2962;;;###autoload 2962;;;###autoload
2963(defun sql-sybase () 2963(defun sql-sybase ()
2964 "Run isql by SyBase as an inferior process. 2964 "Run isql by Sybase as an inferior process.
2965 2965
2966If buffer `*SQL*' exists but no process is running, make a new process. 2966If buffer `*SQL*' exists but no process is running, make a new process.
2967If buffer exists and a process is running, just switch to buffer 2967If buffer exists and a process is running, just switch to buffer
diff --git a/lisp/simple.el b/lisp/simple.el
index 5948536262c..48e1148ae6b 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -422,6 +422,13 @@ Other major modes are defined by comparison with this one."
422 "Parent major mode from which special major modes should inherit." 422 "Parent major mode from which special major modes should inherit."
423 (setq buffer-read-only t)) 423 (setq buffer-read-only t))
424 424
425;; Major mode meant to be the parent of programming modes.
426
427(define-derived-mode prog-mode fundamental-mode "Prog"
428 "Major mode for editing programming language source code."
429 (set (make-local-variable 'require-final-newline) mode-require-final-newline)
430 (set (make-local-variable 'parse-sexp-ignore-comments) t))
431
425;; Making and deleting lines. 432;; Making and deleting lines.
426 433
427(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard)) 434(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
@@ -2070,7 +2077,11 @@ to `shell-command-history'."
2070 2077
2071Like `shell-command' but if COMMAND doesn't end in ampersand, adds `&' 2078Like `shell-command' but if COMMAND doesn't end in ampersand, adds `&'
2072surrounded by whitespace and executes the command asynchronously. 2079surrounded by whitespace and executes the command asynchronously.
2073The output appears in the buffer `*Async Shell Command*'." 2080The output appears in the buffer `*Async Shell Command*'.
2081
2082In Elisp, you will often be better served by calling `start-process'
2083directly, since it offers more control and does not impose the use of a
2084shell (with its need to quote arguments)."
2074 (interactive 2085 (interactive
2075 (list 2086 (list
2076 (read-shell-command "Async shell command: " nil nil 2087 (read-shell-command "Async shell command: " nil nil
@@ -2131,7 +2142,11 @@ If the optional third argument ERROR-BUFFER is non-nil, it is a buffer
2131or buffer name to which to direct the command's standard error output. 2142or buffer name to which to direct the command's standard error output.
2132If it is nil, error output is mingled with regular output. 2143If it is nil, error output is mingled with regular output.
2133In an interactive call, the variable `shell-command-default-error-buffer' 2144In an interactive call, the variable `shell-command-default-error-buffer'
2134specifies the value of ERROR-BUFFER." 2145specifies the value of ERROR-BUFFER.
2146
2147In Elisp, you will often be better served by calling `call-process' or
2148`start-process' directly, since it offers more control and does not impose
2149the use of a shell (with its need to quote arguments)."
2135 2150
2136 (interactive 2151 (interactive
2137 (list 2152 (list
diff --git a/lisp/subr.el b/lisp/subr.el
index 0cc05a78bc7..1c399f89b9c 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -3804,5 +3804,30 @@ which is higher than \"1alpha\"."
3804 (prin1-to-string (make-hash-table))))) 3804 (prin1-to-string (make-hash-table)))))
3805 (provide 'hashtable-print-readable)) 3805 (provide 'hashtable-print-readable))
3806 3806
3807;; Moving with arrows in bidi-sensitive direction.
3808(defun right-arrow-command (&optional n)
3809 "Move point N characters to the right (to the left if N is negative).
3810On reaching beginning or end of buffer, stop and signal error.
3811
3812Depending on the bidirectional context, this may move either forward
3813or backward in the buffer. This is in contrast with \\[forward-char]
3814and \\[backward-char], which see."
3815 (interactive "^p")
3816 (if (eq (current-bidi-paragraph-direction) 'left-to-right)
3817 (forward-char n)
3818 (backward-char n)))
3819
3820(defun left-arrow-command ( &optional n)
3821 "Move point N characters to the left (to the right if N is negative).
3822On reaching beginning or end of buffer, stop and signal error.
3823
3824Depending on the bidirectional context, this may move either backward
3825or forward in the buffer. This is in contrast with \\[backward-char]
3826and \\[forward-char], which see."
3827 (interactive "^p")
3828 (if (eq (current-bidi-paragraph-direction) 'left-to-right)
3829 (backward-char n)
3830 (forward-char n)))
3831
3807;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc 3832;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc
3808;;; subr.el ends here 3833;;; subr.el ends here
diff --git a/lisp/version.el b/lisp/version.el
index 5cd0cc8d634..770409b9487 100644
--- a/lisp/version.el
+++ b/lisp/version.el
@@ -29,12 +29,6 @@
29 29
30;;; Code: 30;;; Code:
31 31
32(defconst emacs-copyright "Copyright (C) 2010 Free Software Foundation, Inc." "\
33Short copyright string for this version of Emacs.")
34
35(defconst emacs-version "24.0.50" "\
36Version numbers of this version of Emacs.")
37
38(defconst emacs-major-version (progn (string-match "^[0-9]+" emacs-version) (string-to-number (match-string 0 emacs-version))) "\ 32(defconst emacs-major-version (progn (string-match "^[0-9]+" emacs-version) (string-to-number (match-string 0 emacs-version))) "\
39Major version number of this version of Emacs. 33Major version number of this version of Emacs.
40This variable first existed in version 19.23.") 34This variable first existed in version 19.23.")
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el
index efdf26b529c..0b97b184d22 100644
--- a/lisp/w32-fns.el
+++ b/lisp/w32-fns.el
@@ -253,15 +253,16 @@ You should set this to t when using a non-system shell.\n\n"))))
253;; (setq source-directory (file-name-as-directory 253;; (setq source-directory (file-name-as-directory
254;; (expand-file-name ".." exec-directory))))) 254;; (expand-file-name ".." exec-directory)))))
255 255
256(defun convert-standard-filename (filename) 256(defun w32-convert-standard-filename (filename)
257 "Convert a standard file's name to something suitable for the current OS. 257 "Convert a standard file's name to something suitable for the MS-Windows.
258This means to guarantee valid names and perhaps to canonicalize 258This means to guarantee valid names and perhaps to canonicalize
259certain patterns. 259certain patterns.
260 260
261On Windows and DOS, replace invalid characters. On DOS, make 261This function is called by `convert-standard-filename'.
262sure to obey the 8.3 limitations. On Windows, turn Cygwin names 262
263into native names, and also turn slashes into backslashes if the 263Replace invalid characters and turn Cygwin names into native
264shell requires it (see `w32-shell-dos-semantics')." 264names, and also turn slashes into backslashes if the shell
265requires it (see `w32-shell-dos-semantics')."
265 (save-match-data 266 (save-match-data
266 (let ((name 267 (let ((name
267 (if (string-match "\\`/cygdrive/\\([a-zA-Z]\\)/" filename) 268 (if (string-match "\\`/cygdrive/\\([a-zA-Z]\\)/" filename)
generated by cgit v1.2.1 (git 2.18.0) at 2026-02-15 18:56:38 +0000