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))))
......@@ -1277,25 +1278,20 @@ arguments."
(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,19 +1432,19 @@ 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)
(lambda (symbol)
(when (string-match-p apropos-regexp (symbol-name symbol))
,(if (memq type '(nil groups))
'(if (get symbol 'custom-group)
(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)
(if (memq type '(nil faces))
(if (custom-facep symbol)
(push (list symbol 'custom-face) found)))
,(if (memq type '(nil options))
`(if (and (boundp symbol)
(if (memq type '(nil options))
(if (and (boundp symbol)
(eq (indirect-variable symbol) symbol)
(or (get symbol 'saved-value)
(custom-variable-p symbol)))
......@@ -1621,7 +1622,7 @@ or a regular expression.")
(widget-create
'editable-field
:size 40 :help-echo echo
:action `(lambda (widget &optional event)
:action (lambda (widget &optional _event)
(customize-apropos (split-string (widget-value widget)))))))
(widget-insert " ")
(widget-create-child-and-convert
......
;;; 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)
"[Show]" 'action (lambda (&rest _ignore)
(with-output-to-temp-buffer
"*Pp Eval Output*"
(princ ',pp)))
(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,14 +337,14 @@ 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 ()
(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)
(set buffer-var nil)
)))))
t t)
)
......@@ -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)
(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
(setq pr (tramp-compat-funcall 'make-progress-reporter ,message)
tm (when pr
(run-at-time 3 0.1 'tramp-progress-reporter-update pr)))))
(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-message ,vec ,level "%s...%s" ,message result)))))
(tramp-compat-font-lock-add-keywords
'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>"))
......
This diff is collapsed.
......@@ -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)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment