(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
"Propertized string representing a hard newline character.")
-(defun newline (&optional arg)
+(defun newline (&optional arg interactive)
"Insert a newline, and move to left margin of the new line if it's blank.
If option `use-hard-newlines' is non-nil, the newline is marked with the
text-property `hard'.
With ARG, insert that many newlines.
Call `auto-fill-function' if the current column number is greater
-than the value of `fill-column' and ARG is nil."
- (interactive "*P")
+than the value of `fill-column' and ARG is nil.
+A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
+ (interactive "*P\np")
(barf-if-buffer-read-only)
;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
;; Set last-command-event to tell self-insert what to insert.
;; starts a page.
(or was-page-start
(move-to-left-margin nil t)))))
- (unwind-protect
- (progn
- (add-hook 'post-self-insert-hook postproc)
+ (if (not interactive)
+ ;; FIXME: For non-interactive uses, many calls actually just want
+ ;; (insert "\n"), so maybe we should do just that, so as to avoid
+ ;; the risk of filling or running abbrevs unexpectedly.
+ (let ((post-self-insert-hook (list postproc)))
(self-insert-command (prefix-numeric-value arg)))
- ;; We first used let-binding to protect the hook, but that was naive
- ;; since add-hook affects the symbol-default value of the variable,
- ;; whereas the let-binding might only protect the buffer-local value.
- (remove-hook 'post-self-insert-hook postproc)))
+ (unwind-protect
+ (progn
+ (add-hook 'post-self-insert-hook postproc)
+ (self-insert-command (prefix-numeric-value arg)))
+ ;; We first used let-binding to protect the hook, but that was naive
+ ;; since add-hook affects the symbol-default value of the variable,
+ ;; whereas the let-binding might only protect the buffer-local value.
+ (remove-hook 'post-self-insert-hook postproc))))
nil)
(defun set-hard-newline-properties (from to)
Such arguments are used as in `read-from-minibuffer'.)"
;; Used for interactive spec `x'.
(read-from-minibuffer prompt initial-contents minibuffer-local-map
- t minibuffer-history))
+ t 'minibuffer-history))
(defun eval-minibuffer (prompt &optional initial-contents)
"Return value of Lisp expression read using the minibuffer.
;; add it to the history.
(or (equal newcmd (car command-history))
(setq command-history (cons newcmd command-history)))
- (eval newcmd))
+ (unwind-protect
+ (progn
+ ;; Trick called-interactively-p into thinking that `newcmd' is
+ ;; an interactive call (bug#14136).
+ (add-hook 'called-interactively-p-functions
+ #'repeat-complex-command--called-interactively-skip)
+ (eval newcmd))
+ (remove-hook 'called-interactively-p-functions
+ #'repeat-complex-command--called-interactively-skip)))
(if command-history
(error "Argument %d is beyond length of command history" arg)
(error "There are no previous complex commands to repeat")))))
+(defun repeat-complex-command--called-interactively-skip (i _frame1 frame2)
+ (and (eq 'eval (cadr frame2))
+ (eq 'repeat-complex-command
+ (cadr (backtrace-frame i #'called-interactively-p)))
+ 1))
+
(defvar extended-command-history nil)
(defun read-extended-command ()
(display-buffer (button-get button 'process-buffer)))
(defun list-processes (&optional query-only buffer)
- "Display a list of all processes.
+ "Display a list of all processes that are Emacs sub-processes.
If optional argument QUERY-ONLY is non-nil, only processes with
the query-on-exit flag set are listed.
Any process listed as exited or signaled is actually eliminated
after the listing is made.
Optional argument BUFFER specifies a buffer to use, instead of
\"*Process List*\".
-The return value is always nil."
+The return value is always nil.
+
+This function lists only processes that were launched by Emacs. To
+see other processes running on the system, use `list-system-processes'."
(interactive)
(or (fboundp 'process-list)
(error "Asynchronous subprocesses are not supported on this system"))
nil)
\f
(defvar universal-argument-map
- (let ((map (make-sparse-keymap)))
- (define-key map [t] 'universal-argument-other-key)
- (define-key map (vector meta-prefix-char t) 'universal-argument-other-key)
- (define-key map [switch-frame] nil)
+ (let ((map (make-sparse-keymap))
+ (universal-argument-minus
+ ;; For backward compatibility, minus with no modifiers is an ordinary
+ ;; command if digits have already been entered.
+ `(menu-item "" negative-argument
+ :filter ,(lambda (cmd)
+ (if (integerp prefix-arg) nil cmd)))))
+ (define-key map [switch-frame]
+ (lambda (e) (interactive "e")
+ (handle-switch-frame e) (universal-argument--mode)))
(define-key map [?\C-u] 'universal-argument-more)
- (define-key map [?-] 'universal-argument-minus)
+ (define-key map [?-] universal-argument-minus)
(define-key map [?0] 'digit-argument)
(define-key map [?1] 'digit-argument)
(define-key map [?2] 'digit-argument)
(define-key map [kp-7] 'digit-argument)
(define-key map [kp-8] 'digit-argument)
(define-key map [kp-9] 'digit-argument)
- (define-key map [kp-subtract] 'universal-argument-minus)
+ (define-key map [kp-subtract] universal-argument-minus)
map)
"Keymap used while processing \\[universal-argument].")
-(defvar universal-argument-num-events nil
- "Number of argument-specifying events read by `universal-argument'.
-`universal-argument-other-key' uses this to discard those events
-from (this-command-keys), and reread only the final command.")
-
-(defvar saved-overriding-map t
- "The saved value of `overriding-terminal-local-map'.
-That variable gets restored to this value on exiting \"universal
-argument mode\".")
-
-(defun save&set-overriding-map (map)
- "Set `overriding-terminal-local-map' to MAP."
- (when (eq saved-overriding-map t)
- (setq saved-overriding-map overriding-terminal-local-map)
- (setq overriding-terminal-local-map map)))
-
-(defun restore-overriding-map ()
- "Restore `overriding-terminal-local-map' to its saved value."
- (setq overriding-terminal-local-map saved-overriding-map)
- (setq saved-overriding-map t))
+(defun universal-argument--mode ()
+ (set-temporary-overlay-map universal-argument-map))
(defun universal-argument ()
"Begin a numeric argument for the following command.
These commands include \\[set-mark-command] and \\[start-kbd-macro]."
(interactive)
(setq prefix-arg (list 4))
- (setq universal-argument-num-events (length (this-command-keys)))
- (save&set-overriding-map universal-argument-map))
+ (universal-argument--mode))
-;; A subsequent C-u means to multiply the factor by 4 if we've typed
-;; nothing but C-u's; otherwise it means to terminate the prefix arg.
(defun universal-argument-more (arg)
+ ;; A subsequent C-u means to multiply the factor by 4 if we've typed
+ ;; nothing but C-u's; otherwise it means to terminate the prefix arg.
(interactive "P")
- (if (consp arg)
- (setq prefix-arg (list (* 4 (car arg))))
- (if (eq arg '-)
- (setq prefix-arg (list -4))
- (setq prefix-arg arg)
- (restore-overriding-map)))
- (setq universal-argument-num-events (length (this-command-keys))))
+ (setq prefix-arg (if (consp arg)
+ (list (* 4 (car arg)))
+ (if (eq arg '-)
+ (list -4)
+ arg)))
+ (when (consp prefix-arg) (universal-argument--mode)))
(defun negative-argument (arg)
"Begin a negative numeric argument for the next command.
\\[universal-argument] following digits or minus sign ends the argument."
(interactive "P")
- (cond ((integerp arg)
- (setq prefix-arg (- arg)))
- ((eq arg '-)
- (setq prefix-arg nil))
- (t
- (setq prefix-arg '-)))
- (setq universal-argument-num-events (length (this-command-keys)))
- (save&set-overriding-map universal-argument-map))
+ (setq prefix-arg (cond ((integerp arg) (- arg))
+ ((eq arg '-) nil)
+ (t '-)))
+ (universal-argument--mode))
(defun digit-argument (arg)
"Part of the numeric argument for the next command.
last-command-event
(get last-command-event 'ascii-character)))
(digit (- (logand char ?\177) ?0)))
- (cond ((integerp arg)
- (setq prefix-arg (+ (* arg 10)
- (if (< arg 0) (- digit) digit))))
- ((eq arg '-)
- ;; Treat -0 as just -, so that -01 will work.
- (setq prefix-arg (if (zerop digit) '- (- digit))))
- (t
- (setq prefix-arg digit))))
- (setq universal-argument-num-events (length (this-command-keys)))
- (save&set-overriding-map universal-argument-map))
-
-;; For backward compatibility, minus with no modifiers is an ordinary
-;; command if digits have already been entered.
-(defun universal-argument-minus (arg)
- (interactive "P")
- (if (integerp arg)
- (universal-argument-other-key arg)
- (negative-argument arg)))
-
-;; Anything else terminates the argument and is left in the queue to be
-;; executed as a command.
-(defun universal-argument-other-key (arg)
- (interactive "P")
- (setq prefix-arg arg)
- (let* ((key (this-command-keys))
- (keylist (listify-key-sequence key)))
- (setq unread-command-events
- (append (nthcdr universal-argument-num-events keylist)
- unread-command-events)))
- (reset-this-command-lengths)
- (restore-overriding-map))
+ (setq prefix-arg (cond ((integerp arg)
+ (+ (* arg 10)
+ (if (< arg 0) (- digit) digit)))
+ ((eq arg '-)
+ ;; Treat -0 as just -, so that -01 will work.
+ (if (zerop digit) '- (- digit)))
+ (t
+ digit))))
+ (universal-argument--mode))
\f
(defvar filter-buffer-substring-functions nil
be copied into other buffers."
(funcall filter-buffer-substring-function beg end delete))
+;; FIXME: `with-wrapper-hook' is obsolete
(defun buffer-substring--filter (beg end &optional delete)
(with-wrapper-hook filter-buffer-substring-functions (beg end delete)
(cond
(progn
(barf-if-buffer-read-only)
(read-buffer "Insert buffer: "
- (if (eq (selected-window) (next-window (selected-window)))
+ (if (eq (selected-window) (next-window))
(other-buffer (current-buffer))
- (window-buffer (next-window (selected-window))))
+ (window-buffer (next-window)))
t))))
(push-mark
(save-excursion
(save-excursion
(insert-buffer-substring oldbuf start end)))))
\f
-(put 'mark-inactive 'error-conditions '(mark-inactive error))
-(put 'mark-inactive 'error-message (purecopy "The mark is not active now"))
+(define-error 'mark-inactive (purecopy "The mark is not active now"))
(defvar activate-mark-hook nil
"Hook run when the mark becomes active.
(marker-position (mark-marker))
(signal 'mark-inactive nil)))
+;; Behind display-selections-p.
+(declare-function x-selection-owner-p "xselect.c"
+ (&optional selection terminal))
+(declare-function x-selection-exists-p "xselect.c"
+ (&optional selection terminal))
+
(defun deactivate-mark (&optional force)
"Deactivate the mark.
If Transient Mark mode is disabled, this function normally does
(defun next-line (&optional arg try-vscroll)
"Move cursor vertically down ARG lines.
Interactively, vscroll tall lines if `auto-window-vscroll' is enabled.
+Non-interactively, use TRY-VSCROLL to control whether to vscroll tall
+lines: if either `auto-window-vscroll' or TRY-VSCROLL is nil, this
+function will not vscroll.
+
+ARG defaults to 1.
+
If there is no character in the target line exactly under the current column,
the cursor is positioned after the character in that line which spans this
column, or at the end of the line if it is not long enough.
(defun previous-line (&optional arg try-vscroll)
"Move cursor vertically up ARG lines.
Interactively, vscroll tall lines if `auto-window-vscroll' is enabled.
+Non-interactively, use TRY-VSCROLL to control whether to vscroll tall
+lines: if either `auto-window-vscroll' or TRY-VSCROLL is nil, this
+function will not vscroll.
+
+ARG defaults to 1.
+
If there is no character in the target line exactly over the current column,
the cursor is positioned after the character in that line which spans this
column, or at the end of the line if it is not long enough.
:group 'editing-basics
:version "23.1")
+;; Only used if display-graphic-p.
+(declare-function font-info "font.c" (name &optional frame))
+
(defun default-font-height ()
"Return the height in pixels of the current buffer's default face font."
- (cond
- ((display-multi-font-p)
- (aref (font-info (face-font 'default)) 3))
- (t (frame-char-height))))
+ (let ((default-font (face-font 'default)))
+ (cond
+ ((and (display-multi-font-p)
+ ;; Avoid calling font-info if the frame's default font was
+ ;; not changed since the frame was created. That's because
+ ;; font-info is expensive for some fonts, see bug #14838.
+ (not (string= (frame-parameter nil 'font) default-font)))
+ (aref (font-info default-font) 3))
+ (t (frame-char-height)))))
(defun default-line-height ()
"Return the pixel height of current buffer's default-face text line.
(this-ypos (nth 2 this-lh))
(dlh (default-line-height))
(wslines (window-screen-lines))
+ (edges (window-inside-pixel-edges))
+ (winh (- (nth 3 edges) (nth 1 edges) 1))
py vs last-line)
(if (> (mod wslines 1.0) 0.0)
(setq wslines (round (+ wslines 0.5))))
nil)
;; If cursor is not in the bottom scroll margin, and the
;; current line is is not too tall, move forward.
- ((and (or (null this-height) (<= this-height dlh))
+ ((and (or (null this-height) (<= this-height winh))
vpos
(> vpos 0)
(< py last-line))
(> vpos 0)
(= py last-line))
;; Don't vscroll if the partially-visible line at window
- ;; bottom has the default height (a.k.a. "just one more text
+ ;; bottom is not too tall (a.k.a. "just one more text
;; line"): in that case, we do want redisplay to behave
;; normally, i.e. recenter or whatever.
;;
;; partially-visible glyph row at the end of the window. As
;; we are dealing with floats, we disregard sub-pixel
;; discrepancies between that and DLH.
- (if (and rowh rbot (>= (- (+ rowh rbot) dlh) 1))
+ (if (and rowh rbot (>= (- (+ rowh rbot) winh) 1))
(set-window-vscroll nil dlh t))
(line-move-1 arg noerror to-end)
t)
;; If we moved into a tall line, set vscroll to make
;; scrolling through tall images more smooth.
(let ((lh (line-pixel-height))
- (dlh (default-line-height)))
+ (edges (window-inside-pixel-edges))
+ (dlh (default-line-height))
+ winh)
+ (setq winh (- (nth 3 edges) (nth 1 edges) 1))
(if (and (< arg 0)
(< (point) (window-start))
- (> lh dlh))
+ (> lh winh))
(set-window-vscroll
nil
(- lh dlh) t))))
(visual-line-mode 1))
(define-globalized-minor-mode global-visual-line-mode
- visual-line-mode turn-on-visual-line-mode
- :lighter " vl")
+ visual-line-mode turn-on-visual-line-mode)
\f
(defun transpose-chars (arg)
\f
(defun backward-word (&optional arg)
"Move backward until encountering the beginning of a word.
-With argument ARG, do this that many times."
+With argument ARG, do this that many times.
+If ARG is omitted or nil, move point backward one word."
(interactive "^p")
(forward-word (- (or arg 1))))
(setq selective-display
(and arg (prefix-numeric-value arg)))
(recenter current-vpos))
- (set-window-start (selected-window) (window-start (selected-window)))
+ (set-window-start (selected-window) (window-start))
(princ "selective-display set to " t)
(prin1 selective-display t)
(princ "." t))
(interactive)
(let ((buf completion-reference-buffer))
(if (one-window-p t)
- (if (window-dedicated-p (selected-window))
- (delete-frame (selected-frame)))
+ (if (window-dedicated-p) (delete-frame))
(delete-window (selected-window))
(if (get-buffer-window buf)
(select-window (get-buffer-window buf))))))
buffer-invisibility-spec)
(setq buffer-invisibility-spec nil)))
\f
+(defvar messages-buffer-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map special-mode-map)
+ (define-key map "g" nil) ; nothing to revert
+ map))
+
+(define-derived-mode messages-buffer-mode special-mode "Messages"
+ "Major mode used in the \"*Messages*\" buffer.")
+
+(defun messages-buffer ()
+ "Return the \"*Messages*\" buffer.
+If it does not exist, create and it switch it to `messages-buffer-mode'."
+ (or (get-buffer "*Messages*")
+ (with-current-buffer (get-buffer-create "*Messages*")
+ (messages-buffer-mode)
+ (current-buffer))))
+
+\f
;; Minibuffer prompt stuff.
;;(defun minibuffer-prompt-modification (start end)
\f
;;; Generic dispatcher commands
-;; Macro `alternatives-define' is used to create generic commands.
+;; Macro `define-alternatives' is used to create generic commands.
;; Generic commands are these (like web, mail, news, encrypt, irc, etc.)
;; that can have different alternative implementations where choosing
;; among them is exclusively a matter of user preference.
-;; (alternatives-define COMMAND) creates a new interactive command
+;; (define-alternatives COMMAND) creates a new interactive command
;; M-x COMMAND and a customizable variable COMMAND-alternatives.
;; Typically, the user will not need to customize this variable; packages
;; wanting to add alternative implementations should use
;;
;; ;;;###autoload (push '("My impl name" . my-impl-symbol) COMMAND-alternatives
-(defmacro alternatives-define (command &rest customizations)
+(defmacro define-alternatives (command &rest customizations)
"Define new command `COMMAND'.
The variable `COMMAND-alternatives' will contain alternative
implementations of COMMAND, so that running `C-u M-x COMMAND'
HCoop / bpt / emacs.git / blobdiff