;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
-(eval-when-compile
- (autoload 'widget-convert "wid-edit")
- (autoload 'shell-mode "shell"))
+(declare-function widget-convert "wid-edit" (type &rest args))
+(declare-function shell-mode "shell" ())
(defvar compilation-current-error)
(unless delay-mode-hooks
(run-hooks 'after-change-major-mode-hook)))
+;; Special major modes to view specially formatted data rather than files.
+
+(defvar special-mode-map
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map)
+ (define-key map "q" 'quit-window)
+ (define-key map " " 'scroll-up)
+ (define-key map "\C-?" 'scroll-down)
+ (define-key map "?" 'describe-mode)
+ (define-key map ">" 'end-of-buffer)
+ (define-key map "<" 'beginning-of-buffer)
+ (define-key map "g" 'revert-buffer)
+ map))
+
+(put 'special-mode 'mode-class 'special)
+(define-derived-mode special-mode nil "Special"
+ "Parent major mode from which special major modes should inherit."
+ (setq buffer-read-only t))
+
;; Making and deleting lines.
(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard)))
(defun forward-to-indentation (&optional arg)
"Move forward ARG lines and position at first nonblank character."
- (interactive "p")
+ (interactive "^p")
(forward-line (or arg 1))
(skip-chars-forward " \t"))
(defun backward-to-indentation (&optional arg)
"Move backward ARG lines and position at first nonblank character."
- (interactive "p")
+ (interactive "^p")
(forward-line (- (or arg 1)))
(skip-chars-forward " \t"))
(defun back-to-indentation ()
"Move point to the first non-whitespace character on this line."
- (interactive)
+ (interactive "^")
(beginning-of-line 1)
(skip-syntax-forward " " (line-end-position))
;; Move back over chars that have whitespace syntax but have the p flag.
Don't use this command in Lisp programs!
\(goto-char (point-min)) is faster and avoids clobbering the mark."
- (interactive "P")
+ (interactive "^P")
(or (consp arg)
- (and transient-mark-mode mark-active)
+ (region-active-p)
(push-mark))
(let ((size (- (point-max) (point-min))))
(goto-char (if (and arg (not (consp arg)))
Don't use this command in Lisp programs!
\(goto-char (point-max)) is faster and avoids clobbering the mark."
- (interactive "P")
- (or (consp arg)
- (and transient-mark-mode mark-active)
- (push-mark))
+ (interactive "^P")
+ (or (consp arg) (region-active-p) (push-mark))
(let ((size (- (point-max) (point-min))))
(goto-char (if (and arg (not (consp arg)))
(- (point-max)
(defun goto-line (arg &optional buffer)
"Goto line ARG, counting from line 1 at beginning of buffer.
-Normally, move point in the current buffer.
-With just \\[universal-argument] as argument, move point in the most recently
-displayed other buffer, and switch to it. When called from Lisp code,
-the optional argument BUFFER specifies a buffer to switch to.
+Normally, move point in the current buffer, and leave mark at previous
+position. With just \\[universal-argument] as argument, move point
+in the most recently displayed other buffer, and switch to it.
+When called from Lisp code, the optional argument BUFFER specifies
+a buffer to switch to.
If there's a number in the buffer at point, it is the default for ARG."
(interactive
(let ((window (get-buffer-window buffer)))
(if window (select-window window)
(switch-to-buffer-other-window buffer))))
+ ;; Leave mark at previous position
+ (or (region-active-p) (push-mark))
;; Move to the specified line number in that buffer.
(save-restriction
(widen)
(defvar minibuffer-temporary-goal-position nil)
+(defvar minibuffer-default-add-function 'minibuffer-default-add-completions
+ "Function run by `goto-history-element' before consuming `minibuffer-default'.
+This is useful to dynamically add more elements to the list `minibuffer-default'
+when `goto-history-element' reaches the end of this list.
+Before calling this function `goto-history-element' sets the variable
+`minibuffer-default-add-done' to t, so it will call this function only
+once. In special cases, when this function needs to be called more
+than once, it can set `minibuffer-default-add-done' to nil explicitly,
+overriding the setting of this variable to t in `goto-history-element'.")
+
+(defvar minibuffer-default-add-done nil
+ "When nil, add more elements to the end of the list of default values.
+The value nil causes `goto-history-element' to add more elements to
+the list of defaults when it reaches the end of this list. It does
+this by calling a function defined by `minibuffer-default-add-function'.")
+
+(make-variable-buffer-local 'minibuffer-default-add-done)
+
+(defun minibuffer-default-add-completions ()
+ "Return a list of all completions without the default value.
+This function is used to add all elements of the completion table to
+the end of the list of defaults just after the default value."
+ (interactive)
+ (let ((def minibuffer-default)
+ (all (all-completions ""
+ minibuffer-completion-table
+ minibuffer-completion-predicate
+ t)))
+ (if (listp def)
+ (append def all)
+ (cons def (delete def all)))))
+
(defun goto-history-element (nabs)
"Puts element of the minibuffer history in the minibuffer.
The argument NABS specifies the absolute history position."
(interactive "p")
+ (when (and (not minibuffer-default-add-done)
+ (functionp minibuffer-default-add-function)
+ (< nabs (- (if (listp minibuffer-default)
+ (length minibuffer-default)
+ 1))))
+ (setq minibuffer-default-add-done t
+ minibuffer-default (funcall minibuffer-default-add-function)))
(let ((minimum (if minibuffer-default
(- (if (listp minibuffer-default)
(length minibuffer-default)
(minibuffer-contents-no-properties)))
(if (< nabs minimum)
(if minibuffer-default
- (error "End of history; no next item")
+ (error "End of defaults; no next item")
(error "End of history; no default available")))
(if (> nabs (length (symbol-value minibuffer-history-variable)))
(error "Beginning of history; no preceding item"))
;; it shows nothing else happened in between.
(gethash list undo-equiv-table))))
(setq undo-in-region
- (if transient-mark-mode mark-active (and arg (not (numberp arg)))))
+ (or (region-active-p) (and arg (not (numberp arg)))))
(if undo-in-region
(undo-start (region-beginning) (region-end))
(undo-start))
(if next (setq equiv next))))
(setq pending-undo-list equiv)))
(undo-more
- (if (or transient-mark-mode (numberp arg))
+ (if (numberp arg)
(prefix-numeric-value arg)
1))
;; Record the fact that the just-generated undo records come from an
is run interactively. A value of nil means that output to stderr and
stdout will be intermixed in the output stream.")
+(declare-function mailcap-file-default-commands "mailcap" (files))
+
+(defun minibuffer-default-add-shell-commands ()
+ "Return a list of all commands associted with the current file.
+This function is used to add all related commands retieved by `mailcap'
+to the end of the list of defaults just after the default value."
+ (interactive)
+ (let* ((filename (if (listp minibuffer-default)
+ (car minibuffer-default)
+ minibuffer-default))
+ (commands (and filename (require 'mailcap nil t)
+ (mailcap-file-default-commands (list filename)))))
+ (setq commands (mapcar (lambda (command)
+ (concat command " " filename))
+ commands))
+ (if (listp minibuffer-default)
+ (append minibuffer-default commands)
+ (cons minibuffer-default commands))))
+
+(defun minibuffer-complete-shell-command ()
+ "Dynamically complete shell command at point."
+ (interactive)
+ (require 'shell)
+ (run-hook-with-args-until-success 'shell-dynamic-complete-functions))
+
+(defvar minibuffer-local-shell-command-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-map)
+ (define-key map "\t" 'minibuffer-complete-shell-command)
+ map)
+ "Keymap used for completiing shell commands in minibufffer.")
+
+(defun read-shell-command (prompt &optional initial-contents hist &rest args)
+ "Read a shell command from the minibuffer.
+The arguments are the same as the ones of `read-from-minibuffer',
+except READ and KEYMAP are missing and HIST defaults
+to `shell-command-history'."
+ (apply 'read-from-minibuffer prompt initial-contents
+ minibuffer-local-shell-command-map
+ nil
+ (or hist 'shell-command-history)
+ args))
+
(defun shell-command (command &optional output-buffer error-buffer)
"Execute string COMMAND in inferior shell; display output, if any.
With prefix argument, insert the COMMAND's output at point.
In an interactive call, the variable `shell-command-default-error-buffer'
specifies the value of ERROR-BUFFER."
- (interactive (list (read-from-minibuffer "Shell command: "
- nil nil nil 'shell-command-history)
- current-prefix-arg
- shell-command-default-error-buffer))
+ (interactive
+ (list
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (set (make-local-variable 'minibuffer-default-add-function)
+ 'minibuffer-default-add-shell-commands))
+ (read-shell-command "Shell command: " nil nil
+ (and buffer-file-name
+ (file-relative-name buffer-file-name))))
+ current-prefix-arg
+ shell-command-default-error-buffer))
;; Look for a handler in case default-directory is a remote file name.
(let ((handler
(find-file-name-handler (directory-file-name default-directory)
;; Do this before calling region-beginning
;; and region-end, in case subprocess output
;; relocates them while we are in the minibuffer.
- (setq string (read-from-minibuffer "Shell command on region: "
- nil nil nil
- 'shell-command-history))
+ (setq string (read-shell-command "Shell command on region: "))
;; call-interactively recognizes region-beginning and
;; region-end specially, leaving them in the history.
(list (region-beginning) (region-end)
(defun start-file-process (name buffer program &rest program-args)
"Start a program in a subprocess. Return the process object for it.
+
Similar to `start-process', but may invoke a file handler based on
-`default-directory'. The current working directory of the
-subprocess is `default-directory'.
+`default-directory'. See Info node `(elisp)Magic File Names'.
+
+This handler ought to run PROGRAM, perhaps on the local host,
+perhaps on a remote host that corresponds to `default-directory'.
+In the latter case, the local part of `default-directory' becomes
+the working directory of the process.
PROGRAM and PROGRAM-ARGS might be file names. They are not
objects of file handler invocation."
"Kill (\"cut\") text between point and mark.
This deletes the text from the buffer and saves it in the kill ring.
The command \\[yank] can retrieve it from there.
-\(If you want to kill and then yank immediately, use \\[kill-ring-save].)
+\(If you want to save the region without killing it, use \\[kill-ring-save].)
If you want to append the killed region to the last killed text,
use \\[append-next-kill] before \\[kill-region].
(if (eq last-command 'kill-region)
(kill-append (filter-buffer-substring beg end) (< end beg))
(kill-new (filter-buffer-substring beg end)))
- (if transient-mark-mode
- (setq deactivate-mark t))
+ (setq deactivate-mark t)
nil)
(defun kill-ring-save (beg end)
;; look like a C-g typed as a command.
(inhibit-quit t))
(if (pos-visible-in-window-p other-end (selected-window))
- (unless (and transient-mark-mode
+ ;; 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))
"Deactivate the mark by setting `mark-active' to nil.
\(That makes a difference only in Transient Mark mode.)
Also runs the hook `deactivate-mark-hook'."
- (cond
- ((eq transient-mark-mode 'lambda)
- (setq transient-mark-mode nil))
- (transient-mark-mode
- (setq mark-active nil)
- (run-hooks 'deactivate-mark-hook))))
+ (when transient-mark-mode
+ (if (or (eq transient-mark-mode 'lambda)
+ (and (eq (car-safe transient-mark-mode) 'only)
+ (null (cdr transient-mark-mode))))
+ (setq transient-mark-mode nil)
+ (if (eq (car-safe transient-mark-mode) 'only)
+ (setq transient-mark-mode (cdr transient-mark-mode)))
+ (setq mark-active nil)
+ (run-hooks 'deactivate-mark-hook))))
+
+(defun activate-mark ()
+ "Activate the mark."
+ (when (mark t)
+ (setq mark-active t)
+ (unless transient-mark-mode
+ (setq transient-mark-mode 'lambda))))
(defcustom select-active-regions nil
"If non-nil, an active region automatically becomes the window selection."
test whether to do that.
This function also obeys `use-empty-active-region'."
- (and transient-mark-mode mark-active
+ (and (region-active-p)
(or use-empty-active-region (> (region-end) (region-beginning)))))
(defun region-active-p ()
old mark position on local mark ring. Also push the old mark on
global mark ring, if the previous mark was set in another buffer.
-Immediately repeating this command activates `transient-mark-mode' temporarily.
+When Transient Mark Mode is off, immediately repeating this
+command activates `transient-mark-mode' temporarily.
With prefix argument \(e.g., \\[universal-argument] \\[set-mark-command]\), \
jump to the mark, and set the mark from
Novice Emacs Lisp programmers often try to use the mark for the wrong
purposes. See the documentation of `set-mark' for more information."
(interactive "P")
- (if (eq transient-mark-mode 'lambda)
- (setq transient-mark-mode nil))
+ (cond ((eq transient-mark-mode 'lambda)
+ (setq transient-mark-mode nil))
+ ((eq (car-safe transient-mark-mode) 'only)
+ (deactivate-mark)))
(cond
((and (consp arg) (> (prefix-numeric-value arg) 4))
(push-mark-command nil))
(arg
(setq this-command 'pop-to-mark-command)
(pop-to-mark-command))
- ((and (eq last-command 'set-mark-command)
- mark-active (null transient-mark-mode))
- (setq transient-mark-mode 'lambda)
- (message "Transient-mark-mode temporarily enabled"))
- ((and (eq last-command 'set-mark-command)
- transient-mark-mode)
- (deactivate-mark))
+ ((eq last-command 'set-mark-command)
+ (if (region-active-p)
+ (progn
+ (deactivate-mark)
+ (message "Mark deactivated"))
+ (activate-mark)
+ (message "Mark activated")))
(t
(push-mark-command nil))))
"Put the mark where point is now, and point where the mark is now.
This command works even when the mark is not active,
and it reactivates the mark.
-With prefix arg, `transient-mark-mode' is enabled temporarily."
+
+If Transient Mark mode is on, a prefix arg deactivates the mark
+if it is active, and otherwise avoids reactivating it. If
+Transient Mark mode is off, a prefix arg enables Transient Mark
+mode temporarily."
(interactive "P")
- (if arg
- (if mark-active
- (if (null transient-mark-mode)
- (setq transient-mark-mode 'lambda))
- (setq arg nil)))
- (unless arg
- (let ((omark (mark t)))
- (if (null omark)
- (error "No mark set in this buffer"))
- (set-mark (point))
- (goto-char omark)
- nil)))
+ (let ((omark (mark t))
+ (temp-highlight (eq (car-safe transient-mark-mode) 'only)))
+ (if (null omark)
+ (error "No mark set in this buffer"))
+ (deactivate-mark)
+ (set-mark (point))
+ (goto-char omark)
+ (cond (temp-highlight
+ (setq transient-mark-mode (cons 'only transient-mark-mode)))
+ ((or (and arg (region-active-p)) ; (xor arg (not (region-active-p)))
+ (not (or arg (region-active-p))))
+ (deactivate-mark))
+ (t (activate-mark)))
+ nil))
+
+(defun handle-shift-selection (&optional deactivate)
+ "Check for shift translation, and operate on the mark accordingly.
+This is called whenever a command with a `^' character in its
+`interactive' spec is invoked while `shift-select-mode' is
+non-nil.
+
+If the command was invoked through shift-translation, set the
+mark and activate the region temporarily, unless it was already
+set in this way. If the command was invoked without
+shift-translation and a region is temporarily active, deactivate
+the mark.
+
+With optional arg DEACTIVATE, only perform region deactivation."
+ (cond ((and this-command-keys-shift-translated
+ (null deactivate))
+ (unless (and mark-active
+ (eq (car-safe transient-mark-mode) 'only))
+ (setq transient-mark-mode
+ (cons 'only
+ (unless (eq transient-mark-mode 'lambda)
+ transient-mark-mode)))
+ (push-mark nil nil t)))
+ ((eq (car-safe transient-mark-mode) 'only)
+ (setq transient-mark-mode (cdr transient-mark-mode))
+ (deactivate-mark))))
(define-minor-mode transient-mark-mode
"Toggle Transient Mark mode.
\"mark.*active\" at the prompt, to see the documentation of
commands which are sensitive to the Transient Mark mode."
:global t
-;;; :init-value (not noninteractive)
+ :init-value (not noninteractive)
:group 'editing-basics)
+;; The variable transient-mark-mode is ugly: it can take on special
+;; values. Document these here.
+(defvar transient-mark-mode t
+ "*Non-nil if Transient Mark mode is enabled.
+See the command `transient-mark-mode' for a description of this minor mode.
+
+Non-nil also enables highlighting of the region whenever the mark is active.
+The variable `highlight-nonselected-windows' controls whether to highlight
+all windows or just the selected window.
+
+If the value is `lambda', that enables Transient Mark mode
+temporarily. After any subsequent action that would normally
+deactivate the mark (such as buffer modification), Transient Mark mode
+is turned off.
+
+If the value is (only . OLDVAL), that enables Transient Mark mode
+temporarily. After any subsequent point motion command that is not
+shift-translated, or any other action that would normally deactivate
+the mark (such as buffer modification), the value of
+`transient-mark-mode' is set to OLDVAL.")
+
(defvar widen-automatically t
"Non-nil means it is ok for commands to call `widen' when they want to.
Some commands will do this in order to go to positions outside
to create a line, and moves the cursor to that line. Otherwise it moves the
cursor to the end of the buffer.
+If the variable `line-move-visual' is non-nil, this command moves
+by display lines. Otherwise, it moves by buffer lines, without
+taking variable-width characters or continued lines into account.
+
The command \\[set-goal-column] can be used to create
a semipermanent goal column for this command.
Then instead of trying to move exactly vertically (or as close as possible),
If you are thinking of using this in a Lisp program, consider
using `forward-line' instead. It is usually easier to use
and more reliable (no dependence on goal column, etc.)."
- (interactive "p\np")
+ (interactive "^p\np")
(or arg (setq arg 1))
(if (and next-line-add-newlines (= arg 1))
(if (save-excursion (end-of-line) (eobp))
the cursor is positioned after the character in that line which spans this
column, or at the end of the line if it is not long enough.
+If the variable `line-move-visual' is non-nil, this command moves
+by display lines. Otherwise, it moves by buffer lines, without
+taking variable-width characters or continued lines into account.
+
The command \\[set-goal-column] can be used to create
a semipermanent goal column for this command.
Then instead of trying to move exactly vertically (or as close as possible),
If you are thinking of using this in a Lisp program, consider using
`forward-line' with a negative argument instead. It is usually easier
to use and more reliable (no dependence on goal column, etc.)."
- (interactive "p\np")
+ (interactive "^p\np")
(or arg (setq arg 1))
(if (interactive-p)
(condition-case nil
(defcustom track-eol nil
"*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."
+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."
:type 'boolean
:group 'editing-basics)
(defvar temporary-goal-column 0
"Current goal column for vertical motion.
-It is the column where point was
-at the start of current run of vertical motion commands.
-When the `track-eol' feature is doing its job, the value is `most-positive-fixnum'.")
+It is the column where point was at the start of the current run
+of vertical motion commands. It is a floating point number when
+moving by visual lines via `line-move-visual'; this is the
+x-position, in pixels, divided by the default column width. When
+the `track-eol' feature is doing its job, the value is
+`most-positive-fixnum'.")
(defcustom line-move-ignore-invisible t
"*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines.
:type 'boolean
:group 'editing-basics)
+(defvar line-move-visual t
+ "When non-nil, `line-move' moves point by visual lines.
+This movement is based on where the cursor is displayed on the
+screen, instead of relying on buffer contents alone. It takes
+into account variable-width characters and line continuation.")
+
;; Returns non-nil if partial move was done.
(defun line-move-partial (arg noerror to-end)
(if (< arg 0)
(not executing-kbd-macro)
(line-move-partial arg noerror to-end))
(set-window-vscroll nil 0 t)
- (line-move-1 arg noerror to-end)))
+ (if line-move-visual
+ (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
+;; specified number of lines.
+(defun line-move-visual (arg &optional noerror)
+ (unless (and (floatp temporary-goal-column)
+ (or (memq last-command '(next-line previous-line))
+ ;; In case we're called from some other command.
+ (eq last-command this-command)))
+ (let ((x (car (nth 2 (posn-at-point)))))
+ (when x
+ (setq temporary-goal-column (/ (float x) (frame-char-width))))))
+ (or (= (vertical-motion
+ (cons (or goal-column (truncate temporary-goal-column)) arg))
+ arg)
+ (unless noerror
+ (signal (if (< arg 0)
+ 'beginning-of-buffer
+ 'end-of-buffer)
+ nil))))
;; This is the guts of next-line and previous-line.
;; Arg says how many lines to move.
(= arg 0))
(cond ((> arg 0)
- ;; If we did not move down as far as desired,
- ;; at least go to end of line.
- (end-of-line))
+ ;; If we did not move down as far as desired, at least go
+ ;; to end of line. Be sure to call point-entered and
+ ;; point-left-hooks.
+ (let* ((npoint (prog1 (line-end-position)
+ (goto-char opoint)))
+ (inhibit-point-motion-hooks nil))
+ (goto-char npoint)))
((< arg 0)
;; If we did not move up as far as desired,
;; at least go to beginning of line.
- (beginning-of-line))
+ (let* ((npoint (prog1 (line-beginning-position)
+ (goto-char opoint)))
+ (inhibit-point-motion-hooks nil))
+ (goto-char npoint)))
(t
(line-move-finish (or goal-column temporary-goal-column)
opoint (> orig-arg 0)))))))
With argument ARG not nil or 1, move forward ARG - 1 lines first.
If point reaches the beginning or end of buffer, it stops there.
To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
- (interactive "p")
+ (interactive "^p")
(or arg (setq arg 1))
(let (done)
(while (not done)
(let ((newpos
(save-excursion
- (let ((goal-column 0))
+ (let ((goal-column 0)
+ (line-move-visual nil))
(and (line-move arg t)
(not (bobp))
(progn
(backward-char 1)
(if (and (> (point) newpos) (not (eobp))
(not (eq (following-char) ?\n)))
- ;; If we skipped something intangible
- ;; and now we're not really at eol,
- ;; keep going.
+ ;; If we skipped something intangible and now we're not
+ ;; really at eol, keep going.
(setq arg 1)
(setq done t)))))))
With argument ARG not nil or 1, move forward ARG - 1 lines first.
If point reaches the beginning or end of buffer, it stops there.
To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
- (interactive "p")
+ (interactive "^p")
(or arg (setq arg 1))
(let ((orig (point))
;; Move by lines, if ARG is not 1 (the default).
(if (/= arg 1)
- (line-move (1- arg) t))
+ (let ((line-move-visual nil))
+ (line-move (1- arg) t)))
;; Move to beginning-of-line, ignoring fields and invisibles.
(skip-chars-backward "^\n")
(defun backward-word (&optional arg)
"Move backward until encountering the beginning of a word.
With argument, do this that many times."
- (interactive "p")
+ (interactive "^p")
(forward-word (- (or arg 1))))
(defun mark-word (&optional arg allow-extend)
(interactive "P\np")
(cond ((and allow-extend
(or (and (eq last-command this-command) (mark t))
- (and transient-mark-mode mark-active)))
+ (region-active-p)))
(setq arg (if arg (prefix-numeric-value arg)
(if (< (mark) (point)) -1 1)))
(set-mark
string)
:group 'fill)
(make-variable-buffer-local 'fill-prefix)
-;;;###autoload(put 'fill-prefix 'safe-local-variable 'string-or-null-p)
+(put 'fill-prefix 'safe-local-variable 'string-or-null-p)
(defcustom auto-fill-inhibit-regexp nil
"*Regexp to match lines which should not be auto-filled."
"Set `fill-column' to specified argument.
Use \\[universal-argument] followed by a number to specify a column.
Just \\[universal-argument] as argument means to use the current column."
- (interactive "P")
+ (interactive
+ (list (or current-prefix-arg
+ ;; We used to use current-column silently, but C-x f is too easily
+ ;; typed as a typo for C-x C-f, so we turned it into an error and
+ ;; now an interactive prompt.
+ (read-number "Set fill-column to: " (current-column)))))
(if (consp arg)
(setq arg (current-column)))
(if (not (integerp arg))
"Toggle whether to fold or truncate long lines for the current buffer.
With prefix argument ARG, truncate long lines if ARG is positive,
otherwise don't truncate them. Note that in side-by-side
-windows, truncation is always enabled."
+windows, this command has no effect if `truncate-partial-width-windows'
+is non-nil."
(interactive "P")
(setq truncate-lines
(if (null arg)
(abort-recursive-edit))
(current-prefix-arg
nil)
- ((and transient-mark-mode mark-active)
+ ((region-active-p)
(deactivate-mark))
((> (recursion-depth) 0)
(exit-recursive-edit))
\f
;; Define the major mode for lists of completions.
-(defvar completion-list-mode-map nil
+(defvar completion-list-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-2] 'mouse-choose-completion)
+ (define-key map [follow-link] 'mouse-face)
+ (define-key map [down-mouse-2] nil)
+ (define-key map "\C-m" 'choose-completion)
+ (define-key map "\e\e\e" 'delete-completion-window)
+ (define-key map [left] 'previous-completion)
+ (define-key map [right] 'next-completion)
+ map)
"Local map for completion list buffers.")
-(or completion-list-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [mouse-2] 'mouse-choose-completion)
- (define-key map [follow-link] 'mouse-face)
- (define-key map [down-mouse-2] nil)
- (define-key map "\C-m" 'choose-completion)
- (define-key map "\e\e\e" 'delete-completion-window)
- (define-key map [left] 'previous-completion)
- (define-key map [right] 'next-completion)
- (setq completion-list-mode-map map)))
;; Completion mode is suitable only for specially formatted data.
(put 'completion-list-mode 'mode-class 'special)
'choose-completion-string-functions
choice buffer mini-p base-size)
;; Insert the completion into the buffer where it was requested.
+ ;; FIXME:
+ ;; - There may not be a field at point, or there may be a field but
+ ;; it's not a "completion field", in which case we have to
+ ;; call choose-completion-delete-max-match even if base-size is set.
+ ;; - we may need to delete further than (point) to (field-end),
+ ;; depending on the completion-style, and for that we need to
+ ;; extra data `completion-extra-size'.
(if base-size
- (delete-region (+ base-size (if mini-p
- (minibuffer-prompt-end)
- (point-min)))
- (point))
+ (delete-region (+ base-size (field-beginning)) (point))
(choose-completion-delete-max-match choice))
(insert choice)
(remove-text-properties (- (point) (length choice)) (point)
(set-window-point window (point)))
;; If completing for the minibuffer, exit it with this choice.
(and (not completion-no-auto-exit)
- (equal buffer (window-buffer (minibuffer-window)))
+ (minibufferp buffer)
minibuffer-completion-table
;; If this is reading a file name, and the file name chosen
;; is a directory, don't exit the minibuffer.
- (if (and (eq minibuffer-completion-table 'read-file-name-internal)
+ (if (and minibuffer-completing-file-name
(file-directory-p (field-string (point-max))))
(let ((mini (active-minibuffer-window)))
(select-window mini)
(raise-frame (window-frame mini))))
(exit-minibuffer)))))))
-(defun completion-list-mode ()
+(define-derived-mode completion-list-mode nil "Completion List"
"Major mode for buffers showing lists of possible completions.
Type \\<completion-list-mode-map>\\[choose-completion] in the completion list\
to select the completion near point.
with the mouse.
\\{completion-list-mode-map}"
-
- (interactive)
- (kill-all-local-variables)
- (use-local-map completion-list-mode-map)
- (setq mode-name "Completion List")
- (setq major-mode 'completion-list-mode)
- (make-local-variable 'completion-base-size)
- (setq completion-base-size nil)
- (run-mode-hooks 'completion-list-mode-hook))
+ (set (make-local-variable 'completion-base-size) nil))
(defun completion-list-mode-finish ()
"Finish setup of the completions buffer.
(add-hook 'temp-buffer-show-hook 'completion-list-mode-finish)
-(defvar completion-setup-hook nil
- "Normal hook run at the end of setting up a completion list buffer.
-When this hook is run, the current buffer is the one in which the
-command to display the completion list buffer was run.
-The completion list buffer is available as the value of `standard-output'.
-The common prefix substring for completion may be available as the
-value of `completion-common-substring'. See also `display-completion-list'.")
-
;; Variables and faces used in `completion-setup-function'.
:version "22.1"
:group 'completion)
-(defface completions-first-difference
- '((t (:inherit bold)))
- "Face put on the first uncommon character in completions in *Completions* buffer."
- :group 'completion)
-
-(defface completions-common-part
- '((t (:inherit default)))
- "Face put on the common prefix substring in completions in *Completions* buffer.
-The idea of `completions-common-part' is that you can use it to
-make the common parts less visible than normal, so that the rest
-of the differing parts is, by contrast, slightly highlighted."
- :group 'completion)
-
;; This is for packages that need to bind it to a non-default regexp
;; in order to make the first-differing character highlight work
;; to their liking
(defvar completion-root-regexp "^/"
"Regexp to use in `completion-setup-function' to find the root directory.")
-(defvar completion-common-substring nil
- "Common prefix substring to use in `completion-setup-function' to put faces.
-The value is set by `display-completion-list' during running `completion-setup-hook'.
-
-To put faces `completions-first-difference' and `completions-common-part'
-in the `*Completions*' buffer, the common prefix substring in completions
-is needed as a hint. (The minibuffer is a special case. The content
-of the minibuffer before point is always the common substring.)")
-
;; This function goes in completion-setup-hook, so that it is called
;; after the text of the completion list buffer is written.
(defun completion-setup-function ()
(setq default-directory
(file-name-directory (expand-file-name mbuf-contents)))))
(with-current-buffer standard-output
- (completion-list-mode)
+ (let ((base-size completion-base-size)) ;Read before killing localvars.
+ (completion-list-mode)
+ (set (make-local-variable 'completion-base-size) base-size))
(set (make-local-variable 'completion-reference-buffer) mainbuf)
- (setq completion-base-size
- (cond
- ((and (symbolp minibuffer-completion-table)
- (get minibuffer-completion-table 'completion-base-size-function))
- ;; To compute base size, a function can use the global value of
- ;; completion-common-substring or minibuffer-completion-contents.
- (with-current-buffer mainbuf
- (funcall (get minibuffer-completion-table
- 'completion-base-size-function))))
- (minibuffer-completing-file-name
- ;; For file name completion, use the number of chars before
- ;; the start of the file name component at point.
- (with-current-buffer mainbuf
- (save-excursion
- (skip-chars-backward completion-root-regexp)
- (- (point) (minibuffer-prompt-end)))))
- (minibuffer-completing-symbol nil)
- ;; Otherwise, in minibuffer, the base size is 0.
- ((minibufferp mainbuf) 0)))
- (setq common-string-length
- (cond
- (completion-common-substring
- (length completion-common-substring))
- (completion-base-size
- (- (length mbuf-contents) completion-base-size))))
- ;; Put faces on first uncommon characters and common parts.
- (when (and (integerp common-string-length) (>= common-string-length 0))
- (let ((element-start (point-min))
- (maxp (point-max))
- element-common-end)
- (while (and (setq element-start
- (next-single-property-change
- element-start 'mouse-face))
- (< (setq element-common-end
- (+ element-start common-string-length))
- maxp))
- (when (get-char-property element-start 'mouse-face)
- (if (and (> common-string-length 0)
- (get-char-property (1- element-common-end) 'mouse-face))
- (put-text-property element-start element-common-end
- 'font-lock-face 'completions-common-part))
- (if (get-char-property element-common-end 'mouse-face)
- (put-text-property element-common-end (1+ element-common-end)
- 'font-lock-face 'completions-first-difference))))))
+ (unless completion-base-size
+ ;; This may be needed for old completion packages which don't use
+ ;; completion-all-completions-with-base-size yet.
+ (setq completion-base-size
+ (cond
+ (minibuffer-completing-file-name
+ ;; For file name completion, use the number of chars before
+ ;; the start of the file name component at point.
+ (with-current-buffer mainbuf
+ (save-excursion
+ (skip-chars-backward completion-root-regexp)
+ (- (point) (minibuffer-prompt-end)))))
+ (minibuffer-completing-symbol nil)
+ ;; Otherwise, in minibuffer, the base size is 0.
+ ((minibufferp mainbuf) 0))))
;; Maybe insert help string.
(when completion-show-help
(goto-char (point-min))
(set-terminal-parameter nil 'normal-erase-is-backspace
(if enabled 1 0))
- (cond ((or (memq window-system '(x w32 mac pc))
+ (cond ((or (memq window-system '(x w32 mac ns pc))
(memq system-type '(ms-dos windows-nt)))
(let* ((bindings
`(([C-delete] [C-backspace])
HCoop / bpt / emacs.git / blobdiff