;;; simple.el --- basic editing commands for Emacs
;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-;; 2000, 2001, 2002, 2003, 2004, 2005
-;; Free Software Foundation, Inc.
+;; 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
(autoload 'widget-convert "wid-edit")
(autoload 'shell-mode "shell"))
+(defvar compilation-current-error)
+
(defcustom idle-update-delay 0.5
"*Idle time delay before updating various things on the screen.
Various Emacs features that update auxiliary information when point moves
;;; next-error support framework
(defgroup next-error nil
- "next-error support framework."
+ "`next-error' support framework."
:group 'compilation
:version "22.1")
(defcustom next-error-highlight 0.1
"*Highlighting of locations in selected source buffers.
-If number, highlight the locus in next-error face for given time in seconds.
-If t, use persistent overlays fontified in next-error face.
+If number, highlight the locus in `next-error' face for given time in seconds.
+If t, use persistent overlays fontified in `next-error' face.
If nil, don't highlight the locus in the source buffer.
If `fringe-arrow', indicate the locus by the fringe arrow."
:type '(choice (number :tag "Delay")
(defcustom next-error-highlight-no-select 0.1
"*Highlighting of locations in non-selected source buffers.
-If number, highlight the locus in next-error face for given time in seconds.
-If t, use persistent overlays fontified in next-error face.
+If number, highlight the locus in `next-error' face for given time in seconds.
+If t, use persistent overlays fontified in `next-error' face.
If nil, don't highlight the locus in the source buffer.
If `fringe-arrow', indicate the locus by the fringe arrow."
:type '(choice (number :tag "Delay")
:group 'next-error
:version "22.1")
+(defcustom next-error-hook nil
+ "*List of hook functions run by `next-error' after visiting source file."
+ :type 'hook
+ :group 'next-error)
+
(defvar next-error-highlight-timer nil)
(defvar next-error-overlay-arrow-position nil)
(add-to-list 'overlay-arrow-variable-list 'next-error-overlay-arrow-position)
(defvar next-error-last-buffer nil
- "The most recent next-error buffer.
+ "The most recent `next-error' buffer.
A buffer becomes most recent when its compilation, grep, or
similar mode is started, or when it is used with \\[next-error]
or \\[compile-goto-error].")
&optional avoid-current
extra-test-inclusive
extra-test-exclusive)
- "Test if BUFFER is a next-error capable buffer.
+ "Test if BUFFER is a `next-error' capable buffer.
If AVOID-CURRENT is non-nil, treat the current buffer
as an absolute last resort only.
(defun next-error-find-buffer (&optional avoid-current
extra-test-inclusive
extra-test-exclusive)
- "Return a next-error capable buffer.
+ "Return a `next-error' capable buffer.
If AVOID-CURRENT is non-nil, treat the current buffer
as an absolute last resort only.
(error "No next-error capable buffer found")))
(defun next-error (&optional arg reset)
- "Visit next next-error message and corresponding source code.
+ "Visit next `next-error' message and corresponding source code.
If all the error messages parsed so far have been processed already,
the message buffer is checked for new ones.
\\[next-error] in that buffer when it is the only one displayed
in the current frame.
-Once \\[next-error] has chosen the buffer for error messages,
-it stays with that buffer until you use it in some other buffer which
-uses Compilation mode or Compilation Minor mode.
+Once \\[next-error] has chosen the buffer for error messages, it
+runs `next-error-hook' with `run-hooks', and stays with that buffer
+until you use it in some other buffer which uses Compilation mode
+or Compilation Minor mode.
See variables `compilation-parse-errors-function' and
\`compilation-error-regexp-alist' for customization ideas."
(when (setq next-error-last-buffer (next-error-find-buffer))
;; 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))))
+ (funcall next-error-function (prefix-numeric-value arg) reset)
+ (run-hooks 'next-error-hook))))
+
+(defun next-error-internal ()
+ "Visit the source code corresponding to the `next-error' message at point."
+ (setq next-error-last-buffer (current-buffer))
+ ;; 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)
+ (run-hooks 'next-error-hook)))
(defalias 'goto-next-locus 'next-error)
(defalias 'next-match 'next-error)
(defun previous-error (&optional n)
- "Visit previous next-error message and corresponding source code.
+ "Visit previous `next-error' message and corresponding source code.
Prefix arg N says how many error messages to move backwards (or
forwards, if negative).
(next-error n t))
(defun next-error-no-select (&optional n)
- "Move point to the next error in the next-error buffer and highlight match.
+ "Move point to the next error in the `next-error' buffer and highlight match.
Prefix arg N says how many error messages to move forwards (or
backwards, if negative).
Finds and highlights the source line like \\[next-error], but does not
(pop-to-buffer next-error-last-buffer))
(defun previous-error-no-select (&optional n)
- "Move point to the previous error in the next-error buffer and highlight match.
+ "Move point to the previous error in the `next-error' buffer and highlight match.
Prefix arg N says how many error messages to move backwards (or
forwards, if negative).
Finds and highlights the source line like \\[previous-error], but does not
When turned on, cursor motion in the compilation, grep, occur or diff
buffer causes automatic display of the corresponding source code
location."
- :group 'next-error :init-value " Fol"
+ :group 'next-error :init-value nil :lighter " Fol"
(if (not next-error-follow-minor-mode)
(remove-hook 'post-command-hook 'next-error-follow-mode-post-command-hook t)
(add-hook 'post-command-hook 'next-error-follow-mode-post-command-hook nil t)
- (make-variable-buffer-local 'next-error-follow-last-line)))
+ (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.
(defun open-line (n)
"Insert a newline and leave point before it.
-If there is a fill prefix and/or a left-margin, insert them on the new line
-if the line would have been blank.
+If there is a fill prefix and/or a `left-margin', insert them
+on the new line if the line would have been blank.
With arg N, insert N newlines."
(interactive "*p")
(let* ((do-fill-prefix (and fill-prefix (bolp)))
(defun split-line (&optional arg)
"Split current line, moving portion beyond point vertically down.
If the current line starts with `fill-prefix', insert it on the new
-line as well. With prefix ARG, don't insert fill-prefix on new line.
+line as well. With prefix ARG, don't insert `fill-prefix' on new line.
When called from Lisp code, ARG may be a prefix string to copy."
(interactive "*P")
(save-excursion (forward-char -1)
(looking-at "$\\|\\s(\\|\\s'")))
nil
- (insert ?\ ))))
+ (insert ?\s))))
(defun delete-horizontal-space (&optional backward-only)
"Delete all spaces and tabs around point.
(skip-chars-backward " \t")
(constrain-to-field nil orig-pos)
(dotimes (i (or n 1))
- (if (= (following-char) ?\ )
+ (if (= (following-char) ?\s)
(forward-char 1)
- (insert ?\ )))
+ (insert ?\s)))
(delete-region
(point)
(progn
(message "point=%d of %d (%d%%) column %d %s"
pos total percent col hscroll))
(let ((coding buffer-file-coding-system)
- encoded encoding-msg)
+ encoded encoding-msg display-prop under-display)
(if (or (not coding)
(eq (coding-system-type coding) t))
(setq coding default-buffer-file-coding-system))
(if (not (char-valid-p char))
(setq encoding-msg
(format "(0%o, %d, 0x%x, invalid)" char char char))
- (setq encoded (and (>= char 128) (encode-coding-char char coding)))
+ ;; 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.
+ (setq display-prop (get-text-property pos 'display))
+ (if display-prop
+ (let ((to (or (next-single-property-change pos 'display)
+ (point-max))))
+ (if (< to (+ pos 4))
+ (setq under-display "")
+ (setq under-display "..."
+ to (+ pos 4)))
+ (setq under-display
+ (concat (buffer-substring-no-properties pos to)
+ under-display)))
+ (setq encoded (and (>= char 128) (encode-coding-char char coding))))
(setq encoding-msg
- (if encoded
- (format "(0%o, %d, 0x%x, file %s)"
- char char char
- (if (> (length encoded) 1)
- "..."
- (encoded-string-description encoded coding)))
- (format "(0%o, %d, 0x%x)" char char char))))
+ (if display-prop
+ (if (not (stringp display-prop))
+ (format "(0%o, %d, 0x%x, part of display \"%s\")"
+ char char char under-display)
+ (format "(0%o, %d, 0x%x, part of display \"%s\"->\"%s\")"
+ char char char under-display display-prop))
+ (if encoded
+ (format "(0%o, %d, 0x%x, file %s)"
+ char char char
+ (if (> (length encoded) 1)
+ "..."
+ (encoded-string-description encoded coding)))
+ (format "(0%o, %d, 0x%x)" char char char)))))
(if detail
;; We show the detailed information about CHAR.
(describe-char (point)))
(buffer-substring-no-properties (point) (1+ (point))))
encoding-msg pos total percent beg end col hscroll)
(message "Char: %s %s point=%d of %d (%d%%) column %d %s"
- (if (< char 256)
- (single-key-description char)
- (buffer-substring-no-properties (point) (1+ (point))))
+ (if enable-multibyte-characters
+ (if (< char 128)
+ (single-key-description char)
+ (buffer-substring-no-properties (point) (1+ (point))))
+ (single-key-description char))
encoding-msg pos total percent col hscroll))))))
\f
(defvar read-expression-map
(memq this-command '(eval-last-sexp eval-print-last-sexp)))
(prin1-char value))))
(if char-string
- (format " (0%o, 0x%x) = %s" value value char-string)
- (format " (0%o, 0x%x)" value value)))))
+ (format " (#o%o, #x%x, %s)" value value char-string)
+ (format " (#o%o, #x%x)" value value)))))
;; We define this, rather than making `eval' interactive,
;; for the sake of completion of names like eval-region, eval-current-buffer.
;; For compatibility with the old subr of the same name.
(defun minibuffer-prompt-width ()
"Return the display width of the minibuffer prompt.
-Return 0 if current buffer is not a mini-buffer."
+Return 0 if current buffer is not a minibuffer."
;; Return the width of everything before the field at the end of
;; the buffer; this should be 0 for normal buffers.
(1- (minibuffer-prompt-end)))
;; and will get another error. To begin undoing the undos,
;; you must type some other command.
(let ((modified (buffer-modified-p))
- (recent-save (recent-auto-save-p)))
+ (recent-save (recent-auto-save-p))
+ message)
;; If we get an error in undo-start,
;; the next command should not be a "consecutive undo".
;; So set `this-command' to something other than `undo'.
;; so, ask the user whether she wants to skip the redo/undo pair.
(let ((equiv (gethash pending-undo-list undo-equiv-table)))
(or (eq (selected-window) (minibuffer-window))
- (message (if undo-in-region
- (if equiv "Redo in region!" "Undo in region!")
- (if equiv "Redo!" "Undo!"))))
+ (setq message (if undo-in-region
+ (if equiv "Redo in region!" "Undo in region!")
+ (if equiv "Redo!" "Undo!"))))
(when (and (consp equiv) undo-no-redo)
;; The equiv entry might point to another redo record if we have done
;; undo-redo-undo-redo-... so skip to the very last equiv.
;; Record what the current undo list says,
;; so the next command can tell if the buffer was modified in between.
(and modified (not (buffer-modified-p))
- (delete-auto-save-file-if-necessary recent-save))))
+ (delete-auto-save-file-if-necessary recent-save))
+ ;; Display a message announcing success.
+ (if message
+ (message message))))
(defun buffer-disable-undo (&optional buffer)
"Make BUFFER stop keeping undo information.
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
+may access and use elements from the kill ring directly, the STRING
argument should still be a \"useful\" string for such uses."
(if (> (length string) 0)
(if yank-handler
(menu-bar-update-yank-menu string (and replace (car kill-ring))))
(if (and replace kill-ring)
(setcar kill-ring string)
- (setq kill-ring (cons string kill-ring))
+ (push string kill-ring)
(if (> (length kill-ring) kill-ring-max)
(setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
(setq kill-ring-yank-pointer kill-ring)
(let ((col (current-column)))
(forward-char -1)
(setq col (- col (current-column)))
- (insert-char ?\ col)
+ (insert-char ?\s col)
(delete-char 1)))
(forward-char -1)
(setq count (1- count))))))
START and END specify the portion of the current buffer to be copied."
(interactive "BCopy to buffer: \nr")
(let ((oldbuf (current-buffer)))
- (save-excursion
- (set-buffer (get-buffer-create buffer))
+ (with-current-buffer (get-buffer-create buffer)
(barf-if-buffer-read-only)
(erase-buffer)
(save-excursion
(unless nomsg
(message "Mark activated")))))
+(defcustom set-mark-command-repeat-pop nil
+ "*Non-nil means that repeating \\[set-mark-command] after popping will pop.
+This means that if you type C-u \\[set-mark-command] \\[set-mark-command]
+will pop twice."
+ :type 'boolean
+ :group 'editing)
+
(defun set-mark-command (arg)
"Set mark at where point is, or jump to mark.
With no prefix argument, set mark, and push old mark position on local
(if arg
(pop-to-mark-command)
(push-mark-command t)))
- ((eq last-command 'pop-to-mark-command)
+ ((and set-mark-command-repeat-pop
+ (eq last-command 'pop-to-mark-command))
(setq this-command 'pop-to-mark-command)
(pop-to-mark-command))
- ((and (eq last-command 'pop-global-mark) (not arg))
+ ((and set-mark-command-repeat-pop
+ (eq last-command 'pop-global-mark)
+ (not arg))
(setq this-command 'pop-global-mark)
(pop-global-mark))
(arg
(or (and (>= position (point-min))
(<= position (point-max)))
(if widen-automatically
- (error "Global mark position is outside accessible part of buffer")
- (widen)))
+ (widen)
+ (error "Global mark position is outside accessible part of buffer")))
(goto-char position)
(switch-to-buffer buffer)))
\f
;; Now move a line.
(end-of-line)
;; If there's no invisibility here, move over the newline.
- (let ((pos-before (point))
- line-done)
- (if (eobp)
- (if (not noerror)
- (signal 'end-of-buffer nil)
- (setq done t)))
- (when (and (not done)
- (not (integerp selective-display))
- (not (line-move-invisible-p (point))))
- (unless (overlays-in (max (1- pos-before) (point-min))
- (min (1+ (point)) (point-max)))
- ;; We avoid vertical-motion when possible
- ;; because that has to fontify.
- (forward-line 1)
- (setq line-done t)))
- (and (not done) (not line-done)
- ;; Otherwise move a more sophisticated way.
- (zerop (vertical-motion 1))
- (if (not noerror)
- (signal 'end-of-buffer nil)
- (setq done t))))
+ (cond
+ ((eobp)
+ (if (not noerror)
+ (signal 'end-of-buffer nil)
+ (setq done t)))
+ ((and (> arg 1) ;; Use vertical-motion for last move
+ (not (integerp selective-display))
+ (not (line-move-invisible-p (point))))
+ ;; We avoid vertical-motion when possible
+ ;; because that has to fontify.
+ (forward-line 1))
+ ;; Otherwise move a more sophisticated way.
+ ((zerop (vertical-motion 1))
+ (if (not noerror)
+ (signal 'end-of-buffer nil)
+ (setq done t))))
(unless done
(setq arg (1- arg))))
;; The logic of this is the same as the loop above,
;; it just goes in the other direction.
(while (and (< arg 0) (not done))
(beginning-of-line)
- (let ((pos-before (point))
- line-done)
- (if (bobp)
- (if (not noerror)
- (signal 'beginning-of-buffer nil)
- (setq done t)))
- (when (and (not done)
- (not (integerp selective-display))
- (not (line-move-invisible-p (1- (point)))))
- (unless (overlays-in (max (1- (point)) (point-min))
- (min (1+ pos-before) (point-max)))
- (forward-line -1)
- (setq line-done t)))
- (and (not done) (not line-done)
- (zerop (vertical-motion -1))
- (if (not noerror)
- (signal 'beginning-of-buffer nil)
- (setq done t))))
+ (cond
+ ((bobp)
+ (if (not noerror)
+ (signal 'beginning-of-buffer nil)
+ (setq done t)))
+ ((and (< arg -1) ;; Use vertical-motion for last move
+ (not (integerp selective-display))
+ (not (line-move-invisible-p (1- (point)))))
+ (forward-line -1))
+ ((zerop (vertical-motion -1))
+ (if (not noerror)
+ (signal 'beginning-of-buffer nil)
+ (setq done t))))
(unless done
(setq arg (1+ arg))
(while (and ;; Don't move over previous invis lines
;; at least go to end of line.
(end-of-line))
((< arg 0)
- ;; If we did not move down as far as desired,
- ;; at least go to end of line.
+ ;; If we did not move up as far as desired,
+ ;; at least go to beginning of line.
(beginning-of-line))
(t
(line-move-finish (or goal-column temporary-goal-column)
;; Compute the end of the line
;; ignoring effectively invisible newlines.
(save-excursion
- (end-of-line)
+ ;; Like end-of-line but ignores fields.
+ (skip-chars-forward "^\n")
(while (and (not (eobp)) (line-move-invisible-p (point)))
(goto-char (next-char-property-change (point)))
- (end-of-line))
+ (skip-chars-forward "^\n"))
(point))))
;; Move to the desired column.
(setq goal-column nil)
(message "No goal column"))
(setq goal-column (current-column))
- (message (substitute-command-keys
- "Goal column %d (use \\[set-goal-column] with an arg to unset it)")
- goal-column))
+ ;; The older method below can be erroneous if `set-goal-column' is bound
+ ;; to a sequence containing %
+ ;;(message (substitute-command-keys
+ ;;"Goal column %d (use \\[set-goal-column] with an arg to unset it)")
+ ;;goal-column)
+ (message "%s"
+ (concat
+ (format "Goal column %d " goal-column)
+ (substitute-command-keys
+ "(use \\[set-goal-column] with an arg to unset it)")))
+
+ )
nil)
\f
(setq arg (current-column)))
(if (not (integerp arg))
;; Disallow missing argument; it's probably a typo for C-x C-f.
- (error "Set-fill-column requires an explicit argument")
+ (error "set-fill-column requires an explicit argument")
(message "Fill column set to %d (was %d)" arg fill-column)
(setq fill-column arg)))
\f
typing characters do.
Note that binary overwrite mode is not its own minor mode; it is a
-specialization of overwrite-mode, entered by setting the
+specialization of overwrite mode, entered by setting the
`overwrite-mode' variable to `overwrite-mode-binary'."
(interactive "P")
(setq overwrite-mode
:group 'paren-blinking)
(defcustom blink-matching-paren-distance (* 25 1024)
- "*If non-nil, is maximum distance to search for matching open-paren."
- :type 'integer
+ "*If non-nil, maximum distance to search backwards for matching open-paren.
+If nil, search stops at the beginning of the accessible portion of the buffer."
+ :type '(choice (const nil) integer)
:group 'paren-blinking)
(defcustom blink-matching-delay 1
(defun blink-matching-open ()
"Move cursor momentarily to the beginning of the sexp before point."
(interactive)
- (and (> (point) (1+ (point-min)))
- blink-matching-paren
- ;; Verify an even number of quoting characters precede the close.
- (= 1 (logand 1 (- (point)
- (save-excursion
- (forward-char -1)
- (skip-syntax-backward "/\\")
- (point)))))
- (let* ((oldpos (point))
- (blinkpos)
- (mismatch)
- matching-paren)
- (save-excursion
- (save-restriction
- (if blink-matching-paren-distance
- (narrow-to-region (max (point-min)
- (- (point) blink-matching-paren-distance))
- 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 (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)))
- mismatch
- (or (null matching-paren)
- (/= (char-after (1- oldpos))
- matching-paren))))
- (if mismatch (setq blinkpos nil))
- (if blinkpos
- ;; Don't log messages about paren matching.
- (let (message-log-max)
- (goto-char blinkpos)
- (if (pos-visible-in-window-p)
- (and blink-matching-paren-on-screen
- (sit-for blink-matching-delay))
- (goto-char blinkpos)
- (message
- "Matches %s"
- ;; Show what precedes the open in its line, if anything.
- (if (save-excursion
- (skip-chars-backward " \t")
- (not (bolp)))
- (buffer-substring (progn (beginning-of-line) (point))
- (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
- (progn (end-of-line) (point)))
- ;; Otherwise show the previous nonblank line,
- ;; if there is one.
- (if (save-excursion
- (skip-chars-backward "\n \t")
- (not (bobp)))
- (concat
- (buffer-substring (progn
+ (when (and (> (point) (point-min))
+ blink-matching-paren
+ ;; Verify an even number of quoting characters precede the close.
+ (= 1 (logand 1 (- (point)
+ (save-excursion
+ (forward-char -1)
+ (skip-syntax-backward "/\\")
+ (point))))))
+ (let* ((oldpos (point))
+ blinkpos
+ message-log-max ; Don't log messages about paren matching.
+ matching-paren
+ open-paren-line-string)
+ (save-excursion
+ (save-restriction
+ (if blink-matching-paren-distance
+ (narrow-to-region (max (point-min)
+ (- (point) blink-matching-paren-distance))
+ 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 (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
+ ((or (null matching-paren)
+ (/= (char-before oldpos)
+ matching-paren))
+ (message "Mismatched parentheses"))
+ ((not blinkpos)
+ (if (not blink-matching-paren-distance)
+ (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.
+ (when blink-matching-paren-on-screen
+ (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")
- (beginning-of-line)
- (point))
- (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))))))))
- (cond (mismatch
- (message "Mismatched parentheses"))
- ((not blink-matching-paren-distance)
- (message "Unmatched parenthesis"))))))))
+ (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.
(setq blink-paren-function 'blink-matching-open)
With a prefix argument, set VARIABLE to VALUE buffer-locally."
(interactive
(let* ((default-var (variable-at-point))
- (var (if (symbolp default-var)
- (read-variable (format "Set variable (default %s): " default-var)
- default-var)
- (read-variable "Set variable: ")))
+ (var (if (user-variable-p default-var)
+ (read-variable (format "Set variable (default %s): " default-var)
+ default-var)
+ (read-variable "Set variable: ")))
(minibuffer-help-form '(describe-variable var))
(prop (get var 'variable-interactive))
(obsolete (car (get var 'byte-obsolete-variable)))
arg))
(read
(read-string prompt nil
- 'set-variable-value-history))))))
+ 'set-variable-value-history
+ (format "%S" (symbol-value var))))))))
(list var val current-prefix-arg)))
(and (custom-variable-p variable)
"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 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'.
-;; This function goes in completion-setup-hook, so that it is called
-;; after the text of the completion list buffer is written.
(defface completions-first-difference
'((t (:inherit bold)))
"Face put on the first uncommon character in completions in *Completions* buffer."
(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'
+into \"*Completions*\* buffer, the common prefix substring in completions is
+needed as a hint. (Minibuffer is a special case. The content of minibuffer itself
+is the 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 ()
- (let ((mainbuf (current-buffer))
- (mbuf-contents (minibuffer-contents)))
+ (let* ((mainbuf (current-buffer))
+ (mbuf-contents (minibuffer-contents))
+ (common-string-length (length mbuf-contents)))
;; When reading a file name in the minibuffer,
;; set default-directory in the minibuffer
;; so it will get copied into the completion list buffer.
;; FIXME: This still doesn't work if the text to be completed
;; starts with a `-'.
(when (and partial-completion-mode (not (eobp)))
- (setq mbuf-contents
- (substring mbuf-contents 0 (- (point) (point-max)))))
+ (setq common-string-length
+ (- common-string-length (- (point) (point-max)))))
(with-current-buffer standard-output
(completion-list-mode)
- (make-local-variable 'completion-reference-buffer)
- (setq completion-reference-buffer mainbuf)
+ (set (make-local-variable 'completion-reference-buffer) mainbuf)
(if minibuffer-completing-file-name
;; For file name completion,
;; use the number of chars before the start of the
(funcall (get minibuffer-completion-table 'completion-base-size-function)))
(setq completion-base-size 0))))
;; Put faces on first uncommon characters and common parts.
- (when completion-base-size
- (let* ((common-string-length
- (- (length mbuf-contents) completion-base-size))
- (element-start (next-single-property-change
- (point-min)
- 'mouse-face))
- (element-common-end
- (and element-start
- (+ (or element-start nil) common-string-length)))
- (maxp (point-max)))
- (while (and element-start (< element-common-end maxp))
+ (when (or completion-common-substring completion-base-size)
+ (setq common-string-length
+ (if completion-common-substring
+ (length completion-common-substring)
+ (- common-string-length completion-base-size)))
+ (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 (and (get-char-property element-start 'mouse-face)
(get-char-property element-common-end 'mouse-face))
(put-text-property element-start element-common-end
'font-lock-face 'completions-common-part)
(put-text-property element-common-end (1+ element-common-end)
- 'font-lock-face 'completions-first-difference))
- (setq element-start (next-single-property-change
- element-start
- 'mouse-face))
- (if element-start
- (setq element-common-end (+ element-start common-string-length))))))
+ 'font-lock-face 'completions-first-difference)))))
;; Insert help string.
(goto-char (point-min))
(if (display-mouse-p)
(add-hook 'completion-setup-hook 'completion-setup-function)
-(define-key minibuffer-local-completion-map [prior]
- 'switch-to-completions)
-(define-key minibuffer-local-must-match-map [prior]
- 'switch-to-completions)
-(define-key minibuffer-local-completion-map "\M-v"
- 'switch-to-completions)
-(define-key minibuffer-local-must-match-map "\M-v"
- 'switch-to-completions)
+(define-key minibuffer-local-completion-map [prior] 'switch-to-completions)
+(define-key minibuffer-local-completion-map "\M-v" 'switch-to-completions)
(defun switch-to-completions ()
"Select the completion list window."
(define-key function-key-map (vector keypad) (vector normal))))
'((kp-0 ?0) (kp-1 ?1) (kp-2 ?2) (kp-3 ?3) (kp-4 ?4)
(kp-5 ?5) (kp-6 ?6) (kp-7 ?7) (kp-8 ?8) (kp-9 ?9)
- (kp-space ?\ )
+ (kp-space ?\s)
(kp-tab ?\t)
(kp-enter ?\r)
(kp-multiply ?*)
DISPLAY-FLAG non-nil means show the new buffer with `pop-to-buffer'.
This is always done when called interactively.
-Optional last arg NORECORD non-nil means do not put this buffer at the
+Optional third arg NORECORD non-nil means do not put this buffer at the
front of the list of recently selected ones."
(interactive
(progn
\f
;;; Handling of Backspace and Delete keys.
-(defcustom normal-erase-is-backspace
- (and (not noninteractive)
- (or (memq system-type '(ms-dos windows-nt))
- (eq initial-window-system 'mac)
- (and (memq initial-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 initial-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 behaviour 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 behaviour. On window systems, the behaviour 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-p nil 'normal-erase-is-backspace)
+ (if (cond ((terminal-parameter-p nil 'normal-erase-is-backspace)
+ (terminal-parameter nil 'normal-erase-is-backspace))
+ ((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, and the Delete key for deleting forward.
+ (and (null window-system)
+ (eq tty-erase-char ?\^H)))))
+ (t
+ normal-erase-is-backspace))
+ (normal-erase-is-backspace-mode 1)
+ (normal-erase-is-backspace-mode 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)))
+ (set-terminal-parameter
+ nil 'normal-erase-is-backspace
+ (if arg
+ (> (prefix-numeric-value arg) 0)
+ (not (terminal-parameter nil '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* ((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 (terminal-parameter nil 'normal-erase-is-backspace)
(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-?]))
+ (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 function-key-map [delete]))
+ (unless (equal old-state (lookup-key local-function-key-map [delete]))
(dolist (binding bindings)
(let ((map global-map))
(when (keymapp (car binding))
(define-key map key1 binding2)
(define-key map key2 binding1)))))))
(t
- (if normal-erase-is-backspace
+ (if (terminal-parameter nil 'normal-erase-is-backspace)
(progn
(keyboard-translate ?\C-h ?\C-?)
(keyboard-translate ?\C-? ?\C-d))
HCoop / bpt / emacs.git / blobdiff