;;; simple.el --- basic editing commands for Emacs
;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Maintainer: FSF
(defvar next-error-highlight-timer nil)
(defvar next-error-overlay-arrow-position nil)
-(put 'next-error-overlay-arrow-position 'overlay-arrow-string "=>")
+(put 'next-error-overlay-arrow-position 'overlay-arrow-string (purecopy "=>"))
(add-to-list 'overlay-arrow-variable-list 'next-error-overlay-arrow-position)
(defvar next-error-last-buffer nil
Major modes providing compile-like functionality should set this variable
to indicate to `next-error' that this is a candidate buffer and how
to navigate in it.")
-
(make-variable-buffer-local 'next-error-function)
+(defvar next-error-move-function nil
+ "Function to use to move to an error locus.
+It takes two arguments, a buffer position in the error buffer
+and a buffer position in the error locus buffer.
+The buffer for the error locus should already be current.
+nil means use goto-char using the second argument position.")
+(make-variable-buffer-local 'next-error-move-function)
+
(defsubst next-error-buffer-p (buffer
&optional avoid-current
extra-test-inclusive
(interactive "p")
(next-error-no-select (- (or n 1))))
-;;; Internal variable for `next-error-follow-mode-post-command-hook'.
+;; Internal variable for `next-error-follow-mode-post-command-hook'.
(defvar next-error-follow-last-line nil)
(define-minor-mode next-error-follow-minor-mode
(add-hook 'post-command-hook 'next-error-follow-mode-post-command-hook nil t)
(make-local-variable 'next-error-follow-last-line)))
-;;; Used as a `post-command-hook' by `next-error-follow-mode'
-;;; for the *Compilation* *grep* and *Occur* buffers.
+;; Used as a `post-command-hook' by `next-error-follow-mode'
+;; for the *Compilation* *grep* and *Occur* buffers.
(defun next-error-follow-mode-post-command-hook ()
(unless (equal next-error-follow-last-line (line-number-at-pos))
(setq next-error-follow-last-line (line-number-at-pos))
;; Making and deleting lines.
-(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard)))
+(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
+ "Propertized string representing a hard newline character.")
(defun newline (&optional arg)
"Insert a newline, and move to left margin of the new line if it's blank.
(constrain-to-field nil orig-pos t)))))
\f
(defun beginning-of-buffer (&optional arg)
- "Move point to the beginning of the buffer; leave mark at previous position.
-With \\[universal-argument] prefix, do not set mark at previous position.
+ "Move point to the beginning of the buffer.
With numeric arg N, put point N/10 of the way from the beginning.
+If the buffer is narrowed, this command uses the beginning of the
+accessible part of the buffer.
-If the buffer is narrowed, this command uses the beginning and size
-of the accessible part of the buffer.
+If Transient Mark mode is disabled, leave mark at previous
+position, unless a \\[universal-argument] prefix is supplied.
Don't use this command in Lisp programs!
-\(goto-char (point-min)) is faster and avoids clobbering the mark."
+\(goto-char (point-min)) is faster."
(interactive "^P")
(or (consp arg)
(region-active-p)
(if (and arg (not (consp arg))) (forward-line 1)))
(defun end-of-buffer (&optional arg)
- "Move point to the end of the buffer; leave mark at previous position.
-With \\[universal-argument] prefix, do not set mark at previous position.
+ "Move point to the end of the buffer.
With numeric arg N, put point N/10 of the way from the end.
+If the buffer is narrowed, this command uses the end of the
+accessible part of the buffer.
-If the buffer is narrowed, this command uses the beginning and size
-of the accessible part of the buffer.
+If Transient Mark mode is disabled, leave mark at previous
+position, unless a \\[universal-argument] prefix is supplied.
Don't use this command in Lisp programs!
-\(goto-char (point-max)) is faster and avoids clobbering the mark."
+\(goto-char (point-max)) is faster."
(interactive "^P")
(or (consp arg) (region-active-p) (push-mark))
(let ((size (- (point-max) (point-min))))
"Goto LINE, counting from line 1 at beginning of buffer.
Normally, move point in the current buffer, and leave mark at the
previous position. With just \\[universal-argument] as argument,
-move point in the most recently selected other buffer, and switch
-to it. When called from Lisp code, the optional argument BUFFER
-specifies a buffer to switch to.
+move point in the most recently selected other buffer, and switch to it.
-If there's a number in the buffer at point, it is the default for
-LINE."
+If there's a number in the buffer at point, it is the default for LINE.
+
+This function is usually the wrong thing to use in a Lisp program.
+What you probably want instead is something like:
+ (goto-char (point-min)) (forward-line (1- N))
+If at all possible, an even better solution is to use char counts
+rather than line counts."
(interactive
(if (and current-prefix-arg (not (consp current-prefix-arg)))
(list (prefix-numeric-value current-prefix-arg))
;; Move to the specified line number in that buffer.
(save-restriction
(widen)
- (goto-char 1)
+ (goto-char (point-min))
(if (eq selective-display t)
(re-search-forward "[\n\C-m]" nil 'end (1- line))
(forward-line (1- line)))))
encoded encoding-msg display-prop under-display)
(if (or (not coding)
(eq (coding-system-type coding) t))
- (setq coding default-buffer-file-coding-system))
+ (setq coding (default-value 'buffer-file-coding-system)))
(if (eq (char-charset char) 'eight-bit)
(setq encoding-msg
(format "(%d, #o%o, #x%x, raw-byte)" char char char))
&optional eval-expression-insert-value)
"Evaluate EVAL-EXPRESSION-ARG and print value in the echo area.
Value is also consed on to front of the variable `values'.
-Optional argument EVAL-EXPRESSION-INSERT-VALUE, if non-nil, means
-insert the result into the current buffer instead of printing it in
-the echo area. Truncates long output according to the value of the
-variables `eval-expression-print-length' and `eval-expression-print-level'.
+Optional argument EVAL-EXPRESSION-INSERT-VALUE non-nil (interactively,
+with prefix argument) means insert the result into the current buffer
+instead of printing it in the echo area. Truncates long output
+according to the value of the variables `eval-expression-print-length'
+and `eval-expression-print-level'.
If `eval-expression-debug-on-error' is non-nil, which is the default,
this command arranges for all errors to enter the debugger."
(let ((def minibuffer-default)
(all (all-completions ""
minibuffer-completion-table
- minibuffer-completion-predicate
- t)))
+ minibuffer-completion-predicate)))
(if (listp def)
(append def all)
(cons def (delete def all)))))
\f
;Put this on C-x u, so we can force that rather than C-_ into startup msg
-(defalias 'advertised-undo 'undo)
+(define-obsolete-function-alias 'advertised-undo 'undo "23.2")
(defconst undo-equiv-table (make-hash-table :test 'eq :weakness t)
"Table mapping redo records to the corresponding undo one.
Maximum length of the history list is determined by the value
of `history-length', which see.")
-(defvar shell-command-switch "-c"
+(defvar shell-command-switch (purecopy "-c")
"Switch used to have the shell execute its command line argument.")
(defvar shell-command-default-error-buffer nil
stdout will be intermixed in the output stream.")
(declare-function mailcap-file-default-commands "mailcap" (files))
+(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
(defun minibuffer-default-add-shell-commands ()
"Return a list of all commands associated with the current file.
If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
If OUTPUT-BUFFER is not a buffer and not nil,
insert output in current buffer. (This cannot be done asynchronously.)
-In either case, the output is inserted after point (leaving mark after it).
+In either case, the buffer is first erased, and the output is
+inserted after point (leaving mark after it).
If the command terminates without error, but generates output,
and you did not specify \"insert it in the current buffer\",
(interactive
(list
(read-shell-command "Shell command: " nil nil
- (and buffer-file-name
- (file-relative-name buffer-file-name)))
+ (let ((filename
+ (cond
+ (buffer-file-name)
+ ((eq major-mode 'dired-mode)
+ (dired-get-filename nil t)))))
+ (and filename (file-relative-name filename))))
current-prefix-arg
shell-command-default-error-buffer))
;; Look for a handler in case default-directory is a remote file name.
(setq mode-line-process '(":%s"))
(require 'shell) (shell-mode)
(set-process-sentinel proc 'shell-command-sentinel)
+ ;; Use the comint filter for proper handling of carriage motion
+ ;; (see `comint-inhibit-carriage-motion'),.
+ (set-process-filter proc 'comint-output-filter)
))
+ ;; Otherwise, command is executed synchronously.
(shell-command-on-region (point) (point) command
output-buffer nil error-buffer)))))))
;; Clear the output buffer, then run the command with
;; output there.
(let ((directory default-directory))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(setq buffer-read-only nil)
(if (not output-buffer)
(setq default-directory directory))
(when stderr-file (delete-file stderr-file))
(when lc (delete-file lc)))))
+(defvar process-file-side-effects t
+ "Whether a call of `process-file' changes remote files.
+
+Per default, this variable is always set to `t', meaning that a
+call of `process-file' could potentially change any file on a
+remote host. When set to `nil', a file handler could optimize
+its behaviour with respect to remote file attributes caching.
+
+This variable should never be changed by `setq'. Instead of, it
+shall be set only by let-binding.")
+
(defun start-file-process (name buffer program &rest program-args)
"Start a program in a subprocess. Return the process object for it.
the working directory of the process.
PROGRAM and PROGRAM-ARGS might be file names. They are not
-objects of file handler invocation."
+objects of file handler invocation. File handlers might not
+support pty association, if PROGRAM is nil."
(let ((fh (find-file-name-handler default-directory 'start-file-process)))
(if fh (apply fh 'start-file-process name buffer program program-args)
(apply 'start-process name buffer program program-args))))
(defvar kill-ring-yank-pointer nil
"The tail of the kill ring whose car is the last thing yanked.")
+(defcustom save-interprogram-paste-before-kill nil
+ "Save clipboard strings into kill ring before replacing them.
+When one selects something in another program to paste it into Emacs,
+but kills something in Emacs before actually pasting it,
+this selection is gone unless this variable is non-nil,
+in which case the other program's selection is saved in the `kill-ring'
+before the Emacs kill and one can still paste it using \\[yank] \\[yank-pop]."
+ :type 'boolean
+ :group 'killing
+ :version "23.2")
+
+(defcustom kill-do-not-save-duplicates nil
+ "Do not add a new string to `kill-ring' when it is the same as the last one."
+ :type 'boolean
+ :group 'killing
+ :version "23.2")
+
(defun kill-new (string &optional replace yank-handler)
"Make STRING the latest kill in the kill ring.
Set `kill-ring-yank-pointer' to point to it.
When a yank handler is specified, STRING must be non-empty (the yank
handler, if non-nil, is stored as a `yank-handler' text property on STRING).
+When `save-interprogram-paste-before-kill' and `interprogram-paste-function'
+are non-nil, saves the interprogram paste string(s) into `kill-ring' before
+STRING.
+
When the yank handler has a non-nil PARAM element, the original STRING
argument is not used by `insert-for-yank'. However, since Lisp code
may access and use elements from the kill ring directly, the STRING
(if yank-handler
(signal 'args-out-of-range
(list string "yank-handler specified for empty string"))))
+ (when (and kill-do-not-save-duplicates
+ (equal string (car kill-ring)))
+ (setq replace t))
(if (fboundp 'menu-bar-update-yank-menu)
(menu-bar-update-yank-menu string (and replace (car kill-ring))))
+ (when save-interprogram-paste-before-kill
+ (let ((interprogram-paste (and interprogram-paste-function
+ (funcall interprogram-paste-function))))
+ (when interprogram-paste
+ (if (listp interprogram-paste)
+ (dolist (s (nreverse interprogram-paste))
+ (push s kill-ring))
+ (push interprogram-paste kill-ring)))))
(if (and replace kill-ring)
(setcar kill-ring string)
(push string kill-ring)
(put 'text-read-only 'error-conditions
'(text-read-only buffer-read-only error))
-(put 'text-read-only 'error-message "Text is read-only")
+(put 'text-read-only 'error-message (purecopy "Text is read-only"))
(defun kill-region (beg end &optional yank-handler)
"Kill (\"cut\") text between point and mark.
the text, but put the text in the kill ring anyway. This means that
you can use the killing commands to copy text from a read-only buffer.
-This is the primitive for programs to kill text (as opposed to deleting it).
+Lisp programs should use this function for killing text.
+ (To delete text, use `delete-region'.)
Supply two arguments, character positions indicating the stretch of text
to be killed.
Any command that calls this function is a \"kill command\".
visual feedback indicating the extent of the region being copied."
(interactive "r")
(copy-region-as-kill beg end)
- ;; This use of interactive-p is correct
+ ;; This use of called-interactively-p is correct
;; because the code it controls just gives the user visual feedback.
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(let ((other-end (if (= (point) beg) end beg))
(opoint (point))
;; Inhibit quitting so we can make a quit here
(list (read-buffer "Append to buffer: " (other-buffer (current-buffer) t))
(region-beginning) (region-end)))
(let ((oldbuf (current-buffer)))
- (save-excursion
- (let* ((append-to (get-buffer-create buffer))
- (windows (get-buffer-window-list append-to t t))
- point)
- (set-buffer append-to)
- (setq point (point))
- (barf-if-buffer-read-only)
- (insert-buffer-substring oldbuf start end)
- (dolist (window windows)
- (when (= (window-point window) point)
- (set-window-point window (point))))))))
+ (let* ((append-to (get-buffer-create buffer))
+ (windows (get-buffer-window-list append-to t t))
+ point)
+ (save-excursion
+ (with-current-buffer append-to
+ (setq point (point))
+ (barf-if-buffer-read-only)
+ (insert-buffer-substring oldbuf start end)
+ (dolist (window windows)
+ (when (= (window-point window) point)
+ (set-window-point window (point)))))))))
(defun prepend-to-buffer (buffer start end)
"Prepend to specified buffer the text of the region.
START and END specify the portion of the current buffer to be copied."
(interactive "BPrepend to buffer: \nr")
(let ((oldbuf (current-buffer)))
- (save-excursion
- (set-buffer (get-buffer-create buffer))
+ (with-current-buffer (get-buffer-create buffer)
(barf-if-buffer-read-only)
(save-excursion
(insert-buffer-substring oldbuf start end)))))
(insert-buffer-substring oldbuf start end)))))
\f
(put 'mark-inactive 'error-conditions '(mark-inactive error))
-(put 'mark-inactive 'error-message "The mark is not active now")
+(put 'mark-inactive 'error-message (purecopy "The mark is not active now"))
(defvar activate-mark-hook nil
"Hook run when the mark becomes active.
:group 'killing
:version "23.1")
+(declare-function x-selection-owner-p "xselect.c" (&optional selection))
+
;; Many places set mark-active directly, and several of them failed to also
;; run deactivate-mark-hook. This shorthand should simplify.
(defsubst deactivate-mark (&optional force)
This is used by commands that act specially on the region under
Transient Mark mode.
-The return value is t provided Transient Mark mode is enabled and
-the mark is active; and, when `use-empty-active-region' is
-non-nil, provided the region is empty. Otherwise, the return
-value is nil.
+The return value is t if Transient Mark mode is enabled and the
+mark is active; furthermore, if `use-empty-active-region' is nil,
+the region must not be empty. Otherwise, the return value is nil.
For some commands, it may be appropriate to ignore the value of
`use-empty-active-region'; in that case, use `region-active-p'."
(push-mark nil nomsg t)
(setq mark-active t)
(run-hooks 'activate-mark-hook)
+ (and select-active-regions (display-selections-p)
+ (x-set-selection 'PRIMARY (current-buffer)))
(unless nomsg
(message "Mark activated")))))
(defcustom set-mark-default-inactive nil
"If non-nil, setting the mark does not activate it.
This causes \\[set-mark-command] and \\[exchange-point-and-mark] to
-behave the same whether or not `transient-mark-mode' is enabled.")
+behave the same whether or not `transient-mark-mode' is enabled."
+ :type 'boolean
+ :group 'editing-basics
+ :version "23.1")
(defun set-mark-command (arg)
"Set the mark where point is, or jump to the mark.
(setq mark-ring (cdr mark-ring)))
(deactivate-mark))
-(defalias 'exchange-dot-and-mark 'exchange-point-and-mark)
+(define-obsolete-function-alias
+ 'exchange-dot-and-mark 'exchange-point-and-mark "23.3")
(defun exchange-point-and-mark (&optional arg)
"Put the mark where point is now, and point where the mark is now.
This command works even when the mark is not active,
commands which are sensitive to the Transient Mark mode."
:global t
:init-value (not noninteractive)
+ :initialize 'custom-initialize-delay
:group 'editing-basics)
;; The variable transient-mark-mode is ugly: it can take on special
(end-of-line)
(insert (if use-hard-newlines hard-newline "\n")))
(line-move arg nil nil try-vscroll))
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(condition-case nil
(line-move arg nil nil try-vscroll)
((beginning-of-buffer end-of-buffer) (ding)))
to use and more reliable (no dependence on goal column, etc.)."
(interactive "^p\np")
(or arg (setq arg 1))
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(condition-case nil
(line-move (- arg) nil nil try-vscroll)
((beginning-of-buffer end-of-buffer) (ding)))
;; Arg says how many lines to move. The value is t if we can move the
;; specified number of lines.
(defun line-move-visual (arg &optional noerror)
- (let ((posn (posn-at-point))
- (opoint (point))
+ (let ((opoint (point))
(hscroll (window-hscroll))
- x)
+ target-hscroll)
;; Check if the previous command was a line-motion command, or if
;; we were called from some other command.
- (cond ((and (consp temporary-goal-column)
- (memq last-command `(next-line previous-line ,this-command)))
- ;; If so, there's no need to reset `temporary-goal-column',
- ;; unless the window hscroll has changed.
- (when (/= hscroll (cdr temporary-goal-column))
- (set-window-hscroll nil 0)
- (setq temporary-goal-column
- (cons (+ (car temporary-goal-column)
- (cdr temporary-goal-column)) 0))))
- ;; Otherwise, we should reset `temporary-goal-column'.
- ;; Handle the `overflow-newline-into-fringe' case:
- ((eq (nth 1 posn) 'right-fringe)
- (setq temporary-goal-column (cons (- (window-width) 1) hscroll)))
- ((setq x (car (posn-x-y posn)))
- (setq temporary-goal-column
- (cons (/ (float x) (frame-char-width)) hscroll))))
- ;; Move using `vertical-motion'.
+ (if (and (consp temporary-goal-column)
+ (memq last-command `(next-line previous-line ,this-command)))
+ ;; If so, there's no need to reset `temporary-goal-column',
+ ;; but we may need to hscroll.
+ (if (or (/= (cdr temporary-goal-column) hscroll)
+ (> (cdr temporary-goal-column) 0))
+ (setq target-hscroll (cdr temporary-goal-column)))
+ ;; Otherwise, we should reset `temporary-goal-column'.
+ (let ((posn (posn-at-point)))
+ (cond
+ ;; Handle the `overflow-newline-into-fringe' case:
+ ((eq (nth 1 posn) 'right-fringe)
+ (setq temporary-goal-column (cons (- (window-width) 1) hscroll)))
+ ((car (posn-x-y posn))
+ (setq temporary-goal-column
+ (cons (/ (float (car (posn-x-y posn)))
+ (frame-char-width)) hscroll))))))
+ (if target-hscroll
+ (set-window-hscroll (selected-window) target-hscroll))
(or (and (= (vertical-motion
(cons (or goal-column
(if (consp temporary-goal-column)
- (truncate (car temporary-goal-column))
+ (car temporary-goal-column)
temporary-goal-column))
arg))
arg)
(point))))
;; Move to the desired column.
- (line-move-to-column column)
+ (line-move-to-column (truncate column))
;; Corner case: suppose we start out in a field boundary in
;; the middle of a continued line. When we get to
(/= arg 1) t nil)))))
-;;; Many people have said they rarely use this feature, and often type
-;;; it by accident. Maybe it shouldn't even be on a key.
+;; Many people have said they rarely use this feature, and often type
+;; it by accident. Maybe it shouldn't even be on a key.
(put 'set-goal-column 'disabled t)
(defun set-goal-column (arg)
(if (/= n 1)
(let ((line-move-visual t))
(line-move (1- n) t)))
+ ;; Unlike `move-beginning-of-line', `move-end-of-line' doesn't
+ ;; constrain to field boundaries, so we don't either.
(vertical-motion (cons (window-width) 0)))
(defun beginning-of-visual-line (&optional n)
To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
(interactive "^p")
(or n (setq n 1))
- (if (/= n 1)
- (let ((line-move-visual t))
- (line-move (1- n) t)))
- (vertical-motion 0))
+ (let ((opoint (point)))
+ (if (/= n 1)
+ (let ((line-move-visual t))
+ (line-move (1- n) t)))
+ (vertical-motion 0)
+ ;; Constrain to field boundaries, like `move-beginning-of-line'.
+ (goto-char (constrain-to-field (point) opoint (/= n 1)))))
(defun kill-visual-line (&optional arg)
"Kill the rest of the visual line.
This also turns on `word-wrap' in the buffer."
:keymap visual-line-mode-map
:group 'visual-line
- :lighter " wrap"
+ :lighter " Wrap"
(if visual-line-mode
(progn
(set (make-local-variable 'visual-line--saved-state) nil)
(forward-line arg))))
arg))
+;; FIXME seems to leave point BEFORE the current object when ARG = 0,
+;; which seems inconsistent with the ARG /= 0 case.
+;; FIXME document SPECIAL.
(defun transpose-subr (mover arg &optional special)
+ "Subroutine to do the work of transposing objects.
+Works for lines, sentences, paragraphs, etc. MOVER is a function that
+moves forward by units of the given object (e.g. forward-sentence,
+forward-paragraph). If ARG is zero, exchanges the current object
+with the one containing mark. If ARG is an integer, moves the
+current object past ARG following (if ARG is positive) or
+preceding (if ARG is negative) objects, leaving point after the
+current object."
(let ((aux (if special mover
(lambda (x)
(cons (progn (funcall mover x) (point))
((= arg 0)
(save-excursion
(setq pos1 (funcall aux 1))
- (goto-char (mark))
+ (goto-char (or (mark) (error "No mark set in this buffer")))
(setq pos2 (funcall aux 1))
(transpose-subr-1 pos1 pos2))
(exchange-point-and-mark))
(message "Word wrapping %s"
(if word-wrap "enabled" "disabled")))
-(defvar overwrite-mode-textual " Ovwrt"
+(defvar overwrite-mode-textual (purecopy " Ovwrt")
"The string displayed in the mode line when in overwrite mode.")
-(defvar overwrite-mode-binary " Bin Ovwrt"
+(defvar overwrite-mode-binary (purecopy " Bin Ovwrt")
"The string displayed in the mode line when in binary overwrite mode.")
(defun overwrite-mode (arg)
"Your preference for a mail reading package.
This is used by some keybindings which support reading mail.
See also `mail-user-agent' concerning sending mail."
- :type '(choice (function-item rmail)
- (function-item gnus)
- (function-item mh-rmail)
- (function :tag "Other"))
+ :type '(radio (function-item :tag "Rmail" :format "%t\n" rmail)
+ (function-item :tag "Gnus" :format "%t\n" gnus)
+ (function-item :tag "Emacs interface to MH"
+ :format "%t\n" mh-rmail)
+ (function :tag "Other"))
:version "21.1"
:group 'mail)
:version "23.2" ; sendmail->message
:group 'mail)
+(defcustom compose-mail-user-agent-warnings t
+ "If non-nil, `compose-mail' warns about changes in `mail-user-agent'.
+If the value of `mail-user-agent' is the default, and the user
+appears to have customizations applying to the old default,
+`compose-mail' issues a warning."
+ :type 'boolean
+ :version "23.2"
+ :group 'mail)
+
(define-mail-user-agent 'sendmail-user-agent
'sendmail-user-agent-compose
'mail-send-and-exit)
Each action has the form (FUNCTION . ARGS)."
(interactive
(list nil nil nil current-prefix-arg))
+
+ ;; In Emacs 23.2, the default value of `mail-user-agent' changed
+ ;; from sendmail-user-agent to message-user-agent. Some users may
+ ;; encounter incompatibilities. This hack tries to detect problems
+ ;; and warn about them.
+ (and compose-mail-user-agent-warnings
+ (eq mail-user-agent 'message-user-agent)
+ (let (warn-vars)
+ (dolist (var '(mail-mode-hook mail-send-hook mail-setup-hook
+ mail-yank-hooks mail-archive-file-name
+ mail-default-reply-to mail-mailing-lists
+ mail-self-blind))
+ (and (boundp var)
+ (symbol-value var)
+ (push var warn-vars)))
+ (when warn-vars
+ (display-warning 'mail
+ (format "\
+The default mail mode is now Message mode.
+You have the following Mail mode variable%s customized:
+\n %s\n\nTo use Mail mode, set `mail-user-agent' to sendmail-user-agent.
+To disable this warning, set `compose-mail-user-agent-warnings' to nil."
+ (if (> (length warn-vars) 1) "s" "")
+ (mapconcat 'symbol-name
+ warn-vars " "))))))
+
(let ((function (get mail-user-agent 'composefunc)))
(funcall function to subject other-headers continue
switch-function yank-action send-actions)))
(defvar completion-no-auto-exit nil
"Non-nil means `choose-completion-string' should never exit the minibuffer.
-This also applies to other functions such as `choose-completion'
-and `mouse-choose-completion'.")
+This also applies to other functions such as `choose-completion'.")
+
+(defvar completion-base-position nil
+ "Position of the base of the text corresponding to the shown completions.
+This variable is used in the *Completions* buffers.
+Its value is a list of the form (START END) where START is the place
+where the completion should be inserted and END (if non-nil) is the end
+of the text to replace. If END is nil, point is used instead.")
(defvar completion-base-size nil
"Number of chars before point not involved in completion.
If nil, Emacs determines which part of the tail end of the
buffer's text is involved in completion by comparing the text
directly.")
+(make-obsolete-variable 'completion-base-size 'completion-base-position "23.2")
(defun delete-completion-window ()
"Delete the completion list window.
(point) 'mouse-face nil beg))
(setq n (1+ n))))))
-(defun choose-completion ()
- "Choose the completion that point is in or next to."
- (interactive)
- (let (beg end completion (buffer completion-reference-buffer)
- (base-size completion-base-size))
- (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
- (setq end (point) beg (1+ (point))))
- (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
- (setq end (1- (point)) beg (point)))
- (if (null beg)
- (error "No completion here"))
- (setq beg (previous-single-property-change beg 'mouse-face))
- (setq end (or (next-single-property-change end 'mouse-face) (point-max)))
- (setq completion (buffer-substring-no-properties beg end))
+(defun choose-completion (&optional event)
+ "Choose the completion at point."
+ (interactive (list last-nonmenu-event))
+ ;; In case this is run via the mouse, give temporary modes such as
+ ;; isearch a chance to turn off.
+ (run-hooks 'mouse-leave-buffer-hook)
+ (let (buffer base-size base-position choice)
+ (with-current-buffer (window-buffer (posn-window (event-start event)))
+ (setq buffer completion-reference-buffer)
+ (setq base-size completion-base-size)
+ (setq base-position completion-base-position)
+ (save-excursion
+ (goto-char (posn-point (event-start event)))
+ (let (beg end)
+ (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
+ (setq end (point) beg (1+ (point))))
+ (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
+ (setq end (1- (point)) beg (point)))
+ (if (null beg)
+ (error "No completion here"))
+ (setq beg (previous-single-property-change beg 'mouse-face))
+ (setq end (or (next-single-property-change end 'mouse-face)
+ (point-max)))
+ (setq choice (buffer-substring-no-properties beg end)))))
+
(let ((owindow (selected-window)))
+ (select-window (posn-window (event-start event)))
(if (and (one-window-p t 'selected-frame)
- (window-dedicated-p owindow))
+ (window-dedicated-p (selected-window)))
;; This is a special buffer's frame
(iconify-frame (selected-frame))
(or (window-dedicated-p (selected-window))
(bury-buffer)))
(select-window
(or (and (buffer-live-p buffer)
- (get-buffer-window buffer))
+ (get-buffer-window buffer 0))
owindow)))
- (choose-completion-string completion buffer base-size)))
+
+ (choose-completion-string
+ choice buffer
+ (or base-position
+ (when base-size
+ ;; Someone's using old completion code that doesn't know
+ ;; about base-position yet.
+ (list (+ base-size (with-current-buffer buffer (field-beginning)))))
+ ;; If all else fails, just guess.
+ (with-current-buffer buffer
+ (list (choose-completion-guess-base-position choice)))))))
;; Delete the longest partial match for STRING
;; that can be found before POINT.
+(defun choose-completion-guess-base-position (string)
+ (save-excursion
+ (let ((opoint (point))
+ len)
+ ;; Try moving back by the length of the string.
+ (goto-char (max (- (point) (length string))
+ (minibuffer-prompt-end)))
+ ;; See how far back we were actually able to move. That is the
+ ;; upper bound on how much we can match and delete.
+ (setq len (- opoint (point)))
+ (if completion-ignore-case
+ (setq string (downcase string)))
+ (while (and (> len 0)
+ (let ((tail (buffer-substring (point) opoint)))
+ (if completion-ignore-case
+ (setq tail (downcase tail)))
+ (not (string= tail (substring string 0 len)))))
+ (setq len (1- len))
+ (forward-char 1))
+ (point))))
+
(defun choose-completion-delete-max-match (string)
- (let ((opoint (point))
- len)
- ;; Try moving back by the length of the string.
- (goto-char (max (- (point) (length string))
- (minibuffer-prompt-end)))
- ;; See how far back we were actually able to move. That is the
- ;; upper bound on how much we can match and delete.
- (setq len (- opoint (point)))
- (if completion-ignore-case
- (setq string (downcase string)))
- (while (and (> len 0)
- (let ((tail (buffer-substring (point) opoint)))
- (if completion-ignore-case
- (setq tail (downcase tail)))
- (not (string= tail (substring string 0 len)))))
- (setq len (1- len))
- (forward-char 1))
- (delete-char len)))
+ (delete-region (choose-completion-guess-base-position string) (point)))
+(make-obsolete 'choose-completion-delete-max-match
+ 'choose-completion-guess-base-position "23.2")
(defvar choose-completion-string-functions nil
"Functions that may override the normal insertion of a completion choice.
If all functions in the list return nil, that means to use
the default method of inserting the completion in BUFFER.")
-(defun choose-completion-string (choice &optional buffer base-size)
+(defun choose-completion-string (choice &optional buffer base-position)
"Switch to BUFFER and insert the completion choice CHOICE.
-BASE-SIZE, if non-nil, says how many characters of BUFFER's text
-to keep. If it is nil, we call `choose-completion-delete-max-match'
-to decide what to delete."
+BASE-POSITION, says where to insert the completion."
;; If BUFFER is the minibuffer, exit the minibuffer
;; unless it is reading a file name and CHOICE is a directory,
;; or completion-no-auto-exit is non-nil.
+ ;; Some older code may call us passing `base-size' instead of
+ ;; `base-position'. It's difficult to make any use of `base-size',
+ ;; so we just ignore it.
+ (unless (consp base-position)
+ (message "Obsolete `base-size' passed to choose-completion-string")
+ (setq base-position nil))
+
(let* ((buffer (or buffer completion-reference-buffer))
(mini-p (minibufferp buffer)))
;; If BUFFER is a minibuffer, barf unless it's the currently
(set-buffer buffer)
(unless (run-hook-with-args-until-success
'choose-completion-string-functions
- choice buffer mini-p base-size)
+ ;; The fourth arg used to be `mini-p' but was useless
+ ;; (since minibufferp can be used on the `buffer' arg)
+ ;; and indeed unused. The last used to be `base-size', so we
+ ;; keep it to try and avoid breaking old code.
+ choice buffer base-position nil)
;; Insert the completion into the buffer where it was requested.
- ;; FIXME:
- ;; - There may not be a field at point, or there may be a field but
- ;; it's not a "completion field", in which case we have to
- ;; call choose-completion-delete-max-match even if base-size is set.
- ;; - we may need to delete further than (point) to (field-end),
- ;; depending on the completion-style, and for that we need to
- ;; extra data `completion-extra-size'.
- (if base-size
- (delete-region (+ base-size (field-beginning)) (point))
- (choose-completion-delete-max-match choice))
+ (delete-region (or (car base-position) (point))
+ (or (cadr base-position) (point)))
(insert choice)
(remove-text-properties (- (point) (length choice)) (point)
'(mouse-face nil))
minibuffer-completion-table
;; If this is reading a file name, and the file name chosen
;; is a directory, don't exit the minibuffer.
- (if (and minibuffer-completing-file-name
- (file-directory-p (field-string (point-max))))
- (let ((mini (active-minibuffer-window)))
- (select-window mini)
- (when minibuffer-auto-raise
- (raise-frame (window-frame mini))))
- (exit-minibuffer)))))))
+ (let* ((result (buffer-substring (field-beginning) (point)))
+ (bounds
+ (completion-boundaries result minibuffer-completion-table
+ minibuffer-completion-predicate
+ "")))
+ (if (eq (car bounds) (length result))
+ ;; The completion chosen leads to a new set of completions
+ ;; (e.g. it's a directory): don't exit the minibuffer yet.
+ (let ((mini (active-minibuffer-window)))
+ (select-window mini)
+ (when minibuffer-auto-raise
+ (raise-frame (window-frame mini))))
+ (exit-minibuffer))))))))
(define-derived-mode completion-list-mode nil "Completion List"
"Major mode for buffers showing lists of possible completions.
:version "22.1"
:group 'completion)
-;; This is for packages that need to bind it to a non-default regexp
-;; in order to make the first-differing character highlight work
-;; to their liking
-(defvar completion-root-regexp "^/"
- "Regexp to use in `completion-setup-function' to find the root directory.")
-
;; This function goes in completion-setup-hook, so that it is called
;; after the text of the completion list buffer is written.
(defun completion-setup-function ()
(substring (minibuffer-completion-contents)
0 (or completion-base-size 0)))))))
(with-current-buffer standard-output
- (let ((base-size completion-base-size)) ;Read before killing localvars.
+ (let ((base-size completion-base-size) ;Read before killing localvars.
+ (base-position completion-base-position))
(completion-list-mode)
- (set (make-local-variable 'completion-base-size) base-size))
+ (set (make-local-variable 'completion-base-size) base-size)
+ (set (make-local-variable 'completion-base-position) base-position))
(set (make-local-variable 'completion-reference-buffer) mainbuf)
(if base-dir (setq default-directory base-dir))
- (unless completion-base-size
- ;; This shouldn't be needed any more, but further analysis is needed
- ;; to make sure it's the case.
- (setq completion-base-size
- (cond
- (minibuffer-completing-file-name
- ;; For file name completion, use the number of chars before
- ;; the start of the file name component at point.
- (with-current-buffer mainbuf
- (save-excursion
- (skip-chars-backward completion-root-regexp)
- (- (point) (minibuffer-prompt-end)))))
- (minibuffer-completing-symbol nil)
- ;; Otherwise, in minibuffer, the base size is 0.
- ((minibufferp mainbuf) 0))))
;; Maybe insert help string.
(when completion-show-help
(goto-char (point-min))
(defun switch-to-completions ()
"Select the completion list window."
(interactive)
- ;; Make sure we have a completions window.
- (or (get-buffer-window "*Completions*")
- (minibuffer-completion-help))
- (let ((window (get-buffer-window "*Completions*")))
+ (let ((window (or (get-buffer-window "*Completions*" 0)
+ ;; Make sure we have a completions window.
+ (progn (minibuffer-completion-help)
+ (get-buffer-window "*Completions*" 0)))))
(when window
(select-window window)
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
- (forward-line 1))))
+ ;; In the new buffer, go to the first completion.
+ ;; FIXME: Perhaps this should be done in `minibuffer-completion-help'.
+ (when (bobp)
+ (next-completion 1)))))
\f
;;; Support keyboard commands to turn on various modifiers.
(kp-subtract ?-)
(kp-decimal ?.)
(kp-divide ?/)
- (kp-equal ?=)))
+ (kp-equal ?=)
+ ;; Do the same for various keys that are represented as symbols under
+ ;; GUIs but naturally correspond to characters.
+ (backspace 127)
+ (delete 127)
+ (tab ?\t)
+ (linefeed ?\n)
+ (clear ?\C-l)
+ (return ?\C-m)
+ (escape ?\e)
+ ))
\f
;;;;
;;;; forking a twin copy of a buffer.
See also `normal-erase-is-backspace'."
(interactive "P")
(let ((enabled (or (and arg (> (prefix-numeric-value arg) 0))
- (and (not arg)
- (not (eq 1 (terminal-parameter
+ (not (or arg
+ (eq 1 (terminal-parameter
nil 'normal-erase-is-backspace)))))))
(set-terminal-parameter nil 'normal-erase-is-backspace
(if enabled 1 0))
(let* ((bindings
`(([M-delete] [M-backspace])
([C-M-delete] [C-M-backspace])
- (,esc-map
- [C-delete] [C-backspace])))
+ ([?\e C-delete] [?\e C-backspace])))
(old-state (lookup-key local-function-key-map [delete])))
(if enabled
(progn
(define-key local-function-key-map [delete] [?\C-d])
(define-key local-function-key-map [kp-delete] [?\C-d])
- (define-key local-function-key-map [backspace] [?\C-?]))
+ (define-key local-function-key-map [backspace] [?\C-?])
+ (dolist (b bindings)
+ ;; Not sure if input-decode-map is really right, but
+ ;; keyboard-translate-table (used below) only works
+ ;; for integer events, and key-translation-table is
+ ;; global (like the global-map, used earlier).
+ (define-key input-decode-map (car b) nil)
+ (define-key input-decode-map (cadr b) nil)))
(define-key local-function-key-map [delete] [?\C-?])
(define-key local-function-key-map [kp-delete] [?\C-?])
- (define-key local-function-key-map [backspace] [?\C-?]))
-
- ;; Maybe swap bindings of C-delete and C-backspace, etc.
- (unless (equal old-state (lookup-key local-function-key-map [delete]))
- (dolist (binding bindings)
- (let ((map global-map))
- (when (keymapp (car binding))
- (setq map (car binding) binding (cdr binding)))
- (let* ((key1 (nth 0 binding))
- (key2 (nth 1 binding))
- (binding1 (lookup-key map key1))
- (binding2 (lookup-key map key2)))
- (define-key map key1 binding2)
- (define-key map key2 binding1)))))))
+ (define-key local-function-key-map [backspace] [?\C-?])
+ (dolist (b bindings)
+ (define-key input-decode-map (car b) (cadr b))
+ (define-key input-decode-map (cadr b) (car b))))))
(t
(if enabled
(progn
(keyboard-translate ?\C-? ?\C-?))))
(run-hooks 'normal-erase-is-backspace-hook)
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "Delete key deletes %s"
- (if (terminal-parameter nil 'normal-erase-is-backspace)
+ (if (eq 1 (terminal-parameter nil 'normal-erase-is-backspace))
"forward" "backward")))))
\f
(defvar vis-mode-saved-buffer-invisibility-spec nil
(setq buffer-invisibility-spec nil)))
\f
;; Partial application of functions (similar to "currying").
+;; This function is here rather than in subr.el because it uses CL.
(defun apply-partially (fun &rest args)
"Return a function that is a partial application of FUN to ARGS.
ARGS is a list of the first N arguments to pass to FUN.
was called."
(lexical-let ((fun fun) (args1 args))
(lambda (&rest args2) (apply fun (append args1 args2)))))
+
+;; This function is here rather than in subr.el because it uses CL.
+(defmacro with-wrapper-hook (var args &rest body)
+ "Run BODY wrapped with the VAR hook.
+VAR is a special hook: its functions are called with a first argument
+which is the \"original\" code (the BODY), so the hook function can wrap
+the original function, or call it any number of times (including not calling
+it at all). This is similar to an `around' advice.
+VAR is normally a symbol (a variable) in which case it is treated like
+a hook, with a buffer-local and a global part. But it can also be an
+arbitrary expression.
+ARGS is a list of variables which will be passed as additional arguments
+to each function, after the initial argument, and which the first argument
+expects to receive when called."
+ (declare (indent 2) (debug t))
+ ;; We need those two gensyms because CL's lexical scoping is not available
+ ;; for function arguments :-(
+ (let ((funs (make-symbol "funs"))
+ (global (make-symbol "global"))
+ (argssym (make-symbol "args")))
+ ;; Since the hook is a wrapper, the loop has to be done via
+ ;; recursion: a given hook function will call its parameter in order to
+ ;; continue looping.
+ `(labels ((runrestofhook (,funs ,global ,argssym)
+ ;; `funs' holds the functions left on the hook and `global'
+ ;; holds the functions left on the global part of the hook
+ ;; (in case the hook is local).
+ (lexical-let ((funs ,funs)
+ (global ,global))
+ (if (consp funs)
+ (if (eq t (car funs))
+ (runrestofhook
+ (append global (cdr funs)) nil ,argssym)
+ (apply (car funs)
+ (lambda (&rest ,argssym)
+ (runrestofhook (cdr funs) global ,argssym))
+ ,argssym))
+ ;; Once there are no more functions on the hook, run
+ ;; the original body.
+ (apply (lambda ,args ,@body) ,argssym)))))
+ (runrestofhook ,var
+ ;; The global part of the hook, if any.
+ ,(if (symbolp var)
+ `(if (local-variable-p ',var)
+ (default-value ',var)))
+ (list ,@args)))))
\f
;; Minibuffer prompt stuff.