;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
-(eval-when-compile
- (autoload 'widget-convert "wid-edit")
- (autoload 'shell-mode "shell"))
+(declare-function widget-convert "wid-edit" (type &rest args))
+(declare-function shell-mode "shell" ())
(defvar compilation-current-error)
buffer list instead of the selected frame's buffer list.
If no other buffer exists, the buffer `*scratch*' is returned."
(setq frame (or frame (selected-frame)))
- (or (get-next-valid-buffer (frame-parameter frame 'buried-buffer-list)
- buffer visible-ok frame)
- (get-next-valid-buffer (nreverse (buffer-list frame))
- buffer visible-ok 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*"))))
-
(defun next-buffer ()
"Switch to the next buffer in cyclic order."
(interactive)
- (let ((buffer (current-buffer))
- (bbl (frame-parameter nil 'buried-buffer-list)))
+ (let ((buffer (current-buffer)))
(switch-to-buffer (other-buffer buffer t))
- (bury-buffer buffer)
- (set-frame-parameter nil 'buried-buffer-list
- (cons buffer (delq buffer bbl)))))
+ (bury-buffer buffer)))
(defun previous-buffer ()
"Switch to the previous buffer in cyclic order."
(interactive)
- (let ((buffer (last-buffer (current-buffer) t))
- (bbl (frame-parameter nil 'buried-buffer-list)))
- (switch-to-buffer buffer)
- ;; Clean up buried-buffer-list up to and including the chosen buffer.
- (while (and bbl (not (eq (car bbl) buffer)))
- (setq bbl (cdr bbl)))
- (set-frame-parameter nil 'buried-buffer-list bbl)))
+ (switch-to-buffer (last-buffer (current-buffer) t)))
\f
;;; next-error support framework
:group 'next-error
:version "22.1")
+(defcustom next-error-recenter nil
+ "*Display the line in the visited source file recentered as specified.
+If non-nil, the value is passed directly to `recenter'."
+ :type '(choice (integer :tag "Line to recenter to")
+ (const :tag "Center of window" (4))
+ (const :tag "No recentering" nil))
+ :group 'next-error
+ :version "23.1")
+
(defcustom next-error-hook nil
"*List of hook functions run by `next-error' after visiting source file."
:type 'hook
;; we know here that next-error-function is a valid symbol we can funcall
(with-current-buffer next-error-last-buffer
(funcall next-error-function (prefix-numeric-value arg) reset)
+ (when next-error-recenter
+ (recenter next-error-recenter))
(run-hooks 'next-error-hook))))
(defun next-error-internal ()
;; we know here that next-error-function is a valid symbol we can funcall
(with-current-buffer next-error-last-buffer
(funcall next-error-function 0 nil)
+ (when next-error-recenter
+ (recenter next-error-recenter))
(run-hooks 'next-error-hook)))
(defalias 'goto-next-locus 'next-error)
;; Mark the newline(s) `hard'.
(if use-hard-newlines
(set-hard-newline-properties
- (- (point) (if arg (prefix-numeric-value arg) 1)) (point)))
+ (- (point) (prefix-numeric-value arg)) (point)))
;; If the newline leaves the previous line blank,
;; and we have a left margin, delete that from the blank line.
(or flag
(newline)
(save-excursion
(goto-char pos)
- ;; Usually indent-according-to-mode should "preserve" point, but it is
- ;; not guaranteed; e.g. indent-to-left-margin doesn't.
- (save-excursion (indent-according-to-mode))
+ ;; We are at EOL before the call to indent-according-to-mode, and
+ ;; after it we usually are as well, but not always. We tried to
+ ;; address it with `save-excursion' but that uses a normal marker
+ ;; whereas we need `move after insertion', so we do the save/restore
+ ;; by hand.
+ (setq pos (copy-marker pos t))
+ (indent-according-to-mode)
+ (goto-char pos)
+ ;; Remove the trailing white-space after indentation because
+ ;; indentation may introduce the whitespace.
(delete-horizontal-space t))
(indent-according-to-mode)))
(defun forward-to-indentation (&optional arg)
"Move forward ARG lines and position at first nonblank character."
- (interactive "p")
+ (interactive "^p")
(forward-line (or arg 1))
(skip-chars-forward " \t"))
(defun backward-to-indentation (&optional arg)
"Move backward ARG lines and position at first nonblank character."
- (interactive "p")
+ (interactive "^p")
(forward-line (- (or arg 1)))
(skip-chars-forward " \t"))
(defun back-to-indentation ()
"Move point to the first non-whitespace character on this line."
- (interactive)
+ (interactive "^")
(beginning-of-line 1)
(skip-syntax-forward " " (line-end-position))
;; Move back over chars that have whitespace syntax but have the p flag.
Don't use this command in Lisp programs!
\(goto-char (point-min)) is faster and avoids clobbering the mark."
- (interactive "P")
+ (interactive "^P")
(or (consp arg)
- (and transient-mark-mode mark-active)
+ (region-active-p)
(push-mark))
(let ((size (- (point-max) (point-min))))
(goto-char (if (and arg (not (consp arg)))
Don't use this command in Lisp programs!
\(goto-char (point-max)) is faster and avoids clobbering the mark."
- (interactive "P")
- (or (consp arg)
- (and transient-mark-mode mark-active)
- (push-mark))
+ (interactive "^P")
+ (or (consp arg) (region-active-p) (push-mark))
(let ((size (- (point-max) (point-min))))
(goto-char (if (and arg (not (consp arg)))
(- (point-max)
(defun goto-line (arg &optional buffer)
"Goto line ARG, counting from line 1 at beginning of buffer.
-Normally, move point in the current buffer.
-With just \\[universal-argument] as argument, move point in the most recently
-displayed other buffer, and switch to it. When called from Lisp code,
-the optional argument BUFFER specifies a buffer to switch to.
+Normally, move point in the current buffer, and leave mark at previous
+position. With just \\[universal-argument] as argument, move point
+in the most recently displayed other buffer, and switch to it.
+When called from Lisp code, the optional argument BUFFER specifies
+a buffer to switch to.
If there's a number in the buffer at point, it is the default for ARG."
(interactive
(let ((window (get-buffer-window buffer)))
(if window (select-window window)
(switch-to-buffer-other-window buffer))))
+ ;; Leave mark at previous position
+ (or (region-active-p) (push-mark))
;; Move to the specified line number in that buffer.
(save-restriction
(widen)
(if (or (not coding)
(eq (coding-system-type coding) t))
(setq coding default-buffer-file-coding-system))
- (if (not (char-valid-p char))
+ (if (eq (char-charset char) 'eight-bit)
(setq encoding-msg
- (format "(%d, #o%o, #x%x, invalid)" char char char))
+ (format "(%d, #o%o, #x%x, raw-byte)" char char char))
;; Check if the character is displayed with some `display'
;; text property. In that case, set under-display to the
;; buffer substring covered by that property.
(if (boundp 'edebug-active) edebug-active)))
(let ((char-string
(if (or (if (boundp 'edebug-active) edebug-active)
- (memq this-command '(eval-last-sexp eval-print-last-sexp)))
+ (memq this-command '(eval-last-sexp eval-print-last-sexp)))
(prin1-char value))))
(if char-string
(format " (#o%o, #x%x, %s)" value value char-string)
(defvar minibuffer-temporary-goal-position nil)
+(defvar minibuffer-default-add-function 'minibuffer-default-add-completions
+ "Function run by `goto-history-element' before consuming `minibuffer-default'.
+This is useful to dynamically add more elements to the list `minibuffer-default'
+when `goto-history-element' reaches the end of this list.
+Before calling this function `goto-history-element' sets the variable
+`minibuffer-default-add-done' to t, so it will call this function only
+once. In special cases, when this function needs to be called more
+than once, it can set `minibuffer-default-add-done' to nil explicitly,
+overriding the setting of this variable to t in `goto-history-element'.")
+
+(defvar minibuffer-default-add-done nil
+ "When nil, add more elements to the end of the list of default values.
+The value nil causes `goto-history-element' to add more elements to
+the list of defaults when it reaches the end of this list. It does
+this by calling a function defined by `minibuffer-default-add-function'.")
+
+(make-variable-buffer-local 'minibuffer-default-add-done)
+
+(defun minibuffer-default-add-completions ()
+ "Return a list of all completions without the default value.
+This function is used to add all elements of the completion table to
+the end of the list of defaults just after the default value."
+ (interactive)
+ (let ((def minibuffer-default)
+ (all (all-completions ""
+ minibuffer-completion-table
+ minibuffer-completion-predicate
+ t)))
+ (if (listp def)
+ (append def all)
+ (cons def (delete def all)))))
+
+(defun goto-history-element (nabs)
+ "Puts element of the minibuffer history in the minibuffer.
+The argument NABS specifies the absolute history position."
+ (interactive "p")
+ (when (and (not minibuffer-default-add-done)
+ (functionp minibuffer-default-add-function)
+ (< nabs (- (if (listp minibuffer-default)
+ (length minibuffer-default)
+ 1))))
+ (setq minibuffer-default-add-done t
+ minibuffer-default (funcall minibuffer-default-add-function)))
+ (let ((minimum (if minibuffer-default
+ (- (if (listp minibuffer-default)
+ (length minibuffer-default)
+ 1))
+ 0))
+ elt minibuffer-returned-to-present)
+ (if (and (zerop minibuffer-history-position)
+ (null minibuffer-text-before-history))
+ (setq minibuffer-text-before-history
+ (minibuffer-contents-no-properties)))
+ (if (< nabs minimum)
+ (if minibuffer-default
+ (error "End of defaults; no next item")
+ (error "End of history; no default available")))
+ (if (> nabs (length (symbol-value minibuffer-history-variable)))
+ (error "Beginning of history; no preceding item"))
+ (unless (memq last-command '(next-history-element
+ previous-history-element))
+ (let ((prompt-end (minibuffer-prompt-end)))
+ (set (make-local-variable 'minibuffer-temporary-goal-position)
+ (cond ((<= (point) prompt-end) prompt-end)
+ ((eobp) nil)
+ (t (point))))))
+ (goto-char (point-max))
+ (delete-minibuffer-contents)
+ (setq minibuffer-history-position nabs)
+ (cond ((< nabs 0)
+ (setq elt (if (listp minibuffer-default)
+ (nth (1- (abs nabs)) minibuffer-default)
+ minibuffer-default)))
+ ((= nabs 0)
+ (setq elt (or minibuffer-text-before-history ""))
+ (setq minibuffer-returned-to-present t)
+ (setq minibuffer-text-before-history nil))
+ (t (setq elt (nth (1- minibuffer-history-position)
+ (symbol-value minibuffer-history-variable)))))
+ (insert
+ (if (and (eq minibuffer-history-sexp-flag (minibuffer-depth))
+ (not minibuffer-returned-to-present))
+ (let ((print-level nil))
+ (prin1-to-string elt))
+ elt))
+ (goto-char (or minibuffer-temporary-goal-position (point-max)))))
+
(defun next-history-element (n)
"Puts next element of the minibuffer history in the minibuffer.
With argument N, it uses the Nth following element."
(interactive "p")
(or (zerop n)
- (let ((narg (- minibuffer-history-position n))
- (minimum (if minibuffer-default -1 0))
- elt minibuffer-returned-to-present)
- (if (and (zerop minibuffer-history-position)
- (null minibuffer-text-before-history))
- (setq minibuffer-text-before-history
- (minibuffer-contents-no-properties)))
- (if (< narg minimum)
- (if minibuffer-default
- (error "End of history; no next item")
- (error "End of history; no default available")))
- (if (> narg (length (symbol-value minibuffer-history-variable)))
- (error "Beginning of history; no preceding item"))
- (unless (memq last-command '(next-history-element
- previous-history-element))
- (let ((prompt-end (minibuffer-prompt-end)))
- (set (make-local-variable 'minibuffer-temporary-goal-position)
- (cond ((<= (point) prompt-end) prompt-end)
- ((eobp) nil)
- (t (point))))))
- (goto-char (point-max))
- (delete-minibuffer-contents)
- (setq minibuffer-history-position narg)
- (cond ((= narg -1)
- (setq elt minibuffer-default))
- ((= narg 0)
- (setq elt (or minibuffer-text-before-history ""))
- (setq minibuffer-returned-to-present t)
- (setq minibuffer-text-before-history nil))
- (t (setq elt (nth (1- minibuffer-history-position)
- (symbol-value minibuffer-history-variable)))))
- (insert
- (if (and (eq minibuffer-history-sexp-flag (minibuffer-depth))
- (not minibuffer-returned-to-present))
- (let ((print-level nil))
- (prin1-to-string elt))
- elt))
- (goto-char (or minibuffer-temporary-goal-position (point-max))))))
+ (goto-history-element (- minibuffer-history-position n))))
(defun previous-history-element (n)
"Puts previous element of the minibuffer history in the minibuffer.
With argument N, it uses the Nth previous element."
(interactive "p")
- (next-history-element (- n)))
+ (or (zerop n)
+ (goto-history-element (+ minibuffer-history-position n))))
(defun next-complete-history-element (n)
"Get next history element which completes the minibuffer before the point.
;; the buffer; this should be 0 for normal buffers.
(1- (minibuffer-prompt-end)))
\f
+;; isearch minibuffer history
+(add-hook 'minibuffer-setup-hook 'minibuffer-history-isearch-setup)
+
+(defvar minibuffer-history-isearch-message-overlay)
+(make-variable-buffer-local 'minibuffer-history-isearch-message-overlay)
+
+(defun minibuffer-history-isearch-setup ()
+ "Set up a minibuffer for using isearch to search the minibuffer history.
+Intended to be added to `minibuffer-setup-hook'."
+ (set (make-local-variable 'isearch-search-fun-function)
+ 'minibuffer-history-isearch-search)
+ (set (make-local-variable 'isearch-message-function)
+ 'minibuffer-history-isearch-message)
+ (set (make-local-variable 'isearch-wrap-function)
+ 'minibuffer-history-isearch-wrap)
+ (set (make-local-variable 'isearch-push-state-function)
+ 'minibuffer-history-isearch-push-state)
+ (add-hook 'isearch-mode-end-hook 'minibuffer-history-isearch-end nil t))
+
+(defun minibuffer-history-isearch-end ()
+ "Clean up the minibuffer after terminating isearch in the minibuffer."
+ (if minibuffer-history-isearch-message-overlay
+ (delete-overlay minibuffer-history-isearch-message-overlay)))
+
+(defun minibuffer-history-isearch-search ()
+ "Return the proper search function, for isearch in minibuffer history."
+ (cond
+ (isearch-word
+ (if isearch-forward 'word-search-forward 'word-search-backward))
+ (t
+ (lambda (string bound noerror)
+ (let ((search-fun
+ ;; Use standard functions to search within minibuffer text
+ (cond
+ (isearch-regexp
+ (if isearch-forward 're-search-forward 're-search-backward))
+ (t
+ (if isearch-forward 'search-forward 'search-backward))))
+ found)
+ ;; Avoid lazy-highlighting matches in the minibuffer prompt when
+ ;; searching forward. Lazy-highlight calls this lambda with the
+ ;; bound arg, so skip the minibuffer prompt.
+ (if (and bound isearch-forward (< (point) (minibuffer-prompt-end)))
+ (goto-char (minibuffer-prompt-end)))
+ (or
+ ;; 1. First try searching in the initial minibuffer text
+ (funcall search-fun string
+ (if isearch-forward bound (minibuffer-prompt-end))
+ noerror)
+ ;; 2. If the above search fails, start putting next/prev history
+ ;; elements in the minibuffer successively, and search the string
+ ;; in them. Do this only when bound is nil (i.e. not while
+ ;; lazy-highlighting search strings in the current minibuffer text).
+ (unless bound
+ (condition-case nil
+ (progn
+ (while (not found)
+ (cond (isearch-forward
+ (next-history-element 1)
+ (goto-char (minibuffer-prompt-end)))
+ (t
+ (previous-history-element 1)
+ (goto-char (point-max))))
+ (setq isearch-barrier (point) isearch-opoint (point))
+ ;; After putting the next/prev history element, search
+ ;; the string in them again, until next-history-element
+ ;; or previous-history-element raises an error at the
+ ;; beginning/end of history.
+ (setq found (funcall search-fun string
+ (unless isearch-forward
+ ;; For backward search, don't search
+ ;; in the minibuffer prompt
+ (minibuffer-prompt-end))
+ noerror)))
+ ;; Return point of the new search result
+ (point))
+ ;; Return nil when next(prev)-history-element fails
+ (error nil)))))))))
+
+(defun minibuffer-history-isearch-message (&optional c-q-hack ellipsis)
+ "Display the minibuffer history search prompt.
+If there are no search errors, this function displays an overlay with
+the isearch prompt which replaces the original minibuffer prompt.
+Otherwise, it displays the standard isearch message returned from
+`isearch-message'."
+ (if (not (and (minibufferp) isearch-success (not isearch-error)))
+ ;; Use standard function `isearch-message' when not in the minibuffer,
+ ;; or search fails, or has an error (like incomplete regexp).
+ ;; This function overwrites minibuffer text with isearch message,
+ ;; so it's possible to see what is wrong in the search string.
+ (isearch-message c-q-hack ellipsis)
+ ;; Otherwise, put the overlay with the standard isearch prompt over
+ ;; the initial minibuffer prompt.
+ (if (overlayp minibuffer-history-isearch-message-overlay)
+ (move-overlay minibuffer-history-isearch-message-overlay
+ (point-min) (minibuffer-prompt-end))
+ (setq minibuffer-history-isearch-message-overlay
+ (make-overlay (point-min) (minibuffer-prompt-end)))
+ (overlay-put minibuffer-history-isearch-message-overlay 'evaporate t))
+ (overlay-put minibuffer-history-isearch-message-overlay
+ 'display (isearch-message-prefix c-q-hack ellipsis))
+ ;; And clear any previous isearch message.
+ (message "")))
+
+(defun minibuffer-history-isearch-wrap ()
+ "Wrap the minibuffer history search when search is failed.
+Move point to the first history element for a forward search,
+or to the last history element for a backward search."
+ (unless isearch-word
+ ;; When `minibuffer-history-isearch-search' fails on reaching the
+ ;; beginning/end of the history, wrap the search to the first/last
+ ;; minibuffer history element.
+ (if isearch-forward
+ (goto-history-element (length (symbol-value minibuffer-history-variable)))
+ (goto-history-element 0))
+ (setq isearch-success t))
+ (goto-char (if isearch-forward (minibuffer-prompt-end) (point-max))))
+
+(defun minibuffer-history-isearch-push-state ()
+ "Save a function restoring the state of minibuffer history search.
+Save `minibuffer-history-position' to the additional state parameter
+in the search status stack."
+ `(lambda (cmd)
+ (minibuffer-history-isearch-pop-state cmd ,minibuffer-history-position)))
+
+(defun minibuffer-history-isearch-pop-state (cmd hist-pos)
+ "Restore the minibuffer history search state.
+Go to the history element by the absolute history position `hist-pos'."
+ (goto-history-element hist-pos))
+
+\f
;Put this on C-x u, so we can force that rather than C-_ into startup msg
(defalias 'advertised-undo 'undo)
;; it shows nothing else happened in between.
(gethash list undo-equiv-table))))
(setq undo-in-region
- (if transient-mark-mode mark-active (and arg (not (numberp arg)))))
+ (or (region-active-p) (and arg (not (numberp arg)))))
(if undo-in-region
(undo-start (region-beginning) (region-end))
(undo-start))
(if next (setq equiv next))))
(setq pending-undo-list equiv)))
(undo-more
- (if (or transient-mark-mode (numberp arg))
+ (if (numberp arg)
(prefix-numeric-value arg)
1))
;; Record the fact that the just-generated undo records come from an
(delete-auto-save-file-if-necessary recent-save))
;; Display a message announcing success.
(if message
- (message message))))
+ (message "%s" message))))
(defun buffer-disable-undo (&optional buffer)
"Make BUFFER stop keeping undo information.
is run interactively. A value of nil means that output to stderr and
stdout will be intermixed in the output stream.")
+(declare-function mailcap-file-default-commands "mailcap" (files))
+
+(defun minibuffer-default-add-shell-commands ()
+ "Return a list of all commands associted with the current file.
+This function is used to add all related commands retieved by `mailcap'
+to the end of the list of defaults just after the default value."
+ (interactive)
+ (let* ((filename (if (listp minibuffer-default)
+ (car minibuffer-default)
+ minibuffer-default))
+ (commands (and filename (require 'mailcap nil t)
+ (mailcap-file-default-commands (list filename)))))
+ (setq commands (mapcar (lambda (command)
+ (concat command " " filename))
+ commands))
+ (if (listp minibuffer-default)
+ (append minibuffer-default commands)
+ (cons minibuffer-default commands))))
+
+(defun minibuffer-complete-shell-command ()
+ "Dynamically complete shell command at point."
+ (interactive)
+ (require 'shell)
+ (run-hook-with-args-until-success 'shell-dynamic-complete-functions))
+
+(defvar minibuffer-local-shell-command-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-map)
+ (define-key map "\t" 'minibuffer-complete-shell-command)
+ map)
+ "Keymap used for completiing shell commands in minibufffer.")
+
+(defun read-shell-command (prompt &optional initial-contents hist &rest args)
+ "Read a shell command from the minibuffer.
+The arguments are the same as the ones of `read-from-minibuffer',
+except READ and KEYMAP are missing and HIST defaults
+to `shell-command-history'."
+ (apply 'read-from-minibuffer prompt initial-contents
+ minibuffer-local-shell-command-map
+ nil
+ (or hist 'shell-command-history)
+ args))
+
(defun shell-command (command &optional output-buffer error-buffer)
"Execute string COMMAND in inferior shell; display output, if any.
With prefix argument, insert the COMMAND's output at point.
In an interactive call, the variable `shell-command-default-error-buffer'
specifies the value of ERROR-BUFFER."
- (interactive (list (read-from-minibuffer "Shell command: "
- nil nil nil 'shell-command-history)
- current-prefix-arg
- shell-command-default-error-buffer))
+ (interactive
+ (list
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (set (make-local-variable 'minibuffer-default-add-function)
+ 'minibuffer-default-add-shell-commands))
+ (read-shell-command "Shell command: " nil nil
+ (and buffer-file-name
+ (file-relative-name buffer-file-name))))
+ current-prefix-arg
+ shell-command-default-error-buffer))
;; Look for a handler in case default-directory is a remote file name.
(let ((handler
(find-file-name-handler (directory-file-name default-directory)
;; Do this before calling region-beginning
;; and region-end, in case subprocess output
;; relocates them while we are in the minibuffer.
- (setq string (read-from-minibuffer "Shell command on region: "
- nil nil nil
- 'shell-command-history))
+ (setq string (read-shell-command "Shell command on region: "))
;; call-interactively recognizes region-beginning and
;; region-end specially, leaving them in the history.
(list (region-beginning) (region-end)
(when stderr-file (delete-file stderr-file))
(when lc (delete-file lc)))))
+(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'. 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."
+ (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))))
+
\f
(defvar universal-argument-map
string, then the caller of the function \(usually `current-kill')
should put this string in the kill ring as the latest kill.
+This function may also return a list of strings if the window
+system supports multiple selections. The first string will be
+used as the pasted text, but the other will be placed in the
+kill ring for easy access via `yank-pop'.
+
Note that the function should return a string only if a program other
than Emacs has provided a string for pasting; if Emacs provided the
most recent string, the function should return nil. If it is
(equal yank-handler (get-text-property 0 'yank-handler cur)))
yank-handler)))
+(defcustom yank-pop-change-selection nil
+ "If non-nil, rotating the kill ring changes the window system selection."
+ :type 'boolean
+ :group 'killing
+ :version "23.1")
+
(defun current-kill (n &optional do-not-move)
"Rotate the yanking point by N places, and then return that kill.
-If N is zero, `interprogram-paste-function' is set, and calling it
-returns a string, then that string is added to the front of the
-kill ring and returned as the latest kill.
-If optional arg DO-NOT-MOVE is non-nil, then don't actually move the
-yanking point; just return the Nth kill forward."
+If N is zero, `interprogram-paste-function' is set, and calling it returns a
+string or list of strings, then that string (or list) is added to the front
+of the kill ring and the string (or first string in the list) is returned as
+the latest kill.
+
+If N is not zero, and if `yank-pop-change-selection' is
+non-nil, use `interprogram-cut-function' to transfer the
+kill at the new yank point into the window system selection.
+
+If optional arg DO-NOT-MOVE is non-nil, then don't actually
+move the yanking point; just return the Nth kill forward."
+
(let ((interprogram-paste (and (= n 0)
interprogram-paste-function
(funcall interprogram-paste-function))))
;; text to the kill ring, so Emacs doesn't try to own the
;; selection, with identical text.
(let ((interprogram-cut-function nil))
- (kill-new interprogram-paste))
- interprogram-paste)
+ (if (listp interprogram-paste)
+ (mapc 'kill-new (nreverse interprogram-paste))
+ (kill-new interprogram-paste)))
+ (car kill-ring))
(or kill-ring (error "Kill ring is empty"))
(let ((ARGth-kill-element
(nthcdr (mod (- n (length kill-ring-yank-pointer))
(length kill-ring))
kill-ring)))
- (or do-not-move
- (setq kill-ring-yank-pointer ARGth-kill-element))
+ (unless do-not-move
+ (setq kill-ring-yank-pointer ARGth-kill-element)
+ (when (and yank-pop-change-selection
+ (> n 0)
+ interprogram-cut-function)
+ (funcall interprogram-cut-function (car ARGth-kill-element))))
(car ARGth-kill-element)))))
"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].
"Save the region as if killed, but don't kill it.
In Transient Mark mode, deactivate the mark.
If `interprogram-cut-function' is non-nil, also save the text for a window
-system cut and paste."
+system cut and paste.
+
+This command's old key binding has been given to `kill-ring-save'."
(interactive "r")
(if (eq last-command 'kill-region)
(kill-append (filter-buffer-substring beg end) (< end beg))
(kill-new (filter-buffer-substring beg end)))
- (if transient-mark-mode
- (setq deactivate-mark t))
+ (setq deactivate-mark t)
nil)
(defun kill-ring-save (beg end)
;; look like a C-g typed as a command.
(inhibit-quit t))
(if (pos-visible-in-window-p other-end (selected-window))
- (unless (and transient-mark-mode
+ ;; Swap point-and-mark quickly so as to show the region that
+ ;; was selected. Don't do it if the region is highlighted.
+ (unless (and (region-active-p)
(face-background 'region))
;; Swap point and mark.
(set-marker (mark-marker) (point) (current-buffer))
(defcustom yank-excluded-properties
'(read-only invisible intangible field mouse-face help-echo local-map keymap
yank-handler follow-link fontified)
- "*Text properties to discard when yanking.
+ "Text properties to discard when yanking.
The value should be a list of text properties to discard or t,
which means to discard all text properties."
:type '(choice (const :tag "All" t) (repeat symbol))
"Deactivate the mark by setting `mark-active' to nil.
\(That makes a difference only in Transient Mark mode.)
Also runs the hook `deactivate-mark-hook'."
- (cond
- ((eq transient-mark-mode 'lambda)
- (setq transient-mark-mode nil))
- (transient-mark-mode
- (setq mark-active nil)
- (run-hooks 'deactivate-mark-hook))))
+ (when transient-mark-mode
+ (if (or (eq transient-mark-mode 'lambda)
+ (and (eq (car-safe transient-mark-mode) 'only)
+ (null (cdr transient-mark-mode))))
+ (setq transient-mark-mode nil)
+ (if (eq (car-safe transient-mark-mode) 'only)
+ (setq transient-mark-mode (cdr transient-mark-mode)))
+ (setq mark-active nil)
+ (run-hooks 'deactivate-mark-hook))))
+
+(defun activate-mark ()
+ "Activate the mark."
+ (when (mark t)
+ (setq mark-active t)
+ (unless transient-mark-mode
+ (setq transient-mark-mode 'lambda))))
+
+(defcustom select-active-regions nil
+ "If non-nil, an active region automatically becomes the window selection."
+ :type 'boolean
+ :group 'killing
+ :version "23.1")
(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))))
(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,
(run-hooks 'deactivate-mark-hook)
(set-marker (mark-marker) nil)))
+(defcustom use-empty-active-region nil
+ "If non-nil, an active region takes control even if empty.
+This applies to certain commands which, in Transient Mark mode,
+apply to the active region if there is one. If the setting is t,
+these commands apply to an empty active region if there is one.
+If the setting is nil, these commands treat an empty active
+region as if it were not active."
+ :type 'boolean
+ :version "23.1"
+ :group 'editing-basics)
+
+(defun use-region-p ()
+ "Return t if certain commands should apply to the region.
+Certain commands normally apply to text near point,
+but in Transient Mark mode when the mark is active they apply
+to the region instead. Such commands should use this subroutine to
+test whether to do that.
+
+This function also obeys `use-empty-active-region'."
+ (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.
+This is NOT the best function to use to test whether a command should
+operate on the region instead of the usual behavior -- for that,
+use `use-region-p'."
+ (and transient-mark-mode mark-active))
+
(defvar mark-ring nil
"The list of former marks of the current buffer, most recent first.")
(make-variable-buffer-local 'mark-ring)
old mark position on local mark ring. Also push the old mark on
global mark ring, if the previous mark was set in another buffer.
-Immediately repeating this command activates `transient-mark-mode' temporarily.
+When Transient Mark Mode is off, immediately repeating this
+command activates `transient-mark-mode' temporarily.
With prefix argument \(e.g., \\[universal-argument] \\[set-mark-command]\), \
jump to the mark, and set the mark from
Novice Emacs Lisp programmers often try to use the mark for the wrong
purposes. See the documentation of `set-mark' for more information."
(interactive "P")
- (if (eq transient-mark-mode 'lambda)
- (setq transient-mark-mode nil))
+ (cond ((eq transient-mark-mode 'lambda)
+ (setq transient-mark-mode nil))
+ ((eq (car-safe transient-mark-mode) 'only)
+ (deactivate-mark)))
(cond
((and (consp arg) (> (prefix-numeric-value arg) 4))
(push-mark-command nil))
(arg
(setq this-command 'pop-to-mark-command)
(pop-to-mark-command))
- ((and (eq last-command 'set-mark-command)
- mark-active (null transient-mark-mode))
- (setq transient-mark-mode 'lambda)
- (message "Transient-mark-mode temporarily enabled"))
+ ((eq last-command 'set-mark-command)
+ (if (region-active-p)
+ (progn
+ (deactivate-mark)
+ (message "Mark deactivated"))
+ (activate-mark)
+ (message "Mark activated")))
(t
(push-mark-command nil))))
"Put the mark where point is now, and point where the mark is now.
This command works even when the mark is not active,
and it reactivates the mark.
-With prefix arg, `transient-mark-mode' is enabled temporarily."
+
+If Transient Mark mode is on, a prefix arg deactivates the mark
+if it is active, and otherwise avoids reactivating it. If
+Transient Mark mode is off, a prefix arg enables Transient Mark
+mode temporarily."
(interactive "P")
- (if arg
- (if mark-active
- (if (null transient-mark-mode)
- (setq transient-mark-mode 'lambda))
- (setq arg nil)))
- (unless arg
- (let ((omark (mark t)))
- (if (null omark)
- (error "No mark set in this buffer"))
- (set-mark (point))
- (goto-char omark)
- nil)))
+ (let ((omark (mark t))
+ (temp-highlight (eq (car-safe transient-mark-mode) 'only)))
+ (if (null omark)
+ (error "No mark set in this buffer"))
+ (deactivate-mark)
+ (set-mark (point))
+ (goto-char omark)
+ (cond (temp-highlight
+ (setq transient-mark-mode (cons 'only transient-mark-mode)))
+ ((or (and arg (region-active-p)) ; (xor arg (not (region-active-p)))
+ (not (or arg (region-active-p))))
+ (deactivate-mark))
+ (t (activate-mark)))
+ nil))
+
+(defun handle-shift-selection (&optional deactivate)
+ "Check for shift translation, and operate on the mark accordingly.
+This is called whenever a command with a `^' character in its
+`interactive' spec is invoked while `shift-select-mode' is
+non-nil.
+
+If the command was invoked through shift-translation, set the
+mark and activate the region temporarily, unless it was already
+set in this way. If the command was invoked without
+shift-translation and a region is temporarily active, deactivate
+the mark.
+
+With optional arg DEACTIVATE, only perform region deactivation."
+ (cond ((and this-command-keys-shift-translated
+ (null deactivate))
+ (unless (and mark-active
+ (eq (car-safe transient-mark-mode) 'only))
+ (setq transient-mark-mode
+ (cons 'only
+ (unless (eq transient-mark-mode 'lambda)
+ transient-mark-mode)))
+ (push-mark nil nil t)))
+ ((eq (car-safe transient-mark-mode) 'only)
+ (setq transient-mark-mode (cdr transient-mark-mode))
+ (deactivate-mark))))
(define-minor-mode transient-mark-mode
"Toggle Transient Mark mode.
Invoke \\[apropos-documentation] and type \"transient\" or
\"mark.*active\" at the prompt, to see the documentation of
commands which are sensitive to the Transient Mark mode."
- :global t :group 'editing-basics)
+ :global t
+ :init-value (not noninteractive)
+ :group 'editing-basics)
+
+;; The variable transient-mark-mode is ugly: it can take on special
+;; values. Document these here.
+(defvar transient-mark-mode t
+ "*Non-nil if Transient Mark mode is enabled.
+See the command `transient-mark-mode' for a description of this minor mode.
+
+Non-nil also enables highlighting of the region whenever the mark is active.
+The variable `highlight-nonselected-windows' controls whether to highlight
+all windows or just the selected window.
+
+If the value is `lambda', that enables Transient Mark mode
+temporarily. After any subsequent action that would normally
+deactivate the mark (such as buffer modification), Transient Mark mode
+is turned off.
+
+If the value is (only . OLDVAL), that enables Transient Mark mode
+temporarily. After any subsequent point motion command that is not
+shift-translated, or any other action that would normally deactivate
+the mark (such as buffer modification), the value of
+`transient-mark-mode' is set to OLDVAL.")
(defvar widen-automatically t
"Non-nil means it is ok for commands to call `widen' when they want to.
If you are thinking of using this in a Lisp program, consider
using `forward-line' instead. It is usually easier to use
and more reliable (no dependence on goal column, etc.)."
- (interactive "p\np")
+ (interactive "^p\np")
(or arg (setq arg 1))
(if (and next-line-add-newlines (= arg 1))
(if (save-excursion (end-of-line) (eobp))
If you are thinking of using this in a Lisp program, consider using
`forward-line' with a negative argument instead. It is usually easier
to use and more reliable (no dependence on goal column, etc.)."
- (interactive "p\np")
+ (interactive "^p\np")
(or arg (setq arg 1))
(if (interactive-p)
(condition-case nil
"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 9999.")
+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)
-(defun invisible-p (pos)
- "Return non-nil if the character after POS is currently invisible."
- (let ((prop
- (get-char-property pos 'invisible)))
- (if (eq buffer-invisibility-spec t)
- prop
- (or (memq prop buffer-invisibility-spec)
- (assq prop buffer-invisibility-spec)))))
-(define-obsolete-function-alias 'line-move-invisible-p 'invisible-p)
-
;; Returns non-nil if partial move was done.
(defun line-move-partial (arg noerror to-end)
(if (< arg 0)
(vpos (nth 1 lh))
(ypos (nth 2 lh))
(rbot (nth 3 lh))
- ppos py vs)
+ py vs)
(when (or (null lh)
(>= rbot (frame-char-height))
(<= ypos (- (frame-char-height))))
;; Don't count beg of empty line as end of line
;; unless we just did explicit end-of-line.
(or (not (bolp)) (eq last-command 'move-end-of-line)))
- 9999
+ most-positive-fixnum
(current-column))))
- (if (and (not (integerp selective-display))
- (not line-move-ignore-invisible))
+ (if (not (or (integerp selective-display)
+ line-move-ignore-invisible))
;; Use just newline characters.
;; Set ARG to 0 if we move as many lines as requested.
(or (if (> arg 0)
(= arg 0))
(cond ((> arg 0)
- ;; If we did not move down as far as desired,
- ;; at least go to end of line.
- (end-of-line))
+ ;; If we did not move down as far as desired, at least go
+ ;; to end of line. Be sure to call point-entered and
+ ;; point-left-hooks.
+ (let* ((npoint (prog1 (line-end-position)
+ (goto-char opoint)))
+ (inhibit-point-motion-hooks nil))
+ (goto-char npoint)))
((< arg 0)
;; If we did not move up as far as desired,
;; at least go to beginning of line.
- (beginning-of-line))
+ (let* ((npoint (prog1 (line-beginning-position)
+ (goto-char opoint)))
+ (inhibit-point-motion-hooks nil))
+ (goto-char npoint)))
(t
(line-move-finish (or goal-column temporary-goal-column)
opoint (> orig-arg 0)))))))
With argument ARG not nil or 1, move forward ARG - 1 lines first.
If point reaches the beginning or end of buffer, it stops there.
To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
- (interactive "p")
+ (interactive "^p")
(or arg (setq arg 1))
(let (done)
(while (not done)
(not (bobp))
(progn
(while (and (not (bobp)) (invisible-p (1- (point))))
- (goto-char (previous-char-property-change (point))))
+ (goto-char (previous-single-char-property-change
+ (point) 'invisible)))
(backward-char 1)))
(point)))))
(goto-char newpos)
With argument ARG not nil or 1, move forward ARG - 1 lines first.
If point reaches the beginning or end of buffer, it stops there.
To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
- (interactive "p")
+ (interactive "^p")
(or arg (setq arg 1))
(let ((orig (point))
- start first-vis first-vis-field-value)
+ first-vis first-vis-field-value)
;; Move by lines, if ARG is not 1 (the default).
(if (/= arg 1)
(while (and (not (bobp)) (invisible-p (1- (point))))
(goto-char (previous-char-property-change (point)))
(skip-chars-backward "^\n"))
- (setq start (point))
;; Now find first visible char in the line
(while (and (not (eobp)) (invisible-p (point)))
(defun backward-word (&optional arg)
"Move backward until encountering the beginning of a word.
With argument, do this that many times."
- (interactive "p")
+ (interactive "^p")
(forward-word (- (or arg 1))))
(defun mark-word (&optional arg allow-extend)
(interactive "P\np")
(cond ((and allow-extend
(or (and (eq last-command this-command) (mark t))
- (and transient-mark-mode mark-active)))
+ (region-active-p)))
(setq arg (if arg (prefix-numeric-value arg)
(if (< (mark) (point)) -1 1)))
(set-mark
string)
:group 'fill)
(make-variable-buffer-local 'fill-prefix)
-;;;###autoload(put 'fill-prefix 'safe-local-variable 'string-or-null-p)
+(put 'fill-prefix 'safe-local-variable 'string-or-null-p)
(defcustom auto-fill-inhibit-regexp nil
"*Regexp to match lines which should not be auto-filled."
regexp)
:group 'fill)
-(defvar comment-line-break-function 'comment-indent-new-line
- "*Mode-specific function which line breaks and continues a comment.
-
-This function is only called during auto-filling of a comment section.
-The function should take a single optional argument, which is a flag
-indicating whether it should use soft newlines.")
-
;; This function is used as the auto-fill-function of a buffer
;; when Auto-Fill mode is enabled.
;; It returns t if it really did any work.
(if (save-excursion
(skip-chars-backward " \t")
(= (point) fill-point))
- (funcall comment-line-break-function t)
+ (default-indent-new-line t)
(save-excursion
(goto-char fill-point)
- (funcall comment-line-break-function t)))
+ (default-indent-new-line t)))
;; Now do justification, if required
(if (not (eq justify 'left))
(save-excursion
(justify-current-line justify t t)
t)))
+(defvar comment-line-break-function 'comment-indent-new-line
+ "*Mode-specific function which line breaks and continues a comment.
+This function is called during auto-filling when a comment syntax
+is defined.
+The function should take a single optional argument, which is a flag
+indicating whether it should use soft newlines.")
+
+(defun default-indent-new-line (&optional soft)
+ "Break line at point and indent.
+If a comment syntax is defined, call `comment-indent-new-line'.
+
+The inserted newline is marked hard if variable `use-hard-newlines' is true,
+unless optional argument SOFT is non-nil."
+ (interactive)
+ (if comment-start
+ (funcall comment-line-break-function soft)
+ ;; Insert the newline before removing empty space so that markers
+ ;; get preserved better.
+ (if soft (insert-and-inherit ?\n) (newline 1))
+ (save-excursion (forward-char -1) (delete-horizontal-space))
+ (delete-horizontal-space)
+
+ (if (and fill-prefix (not adaptive-fill-mode))
+ ;; Blindly trust a non-adaptive fill-prefix.
+ (progn
+ (indent-to-left-margin)
+ (insert-before-markers-and-inherit fill-prefix))
+
+ (cond
+ ;; If there's an adaptive prefix, use it unless we're inside
+ ;; a comment and the prefix is not a comment starter.
+ (fill-prefix
+ (indent-to-left-margin)
+ (insert-and-inherit fill-prefix))
+ ;; If we're not inside a comment, just try to indent.
+ (t (indent-according-to-mode))))))
+
(defvar normal-auto-fill-function 'do-auto-fill
"The function to use for `auto-fill-function' if Auto Fill mode is turned on.
Some major modes set this.")
"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))
(princ "." t))
(defvaralias 'indicate-unused-lines 'indicate-empty-lines)
-(defvaralias 'default-indicate-unused-lines 'default-indicate-empty-lines)
(defun toggle-truncate-lines (&optional 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)
(skip-syntax-backward "/\\")
(point))))))
(let* ((oldpos (point))
- blinkpos
- message-log-max ; Don't log messages about paren matching.
- matching-paren
- open-paren-line-string
- old-start
- new-start
- isdollar)
- (save-excursion
- (save-restriction
- ;; Don't search for matching paren within minibuffer prompt.
- (setq old-start (minibuffer-prompt-end))
- (setq new-start
- (if blink-matching-paren-distance
- (max old-start (- (point) blink-matching-paren-distance))
- old-start))
- (narrow-to-region new-start oldpos)
- (condition-case ()
- (let ((parse-sexp-ignore-comments
- (and parse-sexp-ignore-comments
- (not blink-matching-paren-dont-ignore-comments))))
- (setq blinkpos (scan-sexps oldpos -1)))
- (error nil)))
- (and blinkpos
- ;; Not syntax '$'.
- (not (setq isdollar (eq (syntax-class (syntax-after blinkpos)) 8)))
- (setq matching-paren
- (let ((syntax (syntax-after blinkpos)))
- (and (consp syntax)
- (eq (syntax-class syntax) 4)
- (cdr syntax)))))
- (cond
- ((not blinkpos)
- ;; Don't complain when `$' with no blinkpos, because it
- ;; could just be the first one in the buffer.
- (unless (or (eq (syntax-class (syntax-after (1- oldpos))) 8)
- (and blink-matching-paren-distance
- (> new-start old-start))
- ;; When `blink-matching-paren-distance' is non-nil and we
- ;; didn't find a matching paren within that many characters
- ;; don't display a message.
- (message "Unmatched parenthesis"))))
- ;; isdollar is for:
- ;; http://lists.gnu.org/archive/html/emacs-devel/2007-10/msg00871.html
- ((not (or isdollar
- (eq matching-paren (char-before oldpos))
- ;; The cdr might hold a new paren-class info rather than
- ;; a matching-char info, in which case the two CDRs
- ;; should match.
- (eq matching-paren (cdr (syntax-after (1- oldpos))))))
- (message "Mismatched parentheses"))
- ((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.
- (and blink-matching-paren-on-screen
- (not show-paren-mode)
- (save-excursion
- (goto-char blinkpos)
- (sit-for blink-matching-delay))))
- (t
- (save-excursion
- (goto-char blinkpos)
- (setq open-paren-line-string
- ;; Show what precedes the open in its line, if anything.
- (if (save-excursion
- (skip-chars-backward " \t")
- (not (bolp)))
- (buffer-substring (line-beginning-position)
- (1+ blinkpos))
- ;; Show what follows the open in its line, if anything.
- (if (save-excursion
- (forward-char 1)
- (skip-chars-forward " \t")
- (not (eolp)))
- (buffer-substring blinkpos
- (line-end-position))
- ;; Otherwise show the previous nonblank line,
- ;; if there is one.
- (if (save-excursion
- (skip-chars-backward "\n \t")
- (not (bobp)))
- (concat
- (buffer-substring (progn
- (skip-chars-backward "\n \t")
- (line-beginning-position))
- (progn (end-of-line)
- (skip-chars-backward " \t")
- (point)))
- ;; Replace the newline and other whitespace with `...'.
- "..."
- (buffer-substring blinkpos (1+ blinkpos)))
- ;; There is nothing to show except the char itself.
- (buffer-substring blinkpos (1+ blinkpos)))))))
- (message "Matches %s"
- (substring-no-properties open-paren-line-string))))))))
-
-;Turned off because it makes dbx bomb out.
+ (message-log-max nil) ; Don't log messages about paren matching.
+ (atdollar (eq (syntax-class (syntax-after (1- oldpos))) 8))
+ (isdollar)
+ (blinkpos
+ (save-excursion
+ (save-restriction
+ (if blink-matching-paren-distance
+ (narrow-to-region
+ (max (minibuffer-prompt-end) ;(point-min) unless minibuf.
+ (- (point) blink-matching-paren-distance))
+ oldpos))
+ (let ((parse-sexp-ignore-comments
+ (and parse-sexp-ignore-comments
+ (not blink-matching-paren-dont-ignore-comments))))
+ (condition-case ()
+ (scan-sexps oldpos -1)
+ (error nil))))))
+ (matching-paren
+ (and blinkpos
+ ;; Not syntax '$'.
+ (not (setq isdollar
+ (eq (syntax-class (syntax-after blinkpos)) 8)))
+ (let ((syntax (syntax-after blinkpos)))
+ (and (consp syntax)
+ (eq (syntax-class syntax) 4)
+ (cdr syntax))))))
+ (cond
+ ;; isdollar is for:
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2007-10/msg00871.html
+ ((not (or (and isdollar blinkpos)
+ (and atdollar (not blinkpos)) ; see below
+ (eq matching-paren (char-before oldpos))
+ ;; The cdr might hold a new paren-class info rather than
+ ;; a matching-char info, in which case the two CDRs
+ ;; should match.
+ (eq matching-paren (cdr (syntax-after (1- oldpos))))))
+ (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")))
+ ((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.
+ (and blink-matching-paren-on-screen
+ (not show-paren-mode)
+ (save-excursion
+ (goto-char blinkpos)
+ (sit-for blink-matching-delay))))
+ (t
+ (save-excursion
+ (goto-char blinkpos)
+ (let ((open-paren-line-string
+ ;; Show what precedes the open in its line, if anything.
+ (cond
+ ((save-excursion (skip-chars-backward " \t") (not (bolp)))
+ (buffer-substring (line-beginning-position)
+ (1+ blinkpos)))
+ ;; Show what follows the open in its line, if anything.
+ ((save-excursion
+ (forward-char 1)
+ (skip-chars-forward " \t")
+ (not (eolp)))
+ (buffer-substring blinkpos
+ (line-end-position)))
+ ;; Otherwise show the previous nonblank line,
+ ;; if there is one.
+ ((save-excursion (skip-chars-backward "\n \t") (not (bobp)))
+ (concat
+ (buffer-substring (progn
+ (skip-chars-backward "\n \t")
+ (line-beginning-position))
+ (progn (end-of-line)
+ (skip-chars-backward " \t")
+ (point)))
+ ;; Replace the newline and other whitespace with `...'.
+ "..."
+ (buffer-substring blinkpos (1+ blinkpos))))
+ ;; There is nothing to show except the char itself.
+ (t (buffer-substring blinkpos (1+ blinkpos))))))
+ (message "Matches %s"
+ (substring-no-properties open-paren-line-string)))))))))
+
+;; Turned off because it makes dbx bomb out.
(setq blink-paren-function 'blink-matching-open)
\f
;; This executes C-g typed while Emacs is waiting for a command.
(abort-recursive-edit))
(current-prefix-arg
nil)
- ((and transient-mark-mode mark-active)
+ ((region-active-p)
(deactivate-mark))
((> (recursion-depth) 0)
(exit-recursive-edit))
\f
;; Define the major mode for lists of completions.
-(defvar completion-list-mode-map nil
+(defvar completion-list-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-2] 'mouse-choose-completion)
+ (define-key map [follow-link] 'mouse-face)
+ (define-key map [down-mouse-2] nil)
+ (define-key map "\C-m" 'choose-completion)
+ (define-key map "\e\e\e" 'delete-completion-window)
+ (define-key map [left] 'previous-completion)
+ (define-key map [right] 'next-completion)
+ map)
"Local map for completion list buffers.")
-(or completion-list-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [mouse-2] 'mouse-choose-completion)
- (define-key map [follow-link] 'mouse-face)
- (define-key map [down-mouse-2] nil)
- (define-key map "\C-m" 'choose-completion)
- (define-key map "\e\e\e" 'delete-completion-window)
- (define-key map [left] 'previous-completion)
- (define-key map [right] 'next-completion)
- (setq completion-list-mode-map map)))
;; Completion mode is suitable only for specially formatted data.
(put 'completion-list-mode 'mode-class 'special)
'choose-completion-string-functions
choice buffer mini-p base-size)
;; Insert the completion into the buffer where it was requested.
+ ;; FIXME:
+ ;; - There may not be a field at point, or there may be a field but
+ ;; it's not a "completion field", in which case we have to
+ ;; call choose-completion-delete-max-match even if base-size is set.
+ ;; - we may need to delete further than (point) to (field-end),
+ ;; depending on the completion-style, and for that we need to
+ ;; extra data `completion-extra-size'.
(if base-size
- (delete-region (+ base-size (if mini-p
- (minibuffer-prompt-end)
- (point-min)))
- (point))
+ (delete-region (+ base-size (field-beginning)) (point))
(choose-completion-delete-max-match choice))
(insert choice)
(remove-text-properties (- (point) (length choice)) (point)
(set-window-point window (point)))
;; If completing for the minibuffer, exit it with this choice.
(and (not completion-no-auto-exit)
- (equal buffer (window-buffer (minibuffer-window)))
+ (minibufferp buffer)
minibuffer-completion-table
;; If this is reading a file name, and the file name chosen
;; is a directory, don't exit the minibuffer.
- (if (and (eq minibuffer-completion-table 'read-file-name-internal)
+ (if (and minibuffer-completing-file-name
(file-directory-p (field-string (point-max))))
(let ((mini (active-minibuffer-window)))
(select-window mini)
(raise-frame (window-frame mini))))
(exit-minibuffer)))))))
-(defun completion-list-mode ()
+(define-derived-mode completion-list-mode nil "Completion List"
"Major mode for buffers showing lists of possible completions.
Type \\<completion-list-mode-map>\\[choose-completion] in the completion list\
to select the completion near point.
Use \\<completion-list-mode-map>\\[mouse-choose-completion] to select one\
- with the mouse."
- (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))
+ with the mouse.
+
+\\{completion-list-mode-map}"
+ (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))
\f
;;;; Keypad support.
-;;; Make the keypad keys act like ordinary typing keys. If people add
-;;; bindings for the function key symbols, then those bindings will
-;;; override these, so this shouldn't interfere with any existing
-;;; bindings.
+;; Make the keypad keys act like ordinary typing keys. If people add
+;; bindings for the function key symbols, then those bindings will
+;; override these, so this shouldn't interfere with any existing
+;; bindings.
;; Also tell read-char how to handle these keys.
(mapc
(defvar clone-buffer-hook nil
"Normal hook to run in the new buffer at the end of `clone-buffer'.")
+(defvar clone-indirect-buffer-hook nil
+ "Normal hook to run in the new buffer at the end of `clone-indirect-buffer'.")
+
(defun clone-process (process &optional newname)
"Create a twin copy of PROCESS.
If NEWNAME is nil, it defaults to PROCESS' name;
(funcall mode)
;; Set up other local variables.
- (mapcar (lambda (v)
- (condition-case () ;in case var is read-only
- (if (symbolp v)
- (makunbound v)
- (set (make-local-variable (car v)) (cdr v)))
- (error nil)))
- lvars)
+ (mapc (lambda (v)
+ (condition-case () ;in case var is read-only
+ (if (symbolp v)
+ (makunbound v)
+ (set (make-local-variable (car v)) (cdr v)))
+ (error nil)))
+ lvars)
;; Run any hooks (typically set up by the major mode
;; for cloning to work properly).
(setq newname (substring newname 0 (match-beginning 0))))
(let* ((name (generate-new-buffer-name newname))
(buffer (make-indirect-buffer (current-buffer) name t)))
+ (with-current-buffer buffer
+ (run-hooks 'clone-indirect-buffer-hook))
(when display-flag
(pop-to-buffer buffer norecord))
buffer))
\f
;;; Handling of Backspace and Delete keys.
-(defcustom normal-erase-is-backspace
- (and (not noninteractive)
- (or (memq system-type '(ms-dos windows-nt))
- (eq window-system 'mac)
- (and (memq window-system '(x))
- (fboundp 'x-backspace-delete-keys-p)
- (x-backspace-delete-keys-p))
- ;; If the terminal Emacs is running on has erase char
- ;; set to ^H, use the Backspace key for deleting
- ;; backward and, and the Delete key for deleting forward.
- (and (null window-system)
- (eq tty-erase-char ?\^H))))
- "If non-nil, Delete key deletes forward and Backspace key deletes backward.
-
-On window systems, the default value of this option is chosen
-according to the keyboard used. If the keyboard has both a Backspace
-key and a Delete key, and both are mapped to their usual meanings, the
-option's default value is set to t, so that Backspace can be used to
-delete backward, and Delete can be used to delete forward.
-
-If not running under a window system, customizing this option accomplishes
-a similar effect by mapping C-h, which is usually generated by the
-Backspace key, to DEL, and by mapping DEL to C-d via
-`keyboard-translate'. The former functionality of C-h is available on
-the F1 key. You should probably not use this setting if you don't
-have both Backspace, Delete and F1 keys.
+(defcustom normal-erase-is-backspace 'maybe
+ "Set the default behavior of the Delete and Backspace keys.
+
+If set to t, Delete key deletes forward and Backspace key deletes
+backward.
+
+If set to nil, both Delete and Backspace keys delete backward.
+
+If set to 'maybe (which is the default), Emacs automatically
+selects a behavior. On window systems, the behavior depends on
+the keyboard used. If the keyboard has both a Backspace key and
+a Delete key, and both are mapped to their usual meanings, the
+option's default value is set to t, so that Backspace can be used
+to delete backward, and Delete can be used to delete forward.
+
+If not running under a window system, customizing this option
+accomplishes a similar effect by mapping C-h, which is usually
+generated by the Backspace key, to DEL, and by mapping DEL to C-d
+via `keyboard-translate'. The former functionality of C-h is
+available on the F1 key. You should probably not use this
+setting if you don't have both Backspace, Delete and F1 keys.
Setting this variable with setq doesn't take effect. Programmatically,
call `normal-erase-is-backspace-mode' (which see) instead."
- :type 'boolean
+ :type '(choice (const :tag "Off" nil)
+ (const :tag "Maybe" maybe)
+ (other :tag "On" t))
:group 'editing-basics
:version "21.1"
:set (lambda (symbol value)
(normal-erase-is-backspace-mode (or value 0))
(set-default symbol value))))
+(defun normal-erase-is-backspace-setup-frame (&optional frame)
+ "Set up `normal-erase-is-backspace-mode' on FRAME, if necessary."
+ (unless frame (setq frame (selected-frame)))
+ (with-selected-frame frame
+ (unless (terminal-parameter nil 'normal-erase-is-backspace)
+ (normal-erase-is-backspace-mode
+ (if (if (eq normal-erase-is-backspace 'maybe)
+ (and (not noninteractive)
+ (or (memq system-type '(ms-dos windows-nt))
+ (eq window-system 'mac)
+ (and (memq window-system '(x))
+ (fboundp 'x-backspace-delete-keys-p)
+ (x-backspace-delete-keys-p))
+ ;; If the terminal Emacs is running on has erase char
+ ;; set to ^H, use the Backspace key for deleting
+ ;; backward, and the Delete key for deleting forward.
+ (and (null window-system)
+ (eq tty-erase-char ?\^H))))
+ normal-erase-is-backspace)
+ 1 0)))))
(defun normal-erase-is-backspace-mode (&optional arg)
"Toggle the Erase and Delete mode of the Backspace and Delete keys.
With numeric arg, turn the mode on if and only if ARG is positive.
-On window systems, when this mode is on, Delete is mapped to C-d and
-Backspace is mapped to DEL; when this mode is off, both Delete and
-Backspace are mapped to DEL. (The remapping goes via
-`function-key-map', so binding Delete or Backspace in the global or
-local keymap will override that.)
+On window systems, when this mode is on, Delete is mapped to C-d
+and Backspace is mapped to DEL; when this mode is off, both
+Delete and Backspace are mapped to DEL. (The remapping goes via
+`local-function-key-map', so binding Delete or Backspace in the
+global or local keymap will override that.)
In addition, on window systems, the bindings of C-Delete, M-Delete,
C-M-Delete, C-Backspace, M-Backspace, and C-M-Backspace are changed in
See also `normal-erase-is-backspace'."
(interactive "P")
- (setq normal-erase-is-backspace
- (if arg
- (> (prefix-numeric-value arg) 0)
- (not normal-erase-is-backspace)))
-
- (cond ((or (memq window-system '(x w32 mac pc))
- (memq system-type '(ms-dos windows-nt)))
- (let ((bindings
- `(([C-delete] [C-backspace])
- ([M-delete] [M-backspace])
- ([C-M-delete] [C-M-backspace])
- (,esc-map
- [C-delete] [C-backspace])))
- (old-state (lookup-key function-key-map [delete])))
-
- (if normal-erase-is-backspace
+ (let ((enabled (or (and arg (> (prefix-numeric-value arg) 0))
+ (and (not arg)
+ (not (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 mac pc))
+ (memq system-type '(ms-dos windows-nt)))
+ (let* ((bindings
+ `(([C-delete] [C-backspace])
+ ([M-delete] [M-backspace])
+ ([C-M-delete] [C-M-backspace])
+ (,esc-map
+ [C-delete] [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 [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)))))))
+ (t
+ (if enabled
(progn
- (define-key function-key-map [delete] [?\C-d])
- (define-key function-key-map [kp-delete] [?\C-d])
- (define-key function-key-map [backspace] [?\C-?]))
- (define-key function-key-map [delete] [?\C-?])
- (define-key function-key-map [kp-delete] [?\C-?])
- (define-key function-key-map [backspace] [?\C-?]))
-
- ;; Maybe swap bindings of C-delete and C-backspace, etc.
- (unless (equal old-state (lookup-key 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)))))))
- (t
- (if normal-erase-is-backspace
- (progn
- (keyboard-translate ?\C-h ?\C-?)
- (keyboard-translate ?\C-? ?\C-d))
- (keyboard-translate ?\C-h ?\C-h)
- (keyboard-translate ?\C-? ?\C-?))))
-
- (run-hooks 'normal-erase-is-backspace-hook)
- (if (interactive-p)
- (message "Delete key deletes %s"
- (if normal-erase-is-backspace "forward" "backward"))))
+ (keyboard-translate ?\C-h ?\C-?)
+ (keyboard-translate ?\C-? ?\C-d))
+ (keyboard-translate ?\C-h ?\C-h)
+ (keyboard-translate ?\C-? ?\C-?))))
+
+ (run-hooks 'normal-erase-is-backspace-hook)
+ (if (interactive-p)
+ (message "Delete key deletes %s"
+ (if (terminal-parameter nil 'normal-erase-is-backspace)
+ "forward" "backward")))))
\f
(defvar vis-mode-saved-buffer-invisibility-spec nil
"Saved value of `buffer-invisibility-spec' when Visible mode is on.")