c)))
key)))
-(defsubst eventp (obj)
+(defun eventp (obj)
"True if the argument is an event object."
- (or (integerp obj)
- (and (symbolp obj) obj (not (keywordp obj)))
- (and (consp obj) (symbolp (car obj)))))
+ (when obj
+ (or (integerp obj)
+ (and (symbolp obj) obj (not (keywordp obj)))
+ (and (consp obj) (symbolp (car obj))))))
(defun event-modifiers (event)
"Return a list of symbols representing the modifier keys in event EVENT.
;; is this really correct? maybe remove mouse-movement?
(memq (event-basic-type object) '(mouse-1 mouse-2 mouse-3 mouse-movement)))
-(defsubst event-start (event)
+(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
position of the event. If EVENT is a drag, this is the starting
position of the drag."
(if (consp event) (nth 1 event)
- (list (selected-window) (point) '(0 . 0) 0)))
+ (or (posn-at-point)
+ (list (selected-window) (point) '(0 . 0) 0))))
-(defsubst event-end (event)
+(defun event-end (event)
"Return the ending location 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
position of the event. If EVENT is a drag, this is the starting
position of the drag."
(if (consp event) (nth (if (consp (nth 2 event)) 2 1) event)
- (list (selected-window) (point) '(0 . 0) 0)))
+ (or (posn-at-point)
+ (list (selected-window) (point) '(0 . 0) 0))))
(defsubst event-click-count (event)
"Return the multi-click count of EVENT, a click or drag event.
\f
;;;; Extracting fields of the positions in an event.
+(defun posnp (obj)
+ "Return non-nil if OBJ appears to be a valid `posn' object."
+ (and (windowp (car-safe obj))
+ (atom (car-safe (setq obj (cdr obj)))) ;AREA-OR-POS.
+ (integerp (car-safe (car-safe (setq obj (cdr obj))))) ;XOFFSET.
+ (integerp (car-safe (cdr obj))))) ;TIMESTAMP.
+
(defsubst posn-window (position)
"Return the window in POSITION.
POSITION should be a list of the form returned by the `event-start'
(define-obsolete-function-alias 'string-to-int 'string-to-number "22.1")
(make-obsolete 'forward-point "use (+ (point) N) instead." "23.1")
-(make-obsolete 'buffer-has-markers-at nil "24.2")
+(make-obsolete 'buffer-has-markers-at nil "24.3")
(defun insert-string (&rest args)
"Mocklisp-compatibility insert function.
(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.2")
+(set-advertised-calling-convention 'redirect-frame-focus '(frame focus-frame) "24.3")
\f
;;;; Obsolescence declarations for variables, and aliases.
\f
;;; Load history
+(defsubst autoloadp (object)
+ "Non-nil if OBJECT is an autoload."
+ (eq 'autoload (car-safe object)))
+
+;; (defun autoload-type (object)
+;; "Returns the type of OBJECT or `function' or `command' if the type is nil.
+;; OBJECT should be an autoload object."
+;; (when (autoloadp object)
+;; (let ((type (nth 3 object)))
+;; (cond ((null type) (if (nth 2 object) 'command 'function))
+;; ((eq 'keymap t) 'macro)
+;; (type)))))
+
+;; (defalias 'autoload-file #'cadr
+;; "Return the name of the file from which AUTOLOAD will be loaded.
+;; \n\(fn AUTOLOAD)")
+
(defun symbol-file (symbol &optional type)
"Return the name of the file that defined SYMBOL.
The value is normally an absolute file name. It can also be nil,
definition, variable definition, or face definition only."
(if (and (or (null type) (eq type 'defun))
(symbolp symbol) (fboundp symbol)
- (eq 'autoload (car-safe (symbol-function symbol))))
+ (autoloadp (symbol-function symbol)))
(nth 1 (symbol-function symbol))
(let ((files load-history)
file)
(set (make-local-variable 'post-self-insert-hook) nil)
(add-hook 'after-change-functions hide-chars-fun nil 'local))
(unwind-protect
- (read-string prompt nil t default) ; t = "no history"
+ (let ((enable-recursive-minibuffers t))
+ (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 a numeric value in the minibuffer, prompting with PROMPT.
DEFAULT specifies a default value to return if the user just types RET.
The value of DEFAULT is inserted into PROMPT."
- (let ((n nil))
- (when default
+ (let ((n nil)
+ (default1 (if (consp default) (car default) default)))
+ (when default1
(setq prompt
(if (string-match "\\(\\):[ \t]*\\'" prompt)
- (replace-match (format " (default %s)" default) t t prompt 1)
+ (replace-match (format " (default %s)" default1) t t prompt 1)
(replace-regexp-in-string "[ \t]*\\'"
- (format " (default %s) " default)
+ (format " (default %s) " default1)
prompt t t))))
(while
(progn
- (let ((str (read-from-minibuffer prompt nil nil nil nil
- (and default
- (number-to-string default)))))
+ (let ((str (read-from-minibuffer
+ prompt nil nil nil nil
+ (when default
+ (if (consp default)
+ (mapcar 'number-to-string (delq nil default))
+ (number-to-string default))))))
(condition-case nil
(setq n (cond
- ((zerop (length str)) default)
- ((stringp str) (read str))))
+ ((zerop (length str)) default1)
+ ((stringp str) (string-to-number str))))
(error nil)))
(unless (numberp n)
(message "Please enter a number.")
(error "Called `read-char-choice' without valid char choices"))
(let (char done show-help (helpbuf " *Char Help*"))
(let ((cursor-in-echo-area t)
- (executing-kbd-macro executing-kbd-macro))
+ (executing-kbd-macro executing-kbd-macro)
+ (esc-flag nil))
(save-window-excursion ; in case we call help-form-show
(while (not done)
(unless (get-text-property 0 'face prompt)
;; there are no more events in the macro. Attempt to
;; get an event interactively.
(setq executing-kbd-macro nil))
- ((and (not inhibit-keyboard-quit) (eq char ?\C-g))
- (keyboard-quit))))))
+ ((not inhibit-keyboard-quit)
+ (cond
+ ((and (null esc-flag) (eq char ?\e))
+ (setq esc-flag t))
+ ((memq char '(?\C-g ?\e))
+ (keyboard-quit))))))))
;; Display the question with the answer. But without cursor-in-echo-area.
(message "%s%s" prompt (char-to-string char))
char))
;; For compatibility.
(define-obsolete-function-alias 'redraw-modeline
- 'force-mode-line-update "24.2")
+ '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.
\f
;;;; Misc. useful functions.
+(defsubst buffer-narrowed-p ()
+ "Return non-nil if the current buffer is narrowed."
+ (/= (- (point-max) (point-min)) (buffer-size)))
+
(defun find-tag-default ()
"Determine default tag to search for, based on text at point.
If there is no plausible default, return nil."
form."
(secure-hash 'sha1 object start end binary))
+(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
+in the hope that it will set PROP. If AUTOLOAD is `macro', only do it
+if it's an autoloaded macro."
+ (let ((val nil))
+ (while (and (symbolp f)
+ (null (setq val (get f prop)))
+ (fboundp f))
+ (let ((fundef (symbol-function f)))
+ (if (and autoload (autoloadp fundef)
+ (not (equal fundef
+ (autoload-do-load fundef f
+ (if (eq autoload 'macro)
+ 'macro)))))
+ nil ;Re-try `get' on the same `f'.
+ (setq f fundef))))
+ val))
\f
;;;; Support for yanking and text properties.
+(defvar yank-handled-properties)
(defvar yank-excluded-properties)
(defun remove-yank-excluded-properties (start end)
- "Remove `yank-excluded-properties' between START and END positions.
-Replaces `category' properties with their defined properties."
+ "Process text properties between START and END, inserted for a `yank'.
+Perform the handling specified by `yank-handled-properties', then
+remove properties specified by `yank-excluded-properties'."
(let ((inhibit-read-only t))
- ;; Replace any `category' property with the properties it stands
- ;; for. This is to remove `mouse-face' properties that are placed
- ;; on categories in *Help* buffers' buttons. See
- ;; http://lists.gnu.org/archive/html/emacs-devel/2002-04/msg00648.html
- ;; for the details.
- (unless (memq yank-excluded-properties '(t nil))
- (save-excursion
- (goto-char start)
- (while (< (point) end)
- (let ((cat (get-text-property (point) 'category))
- run-end)
- (setq run-end
- (next-single-property-change (point) 'category nil end))
- (when cat
- (let (run-end2 original)
- (remove-list-of-text-properties (point) run-end '(category))
- (while (< (point) run-end)
- (setq run-end2 (next-property-change (point) nil run-end))
- (setq original (text-properties-at (point)))
- (set-text-properties (point) run-end2 (symbol-plist cat))
- (add-text-properties (point) run-end2 original)
- (goto-char run-end2))))
- (goto-char run-end)))))
+ (dolist (handler yank-handled-properties)
+ (let ((prop (car handler))
+ (fun (cdr handler))
+ (run-start start))
+ (while (< run-start end)
+ (let ((value (get-text-property run-start prop))
+ (run-end (next-single-property-change
+ run-start prop nil end)))
+ (funcall fun value run-start run-end)
+ (setq run-start run-end)))))
(if (eq yank-excluded-properties t)
(set-text-properties start end nil)
(remove-list-of-text-properties start end yank-excluded-properties))))
(insert-for-yank-1 string))
(defun insert-for-yank-1 (string)
- "Insert STRING at point, stripping some text properties.
-
-Strip text properties from the inserted text according to
-`yank-excluded-properties'. Otherwise just like (insert STRING).
-
-If STRING has a non-nil `yank-handler' property on the first character,
-the normal insert behavior is modified in various ways. The value of
-the yank-handler property must be a list with one to four elements
-with the following format: (FUNCTION PARAM NOEXCLUDE UNDO).
-When FUNCTION is present and non-nil, it is called instead of `insert'
- to insert the string. FUNCTION takes one argument--the object to insert.
-If PARAM is present and non-nil, it replaces STRING as the object
- passed to FUNCTION (or `insert'); for example, if FUNCTION is
- `yank-rectangle', PARAM may be a list of strings to insert as a
- rectangle.
-If NOEXCLUDE is present and non-nil, the normal removal of the
+ "Insert STRING at point for the `yank' command.
+This function is like `insert', except it honors the variables
+`yank-handled-properties' and `yank-excluded-properties', and the
+`yank-handler' text property.
+
+Properties listed in `yank-handled-properties' are processed,
+then those listed in `yank-excluded-properties' are discarded.
+
+If STRING has a non-nil `yank-handler' property on its first
+character, the normal insert behavior is altered. The value of
+the `yank-handler' property must be a list of one to four
+elements, of the form (FUNCTION PARAM NOEXCLUDE UNDO).
+FUNCTION, if non-nil, should be a function of one argument, an
+ object to insert; it is called instead of `insert'.
+PARAM, if present and non-nil, replaces STRING as the argument to
+ FUNCTION or `insert'; e.g. if FUNCTION is `yank-rectangle', PARAM
+ may be a list of strings to insert as a rectangle.
+If NOEXCLUDE is present and non-nil, the normal removal of
`yank-excluded-properties' is not performed; instead FUNCTION is
- responsible for removing those properties. This may be necessary
- if FUNCTION adjusts point before or after inserting the object.
-If UNDO is present and non-nil, it is a function that will be called
+ responsible for the removal. This may be necessary if FUNCTION
+ adjusts point before or after inserting the object.
+UNDO, if present and non-nil, should be a function to be called
by `yank-pop' to undo the insertion of the current object. It is
- called with two arguments, the start and end of the current region.
- FUNCTION may set `yank-undo-function' to override the UNDO value."
+ given two arguments, the start and end of the region. FUNCTION
+ may set `yank-undo-function' to override UNDO."
(let* ((handler (and (stringp string)
(get-text-property 0 'yank-handler string)))
(param (or (nth 1 handler) string))
end)
(setq yank-undo-function t)
- (if (nth 0 handler) ;; FUNCTION
+ (if (nth 0 handler) ; FUNCTION
(funcall (car handler) param)
(insert param))
(setq end (point))
;; following text property changes.
(setq inhibit-read-only t)
- ;; What should we do with `font-lock-face' properties?
- (if font-lock-defaults
- ;; No, just wipe them.
- (remove-list-of-text-properties opoint end '(font-lock-face))
- ;; Convert them to `face'.
- (save-excursion
- (goto-char opoint)
- (while (< (point) end)
- (let ((face (get-text-property (point) 'font-lock-face))
- run-end)
- (setq run-end
- (next-single-property-change (point) 'font-lock-face nil end))
- (when face
- (remove-text-properties (point) run-end '(font-lock-face nil))
- (put-text-property (point) run-end 'face face))
- (goto-char run-end)))))
-
- (unless (nth 2 handler) ;; NOEXCLUDE
- (remove-yank-excluded-properties opoint (point)))
+ (unless (nth 2 handler) ; NOEXCLUDE
+ (remove-yank-excluded-properties opoint end))
;; If last inserted char has properties, mark them as rear-nonsticky.
(if (and (> end opoint)
(text-properties-at (1- end)))
(put-text-property (1- end) end 'rear-nonsticky t))
- (if (eq yank-undo-function t) ;; not set by FUNCTION
- (setq yank-undo-function (nth 3 handler))) ;; UNDO
- (if (nth 4 handler) ;; COMMAND
+ (if (eq yank-undo-function t) ; not set by FUNCTION
+ (setq yank-undo-function (nth 3 handler))) ; UNDO
+ (if (nth 4 handler) ; COMMAND
(setq this-command (nth 4 handler)))))
(defun insert-buffer-substring-no-properties (buffer &optional start end)
(insert-buffer-substring buffer start end)
(remove-yank-excluded-properties opoint (point))))
+(defun yank-handle-font-lock-face-property (face start end)
+ "If `font-lock-defaults' is nil, apply FACE as a `face' property.
+START and END denote the start and end of the text to act on.
+Do nothing if FACE is nil."
+ (and face
+ (null font-lock-defaults)
+ (put-text-property start end 'face face)))
+
+;; This removes `mouse-face' properties in *Help* buffer buttons:
+;; http://lists.gnu.org/archive/html/emacs-devel/2002-04/msg00648.html
+(defun yank-handle-category-property (category start end)
+ "Apply property category CATEGORY's properties between START and END."
+ (when category
+ (let ((start2 start))
+ (while (< start2 end)
+ (let ((end2 (next-property-change start2 nil end))
+ (original (text-properties-at start2)))
+ (set-text-properties start2 end2 (symbol-plist category))
+ (add-text-properties start2 end2 original)
+ (setq start2 end2))))))
+
\f
;;;; Synchronous shell commands.
(set-buffer ,buffer-or-name)
,@body))
+(defun internal--before-with-selected-window (window)
+ (let ((other-frame (window-frame window)))
+ (list window (selected-window)
+ ;; Selecting a window on another frame also changes that
+ ;; frame's frame-selected-window. We must save&restore it.
+ (unless (eq (selected-frame) other-frame)
+ (frame-selected-window other-frame))
+ ;; Also remember the top-frame if on ttys.
+ (unless (eq (selected-frame) other-frame)
+ (tty-top-frame other-frame)))))
+
+(defun internal--after-with-selected-window (state)
+ ;; First reset frame-selected-window.
+ (when (window-live-p (nth 2 state))
+ ;; We don't use set-frame-selected-window because it does not
+ ;; pass the `norecord' argument to Fselect_window.
+ (select-window (nth 2 state) 'norecord)
+ (and (frame-live-p (nth 3 state))
+ (not (eq (tty-top-frame) (nth 3 state)))
+ (select-frame (nth 3 state) 'norecord)))
+ ;; Then reset the actual selected-window.
+ (when (window-live-p (nth 1 state))
+ (select-window (nth 1 state) 'norecord)))
+
(defmacro with-selected-window (window &rest body)
"Execute the forms in BODY with WINDOW as the selected window.
The value returned is the value of the last form in BODY.
potentially make a different buffer current. It does not alter
the buffer list ordering."
(declare (indent 1) (debug t))
- ;; Most of this code is a copy of save-selected-window.
- `(let* ((save-selected-window-destination ,window)
- (save-selected-window-frame
- (window-frame save-selected-window-destination))
- (save-selected-window-window (selected-window))
- ;; Selecting a window on another frame also changes that
- ;; frame's frame-selected-window. We must save&restore it.
- (save-selected-window-other-frame
- (unless (eq (selected-frame) save-selected-window-frame)
- (frame-selected-window save-selected-window-frame)))
- (save-selected-window-top-frame
- (unless (eq (selected-frame) save-selected-window-frame)
- (tty-top-frame save-selected-window-frame))))
+ `(let ((save-selected-window--state
+ (internal--before-with-selected-window ,window)))
(save-current-buffer
(unwind-protect
- (progn (select-window save-selected-window-destination 'norecord)
+ (progn (select-window (car save-selected-window--state) 'norecord)
,@body)
- ;; First reset frame-selected-window.
- (when (window-live-p save-selected-window-other-frame)
- ;; We don't use set-frame-selected-window because it does not
- ;; pass the `norecord' argument to Fselect_window.
- (select-window save-selected-window-other-frame 'norecord)
- (and (frame-live-p save-selected-window-top-frame)
- (not (eq (tty-top-frame) save-selected-window-top-frame))
- (select-frame save-selected-window-top-frame 'norecord)))
- ;; Then reset the actual selected-window.
- (when (window-live-p save-selected-window-window)
- (select-window save-selected-window-window 'norecord))))))
+ (internal--after-with-selected-window save-selected-window--state)))))
(defmacro with-selected-frame (frame &rest body)
"Execute the forms in BODY with FRAME as the selected frame.
table))
(defun syntax-after (pos)
- "Return the raw syntax of the char after POS.
+ "Return the raw syntax descriptor for the char after POS.
If POS is outside the buffer's accessible portion, return nil."
(unless (or (< pos (point-min)) (>= pos (point-max)))
(let ((st (if parse-sexp-lookup-properties
(aref (or st (syntax-table)) (char-after pos))))))
(defun syntax-class (syntax)
- "Return the syntax class part of the syntax descriptor SYNTAX.
+ "Return the code for the syntax class described by SYNTAX.
+
+SYNTAX should be a raw syntax descriptor; the return value is a
+integer which encodes the corresponding syntax class. See Info
+node `(elisp)Syntax Table Internals' for a list of codes.
+
If SYNTAX is nil, return nil."
(and syntax (logand (car syntax) 65535)))
\f