;;; simple.el --- basic editing commands for Emacs
-;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99,
-;; 2000, 01, 02, 03, 04
+;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+;; 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Maintainer: FSF
(setq found buffer)))
(setq list (cdr list)))
(switch-to-buffer found)))
-
+\f
;;; next-error support framework
+
+(defgroup next-error nil
+ "next-error support framework."
+ :group 'compilation
+ :version "21.4")
+
+(defface next-error
+ '((t (:inherit region)))
+ "Face used to highlight next error locus."
+ :group 'next-error
+ :version "21.4")
+
+(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 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")
+ (const :tag "Persistent overlay" t)
+ (const :tag "No highlighting" nil)
+ (const :tag "Fringe arrow" 'fringe-arrow))
+ :group 'next-error
+ :version "21.4")
+
+(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 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")
+ (const :tag "Persistent overlay" t)
+ (const :tag "No highlighting" nil)
+ (const :tag "Fringe arrow" 'fringe-arrow))
+ :group 'next-error
+ :version "21.4")
+
(defvar next-error-last-buffer nil
"The most recent next-error buffer.
A buffer becomes most recent when its compilation, grep, or
(make-variable-buffer-local 'next-error-function)
-(defsubst next-error-buffer-p (buffer &optional extra-test)
- "Test if BUFFER is a next-error capable buffer."
+(defsubst next-error-buffer-p (buffer
+ &optional
+ extra-test-inclusive
+ extra-test-exclusive)
+ "Test if BUFFER is a next-error capable buffer.
+EXTRA-TEST-INCLUSIVE is called to allow extra buffers.
+EXTRA-TEST-EXCLUSIVE is called to disallow buffers."
(with-current-buffer buffer
- (or (and extra-test (funcall extra-test))
- next-error-function)))
-
-;; Return a next-error capable buffer according to the following rules:
-;; 1. If the current buffer is a next-error capable buffer, return it.
-;; 2. If one window on the selected frame displays such buffer, return it.
-;; 3. If next-error-last-buffer is set to a live buffer, use that.
-;; 4. Otherwise, look for a next-error capable buffer in a buffer list.
-;; 5. Signal an error if there are none.
-(defun next-error-find-buffer (&optional other-buffer extra-test)
- (if (and (not other-buffer)
- (next-error-buffer-p (current-buffer) extra-test))
- ;; The current buffer is a next-error capable buffer.
- (current-buffer)
- (or
- (let ((window-buffers
- (delete-dups
- (delq nil
- (mapcar (lambda (w)
- (and (next-error-buffer-p (window-buffer w) extra-test)
- (window-buffer w)))
- (window-list))))))
- (if other-buffer
- (setq window-buffers (delq (current-buffer) window-buffers)))
- (if (eq (length window-buffers) 1)
- (car window-buffers)))
- (if (and next-error-last-buffer (buffer-name next-error-last-buffer)
- (next-error-buffer-p next-error-last-buffer extra-test)
- (or (not other-buffer) (not (eq next-error-last-buffer
- (current-buffer)))))
- next-error-last-buffer
- (let ((buffers (buffer-list)))
- (while (and buffers (or (not (next-error-buffer-p (car buffers) extra-test))
- (and other-buffer
- (eq (car buffers) (current-buffer)))))
- (setq buffers (cdr buffers)))
- (if buffers
- (car buffers)
- (or (and other-buffer
- (next-error-buffer-p (current-buffer) extra-test)
- ;; The current buffer is a next-error capable buffer.
- (progn
- (if other-buffer
- (message "This is the only next-error capable buffer."))
- (current-buffer)))
- (error "No next-error capable buffer found"))))))))
-
-(defun next-error (arg &optional reset)
+ (or (and extra-test-inclusive (funcall extra-test-inclusive))
+ (and (if extra-test-exclusive (funcall extra-test-exclusive) t)
+ next-error-function))))
+
+(defun next-error-find-buffer (&optional other-buffer
+ extra-test-inclusive
+ extra-test-exclusive)
+ "Return a next-error capable buffer.
+OTHER-BUFFER will disallow the current buffer.
+EXTRA-TEST-INCLUSIVE is called to allow extra buffers.
+EXTRA-TEST-EXCLUSIVE is called to disallow buffers."
+ (or
+ ;; 1. If one window on the selected frame displays such buffer, return it.
+ (let ((window-buffers
+ (delete-dups
+ (delq nil (mapcar (lambda (w)
+ (if (next-error-buffer-p
+ (window-buffer w)
+ extra-test-inclusive extra-test-exclusive)
+ (window-buffer w)))
+ (window-list))))))
+ (if other-buffer
+ (setq window-buffers (delq (current-buffer) window-buffers)))
+ (if (eq (length window-buffers) 1)
+ (car window-buffers)))
+ ;; 2. If next-error-last-buffer is set to a live buffer, use that.
+ (if (and next-error-last-buffer
+ (buffer-name next-error-last-buffer)
+ (next-error-buffer-p next-error-last-buffer
+ extra-test-inclusive extra-test-exclusive)
+ (or (not other-buffer)
+ (not (eq next-error-last-buffer (current-buffer)))))
+ next-error-last-buffer)
+ ;; 3. If the current buffer is a next-error capable buffer, return it.
+ (if (and (not other-buffer)
+ (next-error-buffer-p (current-buffer)
+ extra-test-inclusive extra-test-exclusive))
+ (current-buffer))
+ ;; 4. Look for a next-error capable buffer in a buffer list.
+ (let ((buffers (buffer-list)))
+ (while (and buffers
+ (or (not (next-error-buffer-p
+ (car buffers)
+ extra-test-inclusive extra-test-exclusive))
+ (and other-buffer (eq (car buffers) (current-buffer)))))
+ (setq buffers (cdr buffers)))
+ (if buffers
+ (car buffers)
+ (or (and other-buffer
+ (next-error-buffer-p (current-buffer)
+ extra-test-inclusive extra-test-exclusive)
+ ;; The current buffer is a next-error capable buffer.
+ (progn
+ (if other-buffer
+ (message "This is the only next-error capable buffer"))
+ (current-buffer)))
+ (error "No next-error capable buffer found"))))))
+
+(defun next-error (&optional arg reset)
"Visit next next-error message and corresponding source code.
If all the error messages parsed so far have been processed already,
buffer with output from the \\[compile], \\[grep] commands, or,
more generally, on any buffer in Compilation mode or with
Compilation Minor mode enabled, or any buffer in which
-`next-error-function' is bound to an appropriate
-function. To specify use of a particular buffer for error
-messages, type \\[next-error] in that buffer.
+`next-error-function' is bound to an appropriate function.
+To specify use of a particular buffer for error messages, type
+\\[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
(define-key ctl-x-map "`" 'next-error)
-(defun previous-error (n)
+(defun previous-error (&optional n)
"Visit previous next-error message and corresponding source code.
Prefix arg N says how many error messages to move backwards (or
This operates on the output from the \\[compile] and \\[grep] commands."
(interactive "p")
- (next-error (- n)))
+ (next-error (- (or n 1))))
-(defun first-error (n)
+(defun first-error (&optional n)
"Restart at the first error.
Visit corresponding source code.
With prefix arg N, visit the source code of the Nth error.
(interactive "p")
(next-error n t))
-(defun next-error-no-select (n)
+(defun next-error-no-select (&optional n)
"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
select the source buffer."
(interactive "p")
- (next-error n)
+ (let ((next-error-highlight next-error-highlight-no-select))
+ (next-error n))
(pop-to-buffer next-error-last-buffer))
-(defun previous-error-no-select (n)
+(defun previous-error-no-select (&optional n)
"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
select the source buffer."
(interactive "p")
- (next-error-no-select (- n)))
+ (next-error-no-select (- (or n 1))))
+
+;;; Internal variable for `next-error-follow-mode-post-command-hook'.
+(defvar next-error-follow-last-line nil)
+
+(define-minor-mode next-error-follow-minor-mode
+ "Minor mode for compilation, occur and diff modes.
+When turned on, cursor motion in the compilation, grep, occur or diff
+buffer causes automatic display of the corresponding source code
+location."
+ nil " Fol" nil
+ (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)))
+
+;;; Used as a `post-command-hook' by `next-error-follow-mode'
+;;; for the *Compilation* *grep* and *Occur* buffers.
+(defun next-error-follow-mode-post-command-hook ()
+ (unless (equal next-error-follow-last-line (line-number-at-pos))
+ (setq next-error-follow-last-line (line-number-at-pos))
+ (condition-case nil
+ (let ((compilation-context-lines nil))
+ (setq compilation-current-error (point))
+ (next-error-no-select 0))
+ (error t))))
+\f
;;;
(defun fundamental-mode ()
"Major mode not specialized for anything in particular.
Other major modes are defined by comparison with this one."
(interactive)
- (kill-all-local-variables))
+ (kill-all-local-variables)
+ (run-hooks 'after-change-major-mode-hook))
;; Making and deleting lines.
\f
(defun beginning-of-buffer (&optional arg)
"Move point to the beginning of the buffer; leave mark at previous position.
-With arg N, put point N/10 of the way from the beginning.
+With \\[universal-argument] prefix, do not set mark at previous position.
+With numeric arg N, put point N/10 of the way from the beginning.
If the buffer is narrowed, this command uses the beginning and size
of the accessible part of the buffer.
Don't use this command in Lisp programs!
\(goto-char (point-min)) is faster and avoids clobbering the mark."
(interactive "P")
- (push-mark)
+ (or (consp arg)
+ (and transient-mark-mode mark-active)
+ (push-mark))
(let ((size (- (point-max) (point-min))))
- (goto-char (if arg
+ (goto-char (if (and arg (not (consp arg)))
(+ (point-min)
(if (> size 10000)
;; Avoid overflow for large buffer sizes!
(defun end-of-buffer (&optional arg)
"Move point to the end of the buffer; leave mark at previous position.
-With arg N, put point N/10 of the way from the end.
+With \\[universal-argument] prefix, do not set mark at previous position.
+With numeric arg N, put point N/10 of the way from the end.
If the buffer is narrowed, this command uses the beginning and size
of the accessible part of the buffer.
Don't use this command in Lisp programs!
\(goto-char (point-max)) is faster and avoids clobbering the mark."
(interactive "P")
- (push-mark)
+ (or (consp arg)
+ (and transient-mark-mode mark-active)
+ (push-mark))
(let ((size (- (point-max) (point-min))))
- (goto-char (if arg
+ (goto-char (if (and arg (not (consp arg)))
(- (point-max)
(if (> size 10000)
;; Avoid overflow for large buffer sizes!
(defun what-line ()
"Print the current buffer line number and narrowed line number of point."
(interactive)
- (let ((opoint (point)) (start (point-min))
+ (let ((start (point-min))
(n (line-number-at-pos)))
(if (= start 1)
(message "Line %d" n)
(t
'(0 . 0)))
'(0 . 0)))
+
+;; When the first undo batch in an undo list is longer than undo-outer-limit,
+;; this function gets called to ask the user what to do.
+;; Garbage collection is inhibited around the call,
+;; so it had better not do a lot of consing.
+(setq undo-outer-limit-function 'undo-outer-limit-truncate)
+(defun undo-outer-limit-truncate (size)
+ (if (yes-or-no-p (format "Buffer %s undo info is %d bytes long; discard it? "
+ (buffer-name) size))
+ (progn (setq buffer-undo-list nil) t)
+ nil))
\f
(defvar shell-command-history nil
"History list for some commands that read shell commands.")
(defun shell-command-on-region (start end command
&optional output-buffer replace
- error-buffer)
+ error-buffer display-error-buffer)
"Execute string COMMAND in inferior shell with region as input.
Normally display output (if any) in temp buffer `*Shell Command Output*';
Prefix arg means replace the region with it. Return the exit code of
`buffer-file-coding-system'. If the output is going to replace the region,
then it is decoded from that same coding system.
-The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER,
-REPLACE, ERROR-BUFFER. Noninteractive callers can specify coding
-systems by binding `coding-system-for-read' and
-`coding-system-for-write'.
+The noninteractive arguments are START, END, COMMAND,
+OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER.
+Noninteractive callers can specify coding systems by binding
+`coding-system-for-read' and `coding-system-for-write'.
If the command generates output, the output may be displayed
in the echo area or in a buffer.
If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
or buffer name to which to direct the command's standard error output.
If it is nil, error output is mingled with regular output.
+If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there
+were any errors. (This is always t, interactively.)
In an interactive call, the variable `shell-command-default-error-buffer'
specifies the value of ERROR-BUFFER."
(interactive (let (string)
string
current-prefix-arg
current-prefix-arg
- shell-command-default-error-buffer)))
+ shell-command-default-error-buffer
+ t)))
(let ((error-file
(if error-buffer
(make-temp-file
(format-insert-file error-file nil)
;; Put point after the inserted errors.
(goto-char (- (point-max) pos-from-end)))
- (display-buffer (current-buffer))))
+ (and display-error-buffer
+ (display-buffer (current-buffer)))))
(delete-file error-file))
exit-status))
(with-current-buffer
standard-output
(call-process shell-file-name nil t nil shell-command-switch command))))
+
+(defun process-file (program &optional infile buffer display &rest args)
+ "Process files synchronously in a separate process.
+Similar to `call-process', but may invoke a file handler based on
+`default-directory'. The current working directory of the
+subprocess is `default-directory'.
+
+File names in INFILE and BUFFER are handled normally, but file
+names in ARGS should be relative to `default-directory', as they
+are passed to the process verbatim. \(This is a difference to
+`call-process' which does not support file handlers for INFILE
+and BUFFER.\)
+
+Some file handlers might not support all variants, for example
+they might behave as if DISPLAY was nil, regardless of the actual
+value passed."
+ (let ((fh (find-file-name-handler default-directory 'process-file))
+ lc stderr-file)
+ (unwind-protect
+ (if fh (apply fh 'process-file program infile buffer display args)
+ (when infile (setq lc (file-local-copy infile)))
+ (setq stderr-file (when (and (consp buffer) (stringp (cadr buffer)))
+ (make-temp-file "emacs")))
+ (prog1
+ (apply 'call-process program
+ (or lc infile)
+ (if stderr-file (list (car buffer) stderr-file) buffer)
+ display args)
+ (when stderr-file (copy-file stderr-file (cadr buffer)))))
+ (when stderr-file (delete-file stderr-file))
+ (when lc (delete-file lc)))))
+
+
\f
(defvar universal-argument-map
(let ((map (make-sparse-keymap)))
visual feedback indicating the extent of the region being copied."
(interactive "r")
(copy-region-as-kill beg end)
+ ;; This use of interactive-p is correct
+ ;; because the code it controls just gives the user visual feedback.
(if (interactive-p)
(let ((other-end (if (= (point) beg) end beg))
(opoint (point))
Many commands change their behavior when Transient Mark mode is in effect
and the mark is active, by acting on the region instead of their usual
default part of the buffer's text. Examples of such commands include
-\\[comment-dwim], \\[flush-lines], \\[ispell], \\[keep-lines],
-\\[query-replace], \\[query-replace-regexp], and \\[undo]. 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."
+\\[comment-dwim], \\[flush-lines], \\[keep-lines], \
+\\[query-replace], \\[query-replace-regexp], \\[ispell], and \\[undo].
+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 :require nil)
(defun pop-global-mark ()
at the start of current run of vertical motion commands.
When the `track-eol' feature is doing its job, the value is 9999.")
-(defcustom line-move-ignore-invisible nil
+(defcustom line-move-ignore-invisible t
"*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines.
Outline mode sets this."
:type 'boolean
:group 'editing-basics)
-(defun line-move-invisible (pos)
+(defun line-move-invisible-p (pos)
"Return non-nil if the character after POS is currently invisible."
(let ((prop
(get-char-property pos 'invisible)))
;; This is the guts of next-line and previous-line.
;; Arg says how many lines to move.
-(defun line-move (arg)
+;; The value is t if we can move the specified number of lines.
+(defun line-move (arg &optional noerror to-end)
;; Don't run any point-motion hooks, and disregard intangibility,
;; for intermediate positions.
(let ((inhibit-point-motion-hooks t)
(opoint (point))
- new line-end line-beg)
+ (forward (> arg 0)))
(unwind-protect
(progn
(if (not (memq last-command '(next-line previous-line)))
(or (not (bolp)) (eq last-command 'end-of-line)))
9999
(current-column))))
+
(if (and (not (integerp selective-display))
(not line-move-ignore-invisible))
;; Use just newline characters.
(and (zerop (forward-line arg))
(bolp)
(setq arg 0)))
- (signal (if (< arg 0)
- 'beginning-of-buffer
- 'end-of-buffer)
- nil))
+ (unless noerror
+ (signal (if (< arg 0)
+ 'beginning-of-buffer
+ 'end-of-buffer)
+ nil)))
;; Move by arg lines, but ignore invisible ones.
- (while (> arg 0)
- ;; If the following character is currently invisible,
- ;; skip all characters with that same `invisible' property value.
- (while (and (not (eobp)) (line-move-invisible (point)))
- (goto-char (next-char-property-change (point))))
- ;; Now move a line.
- (end-of-line)
- (and (zerop (vertical-motion 1))
- (signal 'end-of-buffer nil))
- (setq arg (1- arg)))
- (while (< arg 0)
- (beginning-of-line)
- (and (zerop (vertical-motion -1))
- (signal 'beginning-of-buffer nil))
- (setq arg (1+ arg))
- (while (and (not (bobp)) (line-move-invisible (1- (point))))
- (goto-char (previous-char-property-change (point)))))))
+ (let (done)
+ (while (and (> arg 0) (not done))
+ ;; If the following character is currently invisible,
+ ;; skip all characters with that same `invisible' property value.
+ (while (and (not (eobp)) (line-move-invisible-p (point)))
+ (goto-char (next-char-property-change (point))))
+ ;; Now move a line.
+ (end-of-line)
+ (and (zerop (vertical-motion 1))
+ (if (not noerror)
+ (signal 'end-of-buffer nil)
+ (setq done t)))
+ (unless done
+ (setq arg (1- arg))))
+ (while (and (< arg 0) (not done))
+ (beginning-of-line)
+
+ (if (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
+ ;; if our target is the middle of this line.
+ (or (zerop (or goal-column temporary-goal-column))
+ (< arg 0))
+ (not (bobp)) (line-move-invisible-p (1- (point))))
+ (goto-char (previous-char-property-change (point))))))))
+ ;; This is the value the function returns.
+ (= arg 0))
(cond ((> arg 0)
;; If we did not move down as far as desired,
;; at least go to end of line.
(beginning-of-line))
(t
- (line-move-finish (or goal-column temporary-goal-column) opoint)))))
- nil)
+ (line-move-finish (or goal-column temporary-goal-column)
+ opoint forward))))))
-(defun line-move-finish (column opoint)
+(defun line-move-finish (column opoint forward)
(let ((repeat t))
(while repeat
;; Set REPEAT to t to repeat the whole thing.
(line-beg (save-excursion (beginning-of-line) (point)))
(line-end
;; Compute the end of the line
- ;; ignoring effectively intangible newlines.
- (let ((inhibit-point-motion-hooks nil)
- (inhibit-field-text-motion t))
- (save-excursion (end-of-line) (point)))))
+ ;; ignoring effectively invisible newlines.
+ (save-excursion
+ (end-of-line)
+ (while (and (not (eobp)) (line-move-invisible-p (point)))
+ (goto-char (next-char-property-change (point)))
+ (end-of-line))
+ (point))))
;; Move to the desired column.
(line-move-to-column column)
;; try the previous allowable position.
;; See if it is ok.
(backward-char)
- (if (<= (point) line-end)
+ (if (if forward
+ ;; If going forward, don't accept the previous
+ ;; allowable position if it is before the target line.
+ (< line-beg (point))
+ ;; If going backward, don't accept the previous
+ ;; allowable position if it is still after the target line.
+ (<= (point) line-end))
(setq new (point))
;; As a last resort, use the end of the line.
(setq new line-end))))
(move-to-column col))
(when (and line-move-ignore-invisible
- (not (bolp)) (line-move-invisible (1- (point))))
+ (not (bolp)) (line-move-invisible-p (1- (point))))
(let ((normal-location (point))
(normal-column (current-column)))
;; If the following character is currently invisible,
;; skip all characters with that same `invisible' property value.
(while (and (not (eobp))
- (line-move-invisible (point)))
+ (line-move-invisible-p (point)))
(goto-char (next-char-property-change (point))))
;; Have we advanced to a larger column position?
(if (> (current-column) normal-column)
;; but with a more reasonable buffer position.
(goto-char normal-location)
(let ((line-beg (save-excursion (beginning-of-line) (point))))
- (while (and (not (bolp)) (line-move-invisible (1- (point))))
+ (while (and (not (bolp)) (line-move-invisible-p (1- (point))))
(goto-char (previous-char-property-change (point) line-beg))))))))
+(defun move-end-of-line (arg)
+ "Move point to end of current line.
+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.
+
+This command does not move point across a field boundary unless doing so
+would move beyond there to a different line; if ARG is nil or 1, and
+point starts at a field boundary, point does not move. To ignore field
+boundaries bind `inhibit-field-text-motion' to t."
+ (interactive "p")
+ (or arg (setq arg 1))
+ (let (done)
+ (while (not done)
+ (let ((newpos
+ (save-excursion
+ (let ((goal-column 0))
+ (and (line-move arg t)
+ (not (bobp))
+ (progn
+ (while (and (not (bobp)) (line-move-invisible-p (1- (point))))
+ (goto-char (previous-char-property-change (point))))
+ (backward-char 1)))
+ (point)))))
+ (goto-char newpos)
+ (if (and (> (point) newpos)
+ (eq (preceding-char) ?\n))
+ (backward-char 1)
+ (if (and (> (point) newpos) (not (eobp))
+ (not (eq (following-char) ?\n)))
+ ;; If we skipped something intangible
+ ;; and now we're not really at eol,
+ ;; keep going.
+ (setq arg 1)
+ (setq done t)))))))
+
;;; Many people have said they rarely use this feature, and often type
;;; it by accident. Maybe it shouldn't even be on a key.
(put 'set-goal-column 'disabled t)
(progn
(select-window window)
;; Set point and mark in that window's buffer.
- (beginning-of-buffer arg)
+ (with-no-warnings
+ (beginning-of-buffer arg))
;; Set point accordingly.
(recenter '(t)))
(select-window orig-window))))
(unwind-protect
(progn
(select-window window)
- (end-of-buffer arg)
+ (with-no-warnings
+ (end-of-buffer arg))
(recenter '(t)))
(select-window orig-window))))
\f
(interactive "p")
(forward-word (- (or arg 1))))
-(defun mark-word (arg)
- "Set mark arg words away from point.
-If this command is repeated, it marks the next ARG words after the ones
-already marked."
- (interactive "p")
- (cond ((and (eq last-command this-command) (mark t))
+(defun mark-word (&optional arg)
+ "Set mark ARG words away from point.
+The place mark goes is the same place \\[forward-word] would
+move to with the same argument.
+If this command is repeated or mark is active in Transient Mark mode,
+it marks the next ARG words after the ones already marked."
+ (interactive "P")
+ (cond ((or (and (eq last-command this-command) (mark t))
+ (and transient-mark-mode mark-active))
+ (setq arg (if arg (prefix-numeric-value arg)
+ (if (< (mark) (point)) -1 1)))
(set-mark
(save-excursion
(goto-char (mark))
(t
(push-mark
(save-excursion
- (forward-word arg)
+ (forward-word (prefix-numeric-value arg))
(point))
nil t))))
"Return the symbol or word that point is on (or a nearby one) as a string.
The return value includes no text properties.
If optional arg STRICT is non-nil, return nil unless point is within
-or adjacent to a symbol or word.
+or adjacent to a symbol or word. In all cases the value can be nil
+if there is no word nearby.
The function, belying its name, normally finds a symbol.
If optional arg REALLY-WORD is non-nil, it finds just a word."
(save-excursion
(setq blinkpos (scan-sexps oldpos -1)))
(error nil)))
(and blinkpos
- (save-excursion
- (goto-char blinkpos)
- (not (looking-at "\\s$")))
+ (not (eq (car (syntax-after blinkpos)) 8)) ;Not syntax '$'.
(setq matching-paren
- (or (and parse-sexp-lookup-properties
- (let ((prop (get-text-property blinkpos 'syntax-table)))
- (and (consp prop)
- (eq (car prop) 4)
- (cdr prop))))
- (matching-paren (char-after blinkpos)))
+ (let ((syntax (syntax-after blinkpos)))
+ (and (consp syntax)
+ (eq (car syntax) 4)
+ (cdr syntax)))
mismatch
(or (null matching-paren)
(/= (char-after (1- oldpos))
At top-level, as an editor command, this simply beeps."
(interactive)
(deactivate-mark)
+ (if (fboundp 'kmacro-keyboard-quit)
+ (kmacro-keyboard-quit))
(setq defining-kbd-macro nil)
(signal 'quit nil))
(abort-recursive-edit))
(current-prefix-arg
nil)
- ((and transient-mark-mode
- mark-active)
+ ((and transient-mark-mode mark-active)
(deactivate-mark))
((> (recursion-depth) 0)
(exit-recursive-edit))
(not (equal buffer
(window-buffer (active-minibuffer-window))))))
(error "Minibuffer is not active for completion")
+ ;; Set buffer so buffer-local choose-completion-string-functions works.
+ (set-buffer buffer)
(unless (run-hook-with-args-until-success
'choose-completion-string-functions
choice buffer mini-p base-size)
;; Insert the completion into the buffer where it was requested.
- (set-buffer buffer)
(if base-size
(delete-region (+ base-size (if mini-p
(minibuffer-prompt-end)
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.")
+
(defun completion-setup-function ()
(let ((mainbuf (current-buffer))
(mbuf-contents (minibuffer-contents)))
(if minibuffer-completing-file-name
(with-current-buffer mainbuf
(setq default-directory (file-name-directory mbuf-contents))))
+ ;; If partial-completion-mode is on, point might not be after the
+ ;; last character in the minibuffer.
+ ;; 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)))))
(with-current-buffer standard-output
(completion-list-mode)
(make-local-variable 'completion-reference-buffer)
(with-current-buffer mainbuf
(save-excursion
(goto-char (point-max))
- (skip-chars-backward "^/")
+ (skip-chars-backward completion-root-regexp)
(- (point) (minibuffer-prompt-end)))))
;; Otherwise, in minibuffer, the whole input is being completed.
(if (minibufferp mainbuf)