aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2013-08-29 15:55:58 -0400
committerStefan Monnier2013-08-29 15:55:58 -0400
commit40f7e0e853bf21003fdffeac35e47616f393055d (patch)
tree25770d0dcff8956a77b577d5467caffe37fb0e0f
parent7763d67c87ae050d4e7cc28f1e0c4b14df037d2e (diff)
downloademacs-40f7e0e853bf21003fdffeac35e47616f393055d.tar.gz
emacs-40f7e0e853bf21003fdffeac35e47616f393055d.zip
Misc changes to reduce use of `(lambda...); and other cleanups.
* lisp/cus-edit.el: Use lexical-binding. (customize-push-and-save, customize-apropos) (custom-buffer-create-internal): Use closures. * lisp/progmodes/bat-mode.el (bat-mode-syntax-table): "..." are strings. * lisp/progmodes/ada-xref.el: Use setq. * lisp/net/tramp.el (with-tramp-progress-reporter): Avoid setq. * lisp/dframe.el: Use lexical-binding. (dframe-frame-mode): Fix calling convention for hooks. Use a closure. * lisp/speedbar.el (speedbar-frame-mode): Adjust call accordingly. * lisp/descr-text.el: Use lexical-binding. (describe-text-widget, describe-text-sexp, describe-property-list): Use closures. * lisp/comint.el (comint-history-isearch-push-state): Use a closure. * lisp/calculator.el: Use lexical-binding. (calculator-number-to-string): Make it work with lexical-binding. (calculator-funcall): Same and use cl-letf.
-rw-r--r--lisp/avoid.el6
-rw-r--r--lisp/calculator.el48
-rw-r--r--lisp/comint.el5
-rw-r--r--lisp/cus-edit.el41
-rw-r--r--lisp/descr-text.el21
-rw-r--r--lisp/dframe.el42
-rw-r--r--lisp/emacs-lisp/eldoc.el7
-rw-r--r--lisp/net/tramp.el37
-rw-r--r--lisp/progmodes/ada-xref.el140
-rw-r--r--lisp/progmodes/bat-mode.el1
-rw-r--r--lisp/speedbar.el6
11 files changed, 181 insertions, 173 deletions
diff --git a/lisp/avoid.el b/lisp/avoid.el
index c92d456ef0c..aaccd0974a4 100644
--- a/lisp/avoid.el
+++ b/lisp/avoid.el
@@ -41,9 +41,9 @@
41;; 41;;
42;; (if (eq window-system 'x) 42;; (if (eq window-system 'x)
43;; (mouse-avoidance-set-pointer-shape 43;; (mouse-avoidance-set-pointer-shape
44;; (eval (nth (random 4) 44;; (nth (random 4)
45;; '(x-pointer-man x-pointer-spider 45;; (list x-pointer-man x-pointer-spider
46;; x-pointer-gobbler x-pointer-gumby))))) 46;; x-pointer-gobbler x-pointer-gumby))))
47;; 47;;
48;; For completely random pointer shape, replace the setq above with: 48;; For completely random pointer shape, replace the setq above with:
49;; (setq x-pointer-shape (mouse-avoidance-random-shape)) 49;; (setq x-pointer-shape (mouse-avoidance-random-shape))
diff --git a/lisp/calculator.el b/lisp/calculator.el
index c9a73054712..c988b7e1088 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -1,4 +1,4 @@
1;;; calculator.el --- a [not so] simple calculator for Emacs 1;;; calculator.el --- a [not so] simple calculator for Emacs -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1998, 2000-2013 Free Software Foundation, Inc. 3;; Copyright (C) 1998, 2000-2013 Free Software Foundation, Inc.
4 4
@@ -131,8 +131,8 @@ The displayer is a symbol, a string or an expression. A symbol should
131be the name of a one-argument function, a string is used with a single 131be the name of a one-argument function, a string is used with a single
132argument and an expression will be evaluated with the variable `num' 132argument and an expression will be evaluated with the variable `num'
133bound to whatever should be displayed. If it is a function symbol, it 133bound to whatever should be displayed. If it is a function symbol, it
134should be able to handle special symbol arguments, currently 'left and 134should be able to handle special symbol arguments, currently `left' and
135'right which will be sent by special keys to modify display parameters 135`right' which will be sent by special keys to modify display parameters
136associated with the displayer function (for example to change the number 136associated with the displayer function (for example to change the number
137of digits displayed). 137of digits displayed).
138 138
@@ -241,6 +241,8 @@ Examples:
241;;;===================================================================== 241;;;=====================================================================
242;;; Code: 242;;; Code:
243 243
244(eval-when-compile (require 'cl-lib))
245
244;;;--------------------------------------------------------------------- 246;;;---------------------------------------------------------------------
245;;; Variables 247;;; Variables
246 248
@@ -1124,11 +1126,10 @@ the 'left or 'right when one of the standard modes is used."
1124 (format calculator-displayer num)) 1126 (format calculator-displayer num))
1125 ((symbolp calculator-displayer) 1127 ((symbolp calculator-displayer)
1126 (funcall calculator-displayer num)) 1128 (funcall calculator-displayer num))
1127 ((and (consp calculator-displayer) 1129 ((eq 'std (car-safe calculator-displayer))
1128 (eq 'std (car calculator-displayer)))
1129 (calculator-standard-displayer num (cadr calculator-displayer))) 1130 (calculator-standard-displayer num (cadr calculator-displayer)))
1130 ((listp calculator-displayer) 1131 ((listp calculator-displayer)
1131 (eval calculator-displayer)) 1132 (eval calculator-displayer `((num. ,num))))
1132 (t (prin1-to-string num t)))) 1133 (t (prin1-to-string num t))))
1133 ;; operators are printed here 1134 ;; operators are printed here
1134 (t (prin1-to-string (nth 1 num) t)))) 1135 (t (prin1-to-string (nth 1 num) t))))
@@ -1273,29 +1274,24 @@ arguments."
1273 ;; smaller than calculator-epsilon (1e-15). I don't think this is 1274 ;; smaller than calculator-epsilon (1e-15). I don't think this is
1274 ;; necessary now. 1275 ;; necessary now.
1275 (if (symbolp f) 1276 (if (symbolp f)
1276 (cond ((and X Y) (funcall f X Y)) 1277 (cond ((and X Y) (funcall f X Y))
1277 (X (funcall f X)) 1278 (X (funcall f X))
1278 (t (funcall f))) 1279 (t (funcall f)))
1279 ;; f is an expression 1280 ;; f is an expression
1280 (let* ((__f__ f) ; so we can get this value below... 1281 (let* ((TX (calculator-truncate X))
1281 (TX (calculator-truncate X))
1282 (TY (and Y (calculator-truncate Y))) 1282 (TY (and Y (calculator-truncate Y)))
1283 (DX (if calculator-deg (/ (* X pi) 180) X)) 1283 (DX (if calculator-deg (/ (* X pi) 180) X))
1284 (L calculator-saved-list) 1284 (L calculator-saved-list))
1285 (Fbound (fboundp 'F)) 1285 (cl-letf (((symbol-function 'F)
1286 (Fsave (and Fbound (symbol-function 'F))) 1286 (lambda (&optional x y) (calculator-funcall f x y)))
1287 (Dbound (fboundp 'D)) 1287 ((symbol-function 'D)
1288 (Dsave (and Dbound (symbol-function 'D)))) 1288 (lambda (x) (if calculator-deg (/ (* x 180) float-pi) x))))
1289 ;; a shortened version of flet 1289 (eval f `((X . ,X)
1290 (fset 'F (function 1290 (Y . ,X)
1291 (lambda (&optional x y) 1291 (TX . ,TX)
1292 (calculator-funcall __f__ x y)))) 1292 (TY . ,TY)
1293 (fset 'D (function 1293 (DX . ,DX)
1294 (lambda (x) 1294 (L . ,L))))))
1295 (if calculator-deg (/ (* x 180) float-pi) x))))
1296 (unwind-protect (eval f)
1297 (if Fbound (fset 'F Fsave) (fmakunbound 'F))
1298 (if Dbound (fset 'D Dsave) (fmakunbound 'D)))))
1299 (error 0))) 1295 (error 0)))
1300 1296
1301;;;--------------------------------------------------------------------- 1297;;;---------------------------------------------------------------------
diff --git a/lisp/comint.el b/lisp/comint.el
index 4517e9c65a0..0ce7053c031 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -1562,8 +1562,9 @@ or to the last history element for a backward search."
1562 "Save a function restoring the state of input history search. 1562 "Save a function restoring the state of input history search.
1563Save `comint-input-ring-index' to the additional state parameter 1563Save `comint-input-ring-index' to the additional state parameter
1564in the search status stack." 1564in the search status stack."
1565 `(lambda (cmd) 1565 (let ((index comint-input-ring-index))
1566 (comint-history-isearch-pop-state cmd ,comint-input-ring-index))) 1566 (lambda (cmd)
1567 (comint-history-isearch-pop-state cmd index))))
1567 1568
1568(defun comint-history-isearch-pop-state (_cmd hist-pos) 1569(defun comint-history-isearch-pop-state (_cmd hist-pos)
1569 "Restore the input history search state. 1570 "Restore the input history search state.
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index b50c1a5155b..176440f91bb 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1,4 +1,4 @@
1;;; cus-edit.el --- tools for customizing Emacs and Lisp packages 1;;; cus-edit.el --- tools for customizing Emacs and Lisp packages -*- lexical-binding:t -*-
2;; 2;;
3;; Copyright (C) 1996-1997, 1999-2013 Free Software Foundation, Inc. 3;; Copyright (C) 1996-1997, 1999-2013 Free Software Foundation, Inc.
4;; 4;;
@@ -1057,8 +1057,8 @@ the resulting list value now. Otherwise, add an entry to
1057 (let ((coding-system-for-read nil)) 1057 (let ((coding-system-for-read nil))
1058 (customize-save-variable list-var (eval list-var))) 1058 (customize-save-variable list-var (eval list-var)))
1059 (add-hook 'after-init-hook 1059 (add-hook 'after-init-hook
1060 `(lambda () 1060 (lambda ()
1061 (customize-push-and-save ',list-var ',elts))))) 1061 (customize-push-and-save list-var elts)))))
1062 1062
1063;;;###autoload 1063;;;###autoload
1064(defun customize () 1064(defun customize ()
@@ -1415,6 +1415,7 @@ suggest to customize that face, if it's customizable."
1415 "*Customize Saved*")))) 1415 "*Customize Saved*"))))
1416 1416
1417(declare-function apropos-parse-pattern "apropos" (pattern)) 1417(declare-function apropos-parse-pattern "apropos" (pattern))
1418(defvar apropos-regexp)
1418 1419
1419;;;###autoload 1420;;;###autoload
1420(defun customize-apropos (pattern &optional type) 1421(defun customize-apropos (pattern &optional type)
@@ -1431,23 +1432,23 @@ If TYPE is `groups', include only groups."
1431 (require 'apropos) 1432 (require 'apropos)
1432 (unless (memq type '(nil options faces groups)) 1433 (unless (memq type '(nil options faces groups))
1433 (error "Invalid setting type %s" (symbol-name type))) 1434 (error "Invalid setting type %s" (symbol-name type)))
1434 (apropos-parse-pattern pattern) 1435 (apropos-parse-pattern pattern) ;Sets apropos-regexp by side-effect: Yuck!
1435 (let (found) 1436 (let (found)
1436 (mapatoms 1437 (mapatoms
1437 `(lambda (symbol) 1438 (lambda (symbol)
1438 (when (string-match-p apropos-regexp (symbol-name symbol)) 1439 (when (string-match-p apropos-regexp (symbol-name symbol))
1439 ,(if (memq type '(nil groups)) 1440 (if (memq type '(nil groups))
1440 '(if (get symbol 'custom-group) 1441 (if (get symbol 'custom-group)
1441 (push (list symbol 'custom-group) found))) 1442 (push (list symbol 'custom-group) found)))
1442 ,(if (memq type '(nil faces)) 1443 (if (memq type '(nil faces))
1443 '(if (custom-facep symbol) 1444 (if (custom-facep symbol)
1444 (push (list symbol 'custom-face) found))) 1445 (push (list symbol 'custom-face) found)))
1445 ,(if (memq type '(nil options)) 1446 (if (memq type '(nil options))
1446 `(if (and (boundp symbol) 1447 (if (and (boundp symbol)
1447 (eq (indirect-variable symbol) symbol) 1448 (eq (indirect-variable symbol) symbol)
1448 (or (get symbol 'saved-value) 1449 (or (get symbol 'saved-value)
1449 (custom-variable-p symbol))) 1450 (custom-variable-p symbol)))
1450 (push (list symbol 'custom-variable) found)))))) 1451 (push (list symbol 'custom-variable) found))))))
1451 (unless found 1452 (unless found
1452 (error "No customizable %s matching %s" (symbol-name type) pattern)) 1453 (error "No customizable %s matching %s" (symbol-name type) pattern))
1453 (custom-buffer-create 1454 (custom-buffer-create
@@ -1621,8 +1622,8 @@ or a regular expression.")
1621 (widget-create 1622 (widget-create
1622 'editable-field 1623 'editable-field
1623 :size 40 :help-echo echo 1624 :size 40 :help-echo echo
1624 :action `(lambda (widget &optional event) 1625 :action (lambda (widget &optional _event)
1625 (customize-apropos (split-string (widget-value widget))))))) 1626 (customize-apropos (split-string (widget-value widget)))))))
1626 (widget-insert " ") 1627 (widget-insert " ")
1627 (widget-create-child-and-convert 1628 (widget-create-child-and-convert
1628 search-widget 'push-button 1629 search-widget 'push-button
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index 774ee92a146..134dbdfb33b 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -1,4 +1,4 @@
1;;; descr-text.el --- describe text mode 1;;; descr-text.el --- describe text mode -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1994-1996, 2001-2013 Free Software Foundation, Inc. 3;; Copyright (C) 1994-1996, 2001-2013 Free Software Foundation, Inc.
4 4
@@ -23,7 +23,7 @@
23 23
24;;; Commentary: 24;;; Commentary:
25 25
26;;; Describe-Text Mode. 26;; Describe-Text Mode.
27 27
28;;; Code: 28;;; Code:
29 29
@@ -36,8 +36,7 @@
36 "Insert text to describe WIDGET in the current buffer." 36 "Insert text to describe WIDGET in the current buffer."
37 (insert-text-button 37 (insert-text-button
38 (symbol-name (if (symbolp widget) widget (car widget))) 38 (symbol-name (if (symbolp widget) widget (car widget)))
39 'action `(lambda (&rest ignore) 39 'action (lambda (&rest _ignore) (widget-browse widget))
40 (widget-browse ',widget))
41 'help-echo "mouse-2, RET: browse this widget") 40 'help-echo "mouse-2, RET: browse this widget")
42 (insert " ") 41 (insert " ")
43 (insert-text-button 42 (insert-text-button
@@ -55,10 +54,10 @@
55 (<= (length pp) (- (window-width) (current-column)))) 54 (<= (length pp) (- (window-width) (current-column))))
56 (insert pp) 55 (insert pp)
57 (insert-text-button 56 (insert-text-button
58 "[Show]" 'action `(lambda (&rest ignore) 57 "[Show]" 'action (lambda (&rest _ignore)
59 (with-output-to-temp-buffer 58 (with-output-to-temp-buffer
60 "*Pp Eval Output*" 59 "*Pp Eval Output*"
61 (princ ',pp))) 60 (princ pp)))
62 'help-echo "mouse-2, RET: pretty print value in another buffer")))) 61 'help-echo "mouse-2, RET: pretty print value in another buffer"))))
63 62
64(defun describe-property-list (properties) 63(defun describe-property-list (properties)
@@ -81,8 +80,8 @@ into help buttons that call `describe-text-category' or
81 (cond ((eq key 'category) 80 (cond ((eq key 'category)
82 (insert-text-button 81 (insert-text-button
83 (symbol-name value) 82 (symbol-name value)
84 'action `(lambda (&rest ignore) 83 'action (lambda (&rest _ignore)
85 (describe-text-category ',value)) 84 (describe-text-category value))
86 'follow-link t 85 'follow-link t
87 'help-echo "mouse-2, RET: describe this category")) 86 'help-echo "mouse-2, RET: describe this category"))
88 ((memq key '(face font-lock-face mouse-face)) 87 ((memq key '(face font-lock-face mouse-face))
@@ -663,7 +662,7 @@ relevant to POS."
663 ((and (< char 32) (not (memq char '(9 10)))) 662 ((and (< char 32) (not (memq char '(9 10))))
664 'escape-glyph))))) 663 'escape-glyph)))))
665 (if face (list (list "hardcoded face" 664 (if face (list (list "hardcoded face"
666 `(insert-text-button 665 `(insert-text-button ;FIXME: Wrap in lambda!
667 ,(symbol-name face) 666 ,(symbol-name face)
668 'type 'help-face 667 'type 'help-face
669 'help-args '(,face)))))) 668 'help-args '(,face))))))
diff --git a/lisp/dframe.el b/lisp/dframe.el
index 21b508512d3..66967075e34 100644
--- a/lisp/dframe.el
+++ b/lisp/dframe.el
@@ -1,4 +1,4 @@
1;;; dframe --- dedicate frame support modes 1;;; dframe --- dedicate frame support modes -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1996-2013 Free Software Foundation, Inc. 3;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
4 4
@@ -259,9 +259,15 @@ This buffer will have `dframe-frame-mode' run on it.
259FRAME-NAME is the name of the frame to create. 259FRAME-NAME is the name of the frame to create.
260LOCAL-MODE-FN is the function used to call this one. 260LOCAL-MODE-FN is the function used to call this one.
261PARAMETERS are frame parameters to apply to this dframe. 261PARAMETERS are frame parameters to apply to this dframe.
262DELETE-HOOK are hooks to run when deleting a frame. 262DELETE-HOOK is a hook to run when deleting a frame.
263POPUP-HOOK are hooks to run before showing a frame. 263POPUP-HOOK is a hook to run before showing a frame.
264CREATE-HOOK are hooks to run after creating a frame." 264CREATE-HOOK is a hook to run after creating a frame."
265 (let ((conv-hook (lambda (val)
266 (let ((sym (make-symbol "hook")))
267 (set sym val) sym))))
268 (if (consp delete-hook) (setq delete-hook (funcall conv-hook delete-hook)))
269 (if (consp create-hook) (setq create-hook (funcall conv-hook create-hook)))
270 (if (consp popup-hook) (setq popup-hook (funcall conv-hook popup-hook))))
265 ;; toggle frame on and off. 271 ;; toggle frame on and off.
266 (if (not arg) (if (dframe-live-p (symbol-value frame-var)) 272 (if (not arg) (if (dframe-live-p (symbol-value frame-var))
267 (setq arg -1) (setq arg 1))) 273 (setq arg -1) (setq arg 1)))
@@ -270,7 +276,7 @@ CREATE-HOOK are hooks to run after creating a frame."
270 ;; turn the frame off on neg number 276 ;; turn the frame off on neg number
271 (if (and (numberp arg) (< arg 0)) 277 (if (and (numberp arg) (< arg 0))
272 (progn 278 (progn
273 (run-hooks 'delete-hook) 279 (run-hooks delete-hook)
274 (if (and (symbol-value frame-var) 280 (if (and (symbol-value frame-var)
275 (frame-live-p (symbol-value frame-var))) 281 (frame-live-p (symbol-value frame-var)))
276 (progn 282 (progn
@@ -279,7 +285,7 @@ CREATE-HOOK are hooks to run after creating a frame."
279 (set frame-var nil)) 285 (set frame-var nil))
280 ;; Set this as our currently attached frame 286 ;; Set this as our currently attached frame
281 (setq dframe-attached-frame (selected-frame)) 287 (setq dframe-attached-frame (selected-frame))
282 (run-hooks 'popup-hook) 288 (run-hooks popup-hook)
283 ;; Updated the buffer passed in to contain all the hacks needed 289 ;; Updated the buffer passed in to contain all the hacks needed
284 ;; to make it work well in a dedicated window. 290 ;; to make it work well in a dedicated window.
285 (with-current-buffer (symbol-value buffer-var) 291 (with-current-buffer (symbol-value buffer-var)
@@ -331,15 +337,15 @@ CREATE-HOOK are hooks to run after creating a frame."
331 (setq temp-buffer-show-function 'dframe-temp-buffer-show-function) 337 (setq temp-buffer-show-function 'dframe-temp-buffer-show-function)
332 ;; If this buffer is killed, we must make sure that we destroy 338 ;; If this buffer is killed, we must make sure that we destroy
333 ;; the frame the dedicated window is in. 339 ;; the frame the dedicated window is in.
334 (add-hook 'kill-buffer-hook `(lambda () 340 (add-hook 'kill-buffer-hook (lambda ()
335 (let ((skilling (boundp 'skilling))) 341 (let ((skilling (boundp 'skilling)))
336 (if skilling 342 (if skilling
337 nil 343 nil
338 (if dframe-controlled 344 (if dframe-controlled
339 (progn 345 (progn
340 (funcall dframe-controlled -1) 346 (funcall dframe-controlled -1)
341 (setq ,buffer-var nil) 347 (set buffer-var nil)
342 ))))) 348 )))))
343 t t) 349 t t)
344 ) 350 )
345 ;; Get the frame to work in 351 ;; Get the frame to work in
@@ -396,7 +402,7 @@ CREATE-HOOK are hooks to run after creating a frame."
396 (switch-to-buffer (symbol-value buffer-var)) 402 (switch-to-buffer (symbol-value buffer-var))
397 (set-window-dedicated-p (selected-window) t)) 403 (set-window-dedicated-p (selected-window) t))
398 ;; Run hooks (like reposition) 404 ;; Run hooks (like reposition)
399 (run-hooks 'create-hook) 405 (run-hooks create-hook)
400 ;; Frame name 406 ;; Frame name
401 (if (and (or (null window-system) (eq window-system 'pc)) 407 (if (and (or (null window-system) (eq window-system 'pc))
402 (fboundp 'set-frame-name)) 408 (fboundp 'set-frame-name))
@@ -602,7 +608,7 @@ Argument E is the event deleting the frame."
602If the selected frame is not in the symbol FRAME-VAR, then FRAME-VAR 608If the selected frame is not in the symbol FRAME-VAR, then FRAME-VAR
603frame is selected. If the FRAME-VAR is active, then select the 609frame is selected. If the FRAME-VAR is active, then select the
604attached frame. If FRAME-VAR is nil, ACTIVATOR is called to 610attached frame. If FRAME-VAR is nil, ACTIVATOR is called to
605created it. HOOK is an optional argument of hooks to run when 611created it. HOOK is an optional hook to run when
606selecting FRAME-VAR." 612selecting FRAME-VAR."
607 (interactive) 613 (interactive)
608 (if (eq (selected-frame) (symbol-value frame-var)) 614 (if (eq (selected-frame) (symbol-value frame-var))
@@ -616,7 +622,7 @@ selecting FRAME-VAR."
616 ) 622 )
617 (other-frame 0) 623 (other-frame 0)
618 ;; If updates are off, then refresh the frame (they want it now...) 624 ;; If updates are off, then refresh the frame (they want it now...)
619 (run-hooks 'hook)) 625 (run-hooks hook))
620 626
621 627
622(defun dframe-close-frame () 628(defun dframe-close-frame ()
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 4efbdcb22cb..9b9fd325941 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -185,6 +185,7 @@ expression point is on."
185 (add-hook 'post-self-insert-hook prn-info nil t) 185 (add-hook 'post-self-insert-hook prn-info nil t)
186 (remove-hook 'post-self-insert-hook prn-info t)))) 186 (remove-hook 'post-self-insert-hook prn-info t))))
187 187
188;; FIXME: This changes Emacs's behavior when the file is loaded!
188(add-hook 'eval-expression-minibuffer-setup-hook 'eldoc-post-insert-mode) 189(add-hook 'eval-expression-minibuffer-setup-hook 'eldoc-post-insert-mode)
189 190
190;;;###autoload 191;;;###autoload
@@ -487,11 +488,11 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
487(defun eldoc-beginning-of-sexp () 488(defun eldoc-beginning-of-sexp ()
488 (let ((parse-sexp-ignore-comments t) 489 (let ((parse-sexp-ignore-comments t)
489 (num-skipped-sexps 0)) 490 (num-skipped-sexps 0))
490 (condition-case err 491 (condition-case _
491 (progn 492 (progn
492 ;; First account for the case the point is directly over a 493 ;; First account for the case the point is directly over a
493 ;; beginning of a nested sexp. 494 ;; beginning of a nested sexp.
494 (condition-case err 495 (condition-case _
495 (let ((p (point))) 496 (let ((p (point)))
496 (forward-sexp -1) 497 (forward-sexp -1)
497 (forward-sexp 1) 498 (forward-sexp 1)
@@ -518,7 +519,7 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
518 (let ((defn (and (fboundp fsym) 519 (let ((defn (and (fboundp fsym)
519 (symbol-function fsym)))) 520 (symbol-function fsym))))
520 (and (symbolp defn) 521 (and (symbolp defn)
521 (condition-case err 522 (condition-case _
522 (setq defn (indirect-function fsym)) 523 (setq defn (indirect-function fsym))
523 (error (setq defn nil)))) 524 (error (setq defn nil))))
524 defn)) 525 defn))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 5f473a496e2..43aa0031cb1 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1654,24 +1654,27 @@ If VAR is nil, then we bind `v' to the structure and `method', `user',
1654If LEVEL does not fit for visible messages, there are only traces 1654If LEVEL does not fit for visible messages, there are only traces
1655without a visible progress reporter." 1655without a visible progress reporter."
1656 (declare (indent 3) (debug t)) 1656 (declare (indent 3) (debug t))
1657 `(let ((result "failed") 1657 `(progn
1658 pr tm)
1659 (tramp-message ,vec ,level "%s..." ,message) 1658 (tramp-message ,vec ,level "%s..." ,message)
1660 ;; We start a pulsing progress reporter after 3 seconds. Feature 1659 (let ((result "failed")
1661 ;; introduced in Emacs 24.1. 1660 (tm
1662 (when (and tramp-message-show-message 1661 ;; We start a pulsing progress reporter after 3 seconds. Feature
1663 ;; Display only when there is a minimum level. 1662 ;; introduced in Emacs 24.1.
1664 (<= ,level (min tramp-verbose 3))) 1663 (when (and tramp-message-show-message
1665 (ignore-errors 1664 ;; Display only when there is a minimum level.
1666 (setq pr (tramp-compat-funcall 'make-progress-reporter ,message) 1665 (<= ,level (min tramp-verbose 3)))
1667 tm (when pr 1666 (ignore-errors
1668 (run-at-time 3 0.1 'tramp-progress-reporter-update pr))))) 1667 (let ((pr (tramp-compat-funcall
1669 (unwind-protect 1668 #'make-progress-reporter ,message)))
1670 ;; Execute the body. 1669 (when pr
1671 (prog1 (progn ,@body) (setq result "done")) 1670 (run-at-time 3 0.1
1672 ;; Stop progress reporter. 1671 #'tramp-progress-reporter-update pr)))))))
1673 (if tm (tramp-compat-funcall 'cancel-timer tm)) 1672 (unwind-protect
1674 (tramp-message ,vec ,level "%s...%s" ,message result)))) 1673 ;; Execute the body.
1674 (prog1 (progn ,@body) (setq result "done"))
1675 ;; Stop progress reporter.
1676 (if tm (tramp-compat-funcall 'cancel-timer tm))
1677 (tramp-message ,vec ,level "%s...%s" ,message result)))))
1675 1678
1676(tramp-compat-font-lock-add-keywords 1679(tramp-compat-font-lock-add-keywords
1677 'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>")) 1680 'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>"))
diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el
index d29fa8c1d36..1ca83a97a59 100644
--- a/lisp/progmodes/ada-xref.el
+++ b/lisp/progmodes/ada-xref.el
@@ -342,9 +342,9 @@ CROSS-PREFIX is the prefix to use for the `gnatls' command."
342 ) 342 )
343 (kill-buffer nil)))) 343 (kill-buffer nil))))
344 344
345 (set 'ada-xref-runtime-library-specs-path 345 (setq ada-xref-runtime-library-specs-path
346 (reverse ada-xref-runtime-library-specs-path)) 346 (reverse ada-xref-runtime-library-specs-path))
347 (set 'ada-xref-runtime-library-ali-path 347 (setq ada-xref-runtime-library-ali-path
348 (reverse ada-xref-runtime-library-ali-path)) 348 (reverse ada-xref-runtime-library-ali-path))
349 )) 349 ))
350 350
@@ -582,8 +582,8 @@ as defined in the project file."
582 582
583 (while dirs 583 (while dirs
584 (if (file-directory-p (car dirs)) 584 (if (file-directory-p (car dirs))
585 (set 'list (append list (file-name-all-completions string (car dirs))))) 585 (setq list (append list (file-name-all-completions string (car dirs)))))
586 (set 'dirs (cdr dirs))) 586 (setq dirs (cdr dirs)))
587 (cond ((equal flag 'lambda) 587 (cond ((equal flag 'lambda)
588 (assoc string list)) 588 (assoc string list))
589 (flag 589 (flag
@@ -702,11 +702,11 @@ is non-nil, prompt the user to select one. If none are found, return
702 702
703 ((file-exists-p first-choice) 703 ((file-exists-p first-choice)
704 ;; filename.adp 704 ;; filename.adp
705 (set 'selected first-choice)) 705 (setq selected first-choice))
706 706
707 ((= (length prj-files) 1) 707 ((= (length prj-files) 1)
708 ;; Exactly one project file was found in the current directory 708 ;; Exactly one project file was found in the current directory
709 (set 'selected (car prj-files))) 709 (setq selected (car prj-files)))
710 710
711 ((and (> (length prj-files) 1) (not no-user-question)) 711 ((and (> (length prj-files) 1) (not no-user-question))
712 ;; multiple project files in current directory, ask the user 712 ;; multiple project files in current directory, ask the user
@@ -732,7 +732,7 @@ is non-nil, prompt the user to select one. If none are found, return
732 (> choice (length prj-files))) 732 (> choice (length prj-files)))
733 (setq choice (string-to-number 733 (setq choice (string-to-number
734 (read-from-minibuffer "Enter No. of your choice: ")))) 734 (read-from-minibuffer "Enter No. of your choice: "))))
735 (set 'selected (nth (1- choice) prj-files)))) 735 (setq selected (nth (1- choice) prj-files))))
736 736
737 ((= (length prj-files) 0) 737 ((= (length prj-files) 0)
738 ;; No project file in the current directory; ask user 738 ;; No project file in the current directory; ask user
@@ -742,7 +742,7 @@ is non-nil, prompt the user to select one. If none are found, return
742 (concat "project file [" ada-last-prj-file "]:") 742 (concat "project file [" ada-last-prj-file "]:")
743 nil ada-last-prj-file)) 743 nil ada-last-prj-file))
744 (unless (string= ada-last-prj-file "") 744 (unless (string= ada-last-prj-file "")
745 (set 'selected ada-last-prj-file)))) 745 (setq selected ada-last-prj-file))))
746 ))) 746 )))
747 747
748 (or selected "default.adp") 748 (or selected "default.adp")
@@ -792,9 +792,9 @@ is non-nil, prompt the user to select one. If none are found, return
792 792
793 (setq prj-file (expand-file-name prj-file)) 793 (setq prj-file (expand-file-name prj-file))
794 (if (string= (file-name-extension prj-file) "gpr") 794 (if (string= (file-name-extension prj-file) "gpr")
795 (set 'project (ada-gnat-parse-gpr project prj-file)) 795 (setq project (ada-gnat-parse-gpr project prj-file))
796 796
797 (set 'project (ada-parse-prj-file-1 prj-file project)) 797 (setq project (ada-parse-prj-file-1 prj-file project))
798 ) 798 )
799 799
800 ;; Store the project properties 800 ;; Store the project properties
@@ -842,7 +842,7 @@ Return new value of PROJECT."
842 (substitute-in-file-name (match-string 2))))) 842 (substitute-in-file-name (match-string 2)))))
843 843
844 ((string= (match-string 1) "build_dir") 844 ((string= (match-string 1) "build_dir")
845 (set 'project 845 (setq project
846 (plist-put project 'build_dir 846 (plist-put project 'build_dir
847 (file-name-as-directory (match-string 2))))) 847 (file-name-as-directory (match-string 2)))))
848 848
@@ -884,7 +884,7 @@ Return new value of PROJECT."
884 884
885 (t 885 (t
886 ;; any other field in the file is just copied 886 ;; any other field in the file is just copied
887 (set 'project (plist-put project 887 (setq project (plist-put project
888 (intern (match-string 1)) 888 (intern (match-string 1))
889 (match-string 2)))))) 889 (match-string 2))))))
890 890
@@ -900,21 +900,21 @@ Return new value of PROJECT."
900 (let ((sep (plist-get project 'ada_project_path_sep))) 900 (let ((sep (plist-get project 'ada_project_path_sep)))
901 (setq ada_project_path (reverse ada_project_path)) 901 (setq ada_project_path (reverse ada_project_path))
902 (setq ada_project_path (mapconcat 'identity ada_project_path sep)) 902 (setq ada_project_path (mapconcat 'identity ada_project_path sep))
903 (set 'project (plist-put project 'ada_project_path ada_project_path)) 903 (setq project (plist-put project 'ada_project_path ada_project_path))
904 ;; env var needed now for ada-gnat-parse-gpr 904 ;; env var needed now for ada-gnat-parse-gpr
905 (setenv "ADA_PROJECT_PATH" ada_project_path))) 905 (setenv "ADA_PROJECT_PATH" ada_project_path)))
906 906
907 (if debug_post_cmd (set 'project (plist-put project 'debug_post_cmd (reverse debug_post_cmd)))) 907 (if debug_post_cmd (setq project (plist-put project 'debug_post_cmd (reverse debug_post_cmd))))
908 (if debug_pre_cmd (set 'project (plist-put project 'debug_pre_cmd (reverse debug_pre_cmd)))) 908 (if debug_pre_cmd (setq project (plist-put project 'debug_pre_cmd (reverse debug_pre_cmd))))
909 (if casing (set 'project (plist-put project 'casing (reverse casing)))) 909 (if casing (setq project (plist-put project 'casing (reverse casing))))
910 (if check_cmd (set 'project (plist-put project 'check_cmd (reverse check_cmd)))) 910 (if check_cmd (setq project (plist-put project 'check_cmd (reverse check_cmd))))
911 (if comp_cmd (set 'project (plist-put project 'comp_cmd (reverse comp_cmd)))) 911 (if comp_cmd (setq project (plist-put project 'comp_cmd (reverse comp_cmd))))
912 (if make_cmd (set 'project (plist-put project 'make_cmd (reverse make_cmd)))) 912 (if make_cmd (setq project (plist-put project 'make_cmd (reverse make_cmd))))
913 (if run_cmd (set 'project (plist-put project 'run_cmd (reverse run_cmd)))) 913 (if run_cmd (setq project (plist-put project 'run_cmd (reverse run_cmd))))
914 914
915 (if gpr_file 915 (if gpr_file
916 (progn 916 (progn
917 (set 'project (ada-gnat-parse-gpr project gpr_file)) 917 (setq project (ada-gnat-parse-gpr project gpr_file))
918 ;; append Ada source and object directories to others from Emacs project file 918 ;; append Ada source and object directories to others from Emacs project file
919 (setq src_dir (append (plist-get project 'src_dir) src_dir)) 919 (setq src_dir (append (plist-get project 'src_dir) src_dir))
920 (setq obj_dir (append (plist-get project 'obj_dir) obj_dir)) 920 (setq obj_dir (append (plist-get project 'obj_dir) obj_dir))
@@ -930,8 +930,8 @@ Return new value of PROJECT."
930 (ada-initialize-runtime-library (or (ada-xref-get-project-field 'cross_prefix) "")) 930 (ada-initialize-runtime-library (or (ada-xref-get-project-field 'cross_prefix) ""))
931 ;;) 931 ;;)
932 932
933 (if obj_dir (set 'project (plist-put project 'obj_dir (reverse obj_dir)))) 933 (if obj_dir (setq project (plist-put project 'obj_dir (reverse obj_dir))))
934 (if src_dir (set 'project (plist-put project 'src_dir (reverse src_dir)))) 934 (if src_dir (setq project (plist-put project 'src_dir (reverse src_dir))))
935 935
936 project 936 project
937 )) 937 ))
@@ -1052,9 +1052,9 @@ existing buffer `*gnatfind*', if there is one."
1052 (if old-contents 1052 (if old-contents
1053 (progn 1053 (progn
1054 (goto-char 1) 1054 (goto-char 1)
1055 (set 'buffer-read-only nil) 1055 (setq buffer-read-only nil)
1056 (insert old-contents) 1056 (insert old-contents)
1057 (set 'buffer-read-only t) 1057 (setq buffer-read-only t)
1058 (goto-char (point-max))))) 1058 (goto-char (point-max)))))
1059 ) 1059 )
1060 ) 1060 )
@@ -1194,9 +1194,9 @@ project file."
1194 (objects (getenv "ADA_OBJECTS_PATH")) 1194 (objects (getenv "ADA_OBJECTS_PATH"))
1195 (build-dir (ada-xref-get-project-field 'build_dir))) 1195 (build-dir (ada-xref-get-project-field 'build_dir)))
1196 (if include 1196 (if include
1197 (set 'include (concat path-separator include))) 1197 (setq include (concat path-separator include)))
1198 (if objects 1198 (if objects
1199 (set 'objects (concat path-separator objects))) 1199 (setq objects (concat path-separator objects)))
1200 (cons 1200 (cons
1201 (concat "ADA_INCLUDE_PATH=" 1201 (concat "ADA_INCLUDE_PATH="
1202 (mapconcat (lambda(x) (expand-file-name x build-dir)) 1202 (mapconcat (lambda(x) (expand-file-name x build-dir))
@@ -1303,7 +1303,7 @@ If ARG is non-nil, ask for user confirmation."
1303 1303
1304 ;; Guess the command if it wasn't specified 1304 ;; Guess the command if it wasn't specified
1305 (if (not command) 1305 (if (not command)
1306 (set 'command (list (file-name-sans-extension (buffer-name))))) 1306 (setq command (list (file-name-sans-extension (buffer-name)))))
1307 1307
1308 ;; Modify the command to run remotely 1308 ;; Modify the command to run remotely
1309 (setq command (ada-remote (mapconcat 'identity command 1309 (setq command (ada-remote (mapconcat 'identity command
@@ -1316,7 +1316,7 @@ If ARG is non-nil, ask for user confirmation."
1316 1316
1317 ;; Run the command 1317 ;; Run the command
1318 (with-current-buffer (get-buffer-create "*run*") 1318 (with-current-buffer (get-buffer-create "*run*")
1319 (set 'buffer-read-only nil) 1319 (setq buffer-read-only nil)
1320 1320
1321 (erase-buffer) 1321 (erase-buffer)
1322 (start-process "run" (current-buffer) shell-file-name 1322 (start-process "run" (current-buffer) shell-file-name
@@ -1352,7 +1352,7 @@ project file."
1352 1352
1353 ;; If the command was not given in the project file, start a bare gdb 1353 ;; If the command was not given in the project file, start a bare gdb
1354 (if (not cmd) 1354 (if (not cmd)
1355 (set 'cmd (concat ada-prj-default-debugger 1355 (setq cmd (concat ada-prj-default-debugger
1356 " " 1356 " "
1357 (or executable-name 1357 (or executable-name
1358 (file-name-sans-extension (buffer-file-name)))))) 1358 (file-name-sans-extension (buffer-file-name))))))
@@ -1368,18 +1368,18 @@ project file."
1368 ;; chance to fully manage it. Then it works fine with Enlightenment 1368 ;; chance to fully manage it. Then it works fine with Enlightenment
1369 ;; as well 1369 ;; as well
1370 (let ((frame (make-frame '((visibility . nil))))) 1370 (let ((frame (make-frame '((visibility . nil)))))
1371 (set 'cmd (concat 1371 (setq cmd (concat
1372 cmd " --editor-window=" 1372 cmd " --editor-window="
1373 (cdr (assoc 'outer-window-id (frame-parameters frame))))) 1373 (cdr (assoc 'outer-window-id (frame-parameters frame)))))
1374 (select-frame frame))) 1374 (select-frame frame)))
1375 1375
1376 ;; Add a -fullname switch 1376 ;; Add a -fullname switch
1377 ;; Use the remote machine 1377 ;; Use the remote machine
1378 (set 'cmd (ada-remote (concat cmd " -fullname "))) 1378 (setq cmd (ada-remote (concat cmd " -fullname ")))
1379 1379
1380 ;; Ask for confirmation if required 1380 ;; Ask for confirmation if required
1381 (if (or arg ada-xref-confirm-compile) 1381 (if (or arg ada-xref-confirm-compile)
1382 (set 'cmd (read-from-minibuffer "enter command to debug: " cmd))) 1382 (setq cmd (read-from-minibuffer "enter command to debug: " cmd)))
1383 1383
1384 (let ((old-comint-exec (symbol-function 'comint-exec))) 1384 (let ((old-comint-exec (symbol-function 'comint-exec)))
1385 1385
@@ -1387,13 +1387,13 @@ project file."
1387 ;; FIXME: This is evil but luckily a nop under Emacs-21.3.50 ! -stef 1387 ;; FIXME: This is evil but luckily a nop under Emacs-21.3.50 ! -stef
1388 (fset 'gud-gdb-massage-args (lambda (_file args) args)) 1388 (fset 'gud-gdb-massage-args (lambda (_file args) args))
1389 1389
1390 (set 'pre-cmd (mapconcat 'identity pre-cmd ada-command-separator)) 1390 (setq pre-cmd (mapconcat 'identity pre-cmd ada-command-separator))
1391 (if (not (equal pre-cmd "")) 1391 (if (not (equal pre-cmd ""))
1392 (setq pre-cmd (concat pre-cmd ada-command-separator))) 1392 (setq pre-cmd (concat pre-cmd ada-command-separator)))
1393 1393
1394 (set 'post-cmd (mapconcat 'identity post-cmd "\n")) 1394 (setq post-cmd (mapconcat 'identity post-cmd "\n"))
1395 (if post-cmd 1395 (if post-cmd
1396 (set 'post-cmd (concat post-cmd "\n"))) 1396 (setq post-cmd (concat post-cmd "\n")))
1397 1397
1398 1398
1399 ;; Temporarily replaces the definition of `comint-exec' so that we 1399 ;; Temporarily replaces the definition of `comint-exec' so that we
@@ -1403,7 +1403,7 @@ project file."
1403 `(lambda (buffer name command startfile switches) 1403 `(lambda (buffer name command startfile switches)
1404 (let (compilation-buffer-name-function) 1404 (let (compilation-buffer-name-function)
1405 (save-excursion 1405 (save-excursion
1406 (set 'compilation-buffer-name-function 1406 (setq compilation-buffer-name-function
1407 (lambda(x) (buffer-name buffer))) 1407 (lambda(x) (buffer-name buffer)))
1408 (compile (ada-quote-cmd 1408 (compile (ada-quote-cmd
1409 (concat ,pre-cmd 1409 (concat ,pre-cmd
@@ -1498,12 +1498,12 @@ by replacing the file extension with `.ali'."
1498 "Search for FILE in DIR-LIST." 1498 "Search for FILE in DIR-LIST."
1499 (let (found) 1499 (let (found)
1500 (while (and (not found) dir-list) 1500 (while (and (not found) dir-list)
1501 (set 'found (concat (file-name-as-directory (car dir-list)) 1501 (setq found (concat (file-name-as-directory (car dir-list))
1502 (file-name-nondirectory file))) 1502 (file-name-nondirectory file)))
1503 1503
1504 (unless (file-exists-p found) 1504 (unless (file-exists-p found)
1505 (set 'found nil)) 1505 (setq found nil))
1506 (set 'dir-list (cdr dir-list))) 1506 (setq dir-list (cdr dir-list)))
1507 found)) 1507 found))
1508 1508
1509(defun ada-find-ali-file-in-dir (file) 1509(defun ada-find-ali-file-in-dir (file)
@@ -1558,11 +1558,11 @@ the project file."
1558 (while specs 1558 (while specs
1559 (if (string-match (concat (regexp-quote (car specs)) "$") 1559 (if (string-match (concat (regexp-quote (car specs)) "$")
1560 file) 1560 file)
1561 (set 'is-spec t)) 1561 (setq is-spec t))
1562 (set 'specs (cdr specs))))) 1562 (setq specs (cdr specs)))))
1563 1563
1564 (if is-spec 1564 (if is-spec
1565 (set 'ali-file-name 1565 (setq ali-file-name
1566 (ada-find-ali-file-in-dir 1566 (ada-find-ali-file-in-dir
1567 (concat (file-name-base (ada-other-file-name)) ".ali")))) 1567 (concat (file-name-base (ada-other-file-name)) ".ali"))))
1568 1568
@@ -1589,8 +1589,8 @@ the project file."
1589 (while (and (not ali-file-name) 1589 (while (and (not ali-file-name)
1590 (string-match "^\\(.*\\)[.-][^.-]*" parent-name)) 1590 (string-match "^\\(.*\\)[.-][^.-]*" parent-name))
1591 1591
1592 (set 'parent-name (match-string 1 parent-name)) 1592 (setq parent-name (match-string 1 parent-name))
1593 (set 'ali-file-name (ada-find-ali-file-in-dir 1593 (setq ali-file-name (ada-find-ali-file-in-dir
1594 (concat parent-name ".ali"))) 1594 (concat parent-name ".ali")))
1595 ) 1595 )
1596 ali-file-name))) 1596 ali-file-name)))
@@ -1686,18 +1686,18 @@ macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..."
1686 (if (and (= (char-before) ?\") 1686 (if (and (= (char-before) ?\")
1687 (= (char-after (+ (length (match-string 0)) (point))) ?\")) 1687 (= (char-after (+ (length (match-string 0)) (point))) ?\"))
1688 (forward-char -1)) 1688 (forward-char -1))
1689 (set 'identifier (regexp-quote (concat "\"" (match-string 0) "\"")))) 1689 (setq identifier (regexp-quote (concat "\"" (match-string 0) "\""))))
1690 1690
1691 (if (ada-in-string-p) 1691 (if (ada-in-string-p)
1692 (error "Inside string or character constant")) 1692 (error "Inside string or character constant"))
1693 (if (looking-at (concat ada-keywords "[^a-zA-Z_]")) 1693 (if (looking-at (concat ada-keywords "[^a-zA-Z_]"))
1694 (error "No cross-reference available for reserved keyword")) 1694 (error "No cross-reference available for reserved keyword"))
1695 (if (looking-at "[a-zA-Z0-9_]+") 1695 (if (looking-at "[a-zA-Z0-9_]+")
1696 (set 'identifier (match-string 0)) 1696 (setq identifier (match-string 0))
1697 (error "No identifier around"))) 1697 (error "No identifier around")))
1698 1698
1699 ;; Build the identlist 1699 ;; Build the identlist
1700 (set 'identlist (ada-make-identlist)) 1700 (setq identlist (ada-make-identlist))
1701 (ada-set-name identlist (downcase identifier)) 1701 (ada-set-name identlist (downcase identifier))
1702 (ada-set-line identlist 1702 (ada-set-line identlist
1703 (number-to-string (count-lines 1 (point)))) 1703 (number-to-string (count-lines 1 (point))))
@@ -1725,7 +1725,7 @@ Information is extracted from the ali file."
1725 (concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist))) 1725 (concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist)))
1726 nil t) 1726 nil t)
1727 (let ((bound (save-excursion (re-search-forward "^X " nil t)))) 1727 (let ((bound (save-excursion (re-search-forward "^X " nil t))))
1728 (set 'declaration-found 1728 (setq declaration-found
1729 (re-search-forward 1729 (re-search-forward
1730 (concat "^" (ada-line-of identlist) 1730 (concat "^" (ada-line-of identlist)
1731 "." (ada-column-of identlist) 1731 "." (ada-column-of identlist)
@@ -1743,7 +1743,7 @@ Information is extracted from the ali file."
1743 ;; Since we already know the number of the file, search for a direct 1743 ;; Since we already know the number of the file, search for a direct
1744 ;; reference to it 1744 ;; reference to it
1745 (goto-char (point-min)) 1745 (goto-char (point-min))
1746 (set 'declaration-found t) 1746 (setq declaration-found t)
1747 (ada-set-ali-index 1747 (ada-set-ali-index
1748 identlist 1748 identlist
1749 (number-to-string (ada-find-file-number-in-ali 1749 (number-to-string (ada-find-file-number-in-ali
@@ -1771,7 +1771,7 @@ Information is extracted from the ali file."
1771 ;; If still not found, then either the declaration is unknown 1771 ;; If still not found, then either the declaration is unknown
1772 ;; or the source file has been modified since the ali file was 1772 ;; or the source file has been modified since the ali file was
1773 ;; created 1773 ;; created
1774 (set 'declaration-found nil) 1774 (setq declaration-found nil)
1775 ) 1775 )
1776 ) 1776 )
1777 1777
@@ -1786,7 +1786,7 @@ Information is extracted from the ali file."
1786 (beginning-of-line)) 1786 (beginning-of-line))
1787 (unless (looking-at (concat "[0-9]+.[0-9]+[ *]" 1787 (unless (looking-at (concat "[0-9]+.[0-9]+[ *]"
1788 (ada-name-of identlist) "[ <{=\(\[]")) 1788 (ada-name-of identlist) "[ <{=\(\[]"))
1789 (set 'declaration-found nil)))) 1789 (setq declaration-found nil))))
1790 1790
1791 ;; Still no success ! The ali file must be too old, and we need to 1791 ;; Still no success ! The ali file must be too old, and we need to
1792 ;; use a basic algorithm based on guesses. Note that this only happens 1792 ;; use a basic algorithm based on guesses. Note that this only happens
@@ -1794,7 +1794,7 @@ Information is extracted from the ali file."
1794 ;; automatically 1794 ;; automatically
1795 (unless declaration-found 1795 (unless declaration-found
1796 (if (ada-xref-find-in-modified-ali identlist) 1796 (if (ada-xref-find-in-modified-ali identlist)
1797 (set 'declaration-found t) 1797 (setq declaration-found t)
1798 ;; No more idea to find the declaration. Give up 1798 ;; No more idea to find the declaration. Give up
1799 (progn 1799 (progn
1800 (kill-buffer ali-buffer) 1800 (kill-buffer ali-buffer)
@@ -1814,7 +1814,7 @@ Information is extracted from the ali file."
1814 (forward-line 1) 1814 (forward-line 1)
1815 (beginning-of-line) 1815 (beginning-of-line)
1816 (while (looking-at "^\\.\\(.*\\)") 1816 (while (looking-at "^\\.\\(.*\\)")
1817 (set 'current-line (concat current-line (match-string 1))) 1817 (setq current-line (concat current-line (match-string 1)))
1818 (forward-line 1)) 1818 (forward-line 1))
1819 ) 1819 )
1820 1820
@@ -1860,7 +1860,7 @@ This function is disabled for operators, and only works for identifiers."
1860 (goto-char (point-max)) 1860 (goto-char (point-max))
1861 (while (re-search-backward my-regexp nil t) 1861 (while (re-search-backward my-regexp nil t)
1862 (save-excursion 1862 (save-excursion
1863 (set 'line-ali (count-lines 1 (point))) 1863 (setq line-ali (count-lines 1 (point)))
1864 (beginning-of-line) 1864 (beginning-of-line)
1865 ;; have a look at the line and column numbers 1865 ;; have a look at the line and column numbers
1866 (if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]") 1866 (if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]")
@@ -1948,7 +1948,7 @@ opens a new window to show the declaration."
1948 1948
1949 ;; Get all the possible locations 1949 ;; Get all the possible locations
1950 (string-match "^\\([0-9]+\\)[a-zA-Z+*]\\([0-9]+\\)[ *]" ali-line) 1950 (string-match "^\\([0-9]+\\)[a-zA-Z+*]\\([0-9]+\\)[ *]" ali-line)
1951 (set 'locations (list (list (match-string 1 ali-line) ;; line 1951 (setq locations (list (list (match-string 1 ali-line) ;; line
1952 (match-string 2 ali-line) ;; column 1952 (match-string 2 ali-line) ;; column
1953 (ada-declare-file-of identlist)))) 1953 (ada-declare-file-of identlist))))
1954 (while (string-match "\\([0-9]+\\)[bc]\\(<[^>]+>\\)?\\([0-9]+\\)" 1954 (while (string-match "\\([0-9]+\\)[bc]\\(<[^>]+>\\)?\\([0-9]+\\)"
@@ -1968,16 +1968,16 @@ opens a new window to show the declaration."
1968 (goto-char (point-min)) 1968 (goto-char (point-min))
1969 (re-search-forward "^D \\([a-zA-Z0-9_.-]+\\)" nil t 1969 (re-search-forward "^D \\([a-zA-Z0-9_.-]+\\)" nil t
1970 (string-to-number file-number)) 1970 (string-to-number file-number))
1971 (set 'file (match-string 1)) 1971 (setq file (match-string 1))
1972 ) 1972 )
1973 ;; Else get the nearest file 1973 ;; Else get the nearest file
1974 (set 'file (ada-declare-file-of identlist))) 1974 (setq file (ada-declare-file-of identlist)))
1975 1975
1976 (set 'locations (append locations (list (list line col file))))) 1976 (setq locations (append locations (list (list line col file)))))
1977 1977
1978 ;; Add the specs at the end again, so that from the last body we go to 1978 ;; Add the specs at the end again, so that from the last body we go to
1979 ;; the specs 1979 ;; the specs
1980 (set 'locations (append locations (list (car locations)))) 1980 (setq locations (append locations (list (car locations))))
1981 1981
1982 ;; Find the new location we want to go to. 1982 ;; Find the new location we want to go to.
1983 ;; If we are on none of the locations listed, we simply go to the specs. 1983 ;; If we are on none of the locations listed, we simply go to the specs.
@@ -1996,10 +1996,10 @@ opens a new window to show the declaration."
1996 col (nth 1 locations) 1996 col (nth 1 locations)
1997 file (nth 2 locations) 1997 file (nth 2 locations)
1998 locations nil) 1998 locations nil)
1999 (set 'locations (cdr locations)))) 1999 (setq locations (cdr locations))))
2000 2000
2001 ;; Find the file in the source path 2001 ;; Find the file in the source path
2002 (set 'file (ada-get-ada-file-name file (ada-file-of identlist))) 2002 (setq file (ada-get-ada-file-name file (ada-file-of identlist)))
2003 2003
2004 ;; Kill the .ali buffer 2004 ;; Kill the .ali buffer
2005 (kill-buffer (current-buffer)) 2005 (kill-buffer (current-buffer))
@@ -2044,10 +2044,10 @@ the declaration and documentation of the subprograms one is using."
2044 " " 2044 " "
2045 (shell-quote-argument (file-name-as-directory (car dirs))) 2045 (shell-quote-argument (file-name-as-directory (car dirs)))
2046 "*.ali"))) 2046 "*.ali")))
2047 (set 'dirs (cdr dirs))) 2047 (setq dirs (cdr dirs)))
2048 2048
2049 ;; Now parse the output 2049 ;; Now parse the output
2050 (set 'case-fold-search t) 2050 (setq case-fold-search t)
2051 (goto-char (point-min)) 2051 (goto-char (point-min))
2052 (while (re-search-forward regexp nil t) 2052 (while (re-search-forward regexp nil t)
2053 (save-excursion 2053 (save-excursion
@@ -2058,12 +2058,12 @@ the declaration and documentation of the subprograms one is using."
2058 (setq line (match-string 1) 2058 (setq line (match-string 1)
2059 column (match-string 2)) 2059 column (match-string 2))
2060 (re-search-backward "^X [0-9]+ \\(.*\\)$") 2060 (re-search-backward "^X [0-9]+ \\(.*\\)$")
2061 (set 'file (list (match-string 1) line column)) 2061 (setq file (list (match-string 1) line column))
2062 2062
2063 ;; There could be duplicate choices, because of the structure 2063 ;; There could be duplicate choices, because of the structure
2064 ;; of the .ali files 2064 ;; of the .ali files
2065 (unless (member file list) 2065 (unless (member file list)
2066 (set 'list (append list (list file)))))))) 2066 (setq list (append list (list file))))))))
2067 2067
2068 ;; Current buffer is still "*grep*" 2068 ;; Current buffer is still "*grep*"
2069 (kill-buffer "*grep*") 2069 (kill-buffer "*grep*")
@@ -2078,7 +2078,7 @@ the declaration and documentation of the subprograms one is using."
2078 2078
2079 ;; Only one choice => Do the cross-reference 2079 ;; Only one choice => Do the cross-reference
2080 ((= (length list) 1) 2080 ((= (length list) 1)
2081 (set 'file (ada-find-src-file-in-dir (caar list))) 2081 (setq file (ada-find-src-file-in-dir (caar list)))
2082 (if file 2082 (if file
2083 (ada-xref-change-buffer file 2083 (ada-xref-change-buffer file
2084 (string-to-number (nth 1 (car list))) 2084 (string-to-number (nth 1 (car list)))
@@ -2117,10 +2117,10 @@ the declaration and documentation of the subprograms one is using."
2117 (string-to-number 2117 (string-to-number
2118 (read-from-minibuffer "Enter No. of your choice: ")))) 2118 (read-from-minibuffer "Enter No. of your choice: "))))
2119 ) 2119 )
2120 (set 'choice (1- choice)) 2120 (setq choice (1- choice))
2121 (kill-buffer "*choice list*") 2121 (kill-buffer "*choice list*")
2122 2122
2123 (set 'file (ada-find-src-file-in-dir (car (nth choice list)))) 2123 (setq file (ada-find-src-file-in-dir (car (nth choice list))))
2124 (if file 2124 (if file
2125 (ada-xref-change-buffer file 2125 (ada-xref-change-buffer file
2126 (string-to-number (nth 1 (nth choice list))) 2126 (string-to-number (nth 1 (nth choice list)))
@@ -2144,7 +2144,7 @@ If OTHER-FRAME is non-nil, creates a new frame to show the file."
2144 (if ada-xref-other-buffer 2144 (if ada-xref-other-buffer
2145 (if other-frame 2145 (if other-frame
2146 (find-file-other-frame file) 2146 (find-file-other-frame file)
2147 (set 'declaration-buffer (find-file-noselect file)) 2147 (setq declaration-buffer (find-file-noselect file))
2148 (set-buffer declaration-buffer) 2148 (set-buffer declaration-buffer)
2149 (switch-to-buffer-other-window declaration-buffer) 2149 (switch-to-buffer-other-window declaration-buffer)
2150 ) 2150 )
diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el
index 2b6f9d3434d..60b332170b0 100644
--- a/lisp/progmodes/bat-mode.el
+++ b/lisp/progmodes/bat-mode.el
@@ -120,6 +120,7 @@
120(defvar bat-mode-syntax-table 120(defvar bat-mode-syntax-table
121 (let ((table (make-syntax-table))) 121 (let ((table (make-syntax-table)))
122 (modify-syntax-entry ?\n ">" table) 122 (modify-syntax-entry ?\n ">" table)
123 (modify-syntax-entry ?\" "\"" table)
123 ;; Beware: `w' should not be used for non-alphabetic chars. 124 ;; Beware: `w' should not be used for non-alphabetic chars.
124 (modify-syntax-entry ?~ "_" table) 125 (modify-syntax-entry ?~ "_" table)
125 (modify-syntax-entry ?% "." table) 126 (modify-syntax-entry ?% "." table)
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index d9f59b3a665..52796755625 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -1007,9 +1007,9 @@ supported at a time.
1007 ;; with the selected frame. 1007 ;; with the selected frame.
1008 (list 'parent (selected-frame))) 1008 (list 'parent (selected-frame)))
1009 speedbar-frame-parameters) 1009 speedbar-frame-parameters)
1010 speedbar-before-delete-hook 1010 'speedbar-before-delete-hook
1011 speedbar-before-popup-hook 1011 'speedbar-before-popup-hook
1012 speedbar-after-create-hook) 1012 'speedbar-after-create-hook)
1013 ;; Start up the timer 1013 ;; Start up the timer
1014 (if (not speedbar-frame) 1014 (if (not speedbar-frame)
1015 (speedbar-set-timer nil) 1015 (speedbar-set-timer nil)