;; 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)))
digits are interpreted as a character code. This is intended to be
useful for editing binary files."
(interactive "*p")
- (let* ((char (if (or (not overwrite-mode)
- (eq overwrite-mode 'overwrite-mode-binary))
- (read-quoted-char)
- (read-char))))
+ (let* ((char (let (translation-table-for-input input-method-function)
+ (if (or (not overwrite-mode)
+ (eq overwrite-mode 'overwrite-mode-binary))
+ (read-quoted-char)
+ (read-char)))))
;; Assume character codes 0240 - 0377 stand for characters in some
;; single-byte character set, and convert them to Emacs
;; characters.
(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].
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: ")
+ (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))))
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")
'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.
: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 ()
(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))))))
;; 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])