(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.
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))
&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. Truncates long output according to the value of the
-variables `eval-expression-print-length' and `eval-expression-print-level'.
+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."
\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.
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 associated with the current file.
(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))))
(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
(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.
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)))
(/= 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)
((= 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))
(message "Word wrapping %s"
(if word-wrap "enabled" "disabled")))
-(defvar overwrite-mode-textual " Ovwrt"
+(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)
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 ()
(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)
(if base-dir (setq default-directory base-dir))
- (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))))
;; 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))
(let* ((bindings
`(([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