Commit 40f7e0e8 authored by Stefan Monnier's avatar Stefan Monnier

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.
parent 7763d67c
......@@ -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))
......
;;; 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.
......
;;; 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
......
;;; 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))))))
......
;;; 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."