;; 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'."
"Return the nominal column and row in POSITION, measured in characters.
The column and row values are approximations calculated from the x
and y coordinates in POSITION and the frame's default character width
-and height.
+and default line height, including spacing.
For a scroll-bar event, the result column is 0, and the row
corresponds to the vertical position of the click in the scroll bar.
POSITION should be a list of the form returned by the `event-start'
((null spacing)
(setq spacing 0)))
(cons (/ (car pair) (frame-char-width frame))
- (- (/ (cdr pair) (+ (frame-char-height frame) spacing))
- (if (null (with-current-buffer (window-buffer window)
- header-line-format))
- 0 1))))))))
+ (/ (cdr pair) (+ (frame-char-height frame) spacing))))))))
(defun posn-actual-col-row (position)
- "Return the actual column and row in POSITION, measured in characters.
-These are the actual row number in the window and character number in that row.
+ "Return the window row number in POSITION and character number in that row.
+
Return nil if POSITION does not contain the actual position; in that case
-`posn-col-row' can be used to get approximate values.
+\`posn-col-row' can be used to get approximate values.
POSITION should be a list of the form returned by the `event-start'
-and `event-end' functions."
+and `event-end' functions.
+
+This function does not account for the width on display, like the
+number of visual columns taken by a TAB or image. If you need
+the coordinates of POSITION in character units, you should use
+\`posn-col-row', not this function."
(nth 6 position))
(defsubst posn-timestamp (position)
(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.
+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))
+ (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
char))
(defun sit-for (seconds &optional nodisp obsolete)
- "Perform redisplay, then wait for SECONDS seconds or until input is available.
+ "Redisplay, then wait for SECONDS seconds. Stop when input is available.
SECONDS may be a floating-point value.
\(On operating systems that do not support waiting for fractions of a
second, floating-point values are rounded down to the nearest integer.)
(declare (advertised-calling-convention (seconds &optional nodisp) "22.1"))
;; This used to be implemented in C until the following discussion:
;; http://lists.gnu.org/archive/html/emacs-devel/2006-07/msg00401.html
- ;; Then it was moved to C using an implementation based on an idle timer,
+ ;; Then it was moved here using an implementation based on an idle timer,
;; which was then replaced by the use of read-event.
(if (numberp nodisp)
(setq seconds (+ seconds (* 1e-3 nodisp))
(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
An old calling convention accepted any number of arguments after COMMAND,
which were just concatenated to COMMAND. This is still supported but strongly
discouraged."
- ;; We used to use `exec' to replace the shell with the command,
- ;; but that failed to handle (...) and semicolon, etc.
+ (declare (advertised-calling-convention (name buffer command) "23.1"))
+ ;; We used to use `exec' to replace the shell with the command,
+ ;; but that failed to handle (...) and semicolon, etc.
(start-process name buffer shell-file-name shell-command-switch
(mapconcat 'identity args " ")))
-(set-advertised-calling-convention 'start-process-shell-command
- '(name buffer command) "23.1")
(defun start-file-process-shell-command (name buffer &rest args)
"Start a program in a subprocess. Return the process object for it.
Similar to `start-process-shell-command', but calls `start-file-process'."
+ (declare (advertised-calling-convention (name buffer command) "23.1"))
(start-file-process
name buffer
(if (file-remote-p default-directory) "/bin/sh" shell-file-name)
(if (file-remote-p default-directory) "-c" shell-command-switch)
(mapconcat 'identity args " ")))
-(set-advertised-calling-convention 'start-file-process-shell-command
- '(name buffer command) "23.1")
(defun call-process-shell-command (command &optional infile buffer display
&rest args)
t (mix it with ordinary output), or a file name string.
Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
-Remaining arguments are strings passed as additional arguments for COMMAND.
Wildcards and redirection are handled as usual in the shell.
If BUFFER is 0, `call-process-shell-command' returns immediately with value nil.
Otherwise it waits for COMMAND to terminate and returns a numeric exit
status or a signal description string.
-If you quit, the process is killed with SIGINT, or SIGKILL if you quit again."
+If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
+
+An old calling convention accepted any number of arguments after DISPLAY,
+which were just concatenated to COMMAND. This is still supported but strongly
+discouraged."
+ (declare (advertised-calling-convention
+ (command &optional infile buffer display) "24.5"))
;; We used to use `exec' to replace the shell with the command,
;; but that failed to handle (...) and semicolon, etc.
(call-process shell-file-name
&rest args)
"Process files synchronously in a separate process.
Similar to `call-process-shell-command', but calls `process-file'."
+ (declare (advertised-calling-convention
+ (command &optional infile buffer display) "24.5"))
(process-file
(if (file-remote-p default-directory) "/bin/sh" shell-file-name)
infile buffer display
\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.
temporarily selected. But it doesn't run `temp-buffer-show-hook'
if it uses `temp-buffer-show-function'.
+By default, the setup hook puts the buffer into Help mode before running BODY.
+If BODY does not change the major mode, the show hook makes the buffer
+read-only, and scans it for function and variable names to make them into
+clickable cross-references.
+
See the related form `with-temp-buffer-window'."
(declare (debug t))
(let ((old-dir (make-symbol "old-dir"))
`(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
(lambda ()
(with-demoted-errors "set-transient-map PCH: %S"
(unless (cond
+ ((null keep-pred) nil)
((not (eq map (cadr overriding-terminal-local-map)))
;; There's presumably some other transient-map in
;; effect. Wait for that one to terminate before we
;; C-u and that 1 exits isearch whereas it doesn't
;; exit C-u.
t)
- ((null keep-pred) nil)
((eq t keep-pred)
(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 '("--")