;;; simple.el --- basic editing commands for Emacs
;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
;; Free Software Foundation, Inc.
;; Maintainer: FSF
(car list)))
(defun last-buffer (&optional buffer visible-ok frame)
- "Return the last non-hidden displayable buffer in the buffer list.
-If BUFFER is non-nil, last-buffer will ignore that buffer.
+ "Return the last buffer in FRAME's buffer list.
+If BUFFER is the last buffer, return the preceding buffer instead.
Buffers not visible in windows are preferred to visible buffers,
unless optional argument VISIBLE-OK is non-nil.
-If the optional third argument FRAME is non-nil, use that frame's
-buffer list instead of the selected frame's buffer list.
-If no other buffer exists, the buffer `*scratch*' is returned."
+Optional third argument FRAME nil or omitted means use the
+selected frame's buffer list.
+If no such buffer exists, return the buffer `*scratch*', creating
+it if necessary."
(setq frame (or frame (selected-frame)))
(or (get-next-valid-buffer (nreverse (buffer-list frame))
buffer visible-ok frame)
- (progn
- (set-buffer-major-mode (get-buffer-create "*scratch*"))
- (get-buffer "*scratch*"))))
+ (get-buffer "*scratch*")
+ (let ((scratch (get-buffer-create "*scratch*")))
+ (set-buffer-major-mode scratch)
+ scratch)))
+
(defun next-buffer ()
"Switch to the next buffer in cyclic order."
(interactive)
Major modes providing compile-like functionality should set this variable
to indicate to `next-error' that this is a candidate buffer and how
to navigate in it.")
-
(make-variable-buffer-local 'next-error-function)
+(defvar next-error-move-function nil
+ "Function to use to move to an error locus.
+It takes two arguments, a buffer position in the error buffer
+and a buffer position in the error locus buffer.
+The buffer for the error locus should already be current.
+nil means use goto-char using the second argument position.")
+(make-variable-buffer-local 'next-error-move-function)
+
(defsubst next-error-buffer-p (buffer
&optional avoid-current
extra-test-inclusive
(interactive "p")
(next-error-no-select (- (or n 1))))
-;;; Internal variable for `next-error-follow-mode-post-command-hook'.
+;; Internal variable for `next-error-follow-mode-post-command-hook'.
(defvar next-error-follow-last-line nil)
(define-minor-mode next-error-follow-minor-mode
(add-hook 'post-command-hook 'next-error-follow-mode-post-command-hook nil t)
(make-local-variable 'next-error-follow-last-line)))
-;;; Used as a `post-command-hook' by `next-error-follow-mode'
-;;; for the *Compilation* *grep* and *Occur* buffers.
+;; Used as a `post-command-hook' by `next-error-follow-mode'
+;; for the *Compilation* *grep* and *Occur* buffers.
(defun next-error-follow-mode-post-command-hook ()
(unless (equal next-error-follow-last-line (line-number-at-pos))
(setq next-error-follow-last-line (line-number-at-pos))
;; Making and deleting lines.
-(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard)))
+(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
+ "Propertized string representing a hard newline character.")
(defun newline (&optional arg)
"Insert a newline, and move to left margin of the new line if it's blank.
(beforepos (point)))
(if flag (backward-char 1))
;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
- ;; Set last-command-char to tell self-insert what to insert.
- (let ((last-command-char ?\n)
+ ;; Set last-command-event to tell self-insert what to insert.
+ (let ((last-command-event ?\n)
;; Don't auto-fill if we have a numeric argument.
;; Also not if flag is true (it would fill wrong line);
;; there is no need to since we're at BOL.
digits are interpreted as a character code. This is intended to be
useful for editing binary files."
(interactive "*p")
- (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)))))
+ (let* ((char
+ ;; Avoid "obsolete" warnings for translation-table-for-input.
+ (with-no-warnings
+ (let (translation-table-for-input input-method-function)
+ (if (or (not overwrite-mode)
+ (eq overwrite-mode 'overwrite-mode-binary))
+ (read-quoted-char)
+ (read-char))))))
;; This used to assume character codes 0240 - 0377 stand for
;; characters in some single-byte character set, and converted them
;; to Emacs characters. But in 23.1 this feature is deprecated
"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. When called from Lisp code, the optional argument BUFFER
-specifies a buffer to switch to.
+move point in the most recently selected other buffer, and switch to it.
+
+If there's a number in the buffer at point, it is the default for LINE.
-If there's a number in the buffer at point, it is the default for
-LINE."
+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))
+If at all possible, an even better solution is to use char counts
+rather than line counts."
(interactive
(if (and current-prefix-arg (not (consp current-prefix-arg)))
(list (prefix-numeric-value current-prefix-arg))
;; Move to the specified line number in that buffer.
(save-restriction
(widen)
- (goto-char 1)
+ (goto-char (point-min))
(if (eq selective-display t)
(re-search-forward "[\n\C-m]" nil 'end (1- line))
(forward-line (1- line)))))
encoded encoding-msg display-prop under-display)
(if (or (not coding)
(eq (coding-system-type coding) t))
- (setq coding default-buffer-file-coding-system))
+ (setq coding (default-value 'buffer-file-coding-system)))
(if (eq (char-charset char) 'eight-bit)
(setq encoding-msg
(format "(%d, #o%o, #x%x, raw-byte)" char char char))
(defvar minibuffer-completing-symbol nil
"Non-nil means completing a Lisp symbol in the minibuffer.")
+(defvar minibuffer-default nil
+ "The current default value or list of default values in the minibuffer.
+The functions `read-from-minibuffer' and `completing-read' bind
+this variable locally.")
+
(defcustom eval-expression-print-level 4
"Value for `print-level' while printing value in `eval-expression'.
A value of nil means no limit."
&optional eval-expression-insert-value)
"Evaluate EVAL-EXPRESSION-ARG and print value in the echo area.
Value is also consed on to front of the variable `values'.
-Optional argument EVAL-EXPRESSION-INSERT-VALUE, if non-nil, means
-insert the result into the current buffer instead of printing it in
-the echo area.
+Optional argument EVAL-EXPRESSION-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'
+and `eval-expression-print-level'.
If `eval-expression-debug-on-error' is non-nil, which is the default,
this command arranges for all errors to enter the debugger."
"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
\f
;Put this on C-x u, so we can force that rather than C-_ into startup msg
-(defalias 'advertised-undo 'undo)
+(define-obsolete-function-alias 'advertised-undo 'undo "23.2")
(defconst undo-equiv-table (make-hash-table :test 'eq :weakness t)
"Table mapping redo records to the corresponding undo one.
;; In the ordinary case (not within a region), map the redo
;; record to the following undos.
;; I don't know how to do that in the undo-in-region case.
- (puthash buffer-undo-list
- (if undo-in-region t pending-undo-list)
- undo-equiv-table)
+ (let ((list buffer-undo-list))
+ ;; Strip any leading undo boundaries there might be, like we do
+ ;; above when checking.
+ (while (eq (car list) nil)
+ (setq list (cdr list)))
+ (puthash list (if undo-in-region t pending-undo-list)
+ undo-equiv-table))
;; Don't specify a position in the undo record for the undo command.
;; Instead, undoing this should move point to where the change is.
(let ((tail buffer-undo-list)
probably due to a bug and you should report it.
You can disable the popping up of this buffer by adding the entry
-\(undo discard-info) to the user option `warning-suppress-types'.\n")
+\(undo discard-info) to the user option `warning-suppress-types',
+which is defined in the `warnings' library.\n")
:warning)
(setq buffer-undo-list nil)
t))
stdout will be intermixed in the output stream.")
(declare-function mailcap-file-default-commands "mailcap" (files))
+(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
(defun minibuffer-default-add-shell-commands ()
- "Return a list of all commands associted with the current file.
+ "Return a list of all commands associated with the current file.
This function is used to add all related commands retrieved by `mailcap'
to the end of the list of defaults just after the default value."
(interactive)
(or hist 'shell-command-history)
args)))
+(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.
+The output appears in the buffer `*Async Shell Command*'."
+ (interactive
+ (list
+ (read-shell-command "Async shell command: " nil nil
+ (and buffer-file-name
+ (file-relative-name buffer-file-name)))
+ current-prefix-arg
+ shell-command-default-error-buffer))
+ (unless (string-match "&[ \t]*\\'" command)
+ (setq command (concat command " &")))
+ (shell-command command output-buffer error-buffer))
+
(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.
(interactive
(list
(read-shell-command "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))
;; Look for a handler in case default-directory is a remote file name.
(setq mode-line-process '(":%s"))
(require 'shell) (shell-mode)
(set-process-sentinel proc 'shell-command-sentinel)
+ ;; Use the comint filter for proper handling of carriage motion
+ ;; (see `comint-inhibit-carriage-motion'),.
+ (set-process-filter proc 'comint-output-filter)
))
+ ;; Otherwise, command is executed synchronously.
(shell-command-on-region (point) (point) command
output-buffer nil error-buffer)))))))
(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
+call of `process-file' could potentially change any file on a
+remote host. When set to `nil', a file handler could optimize
+its behaviour with respect to remote file attributes caching.
+
+This variable should never be changed by `setq'. Instead of, it
+shall be set only by let-binding.")
+
(defun start-file-process (name buffer program &rest program-args)
"Start a program in a subprocess. Return the process object for it.
the working directory of the process.
PROGRAM and PROGRAM-ARGS might be file names. They are not
-objects of file handler invocation."
+objects of file handler invocation. File handlers might not
+support pty association, if PROGRAM is nil."
(let ((fh (find-file-name-handler default-directory 'start-file-process)))
(if fh (apply fh 'start-file-process name buffer program program-args)
(apply 'start-process name buffer program program-args))))
"Part of the numeric argument for the next command.
\\[universal-argument] following digits or minus sign ends the argument."
(interactive "P")
- (let* ((char (if (integerp last-command-char)
- last-command-char
- (get last-command-char 'ascii-character)))
+ (let* ((char (if (integerp last-command-event)
+ last-command-event
+ (get last-command-event 'ascii-character)))
(digit (- (logand char ?\177) ?0)))
(cond ((integerp arg)
(setq prefix-arg (+ (* arg 10)
(defvar kill-ring-yank-pointer nil
"The tail of the kill ring whose car is the last thing yanked.")
+(defcustom save-interprogram-paste-before-kill nil
+ "Save the paste strings into `kill-ring' before replacing it with emacs strings.
+When one selects something in another program to paste it into Emacs,
+but kills something in Emacs before actually pasting it,
+this selection is gone unless this variable is non-nil,
+in which case the other program's selection is saved in the `kill-ring'
+before the Emacs kill and one can still paste it using \\[yank] \\[yank-pop]."
+ :type 'boolean
+ :group 'killing
+ :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."
+ :type 'boolean
+ :group 'killing
+ :version "23.2")
+
(defun kill-new (string &optional replace yank-handler)
"Make STRING the latest kill in the kill ring.
Set `kill-ring-yank-pointer' to point to it.
When a yank handler is specified, STRING must be non-empty (the yank
handler, if non-nil, is stored as a `yank-handler' text property on STRING).
+When `save-interprogram-paste-before-kill' and `interprogram-paste-function'
+are non-nil, saves the interprogram paste string(s) into `kill-ring' before
+STRING.
+
When the yank handler has a non-nil PARAM element, the original STRING
argument is not used by `insert-for-yank'. However, since Lisp code
may access and use elements from the kill ring directly, the STRING
(if yank-handler
(signal 'args-out-of-range
(list string "yank-handler specified for empty string"))))
+ (when (and kill-do-not-save-duplicates
+ (equal string (car kill-ring)))
+ (setq replace t))
(if (fboundp 'menu-bar-update-yank-menu)
(menu-bar-update-yank-menu string (and replace (car kill-ring))))
+ (when save-interprogram-paste-before-kill
+ (let ((interprogram-paste (and interprogram-paste-function
+ (funcall interprogram-paste-function))))
+ (when interprogram-paste
+ (if (listp interprogram-paste)
+ (dolist (s (nreverse interprogram-paste))
+ (push s kill-ring))
+ (push interprogram-paste kill-ring)))))
(if (and replace kill-ring)
(setcar kill-ring string)
(push string kill-ring)
visual feedback indicating the extent of the region being copied."
(interactive "r")
(copy-region-as-kill beg end)
- ;; This use of interactive-p is correct
+ ;; This use of called-interactively-p is correct
;; because the code it controls just gives the user visual feedback.
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(let ((other-end (if (= (point) beg) end beg))
(opoint (point))
;; Inhibit quitting so we can make a quit here
(defun kill-forward-chars (arg)
(if (listp arg) (setq arg (car arg)))
(if (eq arg '-) (setq arg -1))
- (kill-region (point) (forward-point arg)))
+ (kill-region (point) (+ (point) arg)))
;; Internal subroutine of backward-delete-char
(defun kill-backward-chars (arg)
(if (listp arg) (setq arg (car arg)))
(if (eq arg '-) (setq arg -1))
- (kill-region (point) (forward-point (- arg))))
+ (kill-region (point) (- (point) arg)))
(defcustom backward-delete-char-untabify-method 'untabify
"The method for untabifying when deleting backward.
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)))
+ ;; 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))))
\(This is meant to make \\[repeat] work well with negative arguments.\)
If ARG is zero, kill current line but exclude the trailing newline."
(interactive "p")
+ (or arg (setq arg 1))
(if (and (> arg 0) (eobp) (save-excursion (forward-visible-line 0) (eobp)))
(signal 'end-of-buffer nil))
(if (and (< arg 0) (bobp) (save-excursion (end-of-visible-line) (bobp)))
(insert-buffer-substring oldbuf start end)))))
\f
(put 'mark-inactive 'error-conditions '(mark-inactive error))
-(put 'mark-inactive 'error-message "The mark is not active now")
+(put 'mark-inactive 'error-message (purecopy "The mark is not active now"))
(defvar activate-mark-hook nil
"Hook run when the mark becomes active.
(marker-position (mark-marker))
(signal 'mark-inactive nil)))
+(defcustom select-active-regions nil
+ "If non-nil, an active region automatically becomes the window selection."
+ :type 'boolean
+ :group 'killing
+ :version "23.1")
+
;; Many places set mark-active directly, and several of them failed to also
;; run deactivate-mark-hook. This shorthand should simplify.
-(defsubst deactivate-mark ()
+(defsubst deactivate-mark (&optional force)
"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'."
- (when transient-mark-mode
- (if (or (eq transient-mark-mode 'lambda)
- (and (eq (car-safe transient-mark-mode) 'only)
- (null (cdr transient-mark-mode))))
+Unless FORCE is non-nil, this function does nothing if Transient
+Mark mode is disabled.
+This function also runs `deactivate-mark-hook'."
+ (when (or transient-mark-mode force)
+ ;; Copy the latest region into the primary selection, if desired.
+ (and select-active-regions
+ mark-active
+ (display-selections-p)
+ (x-selection-owner-p 'PRIMARY)
+ (x-set-selection 'PRIMARY (buffer-substring-no-properties
+ (region-beginning) (region-end))))
+ (if (and (null force)
+ (or (eq transient-mark-mode 'lambda)
+ (and (eq (car-safe transient-mark-mode) 'only)
+ (null (cdr transient-mark-mode)))))
+ ;; When deactivating a temporary region, don't change
+ ;; `mark-active' or run `deactivate-mark-hook'.
(setq transient-mark-mode nil)
(if (eq (car-safe transient-mark-mode) 'only)
(setq transient-mark-mode (cdr transient-mark-mode)))
(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."
- :type 'boolean
- :group 'killing
- :version "23.1")
+ (setq transient-mark-mode 'lambda))
+ (when (and select-active-regions
+ (display-selections-p))
+ (x-set-selection 'PRIMARY (current-buffer)))))
(defun set-mark (pos)
"Set this buffer's mark to POS. Don't use this function!
(progn
(setq mark-active t)
(run-hooks 'activate-mark-hook)
- (and select-active-regions
- (x-set-selection
- nil (buffer-substring (region-beginning) (region-end))))
+ (when (and select-active-regions
+ (display-selections-p))
+ (x-set-selection 'PRIMARY (current-buffer)))
(set-marker (mark-marker) pos (current-buffer)))
;; Normally we never clear mark-active except in Transient Mark mode.
- ;; But when we actually clear out the mark value too,
- ;; we must clear mark-active in any mode.
- (setq mark-active nil)
- (run-hooks 'deactivate-mark-hook)
+ ;; But when we actually clear out the mark value too, we must
+ ;; clear mark-active in any mode.
+ (deactivate-mark t)
(set-marker (mark-marker) nil)))
(defcustom use-empty-active-region nil
(defun use-region-p ()
"Return t if the region is active and it is appropriate to act on it.
This is used by commands that act specially on the region under
-Transient Mark mode. It returns t if and only if Transient Mark
-mode is enabled, the mark is active, and the region is non-empty.
-If `use-empty-active-region' is non-nil, it returns t even if the
-region is empty.
+Transient Mark mode.
+
+The return value is t provided Transient Mark mode is enabled and
+the mark is active; and, when `use-empty-active-region' is
+non-nil, provided the region is empty. Otherwise, the return
+value is nil.
-For some commands, it may be appropriate to disregard the value
-of `use-empty-active-region'; in that case, use `region-active-p'."
+For some commands, it may be appropriate to ignore the value of
+`use-empty-active-region'; in that case, use `region-active-p'."
(and (region-active-p)
(or use-empty-active-region (> (region-end) (region-beginning)))))
(defun region-active-p ()
"Return t if Transient Mark mode is enabled and the mark is active.
-Most commands that act on the region if it is active and
-Transient Mark mode is enabled, and on the text near point
-otherwise, should use `use-region-p' instead. That function
-checks the value of `use-empty-active-region' as well."
+Some commands act specially on the region when Transient Mark
+mode is enabled. Usually, such commands should use
+`use-region-p' instead of this function, because `use-region-p'
+also checks the value of `use-empty-active-region'."
(and transient-mark-mode mark-active))
(defvar mark-ring nil
(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))))
+(defcustom shift-select-mode t
+ "When non-nil, shifted motion keys activate the mark momentarily.
+
+While the mark is activated in this way, any shift-translated point
+motion key extends the region, and if Transient Mark mode was off, it
+is temporarily turned on. Furthermore, the mark will be deactivated
+by any subsequent point motion key that was not shift-translated, or
+by any action that normally deactivates the mark in Transient Mark mode.
+
+See `this-command-keys-shift-translated' for the meaning of
+shift-translation."
+ :type 'boolean
+ :group 'editing-basics)
+
+(defun handle-shift-selection ()
+ "Activate/deactivate mark depending on invocation thru shift translation.
+This function is called by `call-interactively' when a command
+with a `^' character in its `interactive' spec is invoked, before
+running the command itself.
+
+If `shift-select-mode' is enabled and the command was invoked
+through shift translation, set the mark and activate the region
+temporarily, unless it was already set in this way. See
+`this-command-keys-shift-translated' for the meaning of shift
+translation.
+
+Otherwise, if the region has been activated temporarily,
+deactivate it, and restore the variable `transient-mark-mode' to
+its earlier value."
+ (cond ((and shift-select-mode this-command-keys-shift-translated)
+ (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.
commands which are sensitive to the Transient Mark mode."
:global t
:init-value (not noninteractive)
+ :initialize 'custom-initialize-delay
:group 'editing-basics)
;; The variable transient-mark-mode is ugly: it can take on special
(end-of-line)
(insert (if use-hard-newlines hard-newline "\n")))
(line-move arg nil nil try-vscroll))
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(condition-case nil
(line-move arg nil nil try-vscroll)
((beginning-of-buffer end-of-buffer) (ding)))
to use and more reliable (no dependence on goal column, etc.)."
(interactive "^p\np")
(or arg (setq arg 1))
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(condition-case nil
(line-move (- arg) nil nil try-vscroll)
((beginning-of-buffer end-of-buffer) (ding)))
(defvar temporary-goal-column 0
"Current goal column for vertical motion.
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
+of vertical motion commands.
+
+When moving by visual lines via `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.
+
+When the `track-eol' feature is doing its job, the value is
`most-positive-fixnum'.")
(defcustom line-move-ignore-invisible t
;; 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))))
+ (let ((opoint (point))
+ (hscroll (window-hscroll))
+ target-hscroll)
+ ;; Check if the previous command was a line-motion command, or if
+ ;; we were called from some other command.
+ (if (and (consp temporary-goal-column)
+ (memq last-command `(next-line previous-line ,this-command)))
+ ;; If so, there's no need to reset `temporary-goal-column',
+ ;; but we may need to hscroll.
+ (if (or (/= (cdr temporary-goal-column) hscroll)
+ (> (cdr temporary-goal-column) 0))
+ (setq target-hscroll (cdr temporary-goal-column)))
+ ;; Otherwise, we should reset `temporary-goal-column'.
+ (let ((posn (posn-at-point)))
+ (cond
+ ;; Handle the `overflow-newline-into-fringe' case:
+ ((eq (nth 1 posn) 'right-fringe)
+ (setq temporary-goal-column (cons (- (window-width) 1) hscroll)))
+ ((car (posn-x-y posn))
+ (setq temporary-goal-column
+ (cons (/ (float (car (posn-x-y posn)))
+ (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)
+ (truncate (car temporary-goal-column))
+ temporary-goal-column))
+ arg))
+ arg)
+ (or (>= arg 0)
+ (/= (point) opoint)
+ ;; If the goal column lies on a display string,
+ ;; `vertical-motion' advances the cursor to the end
+ ;; of the string. For arg < 0, this can cause the
+ ;; cursor to get stuck. (Bug#3020).
+ (= (vertical-motion 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.
(let ((inhibit-point-motion-hooks t)
(opoint (point))
(orig-arg arg))
- (if (floatp temporary-goal-column)
- (setq temporary-goal-column (truncate temporary-goal-column)))
+ (if (consp temporary-goal-column)
+ (setq temporary-goal-column (+ (car temporary-goal-column)
+ (cdr temporary-goal-column))))
(unwind-protect
(progn
(if (not (memq last-command '(next-line previous-line)))
(point))))
;; Move to the desired column.
- (line-move-to-column column)
+ (line-move-to-column (truncate column))
;; Corner case: suppose we start out in a field boundary in
;; the middle of a continued line. When we get to
(defun move-end-of-line (arg)
"Move point to end of current line as displayed.
-\(If there's an image in the line, this disregards newlines
-which are part of the text that the image rests on.)
-
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."
+
+To ignore the effects of the `intangible' text or overlay
+property, bind `inhibit-point-motion-hooks' to t.
+If there is an image in the current line, this function
+disregards newlines that are part of the text on which the image
+rests."
(interactive "^p")
(or arg (setq arg 1))
(let (done)
(/= arg 1) t nil)))))
-;;; Many people have said they rarely use this feature, and often type
-;;; it by accident. Maybe it shouldn't even be on a key.
+;; Many people have said they rarely use this feature, and often type
+;; it by accident. Maybe it shouldn't even be on a key.
(put 'set-goal-column 'disabled t)
(defun set-goal-column (arg)
(defun kill-visual-line (&optional arg)
"Kill the rest of the visual line.
-If there are only whitespace characters there, kill through the
-newline as well.
-
-With prefix argument ARG, kill that many lines from point.
-Negative arguments kill lines backward.
-With zero argument, kill the text before point on the current line.
-
-When calling from a program, nil means \"no arg\",
-a number counts as a prefix arg.
-
-If `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 \\[beginning-of-line] \\[kill-line].
+With prefix argument ARG, kill that many visual lines from point.
+If ARG is negative, kill visual lines backward.
+If ARG is zero, kill the text before point on the current visual
+line.
If you want to append the killed line to the last killed text,
use \\[append-next-kill] before \\[kill-line].
\(If the variable `kill-read-only-ok' is non-nil, then this won't
even beep.)"
(interactive "P")
+ ;; Like in `kill-line', it's better to move point to the other end
+ ;; of the kill before killing.
(let ((opoint (point))
- (line-move-visual t)
- end)
- ;; It is better to move point to the other end of the kill before
- ;; killing. That way, in a read-only buffer, point moves across
- ;; the text that is copied to the kill ring. The choice has no
- ;; effect on undo now that undo records the value of point from
- ;; before the command was run.
+ (kill-whole-line (and kill-whole-line (bolp))))
(if arg
(vertical-motion (prefix-numeric-value arg))
- (if (eobp)
- (signal 'end-of-buffer nil))
- (setq end (save-excursion
- (end-of-visual-line) (point)))
- (if (or (save-excursion
- ;; If trailing whitespace is visible,
- ;; don't treat it as nothing.
- (unless show-trailing-whitespace
- (skip-chars-forward " \t" end))
- (= (point) end))
- (and kill-whole-line (bolp)))
- (line-move 1)
- (goto-char end)))
- (kill-region opoint (point))))
+ (end-of-visual-line 1)
+ (if (= (point) opoint)
+ (vertical-motion 1)
+ ;; Skip any trailing whitespace at the end of the visual line.
+ ;; We used to do this only if `show-trailing-whitespace' is
+ ;; nil, but that's wrong; the correct thing would be to check
+ ;; whether the trailing whitespace is highlighted. But, it's
+ ;; OK to just do this unconditionally.
+ (skip-chars-forward " \t")))
+ (kill-region opoint (if (and kill-whole-line (looking-at "\n"))
+ (1+ (point))
+ (point)))))
(defun next-logical-line (&optional arg try-vscroll)
"Move cursor vertically down ARG lines.
(define-key map [remap kill-line] 'kill-visual-line)
(define-key map [remap move-beginning-of-line] 'beginning-of-visual-line)
(define-key map [remap move-end-of-line] 'end-of-visual-line)
- (define-key map "\M-[" 'previous-logical-line)
- (define-key map "\M-]" 'next-logical-line)
+ ;; These keybindings interfere with xterm function keys. Are
+ ;; there any other suitable bindings?
+ ;; (define-key map "\M-[" 'previous-logical-line)
+ ;; (define-key map "\M-]" 'next-logical-line)
map))
(defcustom visual-line-fringe-indicators '(nil nil)
((= arg 0)
(save-excursion
(setq pos1 (funcall aux 1))
- (goto-char (mark))
+ (goto-char (or (mark) (error "No mark set in this buffer")))
(setq pos2 (funcall aux 1))
(transpose-subr-1 pos1 pos2))
(exchange-point-and-mark))
Some major modes set this.")
(put 'auto-fill-function :minor-mode-function 'auto-fill-mode)
+;; `functions' and `hooks' are usually unsafe to set, but setting
+;; auto-fill-function to nil in a file-local setting is safe and
+;; can be useful to prevent auto-filling.
+(put 'auto-fill-function 'safe-local-variable 'null)
;; FIXME: turn into a proper minor mode.
;; Add a global minor mode version of it.
(defun auto-fill-mode (&optional arg)
(message "Truncate long lines %s"
(if truncate-lines "enabled" "disabled")))
-(defvar overwrite-mode-textual " Ovwrt"
+(defun toggle-word-wrap (&optional arg)
+ "Toggle whether to use word-wrapping for continuation lines.
+With prefix argument ARG, wrap continuation lines at word boundaries
+if ARG is positive, otherwise wrap them at the right screen edge.
+This command toggles the value of `word-wrap'. It has no effect
+if long lines are truncated."
+ (interactive "P")
+ (setq word-wrap
+ (if (null arg)
+ (not word-wrap)
+ (> (prefix-numeric-value arg) 0)))
+ (force-mode-line-update)
+ (message "Word wrapping %s"
+ (if word-wrap "enabled" "disabled")))
+
+(defvar overwrite-mode-textual (purecopy " Ovwrt")
"The string displayed in the mode line when in overwrite mode.")
-(defvar overwrite-mode-binary " Bin Ovwrt"
+(defvar overwrite-mode-binary (purecopy " Bin Ovwrt")
"The string displayed in the mode line when in binary overwrite mode.")
(defun overwrite-mode (arg)
:type 'boolean
:group 'paren-blinking)
-(defcustom blink-matching-paren-distance (* 25 1024)
+(defcustom blink-matching-paren-distance (* 100 1024)
"If non-nil, maximum distance to search backwards for matching open-paren.
If nil, search stops at the beginning of the accessible portion of the buffer."
+ :version "23.2" ; 25->100k
:type '(choice (const nil) integer)
:group 'paren-blinking)
;; a matching-char info, in which case the two CDRs
;; should match.
(eq matching-paren (cdr (syntax-after (1- oldpos))))))
- (message "Mismatched parentheses"))
+ (if (minibufferp)
+ (minibuffer-message " [Mismatched parentheses]")
+ (message "Mismatched parentheses")))
((not blinkpos)
(or blink-matching-paren-distance
;; Don't complain when `$' with no blinkpos, because it
;; could just be the first one typed in the buffer.
atdollar
- (message "Unmatched parenthesis")))
+ (if (minibufferp)
+ (minibuffer-message " [Unmatched parenthesis]")
+ (message "Unmatched parenthesis"))))
((pos-visible-in-window-p blinkpos)
;; Matching open within window, temporarily move to blinkpos but only
;; if `blink-matching-paren-on-screen' is non-nil.
:version "21.1"
:group 'mail)
-(defcustom mail-user-agent 'sendmail-user-agent
+(defcustom mail-user-agent 'message-user-agent
"Your preference for a mail composition package.
Various Emacs Lisp packages (e.g. Reporter) require you to compose an
outgoing email message. This variable lets you specify which
Valid values include:
- `sendmail-user-agent' -- use the default Emacs Mail package.
+ `message-user-agent' -- use the Message package.
+ See Info node `(message)'.
+ `sendmail-user-agent' -- use the Mail package.
See Info node `(emacs)Sending Mail'.
`mh-e-user-agent' -- use the Emacs interface to the MH mail system.
See Info node `(mh-e)'.
- `message-user-agent' -- use the Gnus Message package.
- See Info node `(message)'.
`gnus-user-agent' -- like `message-user-agent', but with Gnus
paraphernalia, particularly the Gcc: header for
archiving.
succeeds.
See also `read-mail-command' concerning reading mail."
- :type '(radio (function-item :tag "Default Emacs mail"
+ :type '(radio (function-item :tag "Message package"
+ :format "%t\n"
+ message-user-agent)
+ (function-item :tag "Mail package"
:format "%t\n"
sendmail-user-agent)
(function-item :tag "Emacs interface to MH"
:format "%t\n"
mh-e-user-agent)
- (function-item :tag "Gnus Message package"
- :format "%t\n"
- message-user-agent)
- (function-item :tag "Gnus Message with full Gnus features"
+ (function-item :tag "Message with full Gnus features"
:format "%t\n"
gnus-user-agent)
(function :tag "Other"))
+ :version "23.2" ; sendmail->message
:group 'mail)
(define-mail-user-agent 'sendmail-user-agent
HEADER and VALUE are strings.
CONTINUE, if non-nil, says to continue editing a message already
-being composed.
+being composed. Interactively, CONTINUE is the prefix argument.
SWITCH-FUNCTION, if non-nil, is a function to use to
switch to and display the buffer used for mail composition.
(define-key map "\e\e\e" 'delete-completion-window)
(define-key map [left] 'previous-completion)
(define-key map [right] 'next-completion)
+ (define-key map "q" 'quit-window)
map)
"Local map for completion list buffers.")
This also applies to other functions such as `choose-completion'
and `mouse-choose-completion'.")
+(defvar completion-base-position nil
+ "Position of the base of the text corresponding to the shown completions.
+This variable is used in the *Completions* buffers.
+Its value is a list of the form (START END) where START is the place
+where the completion should be inserted and END (if non-nil) is the end
+of the text to replace. If END is nil, point is used instead.")
+
(defvar completion-base-size nil
"Number of chars before point not involved in completion.
This is a local variable in the completion list buffer.
If nil, Emacs determines which part of the tail end of the
buffer's text is involved in completion by comparing the text
directly.")
+(make-obsolete-variable 'completion-base-size 'completion-base-position "23.2")
(defun delete-completion-window ()
"Delete the completion list window.
(point) 'mouse-face nil beg))
(setq n (1+ n))))))
-(defun choose-completion ()
- "Choose the completion that point is in or next to."
- (interactive)
- (let (beg end completion (buffer completion-reference-buffer)
- (base-size completion-base-size))
- (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
- (setq end (point) beg (1+ (point))))
- (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
- (setq end (1- (point)) beg (point)))
- (if (null beg)
- (error "No completion here"))
- (setq beg (previous-single-property-change beg 'mouse-face))
- (setq end (or (next-single-property-change end 'mouse-face) (point-max)))
- (setq completion (buffer-substring-no-properties beg end))
+(defun choose-completion (&optional event)
+ "Choose the completion at point."
+ (interactive (list last-nonmenu-event))
+ ;; In case this is run via the mouse, give temporary modes such as
+ ;; isearch a chance to turn off.
+ (run-hooks 'mouse-leave-buffer-hook)
+ (let (buffer base-size base-position choice)
+ (with-current-buffer (window-buffer (posn-window (event-start event)))
+ (setq buffer completion-reference-buffer)
+ (setq base-size completion-base-size)
+ (setq base-position completion-base-position)
+ (save-excursion
+ (goto-char (posn-point (event-start event)))
+ (let (beg end)
+ (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
+ (setq end (point) beg (1+ (point))))
+ (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
+ (setq end (1- (point)) beg (point)))
+ (if (null beg)
+ (error "No completion here"))
+ (setq beg (previous-single-property-change beg 'mouse-face))
+ (setq end (or (next-single-property-change end 'mouse-face)
+ (point-max)))
+ (setq choice (buffer-substring-no-properties beg end)))))
+
(let ((owindow (selected-window)))
+ (select-window (posn-window (event-start event)))
(if (and (one-window-p t 'selected-frame)
- (window-dedicated-p owindow))
+ (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 (and (buffer-live-p buffer)
- (get-buffer-window buffer))
+ (get-buffer-window buffer 0))
owindow)))
- (choose-completion-string completion buffer base-size)))
+
+ (choose-completion-string
+ choice buffer
+ (or base-position
+ (when base-size
+ ;; Someone's using old completion code that doesn't know
+ ;; about base-position yet.
+ (list (+ base-size (with-current-buffer buffer (field-beginning)))))
+ ;; If all else fails, just guess.
+ (with-current-buffer buffer
+ (list (choose-completion-guess-base-position choice)))))))
;; Delete the longest partial match for STRING
;; that can be found before POINT.
+(defun choose-completion-guess-base-position (string)
+ (save-excursion
+ (let ((opoint (point))
+ len)
+ ;; Try moving back by the length of the string.
+ (goto-char (max (- (point) (length string))
+ (minibuffer-prompt-end)))
+ ;; See how far back we were actually able to move. That is the
+ ;; upper bound on how much we can match and delete.
+ (setq len (- opoint (point)))
+ (if completion-ignore-case
+ (setq string (downcase string)))
+ (while (and (> len 0)
+ (let ((tail (buffer-substring (point) opoint)))
+ (if completion-ignore-case
+ (setq tail (downcase tail)))
+ (not (string= tail (substring string 0 len)))))
+ (setq len (1- len))
+ (forward-char 1))
+ (point))))
+
(defun choose-completion-delete-max-match (string)
- (let ((opoint (point))
- len)
- ;; Try moving back by the length of the string.
- (goto-char (max (- (point) (length string))
- (minibuffer-prompt-end)))
- ;; See how far back we were actually able to move. That is the
- ;; upper bound on how much we can match and delete.
- (setq len (- opoint (point)))
- (if completion-ignore-case
- (setq string (downcase string)))
- (while (and (> len 0)
- (let ((tail (buffer-substring (point) opoint)))
- (if completion-ignore-case
- (setq tail (downcase tail)))
- (not (string= tail (substring string 0 len)))))
- (setq len (1- len))
- (forward-char 1))
- (delete-char len)))
+ (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.
If all functions in the list return nil, that means to use
the default method of inserting the completion in BUFFER.")
-(defun choose-completion-string (choice &optional buffer base-size)
+(defun choose-completion-string (choice &optional buffer base-position)
"Switch to BUFFER and insert the completion choice CHOICE.
-BASE-SIZE, if non-nil, says how many characters of BUFFER's text
-to keep. If it is nil, we call `choose-completion-delete-max-match'
-to decide what to delete."
+BASE-POSITION, says where to insert the completion."
;; If BUFFER is the minibuffer, exit the minibuffer
;; unless it is reading a file name and CHOICE is a directory,
;; or completion-no-auto-exit is non-nil.
+ ;; Some older code may call us passing `base-size' instead of
+ ;; `base-position'. It's difficult to make any use of `base-size',
+ ;; so we just ignore it.
+ (unless (consp base-position)
+ (message "Obsolete `base-size' passed to choose-completion-string")
+ (setq base-position nil))
+
(let* ((buffer (or buffer completion-reference-buffer))
(mini-p (minibufferp buffer)))
;; If BUFFER is a minibuffer, barf unless it's the currently
(set-buffer buffer)
(unless (run-hook-with-args-until-success
'choose-completion-string-functions
- choice buffer mini-p base-size)
+ ;; The fourth arg used to be `mini-p' but was useless
+ ;; (since minibufferp can be used on the `buffer' arg)
+ ;; and indeed unused. The last used to be `base-size', so we
+ ;; keep it to try and avoid breaking old code.
+ choice buffer base-position nil)
;; 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 (field-beginning)) (point))
- (choose-completion-delete-max-match choice))
+ (delete-region (or (car base-position) (point))
+ (or (cadr base-position) (point)))
(insert choice)
(remove-text-properties (- (point) (length choice)) (point)
'(mouse-face nil))
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 minibuffer-completing-file-name
- (file-directory-p (field-string (point-max))))
- (let ((mini (active-minibuffer-window)))
- (select-window mini)
- (when minibuffer-auto-raise
- (raise-frame (window-frame mini))))
- (exit-minibuffer)))))))
+ (let* ((result (buffer-substring (field-beginning) (point)))
+ (bounds
+ (completion-boundaries result minibuffer-completion-table
+ minibuffer-completion-predicate
+ "")))
+ (if (eq (car bounds) (length result))
+ ;; The completion chosen leads to a new set of completions
+ ;; (e.g. it's a directory): don't exit the minibuffer yet.
+ (let ((mini (active-minibuffer-window)))
+ (select-window mini)
+ (when minibuffer-auto-raise
+ (raise-frame (window-frame mini))))
+ (exit-minibuffer))))))))
(define-derived-mode completion-list-mode nil "Completion List"
"Major mode for buffers showing lists of possible completions.
:version "22.1"
: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.")
-
;; 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 ()
(let* ((mainbuf (current-buffer))
- (mbuf-contents (minibuffer-completion-contents))
- common-string-length)
- ;; When reading a file name in the minibuffer,
- ;; set default-directory in the minibuffer
- ;; so it will get copied into the completion list buffer.
- (if minibuffer-completing-file-name
- (with-current-buffer mainbuf
- (setq default-directory
- (file-name-directory (expand-file-name mbuf-contents)))))
+ (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
+ (if minibuffer-completing-file-name
+ (file-name-as-directory
+ (expand-file-name
+ (substring (minibuffer-completion-contents)
+ 0 (or completion-base-size 0)))))))
(with-current-buffer standard-output
- (let ((base-size completion-base-size)) ;Read before killing localvars.
+ (let ((base-size completion-base-size) ;Read before killing localvars.
+ (base-position completion-base-position))
(completion-list-mode)
- (set (make-local-variable 'completion-base-size) base-size))
+ (set (make-local-variable 'completion-base-size) base-size)
+ (set (make-local-variable 'completion-base-position) base-position))
(set (make-local-variable 'completion-reference-buffer) mainbuf)
- (unless completion-base-size
- ;; This shouldn't be needed any more, but further analysis is needed
- ;; to make sure it's the case.
- (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))))
+ (if base-dir (setq default-directory base-dir))
;; Maybe insert help string.
(when completion-show-help
(goto-char (point-min))
(defun switch-to-completions ()
"Select the completion list window."
(interactive)
+ (let ((window (or (get-buffer-window "*Completions*" 0)
;; Make sure we have a completions window.
- (or (get-buffer-window "*Completions*")
- (minibuffer-completion-help))
- (let ((window (get-buffer-window "*Completions*")))
+ (progn (minibuffer-completion-help)
+ (get-buffer-window "*Completions*" 0)))))
(when window
(select-window window)
(goto-char (point-min))
(kp-subtract ?-)
(kp-decimal ?.)
(kp-divide ?/)
- (kp-equal ?=)))
+ (kp-equal ?=)
+ ;; Do the same for various keys that are represented as symbols under
+ ;; GUIs but naturally correspond to characters.
+ (backspace 127)
+ (delete 127)
+ (tab ?\t)
+ (linefeed ?\n)
+ (clear ?\C-l)
+ (return ?\C-m)
+ (escape ?\e)
+ ))
\f
;;;;
;;;; forking a twin copy of a buffer.
See also `normal-erase-is-backspace'."
(interactive "P")
(let ((enabled (or (and arg (> (prefix-numeric-value arg) 0))
- (and (not arg)
- (not (eq 1 (terminal-parameter
+ (not (or arg
+ (eq 1 (terminal-parameter
nil 'normal-erase-is-backspace)))))))
(set-terminal-parameter nil 'normal-erase-is-backspace
(if enabled 1 0))
(cond ((or (memq window-system '(x w32 ns pc))
(memq system-type '(ms-dos windows-nt)))
(let* ((bindings
- `(([C-delete] [C-backspace])
- ([M-delete] [M-backspace])
+ `(([M-delete] [M-backspace])
([C-M-delete] [C-M-backspace])
- (,esc-map
- [C-delete] [C-backspace])))
+ ([?\e C-delete] [?\e C-backspace])))
(old-state (lookup-key local-function-key-map [delete])))
(if enabled
(progn
(define-key local-function-key-map [delete] [?\C-d])
(define-key local-function-key-map [kp-delete] [?\C-d])
- (define-key local-function-key-map [backspace] [?\C-?]))
+ (define-key local-function-key-map [backspace] [?\C-?])
+ (dolist (b bindings)
+ ;; Not sure if input-decode-map is really right, but
+ ;; keyboard-translate-table (used below) only works
+ ;; for integer events, and key-translation-table is
+ ;; global (like the global-map, used earlier).
+ (define-key input-decode-map (car b) nil)
+ (define-key input-decode-map (cadr b) nil)))
(define-key local-function-key-map [delete] [?\C-?])
(define-key local-function-key-map [kp-delete] [?\C-?])
- (define-key local-function-key-map [backspace] [?\C-?]))
-
- ;; Maybe swap bindings of C-delete and C-backspace, etc.
- (unless (equal old-state (lookup-key local-function-key-map [delete]))
- (dolist (binding bindings)
- (let ((map global-map))
- (when (keymapp (car binding))
- (setq map (car binding) binding (cdr binding)))
- (let* ((key1 (nth 0 binding))
- (key2 (nth 1 binding))
- (binding1 (lookup-key map key1))
- (binding2 (lookup-key map key2)))
- (define-key map key1 binding2)
- (define-key map key2 binding1)))))))
+ (define-key local-function-key-map [backspace] [?\C-?])
+ (dolist (b bindings)
+ (define-key input-decode-map (car b) (cadr b))
+ (define-key input-decode-map (cadr b) (car b))))))
(t
(if enabled
(progn
(keyboard-translate ?\C-? ?\C-?))))
(run-hooks 'normal-erase-is-backspace-hook)
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "Delete key deletes %s"
(if (terminal-parameter nil 'normal-erase-is-backspace)
"forward" "backward")))))
HCoop / bpt / emacs.git / blobdiff