;;; simple.el --- basic editing commands for Emacs
-;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99,
-;; 2000, 2001, 2002, 2003
+;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+;; 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Maintainer: FSF
(defgroup killing nil
- "Killing and yanking commands"
+ "Killing and yanking commands."
:group 'editing)
(defgroup paren-matching nil
(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
+similar mode is started, or when it is used with \\[next-error]
+or \\[compile-goto-error].")
+
+(defvar next-error-function nil
+ "Function to use to find the next error in the current buffer.
+The function is called with 2 parameters:
+ARG is an integer specifying by how many errors to move.
+RESET is a boolean which, if non-nil, says to go back to the beginning
+of the errors before moving.
+Major modes providing compile-like functionality should set this variable
+to indicate to `next-error' that this is a candidate buffer and how
+to navigate in it.")
+
+(make-variable-buffer-local 'next-error-function)
+
+(defsubst next-error-buffer-p (buffer
+ &optional avoid-current
+ extra-test-inclusive
+ extra-test-exclusive)
+ "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.
+
+The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer
+that normally would not qualify. If it returns t, the buffer
+in question is treated as usable.
+
+The function EXTRA-TEST-EXCLUSIVE, if non-nil is called in each buffer
+that would normally be considered usable. if it returns nil,
+that buffer is rejected."
+ (and (buffer-name buffer) ;First make sure it's live.
+ (not (and avoid-current (eq buffer (current-buffer))))
+ (with-current-buffer buffer
+ (if next-error-function ; This is the normal test.
+ ;; Optionally reject some buffers.
+ (if extra-test-exclusive
+ (funcall extra-test-exclusive)
+ t)
+ ;; Optionally accept some other buffers.
+ (and extra-test-inclusive
+ (funcall extra-test-inclusive))))))
+
+(defun next-error-find-buffer (&optional avoid-current
+ extra-test-inclusive
+ extra-test-exclusive)
+ "Return a next-error capable buffer.
+If AVOID-CURRENT is non-nil, treat the current buffer
+as an absolute last resort only.
+
+The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffers
+that normally would not qualify. If it returns t, the buffer
+in question is treated as usable.
+
+The function EXTRA-TEST-EXCLUSIVE, if non-nil is called in each buffer
+that would normally be considered usable. If it returns nil,
+that buffer is rejected."
+ (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)
+ avoid-current
+ extra-test-inclusive extra-test-exclusive)
+ (window-buffer w)))
+ (window-list))))))
+ (if (eq (length window-buffers) 1)
+ (car window-buffers)))
+ ;; 2. If next-error-last-buffer is an acceptable buffer, use that.
+ (if (and next-error-last-buffer
+ (next-error-buffer-p next-error-last-buffer avoid-current
+ extra-test-inclusive extra-test-exclusive))
+ next-error-last-buffer)
+ ;; 3. If the current buffer is acceptable, choose it.
+ (if (next-error-buffer-p (current-buffer) avoid-current
+ extra-test-inclusive extra-test-exclusive)
+ (current-buffer))
+ ;; 4. Look for any acceptable buffer.
+ (let ((buffers (buffer-list)))
+ (while (and buffers
+ (not (next-error-buffer-p
+ (car buffers) avoid-current
+ extra-test-inclusive extra-test-exclusive)))
+ (setq buffers (cdr buffers)))
+ (car buffers))
+ ;; 5. Use the current buffer as a last resort if it qualifies,
+ ;; even despite AVOID-CURRENT.
+ (and avoid-current
+ (next-error-buffer-p (current-buffer) nil
+ extra-test-inclusive extra-test-exclusive)
+ (progn
+ (message "This is the only next-error capable buffer")
+ (current-buffer)))
+ ;; 6. Give up.
+ (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,
+the message buffer is checked for new ones.
+
+A prefix ARG specifies how many error messages to move;
+negative means move back to previous error messages.
+Just \\[universal-argument] as a prefix means reparse the error message buffer
+and start at the first error.
+
+The RESET argument specifies that we should restart from the beginning.
+
+\\[next-error] normally uses the most recently started
+compilation, grep, or occur buffer. It can also operate on any
+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 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.
+
+See variables `compilation-parse-errors-function' and
+\`compilation-error-regexp-alist' for customization ideas."
+ (interactive "P")
+ (if (consp arg) (setq reset t arg nil))
+ (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))))
+
+(defalias 'goto-next-locus 'next-error)
+(defalias 'next-match 'next-error)
+
+(define-key ctl-x-map "`" 'next-error)
+
+(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
+forwards, if negative).
+
+This operates on the output from the \\[compile] and \\[grep] commands."
+ (interactive "p")
+ (next-error (- (or n 1))))
+
+(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.
+This operates on the output from the \\[compile] command, for instance."
+ (interactive "p")
+ (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.
+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")
+ (let ((next-error-highlight next-error-highlight-no-select))
+ (next-error n))
+ (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.
+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 (- (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.
(put-text-property from (point) 'rear-nonsticky
(cons 'hard sticky)))))
-(defun open-line (arg)
+(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.
(loc (point))
;; Don't expand an abbrev before point.
(abbrev-mode nil))
- (newline arg)
+ (newline n)
(goto-char loc)
- (while (> arg 0)
+ (while (> n 0)
(cond ((bolp)
(if do-left-margin (indent-to (current-left-margin)))
(if do-fill-prefix (insert-and-inherit fill-prefix))))
(forward-line 1)
- (setq arg (1- arg)))
+ (setq n (1- n)))
(goto-char loc)
(end-of-line)))
(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, the arg may be a prefix string to copy."
+When called from Lisp code, ARG may be a prefix string to copy."
(interactive "*P")
(skip-chars-forward " \t")
(let* ((col (current-column))
\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)
:type 'boolean
:version "21.1")
+(defun eval-expression-print-format (value)
+ "Format VALUE as a result of evaluated expression.
+Return a formatted string which is displayed in the echo area
+in addition to the value printed by prin1 in functions which
+display the result of expression evaluation."
+ (if (and (integerp value)
+ (or (not (memq this-command '(eval-last-sexp eval-print-last-sexp)))
+ (eq this-command last-command)
+ (and (boundp 'edebug-active) edebug-active)))
+ (let ((char-string
+ (if (or (and (boundp 'edebug-active) edebug-active)
+ (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)))))
+
;; We define this, rather than making `eval' interactive,
;; for the sake of completion of names like eval-region, eval-current-buffer.
(defun eval-expression (eval-expression-arg
(with-no-warnings
(let ((standard-output (current-buffer)))
(eval-last-sexp-print-value (car values))))
- (prin1 (car values) t))))
+ (prog1
+ (prin1 (car values) t)
+ (let ((str (eval-expression-print-format (car values))))
+ (if str (princ str t)))))))
(defun edit-and-eval-command (prompt command)
"Prompting with PROMPT, let user edit COMMAND and eval result.
nil
minibuffer-local-map
nil
- 'minibuffer-history-search-history)))
+ 'minibuffer-history-search-history
+ (car minibuffer-history-search-history))))
;; Use the last regexp specified, by default, if input is empty.
(list (if (string= regexp "")
(if minibuffer-history-search-history
nil
minibuffer-local-map
nil
- 'minibuffer-history-search-history)))
+ 'minibuffer-history-search-history
+ (car minibuffer-history-search-history))))
;; Use the last regexp specified, by default, if input is empty.
(list (if (string= regexp "")
- (setcar minibuffer-history-search-history
- (nth 1 minibuffer-history-search-history))
+ (if minibuffer-history-search-history
+ (car minibuffer-history-search-history)
+ (error "No previous history search regexp"))
regexp)
(prefix-numeric-value current-prefix-arg))))
(previous-matching-history-element regexp (- n)))
;; So set `this-command' to something other than `undo'.
(setq this-command 'undo-start)
- (unless (eq last-command 'undo)
+ (unless (and (eq last-command 'undo)
+ ;; If something (a timer or filter?) changed the buffer
+ ;; since the previous command, don't continue the undo seq.
+ (let ((list buffer-undo-list))
+ (while (eq (car list) nil)
+ (setq list (cdr list)))
+ ;; If the last undo record made was made by 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)))))
(if undo-in-region
(undo-start))
;; get rid of initial undo boundary
(undo-more 1))
- ;; If we got this far, the next command should be a consecutive undo.
+ ;; If we got this far, the next command should be a consecutive undo.
(setq this-command 'undo)
;; Check to see whether we're hitting a redo record, and if
;; so, ask the user whether she wants to skip the redo/undo pair.
(setq tail (cdr tail)))
(setq tail nil)))
(setq prev tail tail (cdr tail))))
-
+ ;; 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))))
+(defun buffer-disable-undo (&optional buffer)
+ "Make BUFFER stop keeping undo information.
+No argument or nil as argument means do this for the current buffer."
+ (interactive)
+ (with-current-buffer (if buffer (get-buffer buffer) (current-buffer))
+ (setq buffer-undo-list t)))
+
(defun undo-only (&optional arg)
"Undo some previous changes.
Repeat this command to undo more changes.
(t
'(0 . 0)))
'(0 . 0)))
+
+(defvar undo-extra-outer-limit nil
+ "If non-nil, an extra level of size that's ok in an undo item.
+We don't ask the user about truncating the undo list until the
+current item gets bigger than this amount.")
+(make-variable-buffer-local 'undo-extra-outer-limit)
+
+;; 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)
+ (when (or (null undo-extra-outer-limit)
+ (> size undo-extra-outer-limit))
+ ;; Don't ask the question again unless it gets even bigger.
+ ;; This applies, in particular, if the user quits from the question.
+ ;; Such a quit quits out of GC, but something else will call GC
+ ;; again momentarily. It will call this function again,
+ ;; but we don't want to ask the question again.
+ (setq undo-extra-outer-limit (+ size 50000))
+ (if (let (use-dialog-box)
+ (yes-or-no-p (format "Buffer %s undo info is %d bytes long; discard it? "
+ (buffer-name) size)))
+ (progn (setq buffer-undo-list nil)
+ (setq undo-extra-outer-limit 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)))
you can use the killing commands to copy text from a read-only buffer.
This is the primitive for programs to kill text (as opposed to deleting it).
-Supply two arguments, character numbers indicating the stretch of text
+Supply two arguments, character positions indicating the stretch of text
to be killed.
Any command that calls this function is a \"kill command\".
If the previous command was also a kill command,
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))
;; look like a C-g typed as a command.
(inhibit-quit t))
(if (pos-visible-in-window-p other-end (selected-window))
- (unless transient-mark-mode
+ (unless (and transient-mark-mode
+ (face-background 'region))
;; Swap point and mark.
(set-marker (mark-marker) (point) (current-buffer))
(goto-char other-end)
- (sit-for 1)
+ (sit-for blink-matching-delay)
;; Swap back.
(set-marker (mark-marker) other-end (current-buffer))
(goto-char opoint)
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))
- :group 'editing
+ :group 'killing
:version "21.4")
(defvar yank-window-start nil)
If arg is negative, kill backward. Also kill the preceding newline.
\(This is meant to make C-x z work well with negative arguments.\)
If arg is zero, kill current line but exclude the trailing newline."
- (interactive "P")
- (setq arg (prefix-numeric-value arg))
+ (interactive "p")
(if (and (> arg 0) (eobp) (save-excursion (forward-visible-line 0) (eobp)))
(signal 'end-of-buffer nil))
(if (and (< arg 0) (bobp) (save-excursion (end-of-visible-line) (bobp)))
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 allow-extend)
+ "Set mark ARG words away from point.
+The place mark goes is the same place \\[forward-word] would
+move to with the same argument.
+Interactively, if this command is repeated
+or (in Transient Mark mode) if the mark is active,
+it marks the next ARG words after the ones already marked."
+ (interactive "P\np")
+ (cond ((and allow-extend
+ (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
;; (Actually some major modes use a different auto-fill function,
;; but this one is the default one.)
(defun do-auto-fill ()
- (let (fc justify bol give-up
+ (let (fc justify give-up
(fill-prefix fill-prefix))
(if (or (not (setq justify (current-justification)))
(null (setq fc (current-fill-column)))
(and (eq justify 'left)
(<= (current-column) fc))
- (save-excursion (beginning-of-line)
- (setq bol (point))
- (and auto-fill-inhibit-regexp
+ (and auto-fill-inhibit-regexp
+ (save-excursion (beginning-of-line)
(looking-at auto-fill-inhibit-regexp))))
nil ;; Auto-filling not required
(if (memq justify '(full center right))
;; Determine where to split the line.
(let* (after-prefix
(fill-point
- (let ((opoint (point)))
- (save-excursion
- (beginning-of-line)
- (setq after-prefix (point))
- (and fill-prefix
- (looking-at (regexp-quote fill-prefix))
- (setq after-prefix (match-end 0)))
- (move-to-column (1+ fc))
- (fill-move-to-break-point after-prefix)
- (point)))))
+ (save-excursion
+ (beginning-of-line)
+ (setq after-prefix (point))
+ (and fill-prefix
+ (looking-at (regexp-quote fill-prefix))
+ (setq after-prefix (match-end 0)))
+ (move-to-column (1+ fc))
+ (fill-move-to-break-point after-prefix)
+ (point))))
;; See whether the place we found is any good.
(if (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)
;; 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."
+ :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.")
(defun completion-setup-function ()
- (save-excursion
- (let ((mainbuf (current-buffer))
- (mbuf-contents (minibuffer-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.
- (if minibuffer-completing-file-name
- (with-current-buffer mainbuf
- (setq default-directory (file-name-directory mbuf-contents))))
- (set-buffer standard-output)
+ (let ((mainbuf (current-buffer))
+ (mbuf-contents (minibuffer-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.
+ (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)
(setq completion-reference-buffer mainbuf)
;; use the number of chars before the start of the
;; last file name component.
(setq completion-base-size
- (save-excursion
- (set-buffer mainbuf)
- (goto-char (point-max))
- (skip-chars-backward "^/")
- (- (point) (minibuffer-prompt-end))))
+ (with-current-buffer mainbuf
+ (save-excursion
+ (goto-char (point-max))
+ (skip-chars-backward completion-root-regexp)
+ (- (point) (minibuffer-prompt-end)))))
;; Otherwise, in minibuffer, the whole input is being completed.
- (save-match-data
- (if (minibufferp mainbuf)
- (setq completion-base-size 0))))
+ (if (minibufferp mainbuf)
+ (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
+ (+ (or element-start nil) common-string-length))
+ (maxp (point-max)))
+ (while (and element-start (< element-common-end 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))))))
+ ;; Insert help string.
(goto-char (point-min))
(if (display-mouse-p)
(insert (substitute-command-keys
(provide 'simple)
-;;; arch-tag: 24af67c0-2a49-44f6-b3b1-312d8b570dfd
+;; arch-tag: 24af67c0-2a49-44f6-b3b1-312d8b570dfd
;;; simple.el ends here
HCoop / bpt / emacs.git / blobdiff