;; 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:
(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)))
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)
In an interactive call, the variable `shell-command-default-error-buffer'
specifies the value of ERROR-BUFFER."
- (interactive (list (read-shell-command "Shell command: ")
- 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)
(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].
(t (activate-mark)))
nil))
-(defun handle-shift-selection ()
+(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
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."
- (cond (this-command-keys-shift-translated
+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
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),
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),
(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)))))))
(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)))))))
;; 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")
"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)
\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])