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.
"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")
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)."
(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)
;; 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.
,@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.
(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.
;; Don't use letrec, because equal (in add/remove-hook) would get trapped
;; in a cycle.
(fset clearfun
- (suspicious-object
- (lambda ()
- (with-demoted-errors "set-transient-map PCH: %S"
- (unless (cond
- ((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)
- ((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)
+ (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
+ ;; 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)))
HCoop / bpt / emacs.git / blobdiff