-;;; simple.el --- basic editing commands for Emacs
+;;; simple.el --- basic editing commands for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1993-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1993-2013 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
;;; Code:
-(eval-when-compile (require 'cl)) ;For define-minor-mode.
-
(declare-function widget-convert "wid-edit" (type &rest args))
(declare-function shell-mode "shell" ())
Other major modes are defined by comparison with this one."
(interactive)
(kill-all-local-variables)
- (unless delay-mode-hooks
- (run-hooks 'after-change-major-mode-hook)))
+ (run-mode-hooks))
;; Special major modes to view specially formatted data rather than files.
(suppress-keymap map)
(define-key map "q" 'quit-window)
(define-key map " " 'scroll-up-command)
+ (define-key map [?\S-\ ] 'scroll-down-command)
(define-key map "\C-?" 'scroll-down-command)
(define-key map "?" 'describe-mode)
(define-key map "h" 'describe-mode)
(define-key map ">" 'end-of-buffer)
(define-key map "<" 'beginning-of-buffer)
(define-key map "g" 'revert-buffer)
- (define-key map "z" 'kill-this-buffer)
map))
(put 'special-mode 'mode-class 'special)
"Parent major mode from which special major modes should inherit."
(setq buffer-read-only t))
-;; Major mode meant to be the parent of programming modes.
-
-(defvar prog-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [?\C-\M-q] 'prog-indent-sexp)
- map)
- "Keymap used for programming modes.")
-
-(defun prog-indent-sexp ()
- "Indent the expression after point."
- (interactive)
- (let ((start (point))
- (end (save-excursion (forward-sexp 1) (point))))
- (indent-region start end nil)))
-
-(define-derived-mode prog-mode fundamental-mode "Prog"
- "Major mode for editing programming language source code."
- (set (make-local-variable 'require-final-newline) mode-require-final-newline)
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
- ;; Any programming language is always written left to right.
- (setq bidi-paragraph-direction 'left-to-right))
-
;; Making and deleting lines.
(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
(defun newline (&optional arg)
"Insert a newline, and move to left margin of the new line if it's blank.
-If `use-hard-newlines' is non-nil, the newline is marked with the
+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
(if (looking-at "^[ \t]*\n\\'")
(delete-region (point) (point-max)))))
+(defcustom delete-trailing-lines t
+ "If non-nil, \\[delete-trailing-whitespace] deletes trailing lines.
+Trailing lines are deleted only if `delete-trailing-whitespace'
+is called on the entire buffer (rather than an active region)."
+ :type 'boolean
+ :group 'editing
+ :version "24.3")
+
(defun delete-trailing-whitespace (&optional start end)
- "Delete all the trailing whitespace across the current buffer.
-All whitespace after the last non-whitespace character in a line is deleted.
-This respects narrowing, created by \\[narrow-to-region] and friends.
-A formfeed is not considered whitespace by this function.
-If END is nil, also delete all trailing lines at the end of the buffer.
-If the region is active, only delete whitespace within the region."
+ "Delete trailing whitespace between START and END.
+If called interactively, START and END are the start/end of the
+region if the mark is active, or of the buffer's accessible
+portion if the mark is inactive.
+
+This command deletes whitespace characters after the last
+non-whitespace character in each line between START and END. It
+does not consider formfeed characters to be whitespace.
+
+If this command acts on the entire buffer (i.e. if called
+interactively with the mark inactive, or called from Lisp with
+END nil), it also deletes all trailing lines at the end of the
+buffer if the variable `delete-trailing-lines' is non-nil."
(interactive (progn
(barf-if-buffer-read-only)
(if (use-region-p)
;; Delete trailing empty lines.
(goto-char end-marker)
(when (and (not end)
+ delete-trailing-lines
;; Really the end of buffer.
- (save-restriction (widen) (eobp))
+ (= (point-max) (1+ (buffer-size)))
(<= (skip-chars-backward "\n") -2))
(delete-region (1+ (point)) end-marker))
(set-marker end-marker nil))))
(defun just-one-space (&optional n)
"Delete all spaces and tabs around point, leaving one space (or N spaces).
-If N is negative, delete newlines as well."
+If N is negative, delete newlines as well, leaving -N spaces."
(interactive "*p")
- (unless n (setq n 1))
- (let ((orig-pos (point))
- (skip-characters (if (< n 0) " \t\n\r" " \t"))
- (n (abs n)))
- (skip-chars-backward skip-characters)
+ (cycle-spacing n nil t))
+
+(defvar cycle-spacing--context nil
+ "Store context used in consecutive calls to `cycle-spacing' command.
+The first time this function is run, it saves the original point
+position and original spacing around the point in this
+variable.")
+
+(defun cycle-spacing (&optional n preserve-nl-back single-shot)
+ "Manipulate spaces around the point in a smart way.
+
+When run as an interactive command, the first time it's called
+in a sequence, deletes all spaces and tabs around point leaving
+one (or N spaces). If this does not change content of the
+buffer, skips to the second step:
+
+When run for the second time in a sequence, deletes all the
+spaces it has previously inserted.
+
+When run for the third time, returns the whitespace and point in
+a state encountered when it had been run for the first time.
+
+For example, if buffer contains \"foo ^ bar\" with \"^\" denoting the
+point, calling `cycle-spacing' command will replace two spaces with
+a single space, calling it again immediately after, will remove all
+spaces, and calling it for the third time will bring two spaces back
+together.
+
+If N is negative, delete newlines as well. However, if
+PRESERVE-NL-BACK is t new line characters prior to the point
+won't be removed.
+
+If SINGLE-SHOT is non-nil, will only perform the first step. In
+other words, it will work just like `just-one-space' command."
+ (interactive "*p")
+ (let ((orig-pos (point))
+ (skip-characters (if (and n (< n 0)) " \t\n\r" " \t"))
+ (n (abs (or n 1))))
+ (skip-chars-backward (if preserve-nl-back " \t" skip-characters))
(constrain-to-field nil orig-pos)
- (dotimes (i n)
- (if (= (following-char) ?\s)
- (forward-char 1)
- (insert ?\s)))
- (delete-region
- (point)
- (progn
- (skip-chars-forward skip-characters)
- (constrain-to-field nil orig-pos t)))))
+ (cond
+ ;; Command run for the first time or single-shot is non-nil.
+ ((or single-shot
+ (not (equal last-command this-command))
+ (not cycle-spacing--context))
+ (let* ((start (point))
+ (n (- n (skip-chars-forward " " (+ n (point)))))
+ (mid (point))
+ (end (progn
+ (skip-chars-forward skip-characters)
+ (constrain-to-field nil orig-pos t))))
+ (setq cycle-spacing--context ;; Save for later.
+ ;; Special handling for case where there was no space at all.
+ (unless (= start end)
+ (cons orig-pos (buffer-substring start (point)))))
+ ;; If this run causes no change in buffer content, delete all spaces,
+ ;; otherwise delete all excess spaces.
+ (delete-region (if (and (not single-shot) (zerop n) (= mid end))
+ start mid) end)
+ (insert (make-string n ?\s))))
+
+ ;; Command run for the second time.
+ ((not (equal orig-pos (point)))
+ (delete-region (point) orig-pos))
+
+ ;; Command run for the third time.
+ (t
+ (insert (cdr cycle-spacing--context))
+ (goto-char (car cycle-spacing--context))
+ (setq cycle-spacing--context nil)))))
\f
(defun beginning-of-buffer (&optional arg)
"Move point to the beginning of the buffer.
;; If we went to a place in the middle of the buffer,
;; adjust it to the beginning of a line.
(cond ((and arg (not (consp arg))) (forward-line 1))
- ((> (point) (window-end nil t))
+ ((and (eq (current-buffer) (window-buffer))
+ (> (point) (window-end nil t)))
;; If the end of the buffer is not already on the screen,
;; then scroll specially to put it near, but not at, the bottom.
(overlay-recenter (point))
:type '(choice (const :tag "Delete active region" t)
(const :tag "Kill active region" kill)
(const :tag "Do ordinary deletion" nil))
- :group 'editing
+ :group 'killing
:version "24.1")
(defun delete-backward-char (n &optional killflag)
"Delete the previous N characters (following if N is negative).
If Transient Mark mode is enabled, the mark is active, and N is 1,
delete the text in the region and deactivate the mark instead.
-To disable this, set `delete-active-region' to nil.
+To disable this, set option `delete-active-region' to nil.
Optional second arg KILLFLAG, if non-nil, means to kill (save in
kill ring) instead of delete. Interactively, N is the prefix
"Delete the following N characters (previous if N is negative).
If Transient Mark mode is enabled, the mark is active, and N is 1,
delete the text in the region and deactivate the mark instead.
-To disable this, set `delete-active-region' to nil.
+To disable this, set variable `delete-active-region' to nil.
Optional second arg KILLFLAG non-nil means to kill (save in kill
ring) instead of delete. Interactively, N is the prefix arg, and
;; Counting lines, one way or another.
(defun goto-line (line &optional buffer)
- "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.
+ "Go to LINE, counting from line 1 at beginning of buffer.
+If called interactively, a numeric prefix argument specifies
+LINE; without a numeric prefix argument, read LINE from the
+minibuffer.
+
+If optional argument BUFFER is non-nil, switch to that buffer and
+move to line LINE there. If called interactively with \\[universal-argument]
+as argument, BUFFER is the most recently selected other buffer.
-If there's a number in the buffer at point, it is the default for LINE.
+Prior to moving point, this function sets the mark (without
+activating it), unless Transient Mark mode is enabled and the
+mark is already active.
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))
+ (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
(concat " in " (buffer-name buffer))
"")))
;; Read the argument, offering that number (if any) as default.
- (list (read-number (format (if default "Goto line%s (%s): "
- "Goto line%s: ")
- buffer-prompt
- default)
- default)
+ (list (read-number (format "Goto line%s: " buffer-prompt)
+ (list default (line-number-at-pos)))
buffer))))
;; Switch to the desired buffer, one way or another.
(if buffer
(re-search-forward "[\n\C-m]" nil 'end (1- line))
(forward-line (1- line)))))
-(defun count-words-region (start end)
+(defun count-words-region (start end &optional arg)
"Count the number of words in the region.
If called interactively, print a message reporting the number of
-lines, words, and chars in the region.
+lines, words, and characters in the region (whether or not the
+region is active); with prefix ARG, report for the entire buffer
+rather than the region.
+
If called from Lisp, return the number of words between positions
START and END."
- (interactive "r")
- (if (called-interactively-p 'any)
- (count-words--message "Region" start end)
- (count-words start end)))
+ (interactive (if current-prefix-arg
+ (list nil nil current-prefix-arg)
+ (list (region-beginning) (region-end) nil)))
+ (cond ((not (called-interactively-p 'any))
+ (count-words start end))
+ (arg
+ (count-words--buffer-message))
+ (t
+ (count-words--message "Region" start end))))
(defun count-words (start end)
"Count words between START and END.
((use-region-p)
(call-interactively 'count-words-region))
(t
- (count-words--message "Buffer" (point-min) (point-max)))))
+ (count-words--buffer-message))))
+
+(defun count-words--buffer-message ()
+ (count-words--message
+ (if (buffer-narrowed-p) "Narrowed part of buffer" "Buffer")
+ (point-min) (point-max)))
(defun count-words--message (str start end)
(let ((lines (count-lines start end))
bidi-fixer encoding-msg pos total percent col hscroll))))))
\f
;; Initialize read-expression-map. It is defined at C level.
-(let ((m (make-sparse-keymap)))
- (define-key m "\M-\t" 'lisp-complete-symbol)
- ;; Might as well bind TAB to completion, since inserting a TAB char is much
- ;; too rarely useful.
- (define-key m "\t" 'lisp-complete-symbol)
- (set-keymap-parent m minibuffer-local-map)
- (setq read-expression-map m))
+(defvar read-expression-map
+ (let ((m (make-sparse-keymap)))
+ (define-key m "\M-\t" 'completion-at-point)
+ ;; Might as well bind TAB to completion, since inserting a TAB char is
+ ;; much too rarely useful.
+ (define-key m "\t" 'completion-at-point)
+ (set-keymap-parent m minibuffer-local-map)
+ m))
+
+(defun read-minibuffer (prompt &optional initial-contents)
+ "Return a Lisp object read using the minibuffer, unevaluated.
+Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS
+is a string to insert in the minibuffer before reading.
+\(INITIAL-CONTENTS can also be a cons of a string and an integer.
+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))
+
+(defun eval-minibuffer (prompt &optional initial-contents)
+ "Return value of Lisp expression read using the minibuffer.
+Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS
+is a string to insert in the minibuffer before reading.
+\(INITIAL-CONTENTS can also be a cons of a string and an integer.
+Such arguments are used as in `read-from-minibuffer'.)"
+ ;; Used for interactive spec `X'.
+ (eval (read--expression prompt initial-contents)))
(defvar minibuffer-completing-symbol nil
"Non-nil means completing a Lisp symbol in the minibuffer.")
(format " (#o%o, #x%x, %s)" value value char-string)
(format " (#o%o, #x%x)" value value)))))
+(defvar eval-expression-minibuffer-setup-hook nil
+ "Hook run by `eval-expression' when entering the minibuffer.")
+
+(defun read--expression (prompt &optional initial-contents)
+ (let ((minibuffer-completing-symbol t))
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (add-hook 'completion-at-point-functions
+ #'lisp-completion-at-point nil t)
+ (run-hooks 'eval-expression-minibuffer-setup-hook))
+ (read-from-minibuffer prompt initial-contents
+ read-expression-map t
+ 'read-expression-history))))
+
;; We define this, rather than making `eval' interactive,
;; for the sake of completion of names like eval-region, eval-buffer.
-(defun eval-expression (eval-expression-arg
- &optional eval-expression-insert-value)
- "Evaluate EVAL-EXPRESSION-ARG and print value in the echo area.
+(defun eval-expression (exp &optional insert-value)
+ "Evaluate EXP and print value in the echo area.
When called interactively, read an Emacs Lisp expression and
evaluate it.
Value is also consed on to front of the variable `values'.
-Optional argument EVAL-EXPRESSION-INSERT-VALUE non-nil (interactively,
+Optional argument 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'
If `eval-expression-debug-on-error' is non-nil, which is the default,
this command arranges for all errors to enter the debugger."
(interactive
- (list (let ((minibuffer-completing-symbol t))
- (read-from-minibuffer "Eval: "
- nil read-expression-map t
- 'read-expression-history))
+ (list (read--expression "Eval: ")
current-prefix-arg))
(if (null eval-expression-debug-on-error)
- (push (eval eval-expression-arg lexical-binding) values)
+ (push (eval exp lexical-binding) values)
(let ((old-value (make-symbol "t")) new-value)
;; Bind debug-on-error to something unique so that we can
;; detect when evalled code changes it.
(let ((debug-on-error old-value))
- (push (eval eval-expression-arg lexical-binding) values)
+ (push (eval exp lexical-binding) values)
(setq new-value debug-on-error))
;; If evalled code has changed the value of debug-on-error,
;; propagate that change to the global binding.
(setq debug-on-error new-value))))
(let ((print-length eval-expression-print-length)
- (print-level eval-expression-print-level))
- (if eval-expression-insert-value
+ (print-level eval-expression-print-level)
+ (deactivate-mark))
+ (if insert-value
(with-no-warnings
(let ((standard-output (current-buffer)))
(prin1 (car values))))
(error "Argument %d is beyond length of command history" arg)
(error "There are no previous complex commands to repeat")))))
+(defvar extended-command-history nil)
+
(defun read-extended-command ()
"Read command name to invoke in `execute-extended-command'."
(minibuffer-with-setup-hook
"M-x ")
obarray 'commandp t nil 'extended-command-history)))
+(defcustom suggest-key-bindings t
+ "Non-nil means show the equivalent key-binding when M-x command has one.
+The value can be a length of time to show the message for.
+If the value is non-nil and not a number, we wait 2 seconds."
+ :group 'keyboard
+ :type '(choice (const :tag "off" nil)
+ (integer :tag "time" 2)
+ (other :tag "on")))
+
+(defun execute-extended-command (prefixarg &optional command-name)
+ ;; Based on Fexecute_extended_command in keyboard.c of Emacs.
+ ;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24
+ "Read function name, then read its arguments and call it.
+
+To pass a numeric argument to the command you are invoking, specify
+the numeric argument to this command.
+
+Noninteractively, the argument PREFIXARG is the prefix argument to
+give to the command you invoke, if it asks for an argument."
+ (interactive (list current-prefix-arg (read-extended-command)))
+ ;; Emacs<24 calling-convention was with a single `prefixarg' argument.
+ (if (null command-name)
+ (setq command-name (let ((current-prefix-arg prefixarg)) ; for prompt
+ (read-extended-command))))
+ (let* ((function (and (stringp command-name) (intern-soft command-name)))
+ (binding (and suggest-key-bindings
+ (not executing-kbd-macro)
+ (where-is-internal function overriding-local-map t))))
+ (unless (commandp function)
+ (error "`%s' is not a valid command name" command-name))
+ (setq this-command function)
+ ;; Normally `real-this-command' should never be changed, but here we really
+ ;; want to pretend that M-x <cmd> RET is nothing more than a "key
+ ;; binding" for <cmd>, so the command the user really wanted to run is
+ ;; `function' and not `execute-extended-command'. The difference is
+ ;; visible in cases such as M-x <cmd> RET and then C-x z (bug#11506).
+ (setq real-this-command function)
+ (let ((prefix-arg prefixarg))
+ (command-execute function 'record))
+ ;; If enabled, show which key runs this command.
+ (when binding
+ ;; But first wait, and skip the message if there is input.
+ (let* ((waited
+ ;; If this command displayed something in the echo area;
+ ;; wait a few seconds, then display our suggestion message.
+ (sit-for (cond
+ ((zerop (length (current-message))) 0)
+ ((numberp suggest-key-bindings) suggest-key-bindings)
+ (t 2)))))
+ (when (and waited (not (consp unread-command-events)))
+ (with-temp-message
+ (format "You can run the command `%s' with %s"
+ function (key-description binding))
+ (sit-for (if (numberp suggest-key-bindings)
+ suggest-key-bindings
+ 2))))))))
+
+(defun command-execute (cmd &optional record-flag keys special)
+ ;; BEWARE: Called directly from the C code.
+ "Execute CMD as an editor command.
+CMD must be a symbol that satisfies the `commandp' predicate.
+Optional second arg RECORD-FLAG non-nil
+means unconditionally put this command in the variable `command-history'.
+Otherwise, that is done only if an arg is read using the minibuffer.
+The argument KEYS specifies the value to use instead of (this-command-keys)
+when reading the arguments; if it is nil, (this-command-keys) is used.
+The argument SPECIAL, if non-nil, means that this command is executing
+a special event, so ignore the prefix argument and don't clear it."
+ (setq debug-on-next-call nil)
+ (let ((prefixarg (unless special
+ (prog1 prefix-arg
+ (setq current-prefix-arg prefix-arg)
+ (setq prefix-arg nil)))))
+ (and (symbolp cmd)
+ (get cmd 'disabled)
+ ;; FIXME: Weird calling convention!
+ (run-hooks 'disabled-command-function))
+ (let ((final cmd))
+ (while
+ (progn
+ (setq final (indirect-function final))
+ (if (autoloadp final)
+ (setq final (autoload-do-load final cmd)))))
+ (cond
+ ((arrayp final)
+ ;; If requested, place the macro in the command history. For
+ ;; other sorts of commands, call-interactively takes care of this.
+ (when record-flag
+ (push `(execute-kbd-macro ,final ,prefixarg) command-history)
+ ;; Don't keep command history around forever.
+ (when (and (numberp history-length) (> history-length 0))
+ (let ((cell (nthcdr history-length command-history)))
+ (if (consp cell) (setcdr cell nil)))))
+ (execute-kbd-macro final prefixarg))
+ (t
+ ;; Pass `cmd' rather than `final', for the backtrace's sake.
+ (prog1 (call-interactively cmd record-flag keys)
+ (when (and (symbolp cmd)
+ (get cmd 'byte-obsolete-info)
+ (not (get cmd 'command-execute-obsolete-warned)))
+ (put cmd 'command-execute-obsolete-warned t)
+ (message "%s" (macroexp--obsolete-warning
+ cmd (get cmd 'byte-obsolete-info) "command")))))))))
\f
(defvar minibuffer-history nil
"Default minibuffer history list.
(list (if (string= regexp "")
(if minibuffer-history-search-history
(car minibuffer-history-search-history)
- (error "No previous history search regexp"))
+ (user-error "No previous history search regexp"))
regexp)
(prefix-numeric-value current-prefix-arg))))
(unless (zerop n)
(setq prevpos pos)
(setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
(when (= pos prevpos)
- (error (if (= pos 1)
- "No later matching history item"
- "No earlier matching history item")))
+ (user-error (if (= pos 1)
+ "No later matching history item"
+ "No earlier matching history item")))
(setq match-string
(if (eq minibuffer-history-sexp-flag (minibuffer-depth))
(let ((print-level nil))
(list (if (string= regexp "")
(if minibuffer-history-search-history
(car minibuffer-history-search-history)
- (error "No previous history search regexp"))
+ (user-error "No previous history search regexp"))
regexp)
(prefix-numeric-value current-prefix-arg))))
(previous-matching-history-element regexp (- n)))
(setq minibuffer-text-before-history
(minibuffer-contents-no-properties)))
(if (< nabs minimum)
- (if minibuffer-default
- (error "End of defaults; no next item")
- (error "End of history; no default available")))
+ (user-error (if minibuffer-default
+ "End of defaults; no next item"
+ "End of history; no default available")))
(if (> nabs (length (symbol-value minibuffer-history-variable)))
- (error "Beginning of history; no preceding item"))
+ (user-error "Beginning of history; no preceding item"))
(unless (memq last-command '(next-history-element
previous-history-element))
(let ((prompt-end (minibuffer-prompt-end)))
(defun minibuffer-history-isearch-search ()
"Return the proper search function, for isearch in minibuffer history."
- (cond
- (isearch-word
- (if isearch-forward 'word-search-forward 'word-search-backward))
- (t
- (lambda (string bound noerror)
- (let ((search-fun
- ;; Use standard functions to search within minibuffer text
- (cond
- (isearch-regexp
- (if isearch-forward 're-search-forward 're-search-backward))
- (t
- (if isearch-forward 'search-forward 'search-backward))))
- found)
- ;; Avoid lazy-highlighting matches in the minibuffer prompt when
- ;; searching forward. Lazy-highlight calls this lambda with the
- ;; bound arg, so skip the minibuffer prompt.
- (if (and bound isearch-forward (< (point) (minibuffer-prompt-end)))
- (goto-char (minibuffer-prompt-end)))
- (or
- ;; 1. First try searching in the initial minibuffer text
- (funcall search-fun string
- (if isearch-forward bound (minibuffer-prompt-end))
- noerror)
- ;; 2. If the above search fails, start putting next/prev history
- ;; elements in the minibuffer successively, and search the string
- ;; in them. Do this only when bound is nil (i.e. not while
- ;; lazy-highlighting search strings in the current minibuffer text).
- (unless bound
- (condition-case nil
- (progn
- (while (not found)
- (cond (isearch-forward
- (next-history-element 1)
- (goto-char (minibuffer-prompt-end)))
- (t
- (previous-history-element 1)
- (goto-char (point-max))))
- (setq isearch-barrier (point) isearch-opoint (point))
- ;; After putting the next/prev history element, search
- ;; the string in them again, until next-history-element
- ;; or previous-history-element raises an error at the
- ;; beginning/end of history.
- (setq found (funcall search-fun string
- (unless isearch-forward
- ;; For backward search, don't search
- ;; in the minibuffer prompt
- (minibuffer-prompt-end))
- noerror)))
- ;; Return point of the new search result
- (point))
- ;; Return nil when next(prev)-history-element fails
- (error nil)))))))))
+ (lambda (string bound noerror)
+ (let ((search-fun
+ ;; Use standard functions to search within minibuffer text
+ (isearch-search-fun-default))
+ found)
+ ;; Avoid lazy-highlighting matches in the minibuffer prompt when
+ ;; searching forward. Lazy-highlight calls this lambda with the
+ ;; bound arg, so skip the minibuffer prompt.
+ (if (and bound isearch-forward (< (point) (minibuffer-prompt-end)))
+ (goto-char (minibuffer-prompt-end)))
+ (or
+ ;; 1. First try searching in the initial minibuffer text
+ (funcall search-fun string
+ (if isearch-forward bound (minibuffer-prompt-end))
+ noerror)
+ ;; 2. If the above search fails, start putting next/prev history
+ ;; elements in the minibuffer successively, and search the string
+ ;; in them. Do this only when bound is nil (i.e. not while
+ ;; lazy-highlighting search strings in the current minibuffer text).
+ (unless bound
+ (condition-case nil
+ (progn
+ (while (not found)
+ (cond (isearch-forward
+ (next-history-element 1)
+ (goto-char (minibuffer-prompt-end)))
+ (t
+ (previous-history-element 1)
+ (goto-char (point-max))))
+ (setq isearch-barrier (point) isearch-opoint (point))
+ ;; After putting the next/prev history element, search
+ ;; the string in them again, until next-history-element
+ ;; or previous-history-element raises an error at the
+ ;; beginning/end of history.
+ (setq found (funcall search-fun string
+ (unless isearch-forward
+ ;; For backward search, don't search
+ ;; in the minibuffer prompt
+ (minibuffer-prompt-end))
+ noerror)))
+ ;; Return point of the new search result
+ (point))
+ ;; Return nil when next(prev)-history-element fails
+ (error nil)))))))
(defun minibuffer-history-isearch-message (&optional c-q-hack ellipsis)
"Display the minibuffer history search prompt.
If there are no search errors, this function displays an overlay with
the isearch prompt which replaces the original minibuffer prompt.
Otherwise, it displays the standard isearch message returned from
-`isearch-message'."
+the function `isearch-message'."
(if (not (and (minibufferp) isearch-success (not isearch-error)))
;; Use standard function `isearch-message' when not in the minibuffer,
;; or search fails, or has an error (like incomplete regexp).
"Wrap the minibuffer history search when search fails.
Move point to the first history element for a forward search,
or to the last history element for a backward search."
- (unless isearch-word
- ;; When `minibuffer-history-isearch-search' fails on reaching the
- ;; beginning/end of the history, wrap the search to the first/last
- ;; minibuffer history element.
- (if isearch-forward
- (goto-history-element (length (symbol-value minibuffer-history-variable)))
- (goto-history-element 0))
- (setq isearch-success t))
+ ;; When `minibuffer-history-isearch-search' fails on reaching the
+ ;; beginning/end of the history, wrap the search to the first/last
+ ;; minibuffer history element.
+ (if isearch-forward
+ (goto-history-element (length (symbol-value minibuffer-history-variable)))
+ (goto-history-element 0))
+ (setq isearch-success t)
(goto-char (if isearch-forward (minibuffer-prompt-end) (point-max))))
(defun minibuffer-history-isearch-push-state ()
"Save a function restoring the state of minibuffer history search.
Save `minibuffer-history-position' to the additional state parameter
in the search status stack."
- `(lambda (cmd)
- (minibuffer-history-isearch-pop-state cmd ,minibuffer-history-position)))
+ (let ((pos minibuffer-history-position))
+ (lambda (cmd)
+ (minibuffer-history-isearch-pop-state cmd pos))))
(defun minibuffer-history-isearch-pop-state (_cmd hist-pos)
"Restore the minibuffer history search state.
;; another undo command will find the undo history empty
;; and will get another error. To begin undoing the undos,
;; you must type some other command.
- (let ((modified (buffer-modified-p))
- (recent-save (recent-auto-save-p))
- message)
+ (let* ((modified (buffer-modified-p))
+ ;; For an indirect buffer, look in the base buffer for the
+ ;; auto-save data.
+ (base-buffer (or (buffer-base-buffer) (current-buffer)))
+ (recent-save (with-current-buffer base-buffer
+ (recent-auto-save-p)))
+ message)
;; If we get an error in undo-start,
;; the next command should not be a "consecutive undo".
;; So set `this-command' to something other than `undo'.
;; so, ask the user whether she wants to skip the redo/undo pair.
(let ((equiv (gethash pending-undo-list undo-equiv-table)))
(or (eq (selected-window) (minibuffer-window))
- (setq message (if undo-in-region
- (if equiv "Redo in region!" "Undo in region!")
- (if equiv "Redo!" "Undo!"))))
+ (setq message (format "%s%s!"
+ (if (or undo-no-redo (not equiv))
+ "Undo" "Redo")
+ (if undo-in-region " in region" ""))))
(when (and (consp equiv) undo-no-redo)
;; The equiv entry might point to another redo record if we have done
;; undo-redo-undo-redo-... so skip to the very last equiv.
;; Record what the current undo list says,
;; so the next command can tell if the buffer was modified in between.
(and modified (not (buffer-modified-p))
- (delete-auto-save-file-if-necessary recent-save))
+ (with-current-buffer base-buffer
+ (delete-auto-save-file-if-necessary recent-save)))
;; Display a message announcing success.
(if message
(message "%s" message))))
Call `undo-start' to get ready to undo recent changes,
then call `undo-more' one or more times to undo them."
(or (listp pending-undo-list)
- (error (concat "No further undo information"
- (and undo-in-region " for region"))))
+ (user-error (concat "No further undo information"
+ (and undo-in-region " for region"))))
(let ((undo-in-progress t))
;; Note: The following, while pulling elements off
;; `pending-undo-list' will call primitive change functions which
(if (null pending-undo-list)
(setq pending-undo-list t))))
+(defun primitive-undo (n list)
+ "Undo N records from the front of the list LIST.
+Return what remains of the list."
+
+ ;; This is a good feature, but would make undo-start
+ ;; unable to do what is expected.
+ ;;(when (null (car (list)))
+ ;; ;; If the head of the list is a boundary, it is the boundary
+ ;; ;; preceding this command. Get rid of it and don't count it.
+ ;; (setq list (cdr list))))
+
+ (let ((arg n)
+ ;; In a writable buffer, enable undoing read-only text that is
+ ;; so because of text properties.
+ (inhibit-read-only t)
+ ;; Don't let `intangible' properties interfere with undo.
+ (inhibit-point-motion-hooks t)
+ ;; We use oldlist only to check for EQ. ++kfs
+ (oldlist buffer-undo-list)
+ (did-apply nil)
+ (next nil))
+ (while (> arg 0)
+ (while (setq next (pop list)) ;Exit inner loop at undo boundary.
+ ;; Handle an integer by setting point to that value.
+ (pcase next
+ ((pred integerp) (goto-char next))
+ ;; Element (t . TIME) records previous modtime.
+ ;; Preserve any flag of NONEXISTENT_MODTIME_NSECS or
+ ;; UNKNOWN_MODTIME_NSECS.
+ (`(t . ,time)
+ ;; If this records an obsolete save
+ ;; (not matching the actual disk file)
+ ;; then don't mark unmodified.
+ (when (or (equal time (visited-file-modtime))
+ (and (consp time)
+ (equal (list (car time) (cdr time))
+ (visited-file-modtime))))
+ (when (fboundp 'unlock-buffer)
+ (unlock-buffer))
+ (set-buffer-modified-p nil)))
+ ;; Element (nil PROP VAL BEG . END) is property change.
+ (`(nil . ,(or `(,prop ,val ,beg . ,end) pcase--dontcare))
+ (when (or (> (point-min) beg) (< (point-max) end))
+ (error "Changes to be undone are outside visible portion of buffer"))
+ (put-text-property beg end prop val))
+ ;; Element (BEG . END) means range was inserted.
+ (`(,(and beg (pred integerp)) . ,(and end (pred integerp)))
+ ;; (and `(,beg . ,end) `(,(pred integerp) . ,(pred integerp)))
+ ;; Ideally: `(,(pred integerp beg) . ,(pred integerp end))
+ (when (or (> (point-min) beg) (< (point-max) end))
+ (error "Changes to be undone are outside visible portion of buffer"))
+ ;; Set point first thing, so that undoing this undo
+ ;; does not send point back to where it is now.
+ (goto-char beg)
+ (delete-region beg end))
+ ;; Element (apply FUN . ARGS) means call FUN to undo.
+ (`(apply . ,fun-args)
+ (let ((currbuff (current-buffer)))
+ (if (integerp (car fun-args))
+ ;; Long format: (apply DELTA START END FUN . ARGS).
+ (pcase-let* ((`(,delta ,start ,end ,fun . ,args) fun-args)
+ (start-mark (copy-marker start nil))
+ (end-mark (copy-marker end t)))
+ (when (or (> (point-min) start) (< (point-max) end))
+ (error "Changes to be undone are outside visible portion of buffer"))
+ (apply fun args) ;; Use `save-current-buffer'?
+ ;; Check that the function did what the entry
+ ;; said it would do.
+ (unless (and (= start start-mark)
+ (= (+ delta end) end-mark))
+ (error "Changes to be undone by function different than announced"))
+ (set-marker start-mark nil)
+ (set-marker end-mark nil))
+ (apply fun-args))
+ (unless (eq currbuff (current-buffer))
+ (error "Undo function switched buffer"))
+ (setq did-apply t)))
+ ;; Element (STRING . POS) means STRING was deleted.
+ (`(,(and string (pred stringp)) . ,(and pos (pred integerp)))
+ (when (let ((apos (abs pos)))
+ (or (< apos (point-min)) (> apos (point-max))))
+ (error "Changes to be undone are outside visible portion of buffer"))
+ (if (< pos 0)
+ (progn
+ (goto-char (- pos))
+ (insert string))
+ (goto-char pos)
+ ;; Now that we record marker adjustments
+ ;; (caused by deletion) for undo,
+ ;; we should always insert after markers,
+ ;; so that undoing the marker adjustments
+ ;; put the markers back in the right place.
+ (insert string)
+ (goto-char pos)))
+ ;; (MARKER . OFFSET) means a marker MARKER was adjusted by OFFSET.
+ (`(,(and marker (pred markerp)) . ,(and offset (pred integerp)))
+ (when (marker-buffer marker)
+ (set-marker marker
+ (- marker offset)
+ (marker-buffer marker))))
+ (_ (error "Unrecognized entry in undo list %S" next))))
+ (setq arg (1- arg)))
+ ;; Make sure an apply entry produces at least one undo entry,
+ ;; so the test in `undo' for continuing an undo series
+ ;; will work right.
+ (if (and did-apply
+ (eq oldlist buffer-undo-list))
+ (setq buffer-undo-list
+ (cons (list 'apply 'cdr nil) buffer-undo-list))))
+ list)
+
;; Deep copy of a list
(defun undo-copy-list (list)
"Make a copy of undo list LIST."
that apply to text between BEG and END are used; other undo elements
are ignored. If BEG and END are nil, all undo elements are used."
(if (eq buffer-undo-list t)
- (error "No undo information in this buffer"))
+ (user-error "No undo information in this buffer"))
(setq pending-undo-list
(if (and beg end (not (= beg end)))
(undo-make-selective-list (min beg end) (max beg end))
"Switch used to have the shell execute its command line argument.")
(defvar shell-command-default-error-buffer nil
- "*Buffer name for `shell-command' and `shell-command-on-region' error output.
+ "Buffer name for `shell-command' and `shell-command-on-region' error output.
This buffer is used when `shell-command' or `shell-command-on-region'
is run interactively. A value of nil means that output to stderr and
stdout will be intermixed in the output stream.")
(or hist 'shell-command-history)
args)))
+(defcustom async-shell-command-buffer 'confirm-new-buffer
+ "What to do when the output buffer is used by another shell command.
+This option specifies how to resolve the conflict where a new command
+wants to direct its output to the buffer `*Async Shell Command*',
+but this buffer is already taken by another running shell command.
+
+The value `confirm-kill-process' is used to ask for confirmation before
+killing the already running process and running a new process
+in the same buffer, `confirm-new-buffer' for confirmation before running
+the command in a new buffer with a name other than the default buffer name,
+`new-buffer' for doing the same without confirmation,
+`confirm-rename-buffer' for confirmation before renaming the existing
+output buffer and running a new command in the default buffer,
+`rename-buffer' for doing the same without confirmation."
+ :type '(choice (const :tag "Confirm killing of running command"
+ confirm-kill-process)
+ (const :tag "Confirm creation of a new buffer"
+ confirm-new-buffer)
+ (const :tag "Create a new buffer"
+ new-buffer)
+ (const :tag "Confirm renaming of existing buffer"
+ confirm-rename-buffer)
+ (const :tag "Rename the existing buffer"
+ rename-buffer))
+ :group 'shell
+ :version "24.3")
+
(defun async-shell-command (command &optional output-buffer error-buffer)
"Execute string COMMAND asynchronously in background.
-Like `shell-command' but if COMMAND doesn't end in ampersand, adds `&'
-surrounded by whitespace and executes the command asynchronously.
+Like `shell-command', but adds `&' at the end of COMMAND
+to execute it asynchronously.
+
The output appears in the buffer `*Async Shell Command*'.
+That buffer is in shell mode.
In Elisp, you will often be better served by calling `start-process'
directly, since it offers more control and does not impose the use of a
(interactive
(list
(read-shell-command "Async 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))
(unless (string-match "&[ \t]*\\'" command)
"Execute string COMMAND in inferior shell; display output, if any.
With prefix argument, insert the COMMAND's output at point.
-If COMMAND ends in ampersand, execute it asynchronously.
+If COMMAND ends in `&', execute it asynchronously.
The output appears in the buffer `*Async Shell Command*'.
-That buffer is in shell mode.
+That buffer is in shell mode. You can also use
+`async-shell-command' that automatically adds `&'.
Otherwise, COMMAND is executed synchronously. The output appears in
the buffer `*Shell Command Output*'. If the output is short enough to
proc)
;; Remove the ampersand.
(setq command (substring command 0 (match-beginning 0)))
- ;; If will kill a process, query first.
+ ;; Ask the user what to do with already running process.
(setq proc (get-buffer-process buffer))
- (if proc
- (if (yes-or-no-p "A command is running. Kill it? ")
+ (when proc
+ (cond
+ ((eq async-shell-command-buffer 'confirm-kill-process)
+ ;; If will kill a process, query first.
+ (if (yes-or-no-p "A command is running in the default buffer. Kill it? ")
(kill-process proc)
(error "Shell command in progress")))
+ ((eq async-shell-command-buffer 'confirm-new-buffer)
+ ;; If will create a new buffer, query first.
+ (if (yes-or-no-p "A command is running in the default buffer. Use a new buffer? ")
+ (setq buffer (generate-new-buffer
+ (or output-buffer "*Async Shell Command*")))
+ (error "Shell command in progress")))
+ ((eq async-shell-command-buffer 'new-buffer)
+ ;; It will create a new buffer.
+ (setq buffer (generate-new-buffer
+ (or output-buffer "*Async Shell Command*"))))
+ ((eq async-shell-command-buffer 'confirm-rename-buffer)
+ ;; If will rename the buffer, query first.
+ (if (yes-or-no-p "A command is running in the default buffer. Rename it? ")
+ (progn
+ (with-current-buffer buffer
+ (rename-uniquely))
+ (setq buffer (get-buffer-create
+ (or output-buffer "*Async Shell Command*"))))
+ (error "Shell command in progress")))
+ ((eq async-shell-command-buffer 'rename-buffer)
+ ;; It will rename the buffer.
+ (with-current-buffer buffer
+ (rename-uniquely))
+ (setq buffer (get-buffer-create
+ (or output-buffer "*Async Shell Command*"))))))
(with-current-buffer buffer
(setq buffer-read-only nil)
;; Setting buffer-read-only to nil doesn't suffice
To specify a coding system for converting non-ASCII characters
in the input and output to the shell command, use \\[universal-coding-system-argument]
before this command. By default, the input (from the current buffer)
-is encoded in the same coding system that will be used to save the file,
-`buffer-file-coding-system'. If the output is going to replace the region,
-then it is decoded from that same coding system.
+is encoded using coding-system specified by `process-coding-system-alist',
+falling back to `default-process-coding-system' if no match for COMMAND
+is found in `process-coding-system-alist'.
-The noninteractive arguments are START, END, COMMAND,
-OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER.
Noninteractive callers can specify coding systems by binding
`coding-system-for-read' and `coding-system-for-write'.
in the echo area or in a buffer.
If the output is short enough to display in the echo area
\(determined by the variable `max-mini-window-height' if
-`resize-mini-windows' is non-nil), it is shown there. Otherwise
-it is displayed in the buffer `*Shell Command Output*'. The output
-is available in that buffer in both cases.
+`resize-mini-windows' is non-nil), it is shown there.
+Otherwise it is displayed in the buffer `*Shell Command Output*'.
+The output is available in that buffer in both cases.
If there is output and an error, a message about the error
-appears at the end of the output.
-
-If there is no output, or if output is inserted in the current buffer,
-then `*Shell Command Output*' is deleted.
-
-If the optional fourth argument OUTPUT-BUFFER is non-nil,
-that says to put the output in some other buffer.
-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 the current buffer.
-In either case, the output is inserted after point (leaving mark after it).
-
-If REPLACE, the optional fifth argument, is non-nil, that means insert
-the output in place of text from START to END, putting point and mark
+appears at the end of the output. If there is no output, or if
+output is inserted in the current buffer, the buffer `*Shell
+Command Output*' is deleted.
+
+Optional fourth arg OUTPUT-BUFFER specifies where to put the
+command's output. If the value is a buffer or buffer name, put
+the output there. Any other value, excluding nil, means to
+insert the output in the current buffer. In either case, the
+output is inserted after point (leaving mark after it).
+
+Optional fifth arg REPLACE, if non-nil, means to insert the
+output in place of text from START to END, putting point and mark
around it.
-If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
-or buffer name to which to direct the command's standard error output.
-If it is nil, error output is mingled with regular output.
-If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there
-were any errors. (This is always t, interactively.)
-In an interactive call, the variable `shell-command-default-error-buffer'
-specifies the value of ERROR-BUFFER."
+Optional sixth arg ERROR-BUFFER, if non-nil, specifies a buffer
+or buffer name to which to direct the command's standard error
+output. If nil, error output is mingled with regular output.
+When called interactively, `shell-command-default-error-buffer'
+is used for ERROR-BUFFER.
+
+Optional seventh arg DISPLAY-ERROR-BUFFER, if non-nil, means to
+display the error buffer if there were any errors. When called
+interactively, this is t."
(interactive (let (string)
(unless (mark)
(error "The mark is not set now, so there is no region"))
(goto-char start)
(and replace (push-mark (point) 'nomsg))
(setq exit-status
- (call-process-region start end shell-file-name t
+ (call-process-region start end shell-file-name replace
(if error-file
(list t error-file)
t)
(or lc infile)
(if stderr-file (list (car buffer) stderr-file) buffer)
display args)
- (when stderr-file (copy-file stderr-file (cadr buffer)))))
+ (when stderr-file (copy-file stderr-file (cadr buffer) t))))
(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
+By 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 behavior with respect to remote file attributes caching.
+its behavior with respect to remote file attribute caching.
-This variable should never be changed by `setq'. Instead of, it
-shall be set only by let-binding.")
+You should only ever change this variable with a let-binding;
+never with `setq'.")
(defun start-file-process (name buffer program &rest program-args)
"Start a program in a subprocess. Return the process object for it.
"network")
(if (plist-get contact :server)
(format "server on %s"
- (plist-get contact :server))
+ (or
+ (plist-get contact :host)
+ (plist-get contact :local)))
(format "connection to %s"
(plist-get contact :host))))
(format "(serial port %s%s)"
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\".
+\"*Process List*\".
The return value is always nil."
(interactive)
(or (fboundp 'process-list)
\f
(defvar filter-buffer-substring-functions nil
- "This variable is a wrapper hook around `filter-buffer-substring'.
-Each member of the hook should be a function accepting four arguments:
-\(FUN BEG END DELETE), where FUN is itself a function of three arguments
+ "This variable is a wrapper hook around `filter-buffer-substring'.")
+(make-obsolete-variable 'filter-buffer-substring-functions
+ 'filter-buffer-substring-function "24.4")
+
+(defvar filter-buffer-substring-function #'buffer-substring--filter
+ "Function to perform the filtering in `filter-buffer-substring'.
+The function is called with 3 arguments:
\(BEG END DELETE). The arguments BEG, END, and DELETE are the same
as those of `filter-buffer-substring' in each case.
-
-The first hook function to be called receives a FUN equivalent
-to the default operation of `filter-buffer-substring',
-i.e. one that returns the buffer-substring between BEG and
-END (processed by any `buffer-substring-filters'). Normally,
-the hook function will call FUN and then do its own processing
-of the result. The next hook function receives a FUN equivalent
-to the previous hook function, calls it, and does its own
-processing, and so on. The overall result is that of all hook
-functions acting in sequence.
-
-Any hook may choose not to call FUN though, in which case it
-effectively replaces the default behavior with whatever it chooses.
-Of course, a later hook function may do the same thing.")
+It should return the buffer substring between BEG and END, after filtering.")
(defvar buffer-substring-filters nil
"List of filter functions for `filter-buffer-substring'.
Each function must accept a single argument, a string, and return
a string. The buffer substring is passed to the first function
in the list, and the return value of each function is passed to
-the next. The final result (if `buffer-substring-filters' is
-nil, this is the unfiltered buffer-substring) is passed to the
-first function on `filter-buffer-substring-functions'.
-
+the next.
As a special convention, point is set to the start of the buffer text
being operated on (i.e., the first argument of `filter-buffer-substring')
before these functions are called.")
(make-obsolete-variable 'buffer-substring-filters
- 'filter-buffer-substring-functions "24.1")
+ 'filter-buffer-substring-function "24.1")
(defun filter-buffer-substring (beg end &optional delete)
"Return the buffer substring between BEG and END, after filtering.
-The wrapper hook `filter-buffer-substring-functions' performs
-the actual filtering. The obsolete variable `buffer-substring-filters'
-is also consulted. If both of these are nil, no filtering is done.
+The hook `filter-buffer-substring-function' performs the actual filtering.
+By default, no filtering is done.
If DELETE is non-nil, the text between BEG and END is deleted
from the buffer.
This function should be used instead of `buffer-substring',
`buffer-substring-no-properties', or `delete-and-extract-region'
when you want to allow filtering to take place. For example,
-major or minor modes can use `filter-buffer-substring-functions' to
+major or minor modes can use `filter-buffer-substring-function' to
extract characters that are special to a buffer, and should not
be copied into other buffers."
+ (funcall filter-buffer-substring-function beg end delete))
+
+(defun buffer-substring--filter (beg end &optional delete)
(with-wrapper-hook filter-buffer-substring-functions (beg end delete)
(cond
((or delete buffer-substring-filters)
(defvar interprogram-cut-function nil
"Function to call to make a killed region available to other programs.
+Most window systems provide a facility for cutting and pasting
+text between different programs, such as the clipboard on X and
+MS-Windows, or the pasteboard on Nextstep/Mac OS.
-Most window systems provide some sort of facility for cutting and
-pasting text between the windows of different programs.
-This variable holds a function that Emacs calls whenever text
-is put in the kill ring, to make the new kill available to other
-programs.
-
-The function takes one argument, TEXT, which is a string containing
-the text which should be made available.")
+This variable holds a function that Emacs calls whenever text is
+put in the kill ring, to make the new kill available to other
+programs. The function takes one argument, TEXT, which is a
+string containing the text which should be made available.")
(defvar interprogram-paste-function nil
"Function to call to get text cut from other programs.
-
-Most window systems provide some sort of facility for cutting and
-pasting text between the windows of different programs.
-This variable holds a function that Emacs calls to obtain
-text that other programs have provided for pasting.
-
-The function should be called with no arguments. If the function
-returns nil, then no other program has provided such text, and the top
-of the Emacs kill ring should be used. If the function returns a
-string, then the caller of the function \(usually `current-kill')
-should put this string in the kill ring as the latest kill.
-
-This function may also return a list of strings if the window
+Most window systems provide a facility for cutting and pasting
+text between different programs, such as the clipboard on X and
+MS-Windows, or the pasteboard on Nextstep/Mac OS.
+
+This variable holds a function that Emacs calls to obtain text
+that other programs have provided for pasting. The function is
+called with no arguments. If no other program has provided text
+to paste, the function should return nil (in which case the
+caller, usually `current-kill', should use the top of the Emacs
+kill ring). If another program has provided text to paste, the
+function should return that text as a string (in which case the
+caller should put this string in the kill ring as the latest
+kill).
+
+The function may also return a list of strings if the window
system supports multiple selections. The first string will be
-used as the pasted text, but the other will be placed in the
-kill ring for easy access via `yank-pop'.
-
-Note that the function should return a string only if a program other
-than Emacs has provided a string for pasting; if Emacs provided the
-most recent string, the function should return nil. If it is
-difficult to tell whether Emacs or some other program provided the
-current string, it is probably good enough to return nil if the string
-is equal (according to `string=') to the last text Emacs provided.")
+used as the pasted text, but the other will be placed in the kill
+ring for easy access via `yank-pop'.
+
+Note that the function should return a string only if a program
+other than Emacs has provided a string for pasting; if Emacs
+provided the most recent string, the function should return nil.
+If it is difficult to tell whether Emacs or some other program
+provided the current string, it is probably good enough to return
+nil if the string is equal (according to `string=') to the last
+text Emacs provided.")
\f
: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."
+ "Do not add a new string to `kill-ring' if it duplicates the last one.
+The comparison is done using `equal-including-properties'."
:type 'boolean
:group 'killing
:version "23.2")
(signal 'args-out-of-range
(list string "yank-handler specified for empty string"))))
(unless (and kill-do-not-save-duplicates
- (equal string (car kill-ring)))
+ ;; Due to text properties such as 'yank-handler that
+ ;; can alter the contents to yank, comparison using
+ ;; `equal' is unsafe.
+ (equal-including-properties string (car kill-ring)))
(if (fboundp 'menu-bar-update-yank-menu)
(menu-bar-update-yank-menu string (and replace (car kill-ring)))))
(when save-interprogram-paste-before-kill
(nreverse interprogram-paste)
(list interprogram-paste)))
(unless (and kill-do-not-save-duplicates
- (equal s (car kill-ring)))
+ (equal-including-properties s (car kill-ring)))
(push s kill-ring))))))
(unless (and kill-do-not-save-duplicates
- (equal string (car kill-ring)))
+ (equal-including-properties string (car kill-ring)))
(if (and replace kill-ring)
(setcar kill-ring string)
(push string kill-ring)
(set-advertised-calling-convention 'kill-append '(string before-p) "23.3")
(defcustom yank-pop-change-selection nil
- "If non-nil, rotating the kill ring changes the window system selection."
+ "Whether rotating the kill ring changes the window system selection.
+If non-nil, whenever the kill ring is rotated (usually via the
+`yank-pop' command), Emacs also calls `interprogram-cut-function'
+to copy the new kill to the window system selection."
:type 'boolean
:group 'killing
:version "23.1")
:type 'boolean
:group 'killing)
-(put 'text-read-only 'error-conditions
- '(text-read-only buffer-read-only error))
-(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.
This deletes the text from the buffer and saves it in the kill ring.
(kill-new string nil yank-handler)))
(when (or string (eq last-command 'kill-region))
(setq this-command 'kill-region))
+ (setq deactivate-mark t)
nil)
((buffer-read-only text-read-only)
;; The code above failed because the buffer, or some of the characters
visual feedback indicating the extent of the region being copied."
(interactive "r")
(copy-region-as-kill beg end)
- ;; This use of called-interactively-p is correct
- ;; because the code it controls just gives the user visual feedback.
+ ;; This use of called-interactively-p is correct because the code it
+ ;; controls just gives the user visual feedback.
(if (called-interactively-p 'interactive)
- (let ((other-end (if (= (point) beg) end beg))
- (opoint (point))
- ;; Inhibit quitting so we can make a quit here
- ;; look like a C-g typed as a command.
- (inhibit-quit t))
- (if (pos-visible-in-window-p other-end (selected-window))
- ;; Swap point-and-mark quickly so as to show the region that
- ;; was selected. Don't do it if the region is highlighted.
- (unless (and (region-active-p)
- (face-background 'region))
- ;; Swap point and mark.
- (set-marker (mark-marker) (point) (current-buffer))
- (goto-char other-end)
- (sit-for blink-matching-delay)
- ;; Swap back.
- (set-marker (mark-marker) other-end (current-buffer))
- (goto-char opoint)
- ;; If user quit, deactivate the mark
- ;; as C-g would as a command.
- (and quit-flag mark-active
- (deactivate-mark)))
- (let* ((killed-text (current-kill 0))
- (message-len (min (length killed-text) 40)))
- (if (= (point) beg)
- ;; Don't say "killed"; that is misleading.
- (message "Saved text until \"%s\""
- (substring killed-text (- message-len)))
- (message "Saved text from \"%s\""
- (substring killed-text 0 message-len))))))))
+ (indicate-copied-region)))
+
+(defun indicate-copied-region (&optional message-len)
+ "Indicate that the region text has been copied interactively.
+If the mark is visible in the selected window, blink the cursor
+between point and mark if there is currently no active region
+highlighting.
+
+If the mark lies outside the selected window, display an
+informative message containing a sample of the copied text. The
+optional argument MESSAGE-LEN, if non-nil, specifies the length
+of this sample text; it defaults to 40."
+ (let ((mark (mark t))
+ (point (point))
+ ;; Inhibit quitting so we can make a quit here
+ ;; look like a C-g typed as a command.
+ (inhibit-quit t))
+ (if (pos-visible-in-window-p mark (selected-window))
+ ;; Swap point-and-mark quickly so as to show the region that
+ ;; was selected. Don't do it if the region is highlighted.
+ (unless (and (region-active-p)
+ (face-background 'region))
+ ;; Swap point and mark.
+ (set-marker (mark-marker) (point) (current-buffer))
+ (goto-char mark)
+ (sit-for blink-matching-delay)
+ ;; Swap back.
+ (set-marker (mark-marker) mark (current-buffer))
+ (goto-char point)
+ ;; If user quit, deactivate the mark
+ ;; as C-g would as a command.
+ (and quit-flag mark-active
+ (deactivate-mark)))
+ (let ((len (min (abs (- mark point))
+ (or message-len 40))))
+ (if (< point mark)
+ ;; Don't say "killed"; that is misleading.
+ (message "Saved text until \"%s\""
+ (buffer-substring-no-properties (- mark len) mark))
+ (message "Saved text from \"%s\""
+ (buffer-substring-no-properties mark (+ mark len))))))))
(defun append-next-kill (&optional interactive)
"Cause following command, if it kills, to append to previous kill.
\f
;; Yanking.
+(defcustom yank-handled-properties
+ '((font-lock-face . yank-handle-font-lock-face-property)
+ (category . yank-handle-category-property))
+ "List of special text property handling conditions for yanking.
+Each element should have the form (PROP . FUN), where PROP is a
+property symbol and FUN is a function. When the `yank' command
+inserts text into the buffer, it scans the inserted text for
+stretches of text that have `eq' values of the text property
+PROP; for each such stretch of text, FUN is called with three
+arguments: the property's value in that text, and the start and
+end positions of the text.
+
+This is done prior to removing the properties specified by
+`yank-excluded-properties'."
+ :group 'killing
+ :version "24.3")
+
;; This is actually used in subr.el but defcustom does not work there.
(defcustom yank-excluded-properties
- '(read-only invisible intangible field mouse-face help-echo local-map keymap
- yank-handler follow-link fontified)
+ '(category field follow-link fontified font-lock-face help-echo
+ intangible invisible keymap local-map mouse-face read-only
+ yank-handler)
"Text properties to discard when yanking.
The value should be a list of text properties to discard or t,
-which means to discard all text properties."
+which means to discard all text properties.
+
+See also `yank-handled-properties'."
:type '(choice (const :tag "All" t) (repeat symbol))
:group 'killing
- :version "22.1")
+ :version "24.3")
(defvar yank-window-start nil)
(defvar yank-undo-function nil
(defun yank (&optional arg)
"Reinsert (\"paste\") the last stretch of killed text.
-More precisely, reinsert the stretch of killed text most recently
-killed OR yanked. Put point at end, and set mark at beginning.
-With just \\[universal-argument] as argument, same but put point at beginning (and mark at end).
-With argument N, reinsert the Nth most recently killed stretch of killed
-text.
+More precisely, reinsert the most recent kill, which is the
+stretch of killed text most recently killed OR yanked. Put point
+at the end, and set mark at the beginning without activating it.
+With just \\[universal-argument] as argument, put point at beginning, and mark at end.
+With argument N, reinsert the Nth most recent kill.
-When this command inserts killed text into the buffer, it honors
-`yank-excluded-properties' and `yank-handler' as described in the
-doc string for `insert-for-yank-1', which see.
+When this command inserts text into the buffer, it honors the
+`yank-handled-properties' and `yank-excluded-properties'
+variables, and the `yank-handler' text property. See
+`insert-for-yank-1' for details.
See also the command `yank-pop' (\\[yank-pop])."
(interactive "*P")
((eq backward-delete-char-untabify-method 'all)
" \t\n\r")))
(n (if skip
- (let ((wh (- (point) (save-excursion (skip-chars-backward skip)
- (point)))))
+ (let* ((oldpt (point))
+ (wh (- oldpt (save-excursion
+ (skip-chars-backward skip)
+ (constrain-to-field nil oldpt)))))
(+ arg (if (zerop wh) 0 (1- wh))))
arg)))
;; Avoid warning about delete-backward-char
"Kill up to and including ARGth occurrence of CHAR.
Case is ignored if `case-fold-search' is non-nil in the current buffer.
Goes backward if ARG is negative; error if CHAR not found."
- (interactive "p\ncZap to char: ")
+ (interactive (list (prefix-numeric-value current-prefix-arg)
+ (read-char "Zap to char: " t)))
;; Avoid "obsolete" warnings for translation-table-for-input.
(with-no-warnings
(if (char-table-p translation-table-for-input)
(setq char (or (aref translation-table-for-input char) char))))
(kill-region (point) (progn
(search-forward (char-to-string char) nil nil arg)
-; (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
(point))))
;; kill-line and its subroutines.
(defcustom kill-whole-line nil
- "If non-nil, `kill-line' with no arg at beg of line kills the whole line."
+ "If non-nil, `kill-line' with no arg at start of line kills the whole line."
:type 'boolean
:group 'killing)
kill the rest of the current line, even if there are only
nonblanks there.
-If `kill-whole-line' is non-nil, then this command kills the whole line
+If option `kill-whole-line' is non-nil, then this command kills the whole line
including its terminating newline, when used at the beginning of a line
with no argument. As a consequence, you can always kill a whole line
by typing \\[move-beginning-of-line] \\[kill-line].
(assq prop buffer-invisibility-spec))))))
(skip-chars-forward "^\n")
(if (get-text-property (point) 'invisible)
- (goto-char (next-single-property-change (point) 'invisible))
+ (goto-char (or (next-single-property-change (point) 'invisible)
+ (point-max)))
(goto-char (next-overlay-change (point))))
(end-of-line)))
\f
(marker-position (mark-marker))
(signal 'mark-inactive nil)))
-(defsubst deactivate-mark (&optional force)
+(defun deactivate-mark (&optional force)
"Deactivate the mark.
If Transient Mark mode is disabled, this function normally does
nothing; but if FORCE is non-nil, it deactivates the mark anyway.
(cond (saved-region-selection
(x-set-selection 'PRIMARY saved-region-selection)
(setq saved-region-selection nil))
- ((/= (region-beginning) (region-end))
+ ;; If another program has acquired the selection, region
+ ;; deactivation should not clobber it (Bug#11772).
+ ((and (/= (region-beginning) (region-end))
+ (or (x-selection-owner-p 'PRIMARY)
+ (null (x-selection-exists-p 'PRIMARY))))
(x-set-selection 'PRIMARY
- (buffer-substring-no-properties
- (region-beginning)
- (region-end))))))
+ (buffer-substring (region-beginning)
+ (region-end))))))
(if (and (null force)
(or (eq transient-mark-mode 'lambda)
(and (eq (car-safe transient-mark-mode) 'only)
(when (mark t)
(setq mark-active t)
(unless transient-mark-mode
- (setq transient-mark-mode 'lambda))))
+ (setq transient-mark-mode 'lambda))
+ (run-hooks 'activate-mark-hook)))
(defun set-mark (pos)
"Set this buffer's mark to POS. Don't use this function!
:type 'boolean
:group 'editing-basics)
-(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."
- :type 'boolean
- :group 'editing-basics
- :version "23.1")
-
(defun set-mark-command (arg)
"Set the mark where point is, or jump to the mark.
Setting the mark also alters the region, which is the text
(activate-mark)
(message "Mark activated")))
(t
- (push-mark-command nil)
- (if set-mark-default-inactive (deactivate-mark)))))
+ (push-mark-command nil))))
(defun push-mark (&optional location nomsg activate)
"Set mark at LOCATION (point, by default) and push old mark on mark ring.
(deactivate-mark)
(set-mark (point))
(goto-char omark)
- (if set-mark-default-inactive (deactivate-mark))
(cond (temp-highlight
(setq transient-mark-mode (cons 'only transient-mark-mode)))
((or (and arg (region-active-p)) ; (xor arg (not (region-active-p)))
You can also deactivate the mark by typing \\[keyboard-quit] or
\\[keyboard-escape-quit].
-Many commands change their behavior when Transient Mark mode is in effect
-and the mark is active, by acting on the region instead of their usual
-default part of the buffer's text. Examples of such commands include
-\\[comment-dwim], \\[flush-lines], \\[keep-lines], \
+Many commands change their behavior when Transient Mark mode is
+in effect and the mark is active, by acting on the region instead
+of their usual default part of the buffer's text. Examples of
+such commands include \\[comment-dwim], \\[flush-lines], \\[keep-lines],
\\[query-replace], \\[query-replace-regexp], \\[ispell], and \\[undo].
-Invoke \\[apropos-documentation] and type \"transient\" or
-\"mark.*active\" at the prompt, to see the documentation of
-commands which are sensitive to the Transient Mark mode."
+To see the documentation of commands which are sensitive to the
+Transient Mark mode, invoke \\[apropos-documentation] and type \"transient\"
+or \"mark.*active\" at the prompt."
:global t
;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
:variable transient-mark-mode)
"Non-nil means vertical motion starting at end of line keeps to ends of lines.
This means moving to the end of each line moved onto.
The beginning of a blank line does not count as the end of a line.
-This has no effect when `line-move-visual' is non-nil."
+This has no effect when the variable `line-move-visual' is non-nil."
:type 'boolean
:group 'editing-basics)
(defcustom goal-column nil
"Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil.
-A non-nil setting overrides `line-move-visual', which see."
+A non-nil setting overrides the variable `line-move-visual', which see."
:type '(choice integer
(const :tag "None" nil))
:group 'editing-basics)
It is the column where point was at the start of the current run
of vertical motion commands.
-When moving by visual lines via `line-move-visual', it is a cons
+When moving by visual lines via the function `line-move-visual', it is a cons
cell (COL . HSCROLL), where COL is the x-position, in pixels,
divided by the default column width, and HSCROLL is the number of
columns by which window is scrolled from left margin.
;; a cleaner solution to the problem of making C-n do something
;; useful given a tall image.
(defun line-move (arg &optional noerror to-end try-vscroll)
- (unless (and auto-window-vscroll try-vscroll
- ;; Only vscroll for single line moves
- (= (abs arg) 1)
- ;; But don't vscroll in a keyboard macro.
- (not defining-kbd-macro)
- (not executing-kbd-macro)
- (line-move-partial arg noerror to-end))
- (set-window-vscroll nil 0 t)
- (if (and line-move-visual
- ;; Display-based column are incompatible with goal-column.
- (not goal-column)
- ;; When the text in the window is scrolled to the left,
- ;; display-based motion doesn't make sense (because each
- ;; logical line occupies exactly one screen line).
- (not (> (window-hscroll) 0)))
- (line-move-visual arg noerror)
- (line-move-1 arg noerror to-end))))
+ (if noninteractive
+ (forward-line arg)
+ (unless (and auto-window-vscroll try-vscroll
+ ;; Only vscroll for single line moves
+ (= (abs arg) 1)
+ ;; Under scroll-conservatively, the display engine
+ ;; does this better.
+ (zerop scroll-conservatively)
+ ;; But don't vscroll in a keyboard macro.
+ (not defining-kbd-macro)
+ (not executing-kbd-macro)
+ (line-move-partial arg noerror to-end))
+ (set-window-vscroll nil 0 t)
+ (if (and line-move-visual
+ ;; Display-based column are incompatible with goal-column.
+ (not goal-column)
+ ;; When the text in the window is scrolled to the left,
+ ;; display-based motion doesn't make sense (because each
+ ;; logical line occupies exactly one screen line).
+ (not (> (window-hscroll) 0)))
+ (line-move-visual arg noerror)
+ (line-move-1 arg noerror to-end)))))
;; Display-based alternative to line-move-1.
;; Arg says how many lines to move. The value is t if we can move the
(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)
- (car temporary-goal-column)
- temporary-goal-column))
- arg))
- arg)
+ ;; vertical-motion can move more than it was asked to if it moves
+ ;; across display strings with newlines. We don't want to ring
+ ;; the bell and announce beginning/end of buffer in that case.
+ (or (and (or (and (>= arg 0)
+ (>= (vertical-motion
+ (cons (or goal-column
+ (if (consp temporary-goal-column)
+ (car temporary-goal-column)
+ temporary-goal-column))
+ arg))
+ arg))
+ (and (< arg 0)
+ (<= (vertical-motion
+ (cons (or goal-column
+ (if (consp temporary-goal-column)
+ (car temporary-goal-column)
+ temporary-goal-column))
+ arg))
+ arg)))
(or (>= arg 0)
(/= (point) opoint)
;; If the goal column lies on a display string,
(setq pos1 pos2 pos2 swap)))
(if (> (cdr pos1) (car pos2)) (error "Don't have two things to transpose"))
(atomic-change-group
- (let (word2)
- ;; FIXME: We first delete the two pieces of text, so markers that
- ;; used to point to after the text end up pointing to before it :-(
- (setq word2 (delete-and-extract-region (car pos2) (cdr pos2)))
- (goto-char (car pos2))
- (insert (delete-and-extract-region (car pos1) (cdr pos1)))
- (goto-char (car pos1))
- (insert word2))))
+ ;; This sequence of insertions attempts to preserve marker
+ ;; positions at the start and end of the transposed objects.
+ (let* ((word (buffer-substring (car pos2) (cdr pos2)))
+ (len1 (- (cdr pos1) (car pos1)))
+ (len2 (length word))
+ (boundary (make-marker)))
+ (set-marker boundary (car pos2))
+ (goto-char (cdr pos1))
+ (insert-before-markers word)
+ (setq word (delete-and-extract-region (car pos1) (+ (car pos1) len1)))
+ (goto-char boundary)
+ (insert word)
+ (goto-char (+ boundary len1))
+ (delete-region (point) (+ (point) len2))
+ (set-marker boundary nil))))
\f
(defun backward-word (&optional arg)
"Move backward until encountering the beginning of a word.
t)))
(defvar comment-line-break-function 'comment-indent-new-line
- "*Mode-specific function which line breaks and continues a comment.
+ "Mode-specific function which line breaks and continues a comment.
This function is called during auto-filling when a comment syntax
is defined.
The function should take a single optional argument, which is a flag
The value of `normal-auto-fill-function' specifies the function to use
for `auto-fill-function' when turning Auto Fill mode on."
- :variable (eq auto-fill-function normal-auto-fill-function))
+ :variable (auto-fill-function
+ . (lambda (v) (setq auto-fill-function
+ (if v normal-auto-fill-function)))))
;; This holds a document string used to document auto-fill-mode.
(defun auto-fill-function ()
filled in. \\[quoted-insert] still inserts characters in
overwrite mode; this is supposed to make it easier to insert
characters when necessary."
- :variable (eq overwrite-mode 'overwrite-mode-textual))
+ :variable (overwrite-mode
+ . (lambda (v) (setq overwrite-mode (if v 'overwrite-mode-textual)))))
(define-minor-mode binary-overwrite-mode
"Toggle Binary Overwrite mode.
Note that Binary Overwrite mode is not its own minor mode; it is
a specialization of overwrite mode, entered by setting the
`overwrite-mode' variable to `overwrite-mode-binary'."
- :variable (eq overwrite-mode 'overwrite-mode-binary))
+ :variable (overwrite-mode
+ . (lambda (v) (setq overwrite-mode (if v 'overwrite-mode-binary)))))
(define-minor-mode line-number-mode
"Toggle line number display in the mode line (Line Number mode).
With a prefix argument, set VARIABLE to VALUE buffer-locally."
(interactive
(let* ((default-var (variable-at-point))
- (var (if (user-variable-p default-var)
+ (var (if (custom-variable-p default-var)
(read-variable (format "Set variable (default %s): " default-var)
default-var)
(read-variable "Set variable: ")))
(setq beg (previous-single-property-change beg 'mouse-face))
(setq end (or (next-single-property-change end 'mouse-face)
(point-max)))
- (buffer-substring-no-properties beg end))))
- (owindow (selected-window)))
+ (buffer-substring-no-properties beg end)))))
(unless (buffer-live-p buffer)
(error "Destination buffer is dead"))
- (select-window (posn-window (event-start event)))
- (if (and (one-window-p t 'selected-frame)
- (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 (get-buffer-window buffer 0)
- owindow))
+ (quit-window nil (posn-window (event-start event)))
(with-current-buffer buffer
(choose-completion-string
(point))))
(defun choose-completion-delete-max-match (string)
+ (declare (obsolete choose-completion-guess-base-position "23.2"))
(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.
(defun choose-completion-string (choice &optional
buffer base-position insert-function)
"Switch to BUFFER and insert the completion choice CHOICE.
-BASE-POSITION, says where to insert the completion."
+BASE-POSITION says where to insert the completion.
+INSERT-FUNCTION says how to insert the completion and falls
+back on `completion-list-insert-choice-function' when nil."
;; If BUFFER is the minibuffer, exit the minibuffer
;; unless it is reading a file name and CHOICE is a directory,
"Finish setup of the completions buffer.
Called from `temp-buffer-show-hook'."
(when (eq major-mode 'completion-list-mode)
- (toggle-read-only 1)))
+ (setq buffer-read-only t)))
(add-hook 'temp-buffer-show-hook 'completion-list-mode-finish)
(defun completion-setup-function ()
(let* ((mainbuf (current-buffer))
(base-dir
- ;; When reading a file name in the minibuffer,
- ;; try and find the right default-directory to set in the
- ;; completion list buffer.
- ;; FIXME: Why do we do that, actually? --Stef
+ ;; FIXME: This is a bad hack. We try to set the default-directory
+ ;; in the *Completions* buffer so that the relative file names
+ ;; displayed there can be treated as valid file names, independently
+ ;; from the completion context. But this suffers from many problems:
+ ;; - It's not clear when the completions are file names. With some
+ ;; completion tables (e.g. bzr revision specs), the listed
+ ;; completions can mix file names and other things.
+ ;; - It doesn't pay attention to possible quoting.
+ ;; - With fancy completion styles, the code below will not always
+ ;; find the right base directory.
(if minibuffer-completing-file-name
(file-name-as-directory
(expand-file-name
- (substring (minibuffer-completion-contents)
- 0 (or completion-base-size 0)))))))
+ (buffer-substring (minibuffer-prompt-end)
+ (- (point) (or completion-base-size 0))))))))
(with-current-buffer standard-output
(let ((base-size completion-base-size) ;Read before killing localvars.
(base-position completion-base-position)
(if (if (eq normal-erase-is-backspace 'maybe)
(and (not noninteractive)
(or (memq system-type '(ms-dos windows-nt))
- (memq window-system '(ns))
+ (memq window-system '(w32 ns))
(and (memq window-system '(x))
(fboundp 'x-backspace-delete-keys-p)
(x-backspace-delete-keys-p))
have both Backspace, Delete and F1 keys.
See also `normal-erase-is-backspace'."
- :variable (eq (terminal-parameter
- nil 'normal-erase-is-backspace) 1)
+ :variable ((eq (terminal-parameter nil 'normal-erase-is-backspace) 1)
+ . (lambda (v)
+ (setf (terminal-parameter nil 'normal-erase-is-backspace)
+ (if v 1 0))))
(let ((enabled (eq 1 (terminal-parameter
nil 'normal-erase-is-backspace))))
(defvar vis-mode-saved-buffer-invisibility-spec nil
"Saved value of `buffer-invisibility-spec' when Visible mode is on.")
+(define-minor-mode read-only-mode
+ "Change whether the current buffer is read-only.
+With prefix argument ARG, make the buffer read-only if ARG is
+positive, otherwise make it writable. If buffer is read-only
+and `view-read-only' is non-nil, enter view mode.
+
+Do not call this from a Lisp program unless you really intend to
+do the same thing as the \\[read-only-mode] command, including
+possibly enabling or disabling View mode. Also, note that this
+command works by setting the variable `buffer-read-only', which
+does not affect read-only regions caused by text properties. To
+ignore read-only status in a Lisp program (whether due to text
+properties or buffer state), bind `inhibit-read-only' temporarily
+to a non-nil value."
+ :variable buffer-read-only
+ (cond
+ ((and (not buffer-read-only) view-mode)
+ (View-exit-and-edit)
+ (make-local-variable 'view-read-only)
+ (setq view-read-only t)) ; Must leave view mode.
+ ((and buffer-read-only view-read-only
+ ;; If view-mode is already active, `view-mode-enter' is a nop.
+ (not view-mode)
+ (not (eq (get major-mode 'mode-class) 'special)))
+ (view-mode-enter))))
+
(define-minor-mode visible-mode
"Toggle making all invisible text temporarily visible (Visible mode).
With a prefix argument ARG, enable Visible mode if ARG is
HCoop / bpt / emacs.git / blobdiff