;;; subr.el --- basic lisp subroutines for Emacs -*- coding: utf-8; lexical-binding:t -*-
-;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2013 Free Software
+;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2014 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs
;; Beware: while this file has tag `utf-8', before it's compiled, it gets
;; loaded as "raw-text", so non-ASCII chars won't work right during bootstrap.
-(defvar custom-declare-variable-list nil
- "Record `defcustom' calls made before `custom.el' is loaded to handle them.
-Each element of this list holds the arguments to one call to `defcustom'.")
-
-;; Use this, rather than defcustom, in subr.el and other files loaded
-;; before custom.el.
-(defun custom-declare-variable-early (&rest arguments)
- (setq custom-declare-variable-list
- (cons arguments custom-declare-variable-list)))
-
(defmacro declare-function (_fn _file &optional _arglist _fileonly)
"Tell the byte-compiler that function FN is defined, in FILE.
Optional ARGLIST is the argument list used by the function.
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)
In Emacs, the convention is that error messages start with a capital
letter but *do not* end with a period. Please follow this convention
for the sake of consistency."
- (while t
- (signal 'error (list (apply 'format args)))))
-(set-advertised-calling-convention 'error '(string &rest args) "23.1")
+ (declare (advertised-calling-convention (string &rest args) "23.1"))
+ (signal 'error (list (apply 'format args))))
(defun user-error (format &rest args)
"Signal a pilot error, making error message by passing all args to `format'.
This is just like `error' except that `user-error's are expected to be the
result of an incorrect manipulation on the part of the user, rather than the
result of an actual problem."
- (while t
- (signal 'user-error (list (apply #'format format args)))))
+ (signal 'user-error (list (apply #'format format args))))
(defun define-error (name message &optional parent)
"Define NAME as a new error signal.
configuration."
(and (consp object)
(eq (car object) 'frame-configuration)))
+
\f
;;;; List functions.
(nthcdr (1- (safe-length list)) list))))
(defun butlast (list &optional n)
- "Return a copy of LIST with the last N elements removed."
+ "Return a copy of LIST with the last N elements removed.
+If N is omitted or nil, the last element is removed from the
+copy."
(if (and n (<= n 0)) list
(nbutlast (copy-sequence list) n)))
(defun nbutlast (list &optional n)
- "Modifies LIST to remove the last N elements."
+ "Modifies LIST to remove the last N elements.
+If N is omitted or nil, remove the last element."
(let ((m (length list)))
(or n (setq n 1))
(and (< n m)
(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.
(defun undefined ()
"Beep to tell the user this binding is undefined."
(interactive)
- (ding))
+ (ding)
+ (message "%s is undefined" (key-description (this-single-command-keys)))
+ (setq defining-kbd-macro nil)
+ (force-mode-line-update)
+ ;; If this is a down-mouse event, don't reset prefix-arg;
+ ;; pass it to the command run by the up event.
+ (setq prefix-arg
+ (when (memq 'down (event-modifiers last-command-event))
+ current-prefix-arg)))
;; Prevent the \{...} documentation construct
;; from mentioning keys that run this command.
(defun event-start (event)
"Return the starting position of EVENT.
-EVENT should be a click, drag, or key press event.
-If it is a key press event, the return value has the form
- (WINDOW POS (0 . 0) 0)
-If it is a click or drag event, it has the form
- (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
- IMAGE (DX . DY) (WIDTH . HEIGHT))
-The `posn-' functions access elements of such lists.
-For more information, see Info node `(elisp)Click Events'.
-
-If EVENT is a mouse or key press or a mouse click, this is the
-position of the event. If EVENT is a drag, this is the starting
-position of the drag."
+EVENT should be a mouse click, drag, or key press event. If
+EVENT is nil, the value of `posn-at-point' is used instead.
+
+The following accessor functions are used to access the elements
+of the position:
+
+`posn-window': The window the event is in.
+`posn-area': A symbol identifying the area the event occurred in,
+or nil if the event occurred in the text area.
+`posn-point': The buffer position of the event.
+`posn-x-y': The pixel-based coordinates of the event.
+`posn-col-row': The estimated column and row corresponding to the
+position of the event.
+`posn-actual-col-row': The actual column and row corresponding to the
+position of the event.
+`posn-string': The string object of the event, which is either
+nil or (STRING . POSITION)'.
+`posn-image': The image object of the event, if any.
+`posn-object': The image or string object of the event, if any.
+`posn-timestamp': The time the event occurred, in milliseconds.
+
+For more information, see Info node `(elisp)Click Events'."
(if (consp event) (nth 1 event)
(or (posn-at-point)
(list (selected-window) (point) '(0 . 0) 0))))
(defun event-end (event)
- "Return the ending location of EVENT.
+ "Return the ending position of EVENT.
EVENT should be a click, drag, or key press event.
-If EVENT is a key press event, the return value has the form
- (WINDOW POS (0 . 0) 0)
-If EVENT is a click event, this function is the same as
-`event-start'. For click and drag events, the return value has
-the form
- (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
- IMAGE (DX . DY) (WIDTH . HEIGHT))
-The `posn-' functions access elements of such lists.
-For more information, see Info node `(elisp)Click Events'.
-
-If EVENT is a mouse or key press or a mouse click, this is the
-position of the event. If EVENT is a drag, this is the starting
-position of the drag."
+
+See `event-start' for a description of the value returned."
(if (consp event) (nth (if (consp (nth 2 event)) 2 1) event)
(or (posn-at-point)
(list (selected-window) (point) '(0 . 0) 0))))
"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'
(make-obsolete 'unfocus-frame "it does nothing." "22.1")
(make-obsolete 'make-variable-frame-local
"explicitly check for a frame-parameter instead." "22.2")
-(set-advertised-calling-convention
- 'all-completions '(string collection &optional predicate) "23.1")
(set-advertised-calling-convention 'unintern '(name obarray) "23.3")
(set-advertised-calling-convention 'redirect-frame-focus '(frame focus-frame) "24.3")
+(set-advertised-calling-convention 'decode-char '(ch charset) "21.4")
+(set-advertised-calling-convention 'encode-char '(ch charset) "21.4")
\f
;;;; Obsolescence declarations for variables, and aliases.
(setq local t)))
(let ((hook-value (if local (symbol-value hook) (default-value hook))))
;; If the hook value is a single function, turn it into a list.
- (when (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
+ (when (or (not (listp hook-value)) (functionp hook-value))
(setq hook-value (list hook-value)))
;; Do the actual addition if necessary
(unless (member function hook-value)
to the next hook function, if any. The last (or \"outermost\")
FUN is then called once."
(declare (indent 2) (debug (form sexp body))
- (obsolete "use a <foo>-function variable modified by add-function."
+ (obsolete "use a <foo>-function variable modified by `add-function'."
"24.4"))
;; We need those two gensyms because CL's lexical scoping is not available
;; for function arguments :-(
(defun add-to-list (list-var element &optional append compare-fn)
"Add ELEMENT to the value of LIST-VAR if it isn't there yet.
-The test for presence of ELEMENT is done with `equal',
-or with COMPARE-FN if that's non-nil.
+The test for presence of ELEMENT is done with `equal', or with
+COMPARE-FN if that's non-nil.
If ELEMENT is added, it is added at the beginning of the list,
unless the optional argument APPEND is non-nil, in which case
ELEMENT is added at the end.
The return value is the new value of LIST-VAR.
This is handy to add some elements to configuration variables,
-but please do not abuse it in Elisp code, where you are usually better off
-using `push' or `cl-pushnew'.
-
-If you want to use `add-to-list' on a variable that is not defined
-until a certain package is loaded, you should put the call to `add-to-list'
-into a hook function that will be run only after loading the package.
-`eval-after-load' provides one way to do this. In some cases
-other hooks, such as major mode hooks, can do the job."
+but please do not abuse it in Elisp code, where you are usually
+better off using `push' or `cl-pushnew'.
+
+If you want to use `add-to-list' on a variable that is not
+defined until a certain package is loaded, you should put the
+call to `add-to-list' into a hook function that will be run only
+after loading the package. `eval-after-load' provides one way to
+do this. In some cases other hooks, such as major mode hooks,
+can do the job."
(declare
(compiler-macro
(lambda (exp)
(byte-compile-log-warning msg t :error))))
(code
(macroexp-let2 macroexp-copyable-p x element
- `(unless ,(if compare-fn
- (progn
- (require 'cl-lib)
- `(cl-member ,x ,sym :test ,compare-fn))
- ;; For bootstrapping reasons, don't rely on
- ;; cl--compiler-macro-member for the base case.
- `(member ,x ,sym))
+ `(if ,(if compare-fn
+ (progn
+ (require 'cl-lib)
+ `(cl-member ,x ,sym :test ,compare-fn))
+ ;; For bootstrapping reasons, don't rely on
+ ;; cl--compiler-macro-member for the base case.
+ `(member ,x ,sym))
+ ,sym
,(if append
`(setq ,sym (append ,sym (list ,x)))
`(push ,x ,sym))))))
TYPE is `defun', `defvar', or `defface', that specifies function
definition, variable definition, or face definition only."
(if (and (or (null type) (eq type 'defun))
- (symbolp symbol) (fboundp symbol)
+ (symbolp symbol)
(autoloadp (symbol-function symbol)))
(nth 1 (symbol-function symbol))
(let ((files load-history)
(defun process-live-p (process)
"Returns non-nil if PROCESS is alive.
A process is considered alive if its status is `run', `open',
-`listen', `connect' or `stop'."
- (memq (process-status process)
- '(run open listen connect stop)))
+`listen', `connect' or `stop'. Value is nil if PROCESS is not a
+process."
+ (and (processp process)
+ (memq (process-status process)
+ '(run open listen connect stop))))
;; compatibility
\f
;;;; Input and display facilities.
-(defvar read-quoted-char-radix 8
- "Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
-Legitimate radix values are 8, 10 and 16.")
-
-(custom-declare-variable-early
- 'read-quoted-char-radix 8
- "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
-Legitimate radix values are 8, 10 and 16."
- :type '(choice (const 8) (const 10) (const 16))
- :group 'editing-basics)
-
(defconst read-key-empty-map (make-sparse-keymap))
(defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully.
(cancel-timer timer)
(use-global-map old-global-map))))
-(defun read-quoted-char (&optional prompt)
- "Like `read-char', but do not allow quitting.
-Also, if the first character read is an octal digit,
-we read any number of octal digits and return the
-specified character code. Any nondigit terminates the sequence.
-If the terminator is RET, it is discarded;
-any other terminator is used itself as input.
-
-The optional argument PROMPT specifies a string to use to prompt the user.
-The variable `read-quoted-char-radix' controls which radix to use
-for numeric input."
- (let ((message-log-max nil) done (first t) (code 0) translated)
- (while (not done)
- (let ((inhibit-quit first)
- ;; Don't let C-h get the help message--only help function keys.
- (help-char nil)
- (help-form
- "Type the special character you want to use,
-or the octal character code.
-RET terminates the character code and is discarded;
-any other non-digit terminates the character code and is then used as input."))
- (setq translated (read-key (and prompt (format "%s-" prompt))))
- (if inhibit-quit (setq quit-flag nil)))
- (if (integerp translated)
- (setq translated (char-resolve-modifiers translated)))
- (cond ((null translated))
- ((not (integerp translated))
- (setq unread-command-events
- (listify-key-sequence (this-single-command-raw-keys))
- done t))
- ((/= (logand translated ?\M-\^@) 0)
- ;; Turn a meta-character into a character with the 0200 bit set.
- (setq code (logior (logand translated (lognot ?\M-\^@)) 128)
- done t))
- ((and (<= ?0 translated)
- (< translated (+ ?0 (min 10 read-quoted-char-radix))))
- (setq code (+ (* code read-quoted-char-radix) (- translated ?0)))
- (and prompt (setq prompt (message "%s %c" prompt translated))))
- ((and (<= ?a (downcase translated))
- (< (downcase translated)
- (+ ?a -10 (min 36 read-quoted-char-radix))))
- (setq code (+ (* code read-quoted-char-radix)
- (+ 10 (- (downcase translated) ?a))))
- (and prompt (setq prompt (message "%s %c" prompt translated))))
- ((and (not first) (eq translated ?\C-m))
- (setq done t))
- ((not first)
- (setq unread-command-events
- (listify-key-sequence (this-single-command-raw-keys))
- done t))
- (t (setq code translated
- done t)))
- (setq first nil))
- code))
-
(defvar read-passwd-map
;; BEWARE: `defconst' would purecopy it, breaking the sharing with
;; minibuffer-local-map along the way!
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!
Once the caller uses the password, it can erase the password
by doing (clear-string STRING)."
(setq-local buffer-undo-list t)
(setq-local select-active-regions nil)
(use-local-map read-passwd-map)
+ (setq-local inhibit-modification-hooks nil) ;bug#15501.
+ (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 prompt nil t default)) ; t = "no history"
+ (read-string
+ (if noninteractive
+ (format "%s[INPUT WILL NOT BE HIDDEN!] " prompt) ; bug#17839
+ 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
in milliseconds; this was useful when Emacs was built without
floating point support."
(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,
+ ;; which was then replaced by the use of read-event.
(if (numberp nodisp)
(setq seconds (+ seconds (* 1e-3 nodisp))
nodisp obsolete)
(noninteractive
(sleep-for seconds)
t)
- ((input-pending-p)
+ ((input-pending-p t)
nil)
((<= seconds 0)
(or nodisp (redisplay)))
;; FIXME: we should not read-event here at all, because it's much too
;; difficult to reliably "undo" a read-event by pushing it onto
;; unread-command-events.
- (let ((read (read-event nil t seconds)))
+ ;; For bug#14782, we need read-event to do the keyboard-coding-system
+ ;; decoding (hence non-nil as second arg under POSIX ttys).
+ ;; For bug#15614, we need read-event not to inherit-input-method.
+ ;; So we temporarily suspend input-method-function.
+ (let ((read (let ((input-method-function nil))
+ (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.
+(declare-function x-popup-dialog "menu.c" (position contents &optional header))
+
(defun y-or-n-p (prompt)
"Ask user a \"y or n\" question. Return t if answer is \"y\".
PROMPT is the string to display to ask the question. It should
;; ¡Beware! when I tried to edebug this code, Emacs got into a weird state
;; where all the keys were unbound (i.e. it somehow got triggered
;; within read-key, apparently). I had to kill it.
- (let ((answer 'recenter))
+ (let ((answer 'recenter)
+ (padded (lambda (prompt &optional dialog)
+ (let ((l (length prompt)))
+ (concat prompt
+ (if (or (zerop l) (eq ?\s (aref prompt (1- l))))
+ "" " ")
+ (if dialog "" "(y or n) "))))))
(cond
(noninteractive
- (setq prompt (concat prompt
- (if (or (zerop (length prompt))
- (eq ?\s (aref prompt (1- (length prompt)))))
- "" " ")
- "(y or n) "))
+ (setq prompt (funcall padded prompt))
(let ((temp-prompt prompt))
(while (not (memq answer '(act skip)))
(let ((str (read-string temp-prompt)))
((and (display-popup-menus-p)
(listp last-nonmenu-event)
use-dialog-box)
- (setq answer
- (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip)))))
+ (setq prompt (funcall padded prompt t)
+ answer (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip)))))
(t
- (setq prompt (concat prompt
- (if (or (zerop (length prompt))
- (eq ?\s (aref prompt (1- (length prompt)))))
- "" " ")
- "(y or n) "))
+ (setq prompt (funcall padded prompt))
(while
(let* ((scroll-actions '(recenter scroll-up scroll-down
scroll-other-window scroll-other-window-down))
(discard-input))))
(let ((ret (eq answer 'act)))
(unless noninteractive
- ;; FIXME this prints one too many spaces, since prompt
- ;; already ends in a space. Eg "... (y or n) y".
- (message "%s %s" prompt (if ret "y" "n")))
+ (message "%s%c" prompt (if ret ?y ?n)))
ret)))
\f
(define-obsolete-function-alias 'redraw-modeline
'force-mode-line-update "24.3")
-(defun force-mode-line-update (&optional all)
- "Force redisplay of the current buffer's mode line and header line.
-With optional non-nil ALL, force redisplay of all mode lines and
-header lines. This function also forces recomputation of the
-menu bar menus and the frame title."
- (if all (with-current-buffer (other-buffer)))
- (set-buffer-modified-p (buffer-modified-p)))
-
(defun momentary-string-display (string pos &optional exit-char message)
"Momentarily display STRING in the buffer at POS.
Display remains until next event is input.
Various programs in Emacs store information in this directory.
Note that this should end with a directory separator.
See also `locate-user-emacs-file'.")
-
-(custom-declare-variable-early 'user-emacs-directory-warning t
- "Non-nil means warn if cannot access `user-emacs-directory'.
-Set this to nil at your own risk..."
- :type 'boolean
- :group 'initialization
- :version "24.4")
-
-(defun locate-user-emacs-file (new-name &optional old-name)
- "Return an absolute per-user Emacs-specific file name.
-If NEW-NAME exists in `user-emacs-directory', return it.
-Else if OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME.
-Else return NEW-NAME in `user-emacs-directory', creating the
-directory if it does not exist."
- (convert-standard-filename
- (let* ((home (concat "~" (or init-file-user "")))
- (at-home (and old-name (expand-file-name old-name home)))
- (bestname (abbreviate-file-name
- (expand-file-name new-name user-emacs-directory))))
- (if (and at-home (not (file-readable-p bestname))
- (file-readable-p at-home))
- at-home
- ;; Make sure `user-emacs-directory' exists,
- ;; unless we're in batch mode or dumping Emacs.
- (or noninteractive
- purify-flag
- (let (errtype)
- (if (file-directory-p user-emacs-directory)
- (or (file-accessible-directory-p user-emacs-directory)
- (setq errtype "access"))
- (let ((umask (default-file-modes)))
- (unwind-protect
- (progn
- (set-default-file-modes ?\700)
- (condition-case nil
- (make-directory user-emacs-directory)
- (error (setq errtype "create"))))
- (set-default-file-modes umask))))
- (when (and errtype
- user-emacs-directory-warning
- (not (get 'user-emacs-directory-warning 'this-session)))
- ;; Only warn once per Emacs session.
- (put 'user-emacs-directory-warning 'this-session t)
- (display-warning 'initialization
- (format "\
-Unable to %s `user-emacs-directory' (%s).
-Any data that would normally be written there may be lost!
-If you never want to see this message again,
-customize the variable `user-emacs-directory-warning'."
- errtype user-emacs-directory)))))
- bestname))))
\f
;;;; Misc. useful functions.
When in a major mode that does not provide its own
`find-tag-default-function', return a regexp that matches the
symbol at point exactly."
- (let* ((tagf (or find-tag-default-function
- (get major-mode 'find-tag-default-function)
- 'find-tag-default))
- (tag (funcall tagf)))
- (cond ((null tag) nil)
- ((eq tagf 'find-tag-default)
- (format "\\_<%s\\_>" (regexp-quote tag)))
- (t (regexp-quote tag)))))
+ (let ((tag (funcall (or find-tag-default-function
+ (get major-mode 'find-tag-default-function)
+ 'find-tag-default))))
+ (if tag (regexp-quote tag))))
+
+(defun find-tag-default-as-symbol-regexp ()
+ "Return regexp that matches the default tag at point as symbol.
+If there is no tag at point, return nil.
+
+When in a major mode that does not provide its own
+`find-tag-default-function', return a regexp that matches the
+symbol at point exactly."
+ (let ((tag-regexp (find-tag-default-as-regexp)))
+ (if (and tag-regexp
+ (eq (or find-tag-default-function
+ (get major-mode 'find-tag-default-function)
+ 'find-tag-default)
+ 'find-tag-default))
+ (format "\\_<%s\\_>" tag-regexp)
+ tag-regexp)))
(defun play-sound (sound)
"SOUND is a list of the form `(sound KEYWORD VALUE...)'.
val))
\f
;;;; Support for yanking and text properties.
+;; Why here in subr.el rather than in simple.el? --Stef
(defvar yank-handled-properties)
(defvar yank-excluded-properties)
`(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)
(defmacro with-demoted-errors (format &rest body)
"Run BODY and demote any errors to simple messages.
+FORMAT is a string passed to `message' to format any error message.
+It should contain a single %-sequence; e.g., \"Error: %S\".
+
If `debug-on-error' is non-nil, run BODY without catching its errors.
This is to be used around code which is not expected to signal an error
but which should be robust in the unexpected case that an error is signaled.
+
For backward compatibility, if FORMAT is not a constant string, it
is assumed to be part of BODY, in which case the message format
used is \"Error: %S\"."
,@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.
possible, stopping when a single additional previous character
cannot be part of a match for REGEXP. When the match is
extended, its starting position is allowed to occur before
-LIMIT."
+LIMIT.
+
+As a general recommendation, try to avoid using `looking-back'
+wherever possible, since it is slow."
(let ((start (point))
(pos
(save-excursion
(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.
+If IGNORE-CASE is non-nil, the comparison is done without paying
+attention to case differences."
+ (let ((start-pos (- (length string) (length suffix))))
+ (and (>= start-pos 0)
+ (eq t (compare-strings suffix nil nil
+ string start-pos nil ignore-case)))))
(defun bidi-string-mark-left-to-right (str)
"Return a string that can be safely inserted in left-to-right text.
(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--funcall-interactively
+ (symbol-function 'funcall-interactively))
+
(defun called-interactively-p (&optional kind)
"Return t if the containing function was called by `call-interactively'.
If KIND is `interactive', then only return t if the call was made
(pcase (cons frame nextframe)
;; No subr calls `interactive-p', so we can rule that out.
(`((,_ ,(pred (lambda (f) (subrp (indirect-function f)))) . ,_) . ,_) nil)
- ;; Somehow, I sometimes got `command-execute' rather than
- ;; `call-interactively' on my stacktrace !?
- ;;(`(,_ . (t command-execute . ,_)) 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.
(eq 'add-keymap-witness (nth 1 map))
(set symbol tail)))))
-(defun set-temporary-overlay-map (map &optional keep-pred on-exit)
- "Set MAP as a temporary keymap taking precedence over most other keymaps.
-Note that this does NOT take precedence over the \"overriding\" maps
-`overriding-terminal-local-map' and `overriding-local-map' (or the
-`keymap' text property). Unlike those maps, if no match for a key is
-found in MAP, the normal key lookup sequence then continues.
-
-Normally, MAP is used only once. 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.
-
-Optional ON-EXIT argument is a function that is called after the
-deactivation of MAP."
- (let ((clearfun (make-symbol "clear-temporary-overlay-map")))
+(define-obsolete-function-alias
+ 'set-temporary-overlay-map 'set-transient-map "24.4")
+
+(defun set-transient-map (map &optional keep-pred on-exit)
+ "Set MAP as a temporary keymap taking precedence over other keymaps.
+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.
+
+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")))
;; Don't use letrec, because equal (in add/remove-hook) would get trapped
;; in a cycle.
(fset clearfun
(lambda ()
- ;; FIXME: Handle the case of multiple temporary-overlay-maps
- ;; E.g. if isearch and C-u both use temporary-overlay-maps, Then
- ;; the lifetime of the C-u should be nested within the isearch
- ;; overlay, so the pre-command-hook of isearch should be
- ;; suspended during the C-u one so we don't exit isearch just
- ;; because we hit 1 after C-u and that 1 exits isearch whereas it
- ;; doesn't exit C-u.
- (unless (cond ((null keep-pred) nil)
- ((eq t keep-pred)
- (eq this-command
- (lookup-key map (this-command-keys-vector))))
- (t (funcall keep-pred)))
- (remove-hook 'pre-command-hook clearfun)
- (internal-pop-keymap map 'overriding-terminal-local-map)
- (when on-exit (funcall on-exit)))))
+ (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
+ ;; remove ourselves.
+ ;; For example, if isearch and C-u both use transient
+ ;; maps, then the lifetime of the C-u should be nested
+ ;; within isearch's, so the pre-command-hook of
+ ;; isearch should be suspended during the C-u one so
+ ;; we don't exit isearch just because we hit 1 after
+ ;; C-u and that 1 exits isearch whereas it doesn't
+ ;; exit C-u.
+ t)
+ ((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))
+ ;; Comment out the fset if you want to debug the GC bug.
+;;; (fset clearfun nil)
+;;; (set clearfun nil)
+ ))))
(add-hook 'pre-command-hook clearfun)
(internal-push-keymap map 'overriding-terminal-local-map)))
(defconst version-regexp-alist
- '(("^[-_+ ]?alpha$" . -3)
- ("^[-_+]$" . -3) ; treat "1.2.3-20050920" and "1.2-3" as alpha releases
- ("^[-_+ ]cvs$" . -3) ; treat "1.2.3-CVS" as alpha release
- ("^[-_+ ]?beta$" . -2)
- ("^[-_+ ]?\\(pre\\|rcc\\)$" . -1))
+ '(("^[-_+ ]?snapshot$" . -4)
+ ;; treat "1.2.3-20050920" and "1.2-3" as snapshot releases
+ ("^[-_+]$" . -4)
+ ;; treat "1.2.3-CVS" as snapshot release
+ ("^[-_+ ]?\\(cvs\\|git\\|bzr\\|svn\\|hg\\|darcs\\)$" . -4)
+ ("^[-_+ ]?alpha$" . -3)
+ ("^[-_+ ]?beta$" . -2)
+ ("^[-_+ ]?\\(pre\\|rc\\)$" . -1))
"Specify association between non-numeric version and its priority.
This association is used to handle version string like \"1.0pre2\",
non-numeric part of a version string to an integer. For example:
String Version Integer List Version
+ \"0.9snapshot\" (0 9 -4)
+ \"1.0-git\" (1 0 -4)
\"1.0pre2\" (1 0 -1 2)
\"1.0PRE2\" (1 0 -1 2)
\"22.8beta3\" (22 8 -2 3)
\"0.9alpha1\" (0 9 -3 1)
\"0.9AlphA1\" (0 9 -3 1)
\"0.9alpha\" (0 9 -3)
+ \"0.9snapshot\" (0 9 -4)
+ \"1.0-git\" (1 0 -4)
See documentation for `version-separator' and `version-regexp-alist'."
(or (and (stringp ver) (> (length ver) 0))
Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
etc. That is, the trailing \".0\"s are insignificant. Also, version
string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
-which is higher than \"1alpha\". Also, \"-CVS\" and \"-NNN\" are treated
-as alpha versions."
+which is higher than \"1alpha\", which is higher than \"1snapshot\".
+Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions."
(version-list-< (version-to-list v1) (version-to-list v2)))
-
(defun version<= (v1 v2)
"Return t if version V1 is lower (older) than or equal to V2.
Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
etc. That is, the trailing \".0\"s are insignificant. Also, version
string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
-which is higher than \"1alpha\". Also, \"-CVS\" and \"-NNN\" are treated
-as alpha versions."
+which is higher than \"1alpha\", which is higher than \"1snapshot\".
+Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions."
(version-list-<= (version-to-list v1) (version-to-list v2)))
(defun version= (v1 v2)
Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
etc. That is, the trailing \".0\"s are insignificant. Also, version
string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
-which is higher than \"1alpha\". Also, \"-CVS\" and \"-NNN\" are treated
-as alpha versions."
+which is higher than \"1alpha\", which is higher than \"1snapshot\".
+Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions."
(version-list-= (version-to-list v1) (version-to-list v2)))
\f
HCoop / bpt / emacs.git / blobdiff