;; So we can use `pop' in the bootstrap before `gv' can be used.
(list 'prog1 place (list 'setq place (list 'cdr place)))
(gv-letplace (getter setter) place
- `(prog1 ,getter ,(funcall setter `(cdr ,getter)))))))
+ (macroexp-let2 macroexp-copyable-p x getter
+ `(prog1 ,x ,(funcall setter `(cdr ,x))))))))
(defmacro when (cond &rest body)
"If COND yields non-nil, do BODY, else return nil.
during the evaluation of the `defun' or `defmacro' form.
The possible values of SPECS are specified by
-`defun-declarations-alist' and `macro-declarations-alist'."
+`defun-declarations-alist' and `macro-declarations-alist'.
+
+For more information, see info node `(elisp)Declare Form'."
;; FIXME: edebug spec should pay attention to defun-declarations-alist.
nil)
configuration."
(and (consp object)
(eq (car object) 'frame-configuration)))
+
\f
;;;; List functions.
(if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil))
list))))
+(defun zerop (number)
+ "Return t if NUMBER is zero."
+ ;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because
+ ;; = has a byte-code.
+ (declare (compiler-macro (lambda (_) `(= 0 ,number))))
+ (= 0 number))
+
(defun delete-dups (list)
"Destructively remove `equal' duplicates from LIST.
Store the result in LIST and return it. LIST must be a proper list.
(setq tail tail-cdr))))
alist)
+(defun alist-get (key alist &optional default remove)
+ "Get the value associated to KEY in ALIST.
+DEFAULT is the value to return if KEY is not found in ALIST.
+REMOVE, if non-nil, means that when setting this element, we should
+remove the entry if the new value is `eql' to DEFAULT."
+ (ignore remove) ;;Silence byte-compiler.
+ (let ((x (assq key alist)))
+ (if x (cdr x) default)))
+
(defun remove (elt seq)
"Return a copy of SEQ with all occurrences of ELT removed.
SEQ must be a list, vector, or string. The comparison is done with `equal'."
(or (cdr (assq 'tool-bar global-map))
(lookup-key global-map [tool-bar])))
map))
- (aref (catch 'read-key (read-key-sequence-vector prompt nil t)) 0))
+ (let* ((keys
+ (catch 'read-key (read-key-sequence-vector prompt nil t)))
+ (key (aref keys 0)))
+ (if (and (> (length keys) 1)
+ (memq key '(mode-line header-line
+ left-fringe right-fringe)))
+ (aref keys 1)
+ key)))
(cancel-timer timer)
(use-global-map old-global-map))))
Optional DEFAULT is a default password to use instead of empty input.
This function echoes `.' for each character that the user types.
-Note that in batch mode, the input is not hidden!
+You could let-bind `read-hide-char' to another hiding character, though.
Once the caller uses the password, it can erase the password
by doing (clear-string STRING)."
beg)))
(dotimes (i (- end beg))
(put-text-property (+ i beg) (+ 1 i beg)
- 'display (string ?.)))))
+ 'display (string (or read-hide-char ?.))))))
minibuf)
(minibuffer-with-setup-hook
(lambda ()
(setq-local show-paren-mode nil) ;bug#16091.
(add-hook 'after-change-functions hide-chars-fun nil 'local))
(unwind-protect
- (let ((enable-recursive-minibuffers t))
- (read-string
- (if noninteractive
- (format "%s[INPUT WILL NOT BE HIDDEN!] " prompt) ; bug#17839
- prompt)
- nil t default)) ; t = "no history"
+ (let ((enable-recursive-minibuffers t)
+ (read-hide-char (or read-hide-char ?.)))
+ (read-string prompt nil t default)) ; t = "no history"
(when (buffer-live-p minibuf)
(with-current-buffer minibuf
;; Not sure why but it seems that there might be cases where the
(read-event nil t seconds))))
(or (null read)
(progn
- ;; If last command was a prefix arg, e.g. C-u, push this event onto
- ;; unread-command-events as (t . EVENT) so it will be added to
- ;; this-command-keys by read-key-sequence.
- (if (eq overriding-terminal-local-map universal-argument-map)
- (setq read (cons t read)))
- (push read unread-command-events)
+ ;; https://lists.gnu.org/archive/html/emacs-devel/2006-10/msg00394.html
+ ;; We want `read' appear in the next command's this-command-event
+ ;; but not in the current one.
+ ;; By pushing (cons t read), we indicate that `read' has not
+ ;; yet been recorded in this-command-keys, so it will be recorded
+ ;; next time it's read.
+ ;; And indeed the `seconds' argument to read-event correctly
+ ;; prevented recording this event in the current command's
+ ;; this-command-keys.
+ (push (cons t read) unread-command-events)
nil))))))
;; Behind display-popup-menus-p test.
form."
(secure-hash 'sha1 object start end binary))
-(defalias 'function-put #'put
- ;; This is only really used in Emacs>24.4, but we add it to 24.4 already, so
- ;; as to ease the pain when people use future autoload files that contain
- ;; function-put.
- "Set function F's property PROP to VALUE.
-The namespace for PROP is shared with symbols.
-So far, F can only be a symbol, not a lambda expression.")
-
(defun function-get (f prop &optional autoload)
"Return the value of property PROP of function F.
If AUTOLOAD is non-nil and F is autoloaded, try to autoload it
\f
;;;; Lisp macros to do various things temporarily.
+(defmacro track-mouse (&rest body)
+ "Evaluate BODY with mouse movement events enabled.
+Within a `track-mouse' form, mouse motion generates input events that
+ you can read with `read-event'.
+Normally, mouse motion is ignored."
+ (declare (debug t) (indent 0))
+ `(internal--track-mouse (lambda () ,@body)))
+
(defmacro with-current-buffer (buffer-or-name &rest body)
"Execute the forms in BODY with BUFFER-OR-NAME temporarily current.
BUFFER-OR-NAME must be a buffer or the name of an existing buffer.
`(let* ((,modified (buffer-modified-p))
(buffer-undo-list t)
(inhibit-read-only t)
- (inhibit-modification-hooks t)
- deactivate-mark
- ;; Avoid setting and removing file locks and checking
- ;; buffer's uptodate-ness w.r.t the underlying file.
- buffer-file-name
- buffer-file-truename)
+ (inhibit-modification-hooks t))
(unwind-protect
(progn
,@body)
,@body)
(with-current-buffer ,old-buffer
(set-case-table ,old-case-table))))))
+
+(defmacro with-file-modes (modes &rest body)
+ "Execute BODY with default file permissions temporarily set to MODES.
+MODES is as for `set-default-file-modes'."
+ (declare (indent 1) (debug t))
+ (let ((umask (make-symbol "umask")))
+ `(let ((,umask (default-file-modes)))
+ (unwind-protect
+ (progn
+ (set-default-file-modes ,modes)
+ ,@body)
+ (set-default-file-modes ,umask)))))
+
\f
;;; Matching and match data.
(setq matches (cons (substring string start l) matches)) ; leftover
(apply #'concat (nreverse matches)))))
\f
-(defun string-prefix-p (str1 str2 &optional ignore-case)
- "Return non-nil if STR1 is a prefix of STR2.
+(defun string-prefix-p (prefix string &optional ignore-case)
+ "Return non-nil if PREFIX is a prefix of STRING.
If IGNORE-CASE is non-nil, the comparison is done without paying attention
to case differences."
- (eq t (compare-strings str1 nil nil
- str2 0 (length str1) ignore-case)))
+ (let ((prefix-length (length prefix)))
+ (if (> prefix-length (length string)) nil
+ (eq t (compare-strings prefix 0 prefix-length string
+ 0 prefix-length ignore-case)))))
(defun string-suffix-p (suffix string &optional ignore-case)
"Return non-nil if SUFFIX is a suffix of STRING.
;; discard the file name regexp
(mapc #'funcall (cdr a-l-element))))
;; Complain when the user uses obsolete files.
- (when (string-match-p "/obsolete/[^/]*\\'" abs-file)
+ (when (save-match-data
+ (and (string-match "/obsolete/\\([^/]*\\)\\'" abs-file)
+ (not (equal "loaddefs.el" (match-string 1 abs-file)))))
;; Maybe we should just use display-warning? This seems yucky...
(let* ((file (file-name-nondirectory abs-file))
(msg (format "Package %s is obsolete!"
(byte-compile-log-warning msg))
(run-with-timer 0 nil
(lambda (msg)
- (message "%s" msg)) msg))))
+ (message "%s" msg))
+ msg))))
;; Finally, run any other hook.
(run-hook-with-args 'after-load-functions abs-file))
if those frames don't seem special and otherwise, it should return
the number of frames to skip (minus 1).")
-(defconst internal--call-interactively (symbol-function 'call-interactively))
+(defconst internal--funcall-interactively
+ (symbol-function 'funcall-interactively))
(defun called-interactively-p (&optional kind)
"Return t if the containing function was called by `call-interactively'.
(pcase (cons frame nextframe)
;; No subr calls `interactive-p', so we can rule that out.
(`((,_ ,(pred (lambda (f) (subrp (indirect-function f)))) . ,_) . ,_) nil)
- ;; In case #<subr call-interactively> without going through the
- ;; `call-interactively' symbol (bug#3984).
- (`(,_ . (t ,(pred (eq internal--call-interactively)) . ,_)) t)
- (`(,_ . (t call-interactively . ,_)) t)))))
+ ;; In case #<subr funcall-interactively> without going through the
+ ;; `funcall-interactively' symbol (bug#3984).
+ (`(,_ . (t ,(pred (lambda (f)
+ (eq internal--funcall-interactively
+ (indirect-function f))))
+ . ,_))
+ t)))))
(defun interactive-p ()
"Return t if the containing function was run directly by user input.
Normally, MAP is used only once, to look up the very next key.
However, if the optional argument KEEP-PRED is t, MAP stays
active if a key from MAP is used. KEEP-PRED can also be a
-function of no arguments: if it returns non-nil, then MAP stays
-active.
+function of no arguments: it is called from `pre-command-hook' and
+if it returns non-nil, then MAP stays active.
Optional arg ON-EXIT, if non-nil, specifies a function that is
called, with no arguments, after MAP is deactivated.
This uses `overriding-terminal-local-map' which takes precedence over all other
keymaps. As usual, if no match for a key is found in MAP, the normal key
-lookup sequence then continues."
- (let ((clearfun (make-symbol "clear-transient-map")))
+lookup sequence then continues.
+
+This returns an \"exit function\", which can be called with no argument
+to deactivate this transient map, regardless of KEEP-PRED."
+ (let* ((clearfun (make-symbol "clear-transient-map"))
+ (exitfun
+ (lambda ()
+ (internal-pop-keymap map 'overriding-terminal-local-map)
+ (remove-hook 'pre-command-hook clearfun)
+ (when on-exit (funcall on-exit)))))
;; Don't use letrec, because equal (in add/remove-hook) would get trapped
;; in a cycle.
(fset clearfun
(eq this-command
(lookup-key map (this-command-keys-vector))))
(t (funcall keep-pred)))
- (internal-pop-keymap map 'overriding-terminal-local-map)
- (remove-hook 'pre-command-hook clearfun)
- (when on-exit (funcall on-exit))))))
+ (funcall exitfun)))))
(add-hook 'pre-command-hook clearfun)
- (internal-push-keymap map 'overriding-terminal-local-map)))
+ (internal-push-keymap map 'overriding-terminal-local-map)
+ exitfun))
;;;; Progress reporters.
(min-value (aref parameters 1))
(max-value (aref parameters 2))
(text (aref parameters 3))
- (current-time (float-time))
(enough-time-passed
;; See if enough time has passed since the last update.
(or (not update-time)
- (when (>= current-time update-time)
+ (when (>= (float-time) update-time)
;; Calculate time for the next update
(aset parameters 0 (+ update-time (aref parameters 5)))))))
(cond ((and min-value max-value)
Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions."
(version-list-= (version-to-list v1) (version-to-list v2)))
+(defvar package--builtin-versions
+ ;; Mostly populated by loaddefs.el via autoload-builtin-package-versions.
+ (purecopy `((emacs . ,(version-to-list emacs-version))))
+ "Alist giving the version of each versioned builtin package.
+I.e. each element of the list is of the form (NAME . VERSION) where
+NAME is the package name as a symbol, and VERSION is its version
+as a list.")
+
+(defun package--description-file (dir)
+ (concat (let ((subdir (file-name-nondirectory
+ (directory-file-name dir))))
+ (if (string-match "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)" subdir)
+ (match-string 1 subdir) subdir))
+ "-pkg.el"))
+
\f
;;; Misc.
(defconst menu-bar-separator '("--")