diff options
author | Stefan Monnier <monnier@iro.umontreal.ca> | 2013-08-29 15:55:58 -0400 |
---|---|---|
committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2013-08-29 15:55:58 -0400 |
commit | 40f7e0e853bf21003fdffeac35e47616f393055d (patch) | |
tree | 25770d0dcff8956a77b577d5467caffe37fb0e0f /lisp | |
parent | 7763d67c87ae050d4e7cc28f1e0c4b14df037d2e (diff) |
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.
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/avoid.el | 6 | ||||
-rw-r--r-- | lisp/calculator.el | 48 | ||||
-rw-r--r-- | lisp/comint.el | 5 | ||||
-rw-r--r-- | lisp/cus-edit.el | 41 | ||||
-rw-r--r-- | lisp/descr-text.el | 21 | ||||
-rw-r--r-- | lisp/dframe.el | 42 | ||||
-rw-r--r-- | lisp/emacs-lisp/eldoc.el | 7 | ||||
-rw-r--r-- | lisp/net/tramp.el | 37 | ||||
-rw-r--r-- | lisp/progmodes/ada-xref.el | 140 | ||||
-rw-r--r-- | lisp/progmodes/bat-mode.el | 1 | ||||
-rw-r--r-- | lisp/speedbar.el | 6 |
11 files changed, 181 insertions, 173 deletions
diff --git a/lisp/avoid.el b/lisp/avoid.el index c92d456ef0..aaccd0974a 100644 --- a/lisp/avoid.el +++ b/lisp/avoid.el @@ -41,9 +41,9 @@ ;; ;; (if (eq window-system 'x) ;; (mouse-avoidance-set-pointer-shape -;; (eval (nth (random 4) -;; '(x-pointer-man x-pointer-spider -;; x-pointer-gobbler x-pointer-gumby))))) +;; (nth (random 4) +;; (list x-pointer-man x-pointer-spider +;; x-pointer-gobbler x-pointer-gumby)))) ;; ;; For completely random pointer shape, replace the setq above with: ;; (setq x-pointer-shape (mouse-avoidance-random-shape)) diff --git a/lisp/calculator.el b/lisp/calculator.el index c9a7305471..c988b7e108 100644 --- a/lisp/calculator.el +++ b/lisp/calculator.el @@ -1,4 +1,4 @@ -;;; calculator.el --- a [not so] simple calculator for Emacs +;;; calculator.el --- a [not so] simple calculator for Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1998, 2000-2013 Free Software Foundation, Inc. @@ -131,8 +131,8 @@ The displayer is a symbol, a string or an expression. A symbol should be the name of a one-argument function, a string is used with a single argument and an expression will be evaluated with the variable `num' bound to whatever should be displayed. If it is a function symbol, it -should be able to handle special symbol arguments, currently 'left and -'right which will be sent by special keys to modify display parameters +should be able to handle special symbol arguments, currently `left' and +`right' which will be sent by special keys to modify display parameters associated with the displayer function (for example to change the number of digits displayed). @@ -241,6 +241,8 @@ Examples: ;;;===================================================================== ;;; Code: +(eval-when-compile (require 'cl-lib)) + ;;;--------------------------------------------------------------------- ;;; Variables @@ -1124,11 +1126,10 @@ the 'left or 'right when one of the standard modes is used." (format calculator-displayer num)) ((symbolp calculator-displayer) (funcall calculator-displayer num)) - ((and (consp calculator-displayer) - (eq 'std (car calculator-displayer))) + ((eq 'std (car-safe calculator-displayer)) (calculator-standard-displayer num (cadr calculator-displayer))) ((listp calculator-displayer) - (eval calculator-displayer)) + (eval calculator-displayer `((num. ,num)))) (t (prin1-to-string num t)))) ;; operators are printed here (t (prin1-to-string (nth 1 num) t)))) @@ -1273,29 +1274,24 @@ arguments." ;; smaller than calculator-epsilon (1e-15). I don't think this is ;; necessary now. (if (symbolp f) - (cond ((and X Y) (funcall f X Y)) - (X (funcall f X)) - (t (funcall f))) + (cond ((and X Y) (funcall f X Y)) + (X (funcall f X)) + (t (funcall f))) ;; f is an expression - (let* ((__f__ f) ; so we can get this value below... - (TX (calculator-truncate X)) + (let* ((TX (calculator-truncate X)) (TY (and Y (calculator-truncate Y))) (DX (if calculator-deg (/ (* X pi) 180) X)) - (L calculator-saved-list) - (Fbound (fboundp 'F)) - (Fsave (and Fbound (symbol-function 'F))) - (Dbound (fboundp 'D)) - (Dsave (and Dbound (symbol-function 'D)))) - ;; a shortened version of flet - (fset 'F (function - (lambda (&optional x y) - (calculator-funcall __f__ x y)))) - (fset 'D (function - (lambda (x) - (if calculator-deg (/ (* x 180) float-pi) x)))) - (unwind-protect (eval f) - (if Fbound (fset 'F Fsave) (fmakunbound 'F)) - (if Dbound (fset 'D Dsave) (fmakunbound 'D))))) + (L calculator-saved-list)) + (cl-letf (((symbol-function 'F) + (lambda (&optional x y) (calculator-funcall f x y))) + ((symbol-function 'D) + (lambda (x) (if calculator-deg (/ (* x 180) float-pi) x)))) + (eval f `((X . ,X) + (Y . ,X) + (TX . ,TX) + (TY . ,TY) + (DX . ,DX) + (L . ,L)))))) (error 0))) ;;;--------------------------------------------------------------------- diff --git a/lisp/comint.el b/lisp/comint.el index 4517e9c65a..0ce7053c03 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1562,8 +1562,9 @@ or to the last history element for a backward search." "Save a function restoring the state of input history search. Save `comint-input-ring-index' to the additional state parameter in the search status stack." - `(lambda (cmd) - (comint-history-isearch-pop-state cmd ,comint-input-ring-index))) + (let ((index comint-input-ring-index)) + (lambda (cmd) + (comint-history-isearch-pop-state cmd index)))) (defun comint-history-isearch-pop-state (_cmd hist-pos) "Restore the input history search state. diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index b50c1a5155..176440f91b 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1,4 +1,4 @@ -;;; cus-edit.el --- tools for customizing Emacs and Lisp packages +;;; cus-edit.el --- tools for customizing Emacs and Lisp packages -*- lexical-binding:t -*- ;; ;; Copyright (C) 1996-1997, 1999-2013 Free Software Foundation, Inc. ;; @@ -1057,8 +1057,8 @@ the resulting list value now. Otherwise, add an entry to (let ((coding-system-for-read nil)) (customize-save-variable list-var (eval list-var))) (add-hook 'after-init-hook - `(lambda () - (customize-push-and-save ',list-var ',elts))))) + (lambda () + (customize-push-and-save list-var elts))))) ;;;###autoload (defun customize () @@ -1415,6 +1415,7 @@ suggest to customize that face, if it's customizable." "*Customize Saved*")))) (declare-function apropos-parse-pattern "apropos" (pattern)) +(defvar apropos-regexp) ;;;###autoload (defun customize-apropos (pattern &optional type) @@ -1431,23 +1432,23 @@ If TYPE is `groups', include only groups." (require 'apropos) (unless (memq type '(nil options faces groups)) (error "Invalid setting type %s" (symbol-name type))) - (apropos-parse-pattern pattern) + (apropos-parse-pattern pattern) ;Sets apropos-regexp by side-effect: Yuck! (let (found) (mapatoms - `(lambda (symbol) - (when (string-match-p apropos-regexp (symbol-name symbol)) - ,(if (memq type '(nil groups)) - '(if (get symbol 'custom-group) - (push (list symbol 'custom-group) found))) - ,(if (memq type '(nil faces)) - '(if (custom-facep symbol) - (push (list symbol 'custom-face) found))) - ,(if (memq type '(nil options)) - `(if (and (boundp symbol) - (eq (indirect-variable symbol) symbol) - (or (get symbol 'saved-value) - (custom-variable-p symbol))) - (push (list symbol 'custom-variable) found)))))) + (lambda (symbol) + (when (string-match-p apropos-regexp (symbol-name symbol)) + (if (memq type '(nil groups)) + (if (get symbol 'custom-group) + (push (list symbol 'custom-group) found))) + (if (memq type '(nil faces)) + (if (custom-facep symbol) + (push (list symbol 'custom-face) found))) + (if (memq type '(nil options)) + (if (and (boundp symbol) + (eq (indirect-variable symbol) symbol) + (or (get symbol 'saved-value) + (custom-variable-p symbol))) + (push (list symbol 'custom-variable) found)))))) (unless found (error "No customizable %s matching %s" (symbol-name type) pattern)) (custom-buffer-create @@ -1621,8 +1622,8 @@ or a regular expression.") (widget-create 'editable-field :size 40 :help-echo echo - :action `(lambda (widget &optional event) - (customize-apropos (split-string (widget-value widget))))))) + :action (lambda (widget &optional _event) + (customize-apropos (split-string (widget-value widget))))))) (widget-insert " ") (widget-create-child-and-convert search-widget 'push-button diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 774ee92a14..134dbdfb33 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -1,4 +1,4 @@ -;;; descr-text.el --- describe text mode +;;; descr-text.el --- describe text mode -*- lexical-binding:t -*- ;; Copyright (C) 1994-1996, 2001-2013 Free Software Foundation, Inc. @@ -23,7 +23,7 @@ ;;; Commentary: -;;; Describe-Text Mode. +;; Describe-Text Mode. ;;; Code: @@ -36,8 +36,7 @@ "Insert text to describe WIDGET in the current buffer." (insert-text-button (symbol-name (if (symbolp widget) widget (car widget))) - 'action `(lambda (&rest ignore) - (widget-browse ',widget)) + 'action (lambda (&rest _ignore) (widget-browse widget)) 'help-echo "mouse-2, RET: browse this widget") (insert " ") (insert-text-button @@ -55,10 +54,10 @@ (<= (length pp) (- (window-width) (current-column)))) (insert pp) (insert-text-button - "[Show]" 'action `(lambda (&rest ignore) - (with-output-to-temp-buffer - "*Pp Eval Output*" - (princ ',pp))) + "[Show]" 'action (lambda (&rest _ignore) + (with-output-to-temp-buffer + "*Pp Eval Output*" + (princ pp))) 'help-echo "mouse-2, RET: pretty print value in another buffer")))) (defun describe-property-list (properties) @@ -81,8 +80,8 @@ into help buttons that call `describe-text-category' or (cond ((eq key 'category) (insert-text-button (symbol-name value) - 'action `(lambda (&rest ignore) - (describe-text-category ',value)) + 'action (lambda (&rest _ignore) + (describe-text-category value)) 'follow-link t 'help-echo "mouse-2, RET: describe this category")) ((memq key '(face font-lock-face mouse-face)) @@ -663,7 +662,7 @@ relevant to POS." ((and (< char 32) (not (memq char '(9 10)))) 'escape-glyph))))) (if face (list (list "hardcoded face" - `(insert-text-button + `(insert-text-button ;FIXME: Wrap in lambda! ,(symbol-name face) 'type 'help-face 'help-args '(,face)))))) diff --git a/lisp/dframe.el b/lisp/dframe.el index 21b508512d..66967075e3 100644 --- a/lisp/dframe.el +++ b/lisp/dframe.el @@ -1,4 +1,4 @@ -;;; dframe --- dedicate frame support modes +;;; dframe --- dedicate frame support modes -*- lexical-binding:t -*- ;; Copyright (C) 1996-2013 Free Software Foundation, Inc. @@ -259,9 +259,15 @@ This buffer will have `dframe-frame-mode' run on it. FRAME-NAME is the name of the frame to create. LOCAL-MODE-FN is the function used to call this one. PARAMETERS are frame parameters to apply to this dframe. -DELETE-HOOK are hooks to run when deleting a frame. -POPUP-HOOK are hooks to run before showing a frame. -CREATE-HOOK are hooks to run after creating a frame." +DELETE-HOOK is a hook to run when deleting a frame. +POPUP-HOOK is a hook to run before showing a frame. +CREATE-HOOK is a hook to run after creating a frame." + (let ((conv-hook (lambda (val) + (let ((sym (make-symbol "hook"))) + (set sym val) sym)))) + (if (consp delete-hook) (setq delete-hook (funcall conv-hook delete-hook))) + (if (consp create-hook) (setq create-hook (funcall conv-hook create-hook))) + (if (consp popup-hook) (setq popup-hook (funcall conv-hook popup-hook)))) ;; toggle frame on and off. (if (not arg) (if (dframe-live-p (symbol-value frame-var)) (setq arg -1) (setq arg 1))) @@ -270,7 +276,7 @@ CREATE-HOOK are hooks to run after creating a frame." ;; turn the frame off on neg number (if (and (numberp arg) (< arg 0)) (progn - (run-hooks 'delete-hook) + (run-hooks delete-hook) (if (and (symbol-value frame-var) (frame-live-p (symbol-value frame-var))) (progn @@ -279,7 +285,7 @@ CREATE-HOOK are hooks to run after creating a frame." (set frame-var nil)) ;; Set this as our currently attached frame (setq dframe-attached-frame (selected-frame)) - (run-hooks 'popup-hook) + (run-hooks popup-hook) ;; Updated the buffer passed in to contain all the hacks needed ;; to make it work well in a dedicated window. (with-current-buffer (symbol-value buffer-var) @@ -331,15 +337,15 @@ CREATE-HOOK are hooks to run after creating a frame." (setq temp-buffer-show-function 'dframe-temp-buffer-show-function) ;; If this buffer is killed, we must make sure that we destroy ;; the frame the dedicated window is in. - (add-hook 'kill-buffer-hook `(lambda () - (let ((skilling (boundp 'skilling))) - (if skilling - nil - (if dframe-controlled - (progn - (funcall dframe-controlled -1) - (setq ,buffer-var nil) - ))))) + (add-hook 'kill-buffer-hook (lambda () + (let ((skilling (boundp 'skilling))) + (if skilling + nil + (if dframe-controlled + (progn + (funcall dframe-controlled -1) + (set buffer-var nil) + ))))) t t) ) ;; Get the frame to work in @@ -396,7 +402,7 @@ CREATE-HOOK are hooks to run after creating a frame." (switch-to-buffer (symbol-value buffer-var)) (set-window-dedicated-p (selected-window) t)) ;; Run hooks (like reposition) - (run-hooks 'create-hook) + (run-hooks create-hook) ;; Frame name (if (and (or (null window-system) (eq window-system 'pc)) (fboundp 'set-frame-name)) @@ -602,7 +608,7 @@ Argument E is the event deleting the frame." If the selected frame is not in the symbol FRAME-VAR, then FRAME-VAR frame is selected. If the FRAME-VAR is active, then select the attached frame. If FRAME-VAR is nil, ACTIVATOR is called to -created it. HOOK is an optional argument of hooks to run when +created it. HOOK is an optional hook to run when selecting FRAME-VAR." (interactive) (if (eq (selected-frame) (symbol-value frame-var)) @@ -616,7 +622,7 @@ selecting FRAME-VAR." ) (other-frame 0) ;; If updates are off, then refresh the frame (they want it now...) - (run-hooks 'hook)) + (run-hooks hook)) (defun dframe-close-frame () diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 4efbdcb22c..9b9fd32594 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -185,6 +185,7 @@ expression point is on." (add-hook 'post-self-insert-hook prn-info nil t) (remove-hook 'post-self-insert-hook prn-info t)))) +;; FIXME: This changes Emacs's behavior when the file is loaded! (add-hook 'eval-expression-minibuffer-setup-hook 'eldoc-post-insert-mode) ;;;###autoload @@ -487,11 +488,11 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." (defun eldoc-beginning-of-sexp () (let ((parse-sexp-ignore-comments t) (num-skipped-sexps 0)) - (condition-case err + (condition-case _ (progn ;; First account for the case the point is directly over a ;; beginning of a nested sexp. - (condition-case err + (condition-case _ (let ((p (point))) (forward-sexp -1) (forward-sexp 1) @@ -518,7 +519,7 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." (let ((defn (and (fboundp fsym) (symbol-function fsym)))) (and (symbolp defn) - (condition-case err + (condition-case _ (setq defn (indirect-function fsym)) (error (setq defn nil)))) defn)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 5f473a496e..43aa0031cb 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', If LEVEL does not fit for visible messages, there are only traces without a visible progress reporter." (declare (indent 3) (debug t)) - `(let ((result "failed") - pr tm) + `(progn (tramp-message ,vec ,level "%s..." ,message) - ;; We start a pulsing progress reporter after 3 seconds. Feature - ;; introduced in Emacs 24.1. - (when (and tramp-message-show-message - ;; Display only when there is a minimum level. - (<= ,level (min tramp-verbose 3))) - (ignore-errors - (setq pr (tramp-compat-funcall 'make-progress-reporter ,message) - tm (when pr - (run-at-time 3 0.1 'tramp-progress-reporter-update pr))))) - (unwind-protect - ;; Execute the body. - (prog1 (progn ,@body) (setq result "done")) - ;; Stop progress reporter. - (if tm (tramp-compat-funcall 'cancel-timer tm)) - (tramp-message ,vec ,level "%s...%s" ,message result)))) + (let ((result "failed") + (tm + ;; We start a pulsing progress reporter after 3 seconds. Feature + ;; introduced in Emacs 24.1. + (when (and tramp-message-show-message + ;; Display only when there is a minimum level. + (<= ,level (min tramp-verbose 3))) + (ignore-errors + (let ((pr (tramp-compat-funcall + #'make-progress-reporter ,message))) + (when pr + (run-at-time 3 0.1 + #'tramp-progress-reporter-update pr))))))) + (unwind-protect + ;; Execute the body. + (prog1 (progn ,@body) (setq result "done")) + ;; Stop progress reporter. + (if tm (tramp-compat-funcall 'cancel-timer tm)) + (tramp-message ,vec ,level "%s...%s" ,message result))))) (tramp-compat-font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>")) diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index d29fa8c1d3..1ca83a97a5 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." ) (kill-buffer nil)))) - (set 'ada-xref-runtime-library-specs-path + (setq ada-xref-runtime-library-specs-path (reverse ada-xref-runtime-library-specs-path)) - (set 'ada-xref-runtime-library-ali-path + (setq ada-xref-runtime-library-ali-path (reverse ada-xref-runtime-library-ali-path)) )) @@ -582,8 +582,8 @@ as defined in the project file." (while dirs (if (file-directory-p (car dirs)) - (set 'list (append list (file-name-all-completions string (car dirs))))) - (set 'dirs (cdr dirs))) + (setq list (append list (file-name-all-completions string (car dirs))))) + (setq dirs (cdr dirs))) (cond ((equal flag 'lambda) (assoc string list)) (flag @@ -702,11 +702,11 @@ is non-nil, prompt the user to select one. If none are found, return ((file-exists-p first-choice) ;; filename.adp - (set 'selected first-choice)) + (setq selected first-choice)) ((= (length prj-files) 1) ;; Exactly one project file was found in the current directory - (set 'selected (car prj-files))) + (setq selected (car prj-files))) ((and (> (length prj-files) 1) (not no-user-question)) ;; 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 (> choice (length prj-files))) (setq choice (string-to-number (read-from-minibuffer "Enter No. of your choice: ")))) - (set 'selected (nth (1- choice) prj-files)))) + (setq selected (nth (1- choice) prj-files)))) ((= (length prj-files) 0) ;; 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 (concat "project file [" ada-last-prj-file "]:") nil ada-last-prj-file)) (unless (string= ada-last-prj-file "") - (set 'selected ada-last-prj-file)))) + (setq selected ada-last-prj-file)))) ))) (or selected "default.adp") @@ -792,9 +792,9 @@ is non-nil, prompt the user to select one. If none are found, return (setq prj-file (expand-file-name prj-file)) (if (string= (file-name-extension prj-file) "gpr") - (set 'project (ada-gnat-parse-gpr project prj-file)) + (setq project (ada-gnat-parse-gpr project prj-file)) - (set 'project (ada-parse-prj-file-1 prj-file project)) + (setq project (ada-parse-prj-file-1 prj-file project)) ) ;; Store the project properties @@ -842,7 +842,7 @@ Return new value of PROJECT." (substitute-in-file-name (match-string 2))))) ((string= (match-string 1) "build_dir") - (set 'project + (setq project (plist-put project 'build_dir (file-name-as-directory (match-string 2))))) @@ -884,7 +884,7 @@ Return new value of PROJECT." (t ;; any other field in the file is just copied - (set 'project (plist-put project + (setq project (plist-put project (intern (match-string 1)) (match-string 2)))))) @@ -900,21 +900,21 @@ Return new value of PROJECT." (let ((sep (plist-get project 'ada_project_path_sep))) (setq ada_project_path (reverse ada_project_path)) (setq ada_project_path (mapconcat 'identity ada_project_path sep)) - (set 'project (plist-put project 'ada_project_path ada_project_path)) + (setq project (plist-put project 'ada_project_path ada_project_path)) ;; env var needed now for ada-gnat-parse-gpr (setenv "ADA_PROJECT_PATH" ada_project_path))) - (if debug_post_cmd (set 'project (plist-put project 'debug_post_cmd (reverse debug_post_cmd)))) - (if debug_pre_cmd (set 'project (plist-put project 'debug_pre_cmd (reverse debug_pre_cmd)))) - (if casing (set 'project (plist-put project 'casing (reverse casing)))) - (if check_cmd (set 'project (plist-put project 'check_cmd (reverse check_cmd)))) - (if comp_cmd (set 'project (plist-put project 'comp_cmd (reverse comp_cmd)))) - (if make_cmd (set 'project (plist-put project 'make_cmd (reverse make_cmd)))) - (if run_cmd (set 'project (plist-put project 'run_cmd (reverse run_cmd)))) + (if debug_post_cmd (setq project (plist-put project 'debug_post_cmd (reverse debug_post_cmd)))) + (if debug_pre_cmd (setq project (plist-put project 'debug_pre_cmd (reverse debug_pre_cmd)))) + (if casing (setq project (plist-put project 'casing (reverse casing)))) + (if check_cmd (setq project (plist-put project 'check_cmd (reverse check_cmd)))) + (if comp_cmd (setq project (plist-put project 'comp_cmd (reverse comp_cmd)))) + (if make_cmd (setq project (plist-put project 'make_cmd (reverse make_cmd)))) + (if run_cmd (setq project (plist-put project 'run_cmd (reverse run_cmd)))) (if gpr_file (progn - (set 'project (ada-gnat-parse-gpr project gpr_file)) + (setq project (ada-gnat-parse-gpr project gpr_file)) ;; append Ada source and object directories to others from Emacs project file (setq src_dir (append (plist-get project 'src_dir) src_dir)) (setq obj_dir (append (plist-get project 'obj_dir) obj_dir)) @@ -930,8 +930,8 @@ Return new value of PROJECT." (ada-initialize-runtime-library (or (ada-xref-get-project-field 'cross_prefix) "")) ;;) - (if obj_dir (set 'project (plist-put project 'obj_dir (reverse obj_dir)))) - (if src_dir (set 'project (plist-put project 'src_dir (reverse src_dir)))) + (if obj_dir (setq project (plist-put project 'obj_dir (reverse obj_dir)))) + (if src_dir (setq project (plist-put project 'src_dir (reverse src_dir)))) project )) @@ -1052,9 +1052,9 @@ existing buffer `*gnatfind*', if there is one." (if old-contents (progn (goto-char 1) - (set 'buffer-read-only nil) + (setq buffer-read-only nil) (insert old-contents) - (set 'buffer-read-only t) + (setq buffer-read-only t) (goto-char (point-max))))) ) ) @@ -1194,9 +1194,9 @@ project file." (objects (getenv "ADA_OBJECTS_PATH")) (build-dir (ada-xref-get-project-field 'build_dir))) (if include - (set 'include (concat path-separator include))) + (setq include (concat path-separator include))) (if objects - (set 'objects (concat path-separator objects))) + (setq objects (concat path-separator objects))) (cons (concat "ADA_INCLUDE_PATH=" (mapconcat (lambda(x) (expand-file-name x build-dir)) @@ -1303,7 +1303,7 @@ If ARG is non-nil, ask for user confirmation." ;; Guess the command if it wasn't specified (if (not command) - (set 'command (list (file-name-sans-extension (buffer-name))))) + (setq command (list (file-name-sans-extension (buffer-name))))) ;; Modify the command to run remotely (setq command (ada-remote (mapconcat 'identity command @@ -1316,7 +1316,7 @@ If ARG is non-nil, ask for user confirmation." ;; Run the command (with-current-buffer (get-buffer-create "*run*") - (set 'buffer-read-only nil) + (setq buffer-read-only nil) (erase-buffer) (start-process "run" (current-buffer) shell-file-name @@ -1352,7 +1352,7 @@ project file." ;; If the command was not given in the project file, start a bare gdb (if (not cmd) - (set 'cmd (concat ada-prj-default-debugger + (setq cmd (concat ada-prj-default-debugger " " (or executable-name (file-name-sans-extension (buffer-file-name)))))) @@ -1368,18 +1368,18 @@ project file." ;; chance to fully manage it. Then it works fine with Enlightenment ;; as well (let ((frame (make-frame '((visibility . nil))))) - (set 'cmd (concat + (setq cmd (concat cmd " --editor-window=" (cdr (assoc 'outer-window-id (frame-parameters frame))))) (select-frame frame))) ;; Add a -fullname switch ;; Use the remote machine - (set 'cmd (ada-remote (concat cmd " -fullname "))) + (setq cmd (ada-remote (concat cmd " -fullname "))) ;; Ask for confirmation if required (if (or arg ada-xref-confirm-compile) - (set 'cmd (read-from-minibuffer "enter command to debug: " cmd))) + (setq cmd (read-from-minibuffer "enter command to debug: " cmd))) (let ((old-comint-exec (symbol-function 'comint-exec))) @@ -1387,13 +1387,13 @@ project file." ;; FIXME: This is evil but luckily a nop under Emacs-21.3.50 ! -stef (fset 'gud-gdb-massage-args (lambda (_file args) args)) - (set 'pre-cmd (mapconcat 'identity pre-cmd ada-command-separator)) + (setq pre-cmd (mapconcat 'identity pre-cmd ada-command-separator)) (if (not (equal pre-cmd "")) (setq pre-cmd (concat pre-cmd ada-command-separator))) - (set 'post-cmd (mapconcat 'identity post-cmd "\n")) + (setq post-cmd (mapconcat 'identity post-cmd "\n")) (if post-cmd - (set 'post-cmd (concat post-cmd "\n"))) + (setq post-cmd (concat post-cmd "\n"))) ;; Temporarily replaces the definition of `comint-exec' so that we @@ -1403,7 +1403,7 @@ project file." `(lambda (buffer name command startfile switches) (let (compilation-buffer-name-function) (save-excursion - (set 'compilation-buffer-name-function + (setq compilation-buffer-name-function (lambda(x) (buffer-name buffer))) (compile (ada-quote-cmd (concat ,pre-cmd @@ -1498,12 +1498,12 @@ by replacing the file extension with `.ali'." "Search for FILE in DIR-LIST." (let (found) (while (and (not found) dir-list) - (set 'found (concat (file-name-as-directory (car dir-list)) + (setq found (concat (file-name-as-directory (car dir-list)) (file-name-nondirectory file))) (unless (file-exists-p found) - (set 'found nil)) - (set 'dir-list (cdr dir-list))) + (setq found nil)) + (setq dir-list (cdr dir-list))) found)) (defun ada-find-ali-file-in-dir (file) @@ -1558,11 +1558,11 @@ the project file." (while specs (if (string-match (concat (regexp-quote (car specs)) "$") file) - (set 'is-spec t)) - (set 'specs (cdr specs))))) + (setq is-spec t)) + (setq specs (cdr specs))))) (if is-spec - (set 'ali-file-name + (setq ali-file-name (ada-find-ali-file-in-dir (concat (file-name-base (ada-other-file-name)) ".ali")))) @@ -1589,8 +1589,8 @@ the project file." (while (and (not ali-file-name) (string-match "^\\(.*\\)[.-][^.-]*" parent-name)) - (set 'parent-name (match-string 1 parent-name)) - (set 'ali-file-name (ada-find-ali-file-in-dir + (setq parent-name (match-string 1 parent-name)) + (setq ali-file-name (ada-find-ali-file-in-dir (concat parent-name ".ali"))) ) ali-file-name))) @@ -1686,18 +1686,18 @@ macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..." (if (and (= (char-before) ?\") (= (char-after (+ (length (match-string 0)) (point))) ?\")) (forward-char -1)) - (set 'identifier (regexp-quote (concat "\"" (match-string 0) "\"")))) + (setq identifier (regexp-quote (concat "\"" (match-string 0) "\"")))) (if (ada-in-string-p) (error "Inside string or character constant")) (if (looking-at (concat ada-keywords "[^a-zA-Z_]")) (error "No cross-reference available for reserved keyword")) (if (looking-at "[a-zA-Z0-9_]+") - (set 'identifier (match-string 0)) + (setq identifier (match-string 0)) (error "No identifier around"))) ;; Build the identlist - (set 'identlist (ada-make-identlist)) + (setq identlist (ada-make-identlist)) (ada-set-name identlist (downcase identifier)) (ada-set-line identlist (number-to-string (count-lines 1 (point)))) @@ -1725,7 +1725,7 @@ Information is extracted from the ali file." (concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist))) nil t) (let ((bound (save-excursion (re-search-forward "^X " nil t)))) - (set 'declaration-found + (setq declaration-found (re-search-forward (concat "^" (ada-line-of identlist) "." (ada-column-of identlist) @@ -1743,7 +1743,7 @@ Information is extracted from the ali file." ;; Since we already know the number of the file, search for a direct ;; reference to it (goto-char (point-min)) - (set 'declaration-found t) + (setq declaration-found t) (ada-set-ali-index identlist (number-to-string (ada-find-file-number-in-ali @@ -1771,7 +1771,7 @@ Information is extracted from the ali file." ;; If still not found, then either the declaration is unknown ;; or the source file has been modified since the ali file was ;; created - (set 'declaration-found nil) + (setq declaration-found nil) ) ) @@ -1786,7 +1786,7 @@ Information is extracted from the ali file." (beginning-of-line)) (unless (looking-at (concat "[0-9]+.[0-9]+[ *]" (ada-name-of identlist) "[ <{=\(\[]")) - (set 'declaration-found nil)))) + (setq declaration-found nil)))) ;; Still no success ! The ali file must be too old, and we need to ;; use a basic algorithm based on guesses. Note that this only happens @@ -1794,7 +1794,7 @@ Information is extracted from the ali file." ;; automatically (unless declaration-found (if (ada-xref-find-in-modified-ali identlist) - (set 'declaration-found t) + (setq declaration-found t) ;; No more idea to find the declaration. Give up (progn (kill-buffer ali-buffer) @@ -1814,7 +1814,7 @@ Information is extracted from the ali file." (forward-line 1) (beginning-of-line) (while (looking-at "^\\.\\(.*\\)") - (set 'current-line (concat current-line (match-string 1))) + (setq current-line (concat current-line (match-string 1))) (forward-line 1)) ) @@ -1860,7 +1860,7 @@ This function is disabled for operators, and only works for identifiers." (goto-char (point-max)) (while (re-search-backward my-regexp nil t) (save-excursion - (set 'line-ali (count-lines 1 (point))) + (setq line-ali (count-lines 1 (point))) (beginning-of-line) ;; have a look at the line and column numbers (if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]") @@ -1948,7 +1948,7 @@ opens a new window to show the declaration." ;; Get all the possible locations (string-match "^\\([0-9]+\\)[a-zA-Z+*]\\([0-9]+\\)[ *]" ali-line) - (set 'locations (list (list (match-string 1 ali-line) ;; line + (setq locations (list (list (match-string 1 ali-line) ;; line (match-string 2 ali-line) ;; column (ada-declare-file-of identlist)))) (while (string-match "\\([0-9]+\\)[bc]\\(<[^>]+>\\)?\\([0-9]+\\)" @@ -1968,16 +1968,16 @@ opens a new window to show the declaration." (goto-char (point-min)) (re-search-forward "^D \\([a-zA-Z0-9_.-]+\\)" nil t (string-to-number file-number)) - (set 'file (match-string 1)) + (setq file (match-string 1)) ) ;; Else get the nearest file - (set 'file (ada-declare-file-of identlist))) + (setq file (ada-declare-file-of identlist))) - (set 'locations (append locations (list (list line col file))))) + (setq locations (append locations (list (list line col file))))) ;; Add the specs at the end again, so that from the last body we go to ;; the specs - (set 'locations (append locations (list (car locations)))) + (setq locations (append locations (list (car locations)))) ;; Find the new location we want to go to. ;; 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." col (nth 1 locations) file (nth 2 locations) locations nil) - (set 'locations (cdr locations)))) + (setq locations (cdr locations)))) ;; Find the file in the source path - (set 'file (ada-get-ada-file-name file (ada-file-of identlist))) + (setq file (ada-get-ada-file-name file (ada-file-of identlist))) ;; Kill the .ali buffer (kill-buffer (current-buffer)) @@ -2044,10 +2044,10 @@ the declaration and documentation of the subprograms one is using." " " (shell-quote-argument (file-name-as-directory (car dirs))) "*.ali"))) - (set 'dirs (cdr dirs))) + (setq dirs (cdr dirs))) ;; Now parse the output - (set 'case-fold-search t) + (setq case-fold-search t) (goto-char (point-min)) (while (re-search-forward regexp nil t) (save-excursion @@ -2058,12 +2058,12 @@ the declaration and documentation of the subprograms one is using." (setq line (match-string 1) column (match-string 2)) (re-search-backward "^X [0-9]+ \\(.*\\)$") - (set 'file (list (match-string 1) line column)) + (setq file (list (match-string 1) line column)) ;; There could be duplicate choices, because of the structure ;; of the .ali files (unless (member file list) - (set 'list (append list (list file)))))))) + (setq list (append list (list file)))))))) ;; Current buffer is still "*grep*" (kill-buffer "*grep*") @@ -2078,7 +2078,7 @@ the declaration and documentation of the subprograms one is using." ;; Only one choice => Do the cross-reference ((= (length list) 1) - (set 'file (ada-find-src-file-in-dir (caar list))) + (setq file (ada-find-src-file-in-dir (caar list))) (if file (ada-xref-change-buffer file (string-to-number (nth 1 (car list))) @@ -2117,10 +2117,10 @@ the declaration and documentation of the subprograms one is using." (string-to-number (read-from-minibuffer "Enter No. of your choice: ")))) ) - (set 'choice (1- choice)) + (setq choice (1- choice)) (kill-buffer "*choice list*") - (set 'file (ada-find-src-file-in-dir (car (nth choice list)))) + (setq file (ada-find-src-file-in-dir (car (nth choice list)))) (if file (ada-xref-change-buffer file (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." (if ada-xref-other-buffer (if other-frame (find-file-other-frame file) - (set 'declaration-buffer (find-file-noselect file)) + (setq declaration-buffer (find-file-noselect file)) (set-buffer declaration-buffer) (switch-to-buffer-other-window declaration-buffer) ) diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el index 2b6f9d3434..60b332170b 100644 --- a/lisp/progmodes/bat-mode.el +++ b/lisp/progmodes/bat-mode.el @@ -120,6 +120,7 @@ (defvar bat-mode-syntax-table (let ((table (make-syntax-table))) (modify-syntax-entry ?\n ">" table) + (modify-syntax-entry ?\" "\"" table) ;; Beware: `w' should not be used for non-alphabetic chars. (modify-syntax-entry ?~ "_" table) (modify-syntax-entry ?% "." table) diff --git a/lisp/speedbar.el b/lisp/speedbar.el index d9f59b3a66..5279675562 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -1007,9 +1007,9 @@ supported at a time. ;; with the selected frame. (list 'parent (selected-frame))) speedbar-frame-parameters) - speedbar-before-delete-hook - speedbar-before-popup-hook - speedbar-after-create-hook) + 'speedbar-before-delete-hook + 'speedbar-before-popup-hook + 'speedbar-after-create-hook) ;; Start up the timer (if (not speedbar-frame) (speedbar-set-timer nil) |