;;; 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
(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))))
(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)))))
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
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\",
;; 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))
"The tail of the kill ring whose car is the last thing yanked.")
(defcustom save-interprogram-paste-before-kill nil
- "Save the paste strings into `kill-ring' before replacing it with emacs strings.
+ "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,
(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\".
(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)))))
: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,
(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)
(goto-char (next-char-property-change (point))))
;; Move a line.
;; We don't use `end-of-line', since we want to escape
- ;; from field boundaries ocurring exactly at point.
+ ;; from field boundaries occurring exactly at point.
(goto-char (constrain-to-field
(let ((inhibit-field-text-motion t))
(line-end-position))
(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))
"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.
(or (and (buffer-live-p buffer)
(get-buffer-window buffer 0))
owindow)))
-
+
(choose-completion-string
choice buffer
(or base-position
"Select the completion list window."
(interactive)
(let ((window (or (get-buffer-window "*Completions*" 0)
- ;; Make sure we have a completions window.
+ ;; 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.
(run-hooks 'normal-erase-is-backspace-hook)
(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.
HCoop / bpt / emacs.git / blobdiff