(,keyvar ,(if (stringp key-name) (read-kbd-macro key-name)
`(if (vectorp ,namevar) ,namevar
(read-kbd-macro ,namevar))))
- (,kmapvar ,(cond
- ((byte-compile-nilconstp keymap) 'global-map)
- (t `(or (if (and ,keymap (symbolp ,keymap))
+ (,kmapvar ,(if keymap
+ `(or (if (and ,keymap (symbolp ,keymap))
(symbol-value ,keymap) ,keymap)
- global-map))))
+ global-map)
+ 'global-map))
(,kdescvar (cons (if (stringp ,namevar) ,namevar
(key-description ,namevar))
(if (symbolp ,keymap) ,keymap (quote ,keymap))))
(,bindingvar (lookup-key ,kmapvar ,keyvar)))
- (require 'bind-key) ; ensure `personal-keybindings' is in scope
+ (require 'bind-key) ; ensure `personal-keybindings' is in scope
(let ((entry (assoc ,kdescvar personal-keybindings))
(details (list ,command
(unless (numberp ,bindingvar)
(add-to-list 'personal-keybindings (cons ,kdescvar details))))
,(if predicate
`(define-key ,kmapvar ,keyvar
- '(menu-item "" nil :filter (lambda (&optional _)
- (when ,predicate
- ,command))))
+ '(menu-item "" nil :filter (lambda (&optional _)
+ (when ,predicate
+ ,command))))
`(define-key ,kmapvar ,keyvar ,command)))))
;;;###autoload
(dired-repeat-over-lines
,arg
(lambda ()
- ,@(unless (byte-compile-nilconstp show-progress)
+ ,@(when show-progress
`((if ,show-progress (sit-for 0))))
(setq results (cons ,body results))))
(when (< ,arg 0)
found (not (null next-position)))
(while next-position
(goto-char next-position)
- ,@(unless (byte-compile-nilconstp show-progress)
+ ,@(when show-progress
`((if ,show-progress (sit-for 0))))
(setq results (cons ,body results))
;; move after last match
(set-marker next-position nil)
(setq next-position (and (re-search-forward regexp nil t)
(point-marker)))))
- ,@(unless (byte-compile-nilconstp distinguish-one-marked)
+ ,@(when distinguish-one-marked
`((if (and ,distinguish-one-marked (= (length results) 1))
(setq results (cons t results)))))
(if found
t))))
form)
-(defun byte-compile-trueconstp (form)
- "Return non-nil if FORM always evaluates to a non-nil value."
- (setq form (byte-opt--bool-value-form form))
- (cond ((consp form)
- (let ((head (car form)))
- ;; FIXME: Lots of other expressions are statically non-nil.
- (cond ((memq head '(quote function)) (cadr form))
- ((eq head 'list) (cdr form))
- ((memq head
- ;; FIXME: Replace this list with a function property?
- '( lambda internal-make-closure
- length safe-length cons
- string unibyte-string make-string concat
- format format-message
- substring substring-no-properties string-replace
- replace-regexp-in-string symbol-name make-symbol
- compare-strings string-distance
- mapconcat
- vector make-vector vconcat make-record record
- regexp-quote regexp-opt
- buffer-string buffer-substring
- buffer-substring-no-properties
- current-buffer buffer-size get-buffer-create
- point point-min point-max buffer-end count-lines
- following-char preceding-char get-byte max-char
- region-beginning region-end
- line-beginning-position line-end-position
- pos-bol pos-eol
- + - * / % 1+ 1- min max abs mod expt logb
- logand logior logxor lognot ash logcount
- floor ceiling round truncate
- sqrt sin cos tan asin acos atan exp log copysign
- ffloor fceiling fround ftruncate float
- ldexp frexp
- number-to-string string-to-number
- int-to-string char-to-string
- prin1-to-string read-from-string
- byte-to-string string-to-vector string-to-char
- capitalize upcase downcase
- propertize
- string-as-multibyte string-as-unibyte
- string-to-multibyte string-to-unibyte
- string-make-multibyte string-make-unibyte
- string-width char-width
- make-hash-table hash-table-count
- unibyte-char-to-multibyte multibyte-char-to-unibyte
- sxhash sxhash-equal sxhash-eq sxhash-eql
- sxhash-equal-including-properties
- make-marker copy-marker point-marker mark-marker
- set-marker
- kbd key-description
- skip-chars-forward skip-chars-backward
- skip-syntax-forward skip-syntax-backward
- current-column current-indentation
- char-syntax syntax-class-to-char
- parse-partial-sexp goto-char forward-line
- next-window previous-window minibuffer-window
- selected-frame selected-window
- standard-case-table standard-syntax-table
- syntax-table
- frame-first-window frame-root-window
- frame-selected-window
- always))
- t)
- ((eq head 'if)
- (and (byte-compile-trueconstp (nth 2 form))
- (byte-compile-trueconstp (car (last (cdddr form))))))
- ((memq head '(not null))
- (byte-compile-nilconstp (cadr form)))
- ((eq head 'or)
- (and (cdr form)
- (byte-compile-trueconstp (car (last (cdr form)))))))))
- ((not (symbolp form)))
- ((eq form t))
- ((keywordp form))))
-
-(defun byte-compile-nilconstp (form)
- "Return non-nil if FORM always evaluates to a nil value."
- (setq form (byte-opt--bool-value-form form))
- (or (not form) ; assume (quote nil) always being normalized to nil
- (and (consp form)
- (let ((head (car form)))
- (cond ((memq head
- ;; Some forms that are statically nil.
- ;; FIXME: Replace with a function property?
- '( while ignore
- insert insert-and-inherit insert-before-markers
- insert-before-markers-and-inherit
- insert-char insert-byte insert-buffer-substring
- delete-region delete-char
- widen narrow-to-region transpose-regions
- forward-char backward-char
- beginning-of-line end-of-line
- erase-buffer buffer-swap-text
- delete-overlay delete-all-overlays
- remhash
- maphash
- map-charset-chars map-char-table
- mapbacktrace
- mapatoms
- ding beep sleep-for
- json-insert
- set-match-data
- ))
- t)
- ((eq head 'if)
- (and (byte-compile-nilconstp (nth 2 form))
- (byte-compile-nilconstp (car (last (cdddr form))))))
- ((memq head '(not null))
- (byte-compile-trueconstp (cadr form)))
- ((eq head 'and)
- (and (cdr form)
- (byte-compile-nilconstp (car (last (cdr form)))))))))))
-
;; If the function is being called with constant integer args,
;; evaluate as much as possible at compile-time. This optimizer
;; assumes that the function is associative, like min or max.
(error "Eager macro-expansion failure: %S" err)
form)))))
+(defun byte-compile-trueconstp (form)
+ "Return non-nil if FORM always evaluates to a non-nil value."
+ (setq form (byte-opt--bool-value-form form))
+ (cond ((consp form)
+ (let ((head (car form)))
+ ;; FIXME: Lots of other expressions are statically non-nil.
+ (cond ((memq head '(quote function)) (cadr form))
+ ((eq head 'list) (cdr form))
+ ((memq head
+ ;; FIXME: Replace this list with a function property?
+ '( lambda internal-make-closure
+ length safe-length cons
+ string unibyte-string make-string concat
+ format format-message
+ substring substring-no-properties string-replace
+ replace-regexp-in-string symbol-name make-symbol
+ compare-strings string-distance
+ mapconcat
+ vector make-vector vconcat make-record record
+ regexp-quote regexp-opt
+ buffer-string buffer-substring
+ buffer-substring-no-properties
+ current-buffer buffer-size get-buffer-create
+ point point-min point-max buffer-end count-lines
+ following-char preceding-char get-byte max-char
+ region-beginning region-end
+ line-beginning-position line-end-position
+ pos-bol pos-eol
+ + - * / % 1+ 1- min max abs mod expt logb
+ logand logior logxor lognot ash logcount
+ floor ceiling round truncate
+ sqrt sin cos tan asin acos atan exp log copysign
+ ffloor fceiling fround ftruncate float
+ ldexp frexp
+ number-to-string string-to-number
+ int-to-string char-to-string
+ prin1-to-string read-from-string
+ byte-to-string string-to-vector string-to-char
+ capitalize upcase downcase
+ propertize
+ string-as-multibyte string-as-unibyte
+ string-to-multibyte string-to-unibyte
+ string-make-multibyte string-make-unibyte
+ string-width char-width
+ make-hash-table hash-table-count
+ unibyte-char-to-multibyte multibyte-char-to-unibyte
+ sxhash sxhash-equal sxhash-eq sxhash-eql
+ sxhash-equal-including-properties
+ make-marker copy-marker point-marker mark-marker
+ set-marker
+ kbd key-description
+ skip-chars-forward skip-chars-backward
+ skip-syntax-forward skip-syntax-backward
+ current-column current-indentation
+ char-syntax syntax-class-to-char
+ parse-partial-sexp goto-char forward-line
+ next-window previous-window minibuffer-window
+ selected-frame selected-window
+ standard-case-table standard-syntax-table
+ syntax-table
+ frame-first-window frame-root-window
+ frame-selected-window
+ always))
+ t)
+ ((eq head 'if)
+ (and (byte-compile-trueconstp (nth 2 form))
+ (byte-compile-trueconstp (car (last (cdddr form))))))
+ ((memq head '(not null))
+ (byte-compile-nilconstp (cadr form)))
+ ((eq head 'or)
+ (and (cdr form)
+ (byte-compile-trueconstp (car (last (cdr form)))))))))
+ ((not (symbolp form)))
+ ((eq form t))
+ ((keywordp form))))
+
+(defun byte-compile-nilconstp (form)
+ "Return non-nil if FORM always evaluates to a nil value."
+ (setq form (byte-opt--bool-value-form form))
+ (or (not form) ; assume (quote nil) always being normalized to nil
+ (and (consp form)
+ (let ((head (car form)))
+ (cond ((memq head
+ ;; Some forms that are statically nil.
+ ;; FIXME: Replace with a function property?
+ '( while ignore
+ insert insert-and-inherit insert-before-markers
+ insert-before-markers-and-inherit
+ insert-char insert-byte insert-buffer-substring
+ delete-region delete-char
+ widen narrow-to-region transpose-regions
+ forward-char backward-char
+ beginning-of-line end-of-line
+ erase-buffer buffer-swap-text
+ delete-overlay delete-all-overlays
+ remhash
+ maphash
+ map-charset-chars map-char-table
+ mapbacktrace
+ mapatoms
+ ding beep sleep-for
+ json-insert
+ set-match-data
+ ))
+ t)
+ ((eq head 'if)
+ (and (byte-compile-nilconstp (nth 2 form))
+ (byte-compile-nilconstp (car (last (cdddr form))))))
+ ((memq head '(not null))
+ (byte-compile-trueconstp (cadr form)))
+ ((eq head 'and)
+ (and (cdr form)
+ (byte-compile-nilconstp (car (last (cdr form)))))))))))
+
;; ¡¡¡ Big Ugly Hack !!!
;; src/bootstrap-emacs is mostly used to compile .el files, so it needs
;; macroexp, bytecomp, cconv, and byte-opt to be fast. Generally this is done
(me (match-end ,gn)))
,(macroexp-let2 nil syntax (nth 1 action)
`(progn
- ,@(unless (byte-compile-nilconstp syntax)
+ ,@(when syntax
`((when ,syntax
(put-text-property
mb me 'syntax-table ,syntax))))
projects / emacs.git / commitdiff