mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-12 16:23:57 +00:00
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.
This commit is contained in:
Stefan Monnier
parent
7763d67c87
commit
40f7e0e853
@ -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))
|
||||
|
||||
@ -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)))
|
||||
|
||||
;;;---------------------------------------------------------------------
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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))))))
|
||||
|
||||
@ -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 ()
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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\\>"))
|
||||
|
||||
@ -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)
|
||||
)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user