;;; simple.el --- basic editing commands for Emacs
-;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99, 2000, 2001
+;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99,
+;; 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
+;; Maintainer: FSF
+;; Keywords: internal
+
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
(eval-when-compile
(autoload 'widget-convert "wid-edit")
- (autoload 'shell-mode "shell")
- (require 'cl))
+ (autoload 'shell-mode "shell"))
(defgroup killing nil
"Highlight (un)matching of parens and expressions."
:group 'matching)
+(define-key global-map [?\C-x right] 'next-buffer)
+(define-key global-map [?\C-x left] 'prev-buffer)
+(defun next-buffer ()
+ "Switch to the next buffer in cyclic order."
+ (interactive)
+ (let ((buffer (current-buffer)))
+ (switch-to-buffer (other-buffer buffer))
+ (bury-buffer buffer)))
+
+(defun prev-buffer ()
+ "Switch to the previous buffer in cyclic order."
+ (interactive)
+ (let ((list (nreverse (buffer-list)))
+ found)
+ (while (and (not found) list)
+ (let ((buffer (car list)))
+ (if (and (not (get-buffer-window buffer))
+ (not (string-match "\\` " (buffer-name buffer))))
+ (setq found buffer)))
+ (setq list (cdr list)))
+ (switch-to-buffer found)))
(defun fundamental-mode ()
"Major mode not specialized for anything in particular.
(defun newline (&optional arg)
"Insert a newline, and move to left margin of the new line if it's blank.
-The newline is marked with the text-property `hard'.
+If `use-hard-newlines' is non-nil, the newline is marked with the
+text-property `hard'.
With ARG, insert that many newlines.
-In Auto Fill mode, if no numeric arg, break the preceding line if it's long."
+Call `auto-fill-function' if the current column number is greater
+than the value of `fill-column' and ARG is `nil'."
(interactive "*P")
(barf-if-buffer-read-only)
;; Inserting a newline at the end of a line produces better redisplay in
(goto-char loc)
(end-of-line)))
-(defun split-line ()
- "Split current line, moving portion beyond point vertically down."
- (interactive "*")
+(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.
+
+When called from Lisp code, the arg may be a prefix string to copy."
+ (interactive "*P")
(skip-chars-forward " \t")
- (let ((col (current-column))
- (pos (point)))
+ (let* ((col (current-column))
+ (pos (point))
+ ;; What prefix should we check for (nil means don't).
+ (prefix (cond ((stringp arg) arg)
+ (arg nil)
+ (t fill-prefix)))
+ ;; Does this line start with it?
+ (have-prfx (and prefix
+ (save-excursion
+ (beginning-of-line)
+ (looking-at (regexp-quote prefix))))))
(newline 1)
+ (if have-prfx (insert-and-inherit prefix))
(indent-to col 0)
(goto-char pos)))
In some text modes, where TAB inserts a tab, this indents to the
column specified by the function `current-left-margin'."
(interactive "*")
- (save-excursion
- (delete-horizontal-space t)
- (indent-according-to-mode))
- (newline)
- (indent-according-to-mode))
+ (delete-horizontal-space t)
+ (let ((pos (point)))
+ ;; Be careful to insert the newline before indenting the line.
+ ;; Otherwise, the indentation might be wrong.
+ (newline)
+ (save-excursion
+ (goto-char pos)
+ (indent-according-to-mode))
+ (indent-according-to-mode)))
(defun quoted-insert (arg)
"Read next input character and insert it.
digits are interpreted as a character code. This is intended to be
useful for editing binary files."
(interactive "*p")
- (let ((char (if (or (not overwrite-mode)
- (eq overwrite-mode 'overwrite-mode-binary))
- (read-quoted-char)
- (read-char))))
+ (let* ((char (let (translation-table-for-input)
+ (if (or (not overwrite-mode)
+ (eq overwrite-mode 'overwrite-mode-binary))
+ (read-quoted-char)
+ (read-char)))))
;; Assume character codes 0240 - 0377 stand for characters in some
;; single-byte character set, and convert them to Emacs
;; characters.
(progn
(skip-chars-forward " \t")
(constrain-to-field nil orig-pos t)))))
-
+\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.
;; If we went to a place in the middle of the buffer,
;; adjust it to the beginning of a line.
(cond (arg (forward-line 1))
- ((< (point) (window-end nil t))
+ ((> (point) (window-end nil t))
;; If the end of the buffer is not already on the screen,
;; then scroll specially to put it near, but not at, the bottom.
(overlay-recenter (point))
(push-mark (point))
(push-mark (point-max) nil t)
(goto-char (point-min)))
-
+\f
;; Counting lines, one way or another.
(save-restriction
(goto-char (point-min))
(widen)
- (beginning-of-line)
+ (forward-line 0)
(setq start (point))
(goto-char opoint)
- (beginning-of-line)
- (if (/= start 1)
+ (forward-line 0)
+ (if (/= start (point-min))
(message "line %d (narrowed line %d)"
- (1+ (count-lines 1 (point)))
+ (1+ (count-lines (point-min) (point)))
(1+ (count-lines start (point))))
- (message "Line %d" (1+ (count-lines 1 (point)))))))))
+ (message "Line %d" (1+ (count-lines (point-min) (point)))))))))
(defun count-lines (start end)
"Return number of lines between START and END.
byte, just \"...\" is shown.
In addition, with prefix argument, show details about that character
-in *Help* buffer. See also the command `describe-char-after'."
+in *Help* buffer. See also the command `describe-char'."
(interactive "P")
(let* ((char (following-char))
(beg (point-min))
(format "(0%o, %d, 0x%x)" char char char))))
(if detail
;; We show the detailed information about CHAR.
- (describe-char-after (point)))
+ (describe-char (point)))
(if (or (/= beg 1) (/= end (1+ total)))
(message "Char: %s %s point=%d of %d (%d%%) <%d - %d> column %d %s"
(if (< char 256)
(single-key-description char)
(buffer-substring-no-properties (point) (1+ (point))))
encoding-msg pos total percent col hscroll))))))
-
+\f
(defvar read-expression-map
(let ((m (make-sparse-keymap)))
(define-key m "\M-\t" 'lisp-complete-symbol)
(defvar read-expression-history nil)
(defcustom eval-expression-print-level 4
- "*Value to use for `print-level' when printing value in `eval-expression'."
+ "*Value to use for `print-level' when printing value in `eval-expression'.
+A value of nil means no limit."
:group 'lisp
- :type '(choice (const nil) integer)
+ :type '(choice (const :tag "No Limit" nil) integer)
:version "21.1")
(defcustom eval-expression-print-length 12
- "*Value to use for `print-length' when printing value in `eval-expression'."
+ "*Value to use for `print-length' when printing value in `eval-expression'.
+A value of nil means no limit."
:group 'lisp
- :type '(choice (const nil) integer)
+ :type '(choice (const :tag "No Limit" nil) integer)
:version "21.1")
(defcustom eval-expression-debug-on-error t
"Prompting with PROMPT, let user edit COMMAND and eval result.
COMMAND is a Lisp expression. Let user edit that expression in
the minibuffer, then read and evaluate the result."
- (let ((command (read-from-minibuffer prompt
- (prin1-to-string command)
- read-expression-map t
- '(command-history . 1))))
- ;; If command was added to command-history as a string,
- ;; get rid of that. We want only evaluable expressions there.
- (if (stringp (car command-history))
- (setq command-history (cdr command-history)))
+ (let ((command
+ (unwind-protect
+ (read-from-minibuffer prompt
+ (prin1-to-string command)
+ read-expression-map t
+ '(command-history . 1))
+ ;; If command was added to command-history as a string,
+ ;; get rid of that. We want only evaluable expressions there.
+ (if (stringp (car command-history))
+ (setq command-history (cdr command-history))))))
;; If command to be redone does not match front of history,
;; add it to the history.
(let ((print-level nil)
(minibuffer-history-position arg)
(minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
- (read-from-minibuffer
- "Redo: " (prin1-to-string elt) read-expression-map t
- (cons 'command-history arg))))
+ (unwind-protect
+ (read-from-minibuffer
+ "Redo: " (prin1-to-string elt) read-expression-map t
+ (cons 'command-history arg))
- ;; If command was added to command-history as a string,
- ;; get rid of that. We want only evaluable expressions there.
- (if (stringp (car command-history))
- (setq command-history (cdr command-history)))
+ ;; If command was added to command-history as a
+ ;; string, get rid of that. We want only
+ ;; evaluable expressions there.
+ (if (stringp (car command-history))
+ (setq command-history (cdr command-history))))))
;; If command to be redone does not match front of history,
;; add it to the history.
(or (equal newcmd (car command-history))
(setq command-history (cons newcmd command-history)))
(eval newcmd))
- (ding))))
-
+ (if command-history
+ (error "Argument %d is beyond length of command history" arg)
+ (error "There are no previous complex commands to repeat")))))
+\f
(defvar minibuffer-history nil
"Default minibuffer history list.
This is used for all minibuffer input
except when an alternate history list is specified.")
(defvar minibuffer-history-sexp-flag nil
- "Non-nil when doing history operations on `command-history'.
+ "Non-nil when doing history operations on the variable `command-history'.
More generally, indicates that the history list being acted on
contains expressions rather than strings.
It is only valid if its value equals the current minibuffer depth,
(setq minibuffer-history-position nil)
(defvar minibuffer-history-search-history nil)
-(mapcar
- (lambda (key-and-command)
- (mapcar
- (lambda (keymap-and-completionp)
- ;; Arg is (KEYMAP-SYMBOL . COMPLETION-MAP-P).
- ;; If the cdr of KEY-AND-COMMAND (the command) is a cons,
- ;; its car is used if COMPLETION-MAP-P is nil, its cdr if it is t.
- (define-key (symbol-value (car keymap-and-completionp))
- (car key-and-command)
- (let ((command (cdr key-and-command)))
- (if (consp command)
- ;; (and ... nil) => ... turns back on the completion-oriented
- ;; history commands which rms turned off since they seem to
- ;; do things he doesn't like.
- (if (and (cdr keymap-and-completionp) nil) ;XXX turned off
- (progn (error "EMACS BUG!") (cdr command))
- (car command))
- command))))
- '((minibuffer-local-map . nil)
- (minibuffer-local-ns-map . nil)
- (minibuffer-local-completion-map . t)
- (minibuffer-local-must-match-map . t)
- (read-expression-map . nil))))
- '(("\en" . (next-history-element . next-complete-history-element))
- ([next] . (next-history-element . next-complete-history-element))
- ("\ep" . (previous-history-element . previous-complete-history-element))
- ([prior] . (previous-history-element . previous-complete-history-element))
- ("\er" . previous-matching-history-element)
- ("\es" . next-matching-history-element)))
-
(defvar minibuffer-text-before-history nil
"Text that was in this minibuffer before any history commands.
This is nil if there have not yet been any history commands
(unless (zerop n)
(if (and (zerop minibuffer-history-position)
(null minibuffer-text-before-history))
- (setq minibuffer-text-before-history (field-string (point-max))))
+ (setq minibuffer-text-before-history
+ (minibuffer-contents-no-properties)))
(let ((history (symbol-value minibuffer-history-variable))
(case-fold-search
(if (isearch-no-upper-case-p regexp t) ; assume isearch.el is dumped
(setq n (+ n (if (< n 0) 1 -1)))))
(setq minibuffer-history-position pos)
(goto-char (point-max))
- (delete-field)
+ (delete-minibuffer-contents)
(insert match-string)
- (goto-char (+ (field-beginning) match-offset))))
- (if (or (eq (car (car command-history)) 'previous-matching-history-element)
- (eq (car (car command-history)) 'next-matching-history-element))
+ (goto-char (+ (minibuffer-prompt-end) match-offset))))
+ (if (memq (car (car command-history)) '(previous-matching-history-element
+ next-matching-history-element))
(setq command-history (cdr command-history))))
(defun next-matching-history-element (regexp n)
elt minibuffer-returned-to-present)
(if (and (zerop minibuffer-history-position)
(null minibuffer-text-before-history))
- (setq minibuffer-text-before-history (field-string (point-max))))
+ (setq minibuffer-text-before-history
+ (minibuffer-contents-no-properties)))
(if (< narg minimum)
(if minibuffer-default
(error "End of history; no next item")
(error "End of history; no default available")))
(if (> narg (length (symbol-value minibuffer-history-variable)))
(error "Beginning of history; no preceding item"))
- (unless (or (eq last-command 'next-history-element)
- (eq last-command 'previous-history-element))
- (let ((prompt-end (field-beginning (point-max))))
+ (unless (memq last-command '(next-history-element
+ previous-history-element))
+ (let ((prompt-end (minibuffer-prompt-end)))
(set (make-local-variable 'minibuffer-temporary-goal-position)
(cond ((<= (point) prompt-end) prompt-end)
((eobp) nil)
(t (point))))))
(goto-char (point-max))
- (delete-field)
+ (delete-minibuffer-contents)
(setq minibuffer-history-position narg)
(cond ((= narg -1)
(setq elt minibuffer-default))
(let ((point-at-start (point)))
(next-matching-history-element
(concat
- "^" (regexp-quote (buffer-substring (field-beginning) (point))))
+ "^" (regexp-quote (buffer-substring (minibuffer-prompt-end) (point))))
n)
;; next-matching-history-element always puts us at (point-min).
;; Move to the position we were at before changing the buffer contents.
(interactive "p")
(next-complete-history-element (- n)))
-;; These two functions are for compatibility with the old subrs of the
-;; same name.
-
+;; 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 the width of everything before the field at the end of
;; the buffer; this should be 0 for normal buffers.
- (1- (field-beginning (point-max))))
-
-(defun minibuffer-prompt-end ()
- "Return the buffer position of the end of the minibuffer prompt.
-Return (point-min) if current buffer is not a mini-buffer."
- (field-beginning (point-max)))
-
-(defun minibuffer-contents ()
- "Return the user input in a minbuffer as a string.
-The current buffer must be a minibuffer."
- (field-string (point-max)))
-
-(defun minibuffer-contents-no-properties ()
- "Return the user input in a minbuffer as a string, without text-properties.
-The current buffer must be a minibuffer."
- (field-string-no-properties (point-max)))
-
-(defun delete-minibuffer-contents ()
- "Delete all user input in a minibuffer.
-The current buffer must be a minibuffer."
- (delete-field (point-max)))
-
+ (1- (minibuffer-prompt-end)))
+\f
;Put this on C-x u, so we can force that rather than C-_ into startup msg
(defalias 'advertised-undo 'undo)
the current region. Similarly, when not in Transient Mark mode, just C-u
as an argument limits undo to changes within the current region."
(interactive "*P")
- ;; If we don't get all the way thru, make last-command indicate that
- ;; for the following command.
- (setq this-command t)
+ ;; Make last-command indicate for the next command that this was an undo.
+ ;; That way, another undo will undo more.
+ ;; If we get to the end of the undo history and get an error,
+ ;; another undo command will find the undo history empty
+ ;; and will get another error. To begin undoing the undos,
+ ;; you must type some other command.
+ (setq this-command 'undo)
(let ((modified (buffer-modified-p))
(recent-save (recent-auto-save-p)))
(or (eq (selected-window) (minibuffer-window))
- (message "Undo!"))
+ (message (if (and transient-mark-mode mark-active)
+ "Undo in region!"
+ "Undo!")))
(unless (eq last-command 'undo)
(if (if transient-mark-mode mark-active (and arg (not (numberp arg))))
(undo-start (region-beginning) (region-end))
(setq prev tail tail (cdr tail))))
(and modified (not (buffer-modified-p))
- (delete-auto-save-file-if-necessary recent-save)))
- ;; If we do get all the way thru, make this-command indicate that.
- (setq this-command 'undo))
+ (delete-auto-save-file-if-necessary recent-save))))
(defvar pending-undo-list nil
"Within a run of consecutive undo commands, list remaining to be undone.")
Call `undo-start' to get ready to undo recent changes,
then call `undo-more' one or more times to undo them."
(or pending-undo-list
- (error "No further undo information"))
+ (error (format "No further undo information%s"
+ (if (and transient-mark-mode mark-active)
+ " for region" ""))))
(let ((undo-in-progress t))
(setq pending-undo-list (primitive-undo count pending-undo-list))))
(let ((position (car delta))
(offset (cdr delta)))
- ;; Loop down the earlier events adjusting their buffer positions
- ;; to reflect the fact that a change to the buffer isn't being
- ;; undone. We only need to process those element types which
- ;; undo-elt-in-region will return as being in the region since
- ;; only those types can ever get into the output
+ ;; Loop down the earlier events adjusting their buffer
+ ;; positions to reflect the fact that a change to the buffer
+ ;; isn't being undone. We only need to process those element
+ ;; types which undo-elt-in-region will return as being in
+ ;; the region since only those types can ever get into the
+ ;; output
(while temp-undo-list
(setq undo-elt (car temp-undo-list))
If it crosses the edge, we return nil."
(cond ((integerp undo-elt)
(and (>= undo-elt start)
- (< undo-elt end)))
+ (<= undo-elt end)))
((eq undo-elt nil)
t)
((atom undo-elt)
(cons alist-elt undo-adjusted-markers)))
(and (cdr alist-elt)
(>= (cdr alist-elt) start)
- (< (cdr alist-elt) end))))
+ (<= (cdr alist-elt) end))))
((null (car undo-elt))
;; (nil PROPERTY VALUE BEG . END)
(let ((tail (nthcdr 3 undo-elt)))
(and (>= (car tail) start)
- (< (cdr tail) end))))
+ (<= (cdr tail) end))))
((integerp (car undo-elt))
;; (BEGIN . END)
(and (>= (car undo-elt) start)
- (< (cdr undo-elt) end)))))
+ (<= (cdr undo-elt) end)))))
(defun undo-elt-crosses-region (undo-elt start end)
"Test whether UNDO-ELT crosses one edge of that region START ... END.
(t
'(0 . 0)))
'(0 . 0)))
-
+\f
(defvar shell-command-history nil
"History list for some commands that read shell commands.")
(defvar shell-command-default-error-buffer nil
"*Buffer name for `shell-command' and `shell-command-on-region' error output.
-This buffer is used when `shell-command' or 'shell-command-on-region'
+This buffer is used when `shell-command' or `shell-command-on-region'
is run interactively. A value of nil means that output to stderr and
stdout will be intermixed in the output stream.")
display in the echo area (which is determined by the variables
`resize-mini-windows' and `max-mini-window-height'), it is shown
there, but it is nonetheless available in buffer `*Shell Command
-Output*' even though that buffer is not automatically displayed. If
-there is no output, or if output is inserted in the current buffer,
-then `*Shell Command Output*' is deleted.
+Output*' even though that buffer is not automatically displayed.
To specify a coding system for converting non-ASCII characters
in the shell command output, use \\[universal-coding-system-argument]
insert output in current buffer. (This cannot be done asynchronously.)
In either case, the output is inserted after point (leaving mark after it).
+If the command terminates without error, but generates output,
+and you did not specify \"insert it in the current buffer\",
+the output can be displayed in the echo area or in its buffer.
+If the output is short enough to display in the echo area
+\(determined by the variable `max-mini-window-height' if
+`resize-mini-windows' is non-nil), it is shown there. Otherwise,
+the buffer containing the output is displayed.
+
+If there is output and an error, and you did not specify \"insert it
+in the current buffer\", a message about the error goes at the end
+of the output.
+
+If there is no output, or if output is inserted in the current buffer,
+then `*Shell Command Output*' is deleted.
+
If the optional third 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.
(funcall handler 'shell-command command output-buffer error-buffer)
(if (and output-buffer
(not (or (bufferp output-buffer) (stringp output-buffer))))
+ ;; Output goes in current buffer.
(let ((error-file
(if error-buffer
(make-temp-file
(goto-char (prog1 (mark t)
(set-marker (mark-marker) (point)
(current-buffer)))))
+ ;; Output goes in a separate buffer.
;; Preserve the match data in case called from a program.
(save-match-data
- (if (string-match "[ \t]*&[ \t]*$" command)
+ (if (string-match "[ \t]*&[ \t]*\\'" command)
;; Command ending with ampersand means asynchronous.
(let ((buffer (get-buffer-create
(or output-buffer "*Async Shell Command*")))
(if (= (buffer-size) 0)
0
(count-lines (point-min) (point-max)))))
- (cond ((or (<= lines 1)
- (<= lines
- (if resize-mini-windows
- (cond ((floatp max-mini-window-height)
- (* (frame-height)
- max-mini-window-height))
- ((integerp max-mini-window-height)
- max-mini-window-height)
- (t
- 1))
- 1)))
+ (cond ((= lines 0))
+ ((and (or (<= lines 1)
+ (<= lines
+ (if resize-mini-windows
+ (cond ((floatp max-mini-window-height)
+ (* (frame-height)
+ max-mini-window-height))
+ ((integerp max-mini-window-height)
+ max-mini-window-height)
+ (t
+ 1))
+ 1)))
+ ;; Don't use the echo area if the output buffer is
+ ;; already dispayed in the selected frame.
+ (not (get-buffer-window (current-buffer))))
;; Echo area
(goto-char (point-max))
(when (bolp)
(t
;; Buffer
(goto-char (point-min))
- (display-buffer message not-this-window frame))))))))
+ (display-buffer (current-buffer)
+ not-this-window frame))))))))
;; We have a sentinel to prevent insertion of a termination message
systems by binding `coding-system-for-read' and
`coding-system-for-write'.
-If the output is short enough to display in the echo area (which is
-determined by the variable `max-mini-window-height' if
-`resize-mini-windows' is non-nil), it is shown there, but it is
-nonetheless available in buffer `*Shell Command Output*' even though
-that buffer is not automatically displayed. If there is no output, or
-if output is inserted in the current buffer, then `*Shell Command
-Output*' is deleted.
+If the command generates output, the output may be displayed
+in the echo area or in a buffer.
+If the output is short enough to display in the echo area
+\(determined by the variable `max-mini-window-height' if
+`resize-mini-windows' is non-nil), it is shown there. Otherwise
+it is displayed in the buffer `*Shell Command Output*'. The output
+is available in that buffer in both cases.
+
+If there is output and an error, a message about the error
+appears at the end of the output.
+
+If there is no output, or if output is inserted in the current buffer,
+then `*Shell Command Output*' is deleted.
If the optional fourth argument OUTPUT-BUFFER is non-nil,
that says to put the output in some other buffer.
If it is nil, error output is mingled with regular output.
In an interactive call, the variable `shell-command-default-error-buffer'
specifies the value of ERROR-BUFFER."
- (interactive (let ((string
- ;; Do this before calling region-beginning
- ;; and region-end, in case subprocess output
- ;; relocates them while we are in the minibuffer.
- (read-from-minibuffer "Shell command on region: "
- nil nil nil
- 'shell-command-history)))
+ (interactive (let (string)
+ (unless (mark)
+ (error "The mark is not set now, so there is no region"))
+ ;; Do this before calling region-beginning
+ ;; and region-end, in case subprocess output
+ ;; relocates them while we are in the minibuffer.
+ (setq string (read-from-minibuffer "Shell command on region: "
+ nil nil nil
+ 'shell-command-history))
;; call-interactively recognizes region-beginning and
;; region-end specially, leaving them in the history.
(list (region-beginning) (region-end)
(let ((swap (and replace (< start end))))
;; Don't muck with mark unless REPLACE says we should.
(goto-char start)
- (and replace (push-mark))
+ (and replace (push-mark (point) 'nomsg))
(setq exit-status
(call-process-region start end shell-file-name t
(if error-file
(list t error-file)
t)
nil shell-command-switch command))
-;;; It is rude to delete a buffer which the command is not using.
-;;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
-;;; (and shell-buffer (not (eq shell-buffer (current-buffer)))
-;;; (kill-buffer shell-buffer)))
+ ;; It is rude to delete a buffer which the command is not using.
+ ;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
+ ;; (and shell-buffer (not (eq shell-buffer (current-buffer)))
+ ;; (kill-buffer shell-buffer)))
;; Don't muck with mark unless REPLACE says we should.
(and replace swap (exchange-point-and-mark)))
;; No prefix argument: put the output in a temp buffer,
;; replacing its entire contents.
(let ((buffer (get-buffer-create
- (or output-buffer "*Shell Command Output*")))
- (success nil))
+ (or output-buffer "*Shell Command Output*"))))
(unwind-protect
(if (eq buffer (current-buffer))
;; If the input is the same buffer as the output,
(list buffer error-file)
buffer)
nil shell-command-switch command)))
- (setq success (and exit-status (equal 0 exit-status)))
- ;; Report the amount of output.
+ ;; Report the output.
+ (with-current-buffer buffer
+ (setq mode-line-process
+ (cond ((null exit-status)
+ " - Error")
+ ((stringp exit-status)
+ (format " - Signal [%s]" exit-status))
+ ((not (equal 0 exit-status))
+ (format " - Exit [%d]" exit-status)))))
(if (with-current-buffer buffer (> (point-max) (point-min)))
;; There's some output, display it
(display-message-or-buffer buffer)
;; No output; error?
- (message (if (and error-file
- (< 0 (nth 7 (file-attributes error-file))))
- "(Shell command %sed with some error output)"
- "(Shell command %sed with no output)")
- (if (equal 0 exit-status) "succeed" "fail"))))))
+ (let ((output
+ (if (and error-file
+ (< 0 (nth 7 (file-attributes error-file))))
+ "some error output"
+ "no output")))
+ (cond ((null exit-status)
+ (message "(Shell command failed with error)"))
+ ((equal 0 exit-status)
+ (message "(Shell command succeeded with %s)"
+ output))
+ ((stringp exit-status)
+ (message "(Shell command killed by signal %s)"
+ exit-status))
+ (t
+ (message "(Shell command failed with code %d and %s)"
+ exit-status output))))
+ ;; Don't kill: there might be useful info in the undo-log.
+ ;; (kill-buffer buffer)
+ ))))
(when (and error-file (file-exists-p error-file))
(if (< 0 (nth 7 (file-attributes error-file)))
(with-current-buffer
standard-output
(call-process shell-file-name nil t nil shell-command-switch command))))
-
+\f
(defvar universal-argument-map
(let ((map (make-sparse-keymap)))
(define-key map [t] 'universal-argument-other-key)
unread-command-events)))
(reset-this-command-lengths)
(setq overriding-terminal-local-map nil))
-
+\f
;;;; Window system cut and paste hooks.
(defvar interprogram-cut-function nil
difficult to tell whether Emacs or some other program provided the
current string, it is probably good enough to return nil if the string
is equal (according to `string=') to the last text Emacs provided.")
-
+\f
;;;; The kill ring data structure.
(defun kill-new (string &optional replace)
"Make STRING the latest kill in the kill ring.
-Set the kill-ring-yank pointer to point to it.
+Set `kill-ring-yank-pointer' to point to it.
If `interprogram-cut-function' is non-nil, apply it to STRING.
Optional second argument REPLACE non-nil means that STRING will replace
the front of the kill ring, rather than being added to the list."
it."
(kill-new (if before-p
(concat string (car kill-ring))
- (concat (car kill-ring) string)) t))
+ (concat (car kill-ring) string))
+ t))
(defun current-kill (n &optional do-not-move)
"Rotate the yanking point by N places, and then return that kill.
;; look like a C-g typed as a command.
(inhibit-quit t))
(if (pos-visible-in-window-p other-end (selected-window))
- (progn
+ (unless transient-mark-mode
;; Swap point and mark.
(set-marker (mark-marker) (point) (current-buffer))
(goto-char other-end)
(setq this-command 'kill-region)
(message "If the next command is a kill, it will append"))
(setq last-command 'kill-region)))
-
+\f
;; Yanking.
+;; This is actually used in subr.el but defcustom does not work there.
+(defcustom yank-excluded-properties
+ '(read-only invisible intangible field mouse-face help-echo local-map keymap)
+ "*Text properties to discard when yanking."
+ :type '(choice (const :tag "All" t) (repeat symbol))
+ :group 'editing
+ :version "21.4")
+
+(defvar yank-window-start nil)
+
(defun yank-pop (arg)
"Replace just-yanked stretch of killed text with a different stretch.
This command is allowed only immediately after a `yank' or a `yank-pop'.
(before (< (point) (mark t))))
(delete-region (point) (mark t))
(set-marker (mark-marker) (point) (current-buffer))
- (let ((opoint (point)))
- (insert (current-kill arg))
- (let ((inhibit-read-only t))
- (remove-text-properties opoint (point) '(read-only nil))))
+ (insert-for-yank (current-kill arg))
+ ;; Set the window start back where it was in the yank command,
+ ;; if possible.
+ (set-window-start (selected-window) yank-window-start t)
(if before
;; This is like exchange-point-and-mark, but doesn't activate the mark.
;; It is cleaner to avoid activation, even though the command
"Reinsert the last stretch of killed text.
More precisely, reinsert the stretch of killed text most recently
killed OR yanked. Put point at end, and set mark at beginning.
-With just C-u as argument, same but put point at beginning (and mark at end).
+With just \\[universal-argument] as argument, same but put point at beginning (and mark at end).
With argument N, reinsert the Nth most recently killed stretch of killed
text.
See also the command \\[yank-pop]."
(interactive "*P")
+ (setq yank-window-start (window-start))
;; If we don't get all the way thru, make last-command indicate that
;; for the following command.
(setq this-command t)
(push-mark (point))
- (let ((opoint (point)))
- (insert (current-kill (cond
- ((listp arg) 0)
- ((eq arg '-) -1)
- (t (1- arg)))))
- (let ((inhibit-read-only t))
- (remove-text-properties opoint (point) '(read-only nil))))
+ (insert-for-yank (current-kill (cond
+ ((listp arg) 0)
+ ((eq arg '-) -1)
+ (t (1- arg)))))
(if (consp arg)
;; This is like exchange-point-and-mark, but doesn't activate the mark.
;; It is cleaner to avoid activation, even though the command
With argument, rotate that many kills forward (or backward, if negative)."
(interactive "p")
(current-kill arg))
-
+\f
;; Some kill commands.
;; Internal subroutine of delete-char
(forward-visible-line (prefix-numeric-value arg))
(if (eobp)
(signal 'end-of-buffer nil))
- (if (or (looking-at "[ \t]*$") (and kill-whole-line (bolp)))
- (forward-visible-line 1)
- (end-of-visible-line)))
+ (let ((end
+ (save-excursion
+ (end-of-visible-line) (point))))
+ (if (or (save-excursion
+ (skip-chars-forward " \t" end)
+ (= (point) end))
+ (and kill-whole-line (bolp)))
+ (forward-visible-line 1)
+ (goto-char end))))
(point))))
+
(defun forward-visible-line (arg)
"Move forward by ARG lines, ignoring currently invisible newlines only.
If ARG is negative, move backward -ARG lines.
If ARG is zero, move to the beginning of the current line."
(condition-case nil
(if (> arg 0)
- (while (> arg 0)
- (or (zerop (forward-line 1))
- (signal 'end-of-buffer nil))
- ;; If the following character is currently invisible,
- ;; skip all characters with that same `invisible' property value,
- ;; then find the next newline.
- (while (and (not (eobp))
- (let ((prop
- (get-char-property (point) 'invisible)))
- (if (eq buffer-invisibility-spec t)
- prop
- (or (memq prop buffer-invisibility-spec)
- (assq prop buffer-invisibility-spec)))))
- (goto-char
- (if (get-text-property (point) 'invisible)
- (or (next-single-property-change (point) 'invisible)
- (point-max))
- (next-overlay-change (point))))
+ (progn
+ (while (> arg 0)
(or (zerop (forward-line 1))
- (signal 'end-of-buffer nil)))
- (setq arg (1- arg)))
+ (signal 'end-of-buffer nil))
+ ;; If the newline we just skipped is invisible,
+ ;; don't count it.
+ (let ((prop
+ (get-char-property (1- (point)) 'invisible)))
+ (if (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))
+ (setq arg (1+ arg))))
+ (setq arg (1- arg)))
+ ;; If invisible text follows, and it is a number of complete lines,
+ ;; skip it.
+ (let ((opoint (point)))
+ (while (and (not (eobp))
+ (let ((prop
+ (get-char-property (point) 'invisible)))
+ (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))))
+ (goto-char
+ (if (get-text-property (point) 'invisible)
+ (or (next-single-property-change (point) 'invisible)
+ (point-max))
+ (next-overlay-change (point)))))
+ (unless (bolp)
+ (goto-char opoint))))
(let ((first t))
(while (or first (< arg 0))
(if (zerop arg)
(beginning-of-line)
(or (zerop (forward-line -1))
(signal 'beginning-of-buffer nil)))
+ ;; If the newline we just moved to is invisible,
+ ;; don't count it.
+ (unless (bobp)
+ (let ((prop
+ (get-char-property (1- (point)) 'invisible)))
+ (if (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))
+ (setq arg (1+ arg)))))
+ (setq first nil)
+ (setq arg (1+ arg)))
+ ;; If invisible text follows, and it is a number of complete lines,
+ ;; skip it.
+ (let ((opoint (point)))
(while (and (not (bobp))
(let ((prop
(get-char-property (1- (point)) 'invisible)))
(if (get-text-property (1- (point)) 'invisible)
(or (previous-single-property-change (point) 'invisible)
(point-min))
- (previous-overlay-change (point))))
- (or (zerop (forward-line -1))
- (signal 'beginning-of-buffer nil)))
- (setq first nil)
- (setq arg (1+ arg)))))
+ (previous-overlay-change (point)))))
+ (unless (bolp)
+ (goto-char opoint)))))
((beginning-of-buffer end-of-buffer)
nil)))
;; skip all characters with that same `invisible' property value,
;; then find the next newline.
(while (and (not (eobp))
- (let ((prop
- (get-char-property (point) 'invisible)))
- (if (eq buffer-invisibility-spec t)
- prop
- (or (memq prop buffer-invisibility-spec)
- (assq prop buffer-invisibility-spec)))))
+ (save-excursion
+ (skip-chars-forward "^\n")
+ (let ((prop
+ (get-char-property (point) 'invisible)))
+ (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec))))))
+ (skip-chars-forward "^\n")
(if (get-text-property (point) 'invisible)
(goto-char (next-single-property-change (point) 'invisible))
(goto-char (next-overlay-change (point))))
(end-of-line)))
-
+\f
(defun insert-buffer (buffer)
"Insert after point the contents of BUFFER.
Puts mark after the inserted text.
(erase-buffer)
(save-excursion
(insert-buffer-substring oldbuf start end)))))
-
+\f
(put 'mark-inactive 'error-conditions '(mark-inactive error))
(put 'mark-inactive 'error-message "The mark is not active now")
"Deactivate the mark by setting `mark-active' to nil.
\(That makes a difference only in Transient Mark mode.)
Also runs the hook `deactivate-mark-hook'."
- (if transient-mark-mode
- (progn
- (setq mark-active nil)
- (run-hooks 'deactivate-mark-hook))))
+ (cond
+ ((eq transient-mark-mode 'lambda)
+ (setq transient-mark-mode nil))
+ (transient-mark-mode
+ (setq mark-active nil)
+ (run-hooks 'deactivate-mark-hook))))
(defun set-mark (pos)
"Set this buffer's mark to POS. Don't use this function!
:type 'integer
:group 'editing-basics)
+(defun pop-to-mark-command ()
+ "Jump to mark, and pop a new position for mark off the ring
+\(does not affect global mark ring\)."
+ (interactive)
+ (if (null (mark t))
+ (error "No mark set in this buffer")
+ (goto-char (mark t))
+ (pop-mark)))
+
+(defun push-mark-command (arg &optional nomsg)
+ "Set mark at where point is.
+If no prefix arg and mark is already set there, just activate it.
+Display `Mark set' unless the optional second arg NOMSG is non-nil."
+ (interactive "P")
+ (let ((mark (marker-position (mark-marker))))
+ (if (or arg (null mark) (/= mark (point)))
+ (push-mark nil nomsg t)
+ (setq mark-active t)
+ (unless nomsg
+ (message "Mark activated")))))
+
(defun set-mark-command (arg)
"Set mark at where point is, or jump to mark.
With no prefix argument, set mark, push old mark position on local mark
-ring, and push mark on global mark ring.
+ring, and push mark on global mark ring. Immediately repeating the
+command activates `transient-mark-mode' temporarily.
+
With argument, jump to mark, and pop a new position for mark off the ring
-\(does not affect global mark ring\).
+\(does not affect global mark ring\). Repeating the command without
+an argument jumps to the next position off the mark ring.
Novice Emacs Lisp programmers often try to use the mark for the wrong
purposes. See the documentation of `set-mark' for more information."
(interactive "P")
- (if (null arg)
- (progn
- (push-mark nil nil t))
- (if (null (mark t))
- (error "No mark set in this buffer")
- (goto-char (mark t))
- (pop-mark))))
+ (if (eq transient-mark-mode 'lambda)
+ (setq transient-mark-mode nil))
+ (cond
+ ((not (eq this-command 'set-mark-command))
+ (if arg
+ (pop-to-mark-command)
+ (push-mark-command t)))
+ ((eq last-command 'pop-to-mark-command)
+ (if (and (consp arg) (> (prefix-numeric-value arg) 4))
+ (push-mark-command nil)
+ (setq this-command 'pop-to-mark-command)
+ (pop-to-mark-command)))
+ (arg
+ (setq this-command 'pop-to-mark-command)
+ (pop-to-mark-command))
+ ((and (eq last-command 'set-mark-command)
+ mark-active (null transient-mark-mode))
+ (setq transient-mark-mode 'lambda)
+ (message "Transient-mark-mode temporarily enabled"))
+ (t
+ (push-mark-command nil))))
(defun push-mark (&optional location nomsg activate)
"Set mark at LOCATION (point, by default) and push old mark on mark ring.
(setq mark-ring (cdr mark-ring)))))
(defalias 'exchange-dot-and-mark 'exchange-point-and-mark)
-(defun exchange-point-and-mark ()
+(defun exchange-point-and-mark (&optional arg)
"Put the mark where point is now, and point where the mark is now.
This command works even when the mark is not active,
-and it reactivates the mark."
- (interactive nil)
- (let ((omark (mark t)))
- (if (null omark)
- (error "No mark set in this buffer"))
- (set-mark (point))
- (goto-char omark)
- nil))
-
-(defun transient-mark-mode (arg)
+and it reactivates the mark.
+With prefix arg, `transient-mark-mode' is enabled temporarily."
+ (interactive "P")
+ (if arg
+ (if mark-active
+ (if (null transient-mark-mode)
+ (setq transient-mark-mode 'lambda))
+ (setq arg nil)))
+ (unless arg
+ (let ((omark (mark t)))
+ (if (null omark)
+ (error "No mark set in this buffer"))
+ (set-mark (point))
+ (goto-char omark)
+ nil)))
+
+(define-minor-mode transient-mark-mode
"Toggle Transient Mark mode.
With arg, turn Transient Mark mode on if arg is positive, off otherwise.
\\[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."
- (interactive "P")
- (setq transient-mark-mode
- (if (null arg)
- (not transient-mark-mode)
- (> (prefix-numeric-value arg) 0)))
- (if (interactive-p)
- (if transient-mark-mode
- (message "Transient Mark mode enabled")
- (message "Transient Mark mode disabled"))))
+ :global t :group 'editing-basics :require nil)
(defun pop-global-mark ()
"Pop off global mark ring and jump to the top location."
(widen))
(goto-char position)
(switch-to-buffer buffer)))
-
+\f
(defcustom next-line-add-newlines nil
"*If non-nil, `next-line' inserts newline to avoid `end of buffer' error."
:type 'boolean
:version "21.1"
:group 'editing-basics)
-(defun next-line (arg)
+(defun next-line (&optional arg)
"Move cursor vertically down ARG lines.
If there is no character in the target line exactly under the current column,
the cursor is positioned after the character in that line which spans this
using `forward-line' instead. It is usually easier to use
and more reliable (no dependence on goal column, etc.)."
(interactive "p")
+ (unless arg (setq arg 1))
(if (and next-line-add-newlines (= arg 1))
(if (save-excursion (end-of-line) (eobp))
;; When adding a newline, don't expand an abbrev.
(line-move arg)))
nil)
-(defun previous-line (arg)
+(defun previous-line (&optional arg)
"Move cursor vertically up ARG lines.
If there is no character in the target line exactly over the current column,
the cursor is positioned after the character in that line which spans this
`forward-line' with a negative argument instead. It is usually easier
to use and more reliable (no dependence on goal column, etc.)."
(interactive "p")
+ (unless arg (setq arg 1))
(if (interactive-p)
(condition-case nil
(line-move (- arg))
:type 'boolean
:group 'editing-basics)
+(defun line-move-invisible (pos)
+ "Return non-nil if the character after POS is currently invisible."
+ (let ((prop
+ (get-char-property pos 'invisible)))
+ (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))))
+
;; This is the guts of next-line and previous-line.
;; Arg says how many lines to move.
(defun line-move (arg)
new line-end line-beg)
(unwind-protect
(progn
- (if (not (or (eq last-command 'next-line)
- (eq last-command 'previous-line)))
+ (if (not (memq last-command '(next-line previous-line)))
(setq temporary-goal-column
(if (and track-eol (eolp)
;; Don't count beg of empty line as end of line
(if (and (not (integerp selective-display))
(not line-move-ignore-invisible))
;; Use just newline characters.
+ ;; Set ARG to 0 if we move as many lines as requested.
(or (if (> arg 0)
(progn (if (> arg 1) (forward-line (1- arg)))
;; This way of moving forward ARG lines
;; verifies that we have a newline after the last one.
;; It doesn't get confused by intangible text.
(end-of-line)
- (zerop (forward-line 1)))
+ (if (zerop (forward-line 1))
+ (setq arg 0)))
(and (zerop (forward-line arg))
- (bolp)))
+ (bolp)
+ (setq arg 0)))
(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))
- ;; If the following character is currently invisible,
- ;; skip all characters with that same `invisible' property value.
- (while (and (not (eobp))
- (let ((prop
- (get-char-property (point) 'invisible)))
- (if (eq buffer-invisibility-spec t)
- prop
- (or (memq prop buffer-invisibility-spec)
- (assq prop buffer-invisibility-spec)))))
- (if (get-text-property (point) 'invisible)
- (goto-char (next-single-property-change (point) 'invisible))
- (goto-char (next-overlay-change (point)))))
(setq arg (1- arg)))
(while (< arg 0)
(beginning-of-line)
(and (zerop (vertical-motion -1))
(signal 'beginning-of-buffer nil))
- (while (and (not (bobp))
- (let ((prop
- (get-char-property (1- (point)) 'invisible)))
- (if (eq buffer-invisibility-spec t)
- prop
- (or (memq prop buffer-invisibility-spec)
- (assq prop buffer-invisibility-spec)))))
- (if (get-text-property (1- (point)) 'invisible)
- (goto-char (previous-single-property-change (point) 'invisible))
- (goto-char (previous-overlay-change (point)))))
- (setq arg (1+ arg))))
- (let ((buffer-invisibility-spec nil))
- (move-to-column (or goal-column temporary-goal-column))))
- (setq new (point))
- ;; If we are moving into some intangible text,
- ;; look for following text on the same line which isn't intangible
- ;; and move there.
- (setq line-end (save-excursion (end-of-line) (point)))
- (setq line-beg (save-excursion (beginning-of-line) (point)))
- (let ((after (and (< new (point-max))
- (get-char-property new 'intangible)))
- (before (and (> new (point-min))
- (get-char-property (1- new) 'intangible))))
- (when (and before (eq before after)
- (not (bolp)))
- (goto-char (point-min))
- (let ((inhibit-point-motion-hooks nil))
- (goto-char new))
- (if (<= new line-end)
- (setq new (point)))))
- ;; NEW is where we want to move to.
- ;; LINE-BEG and LINE-END are the beginning and end of the line.
- ;; Move there in just one step, from our starting position,
- ;; with intangibility and point-motion hooks enabled this time.
- (goto-char opoint)
- (setq inhibit-point-motion-hooks nil)
- (goto-char
- (constrain-to-field new opoint nil t 'inhibit-line-move-field-capture))
- ;; If intangibility processing moved us to a different line,
- ;; readjust the horizontal position within the line we ended up at.
- (when (or (< (point) line-beg) (> (point) line-end))
+ (setq arg (1+ arg))
+ (while (and (not (bobp)) (line-move-invisible (1- (point))))
+ (goto-char (previous-char-property-change (point)))))))
+
+ (cond ((> arg 0)
+ ;; If we did not move down as far as desired,
+ ;; 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.
+ (beginning-of-line))
+ (t
+ (line-move-finish (or goal-column temporary-goal-column) opoint)))))
+ nil)
+
+(defun line-move-finish (column opoint)
+ (let ((repeat t))
+ (while repeat
+ ;; Set REPEAT to t to repeat the whole thing.
+ (setq repeat nil)
+
+ (let (new
+ (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)))))
+
+ ;; Move to the desired column.
+ (line-move-to-column column)
(setq new (point))
- (setq inhibit-point-motion-hooks t)
- (setq line-end (save-excursion (end-of-line) (point)))
- (beginning-of-line)
- (setq line-beg (point))
- (let ((buffer-invisibility-spec nil))
- (move-to-column (or goal-column temporary-goal-column)))
- (if (<= (point) line-end)
- (setq new (point)))
+
+ ;; Process intangibility within a line.
+ ;; Move to the chosen destination position from above,
+ ;; with intangibility processing enabled.
+
(goto-char (point-min))
- (setq inhibit-point-motion-hooks nil)
- (goto-char
- (constrain-to-field new opoint nil t
- 'inhibit-line-move-field-capture)))))
- nil)
+ (let ((inhibit-point-motion-hooks nil))
+ (goto-char new)
+
+ ;; If intangibility moves us to a different (later) place
+ ;; in the same line, use that as the destination.
+ (if (<= (point) line-end)
+ (setq new (point))
+ ;; If that position is "too late",
+ ;; try the previous allowable position.
+ ;; See if it is ok.
+ (backward-char)
+ (if (<= (point) line-end)
+ (setq new (point))
+ ;; As a last resort, use the end of the line.
+ (setq new line-end))))
+
+ ;; Now move to the updated destination, processing fields
+ ;; as well as intangibility.
+ (goto-char opoint)
+ (let ((inhibit-point-motion-hooks nil))
+ (goto-char
+ (constrain-to-field new opoint nil t
+ 'inhibit-line-move-field-capture)))
+
+ ;; If all this moved us to a different line,
+ ;; retry everything within that new line.
+ (when (or (< (point) line-beg) (> (point) line-end))
+ ;; Repeat the intangibility and field processing.
+ (setq repeat t))))))
+
+(defun line-move-to-column (col)
+ "Try to find column COL, considering invisibility.
+This function works only in certain cases,
+because what we really need is for `move-to-column'
+and `current-column' to be able to ignore invisible text."
+ (if (zerop col)
+ (beginning-of-line)
+ (move-to-column col))
+
+ (when (and line-move-ignore-invisible
+ (not (bolp)) (line-move-invisible (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)))
+ (goto-char (next-char-property-change (point))))
+ ;; Have we advanced to a larger column position?
+ (if (> (current-column) normal-column)
+ ;; We have made some progress towards the desired column.
+ ;; See if we can make any further progress.
+ (line-move-to-column (+ (current-column) (- col normal-column)))
+ ;; Otherwise, go to the place we originally found
+ ;; and move back over invisible text.
+ ;; that will get us to the same place on the screen
+ ;; 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))))
+ (goto-char (previous-char-property-change (point) line-beg))))))))
;;; Many people have said they rarely use this feature, and often type
;;; it by accident. Maybe it shouldn't even be on a key.
"Goal column %d (use \\[set-goal-column] with an arg to unset it)")
goal-column))
nil)
-
+\f
(defun scroll-other-window-down (lines)
"Scroll the \"other window\" down.
(end-of-buffer arg)
(recenter '(t)))
(select-window orig-window))))
-
+\f
(defun transpose-chars (arg)
"Interchange characters around point, moving forward one character.
With prefix arg ARG, effect is to take character before point
and drag it forward past ARG other words (backward if ARG negative).
If ARG is zero, the words around or after point and around or after mark
are interchanged."
+ ;; FIXME: `foo a!nd bar' should transpose into `bar and foo'.
(interactive "*p")
(transpose-subr 'forward-word arg))
Does not work on a sexp that point is in the middle of
if it is a list or string."
(interactive "*p")
- (transpose-subr 'forward-sexp arg))
+ (transpose-subr
+ (lambda (arg)
+ ;; Here we should try to simulate the behavior of
+ ;; (cons (progn (forward-sexp x) (point))
+ ;; (progn (forward-sexp (- x)) (point)))
+ ;; Except that we don't want to rely on the second forward-sexp
+ ;; putting us back to where we want to be, since forward-sexp-function
+ ;; might do funny things like infix-precedence.
+ (if (if (> arg 0)
+ (looking-at "\\sw\\|\\s_")
+ (and (not (bobp))
+ (save-excursion (forward-char -1) (looking-at "\\sw\\|\\s_"))))
+ ;; Jumping over a symbol. We might be inside it, mind you.
+ (progn (funcall (if (> arg 0)
+ 'skip-syntax-backward 'skip-syntax-forward)
+ "w_")
+ (cons (save-excursion (forward-sexp arg) (point)) (point)))
+ ;; Otherwise, we're between sexps. Take a step back before jumping
+ ;; to make sure we'll obey the same precedence no matter which direction
+ ;; we're going.
+ (funcall (if (> arg 0) 'skip-syntax-backward 'skip-syntax-forward) " .")
+ (cons (save-excursion (forward-sexp arg) (point))
+ (progn (while (or (forward-comment (if (> arg 0) 1 -1))
+ (not (zerop (funcall (if (> arg 0)
+ 'skip-syntax-forward
+ 'skip-syntax-backward)
+ ".")))))
+ (point)))))
+ arg 'special))
(defun transpose-lines (arg)
"Exchange current line and previous line, leaving point after both.
(forward-line arg))))
arg))
-(defvar transpose-subr-start1)
-(defvar transpose-subr-start2)
-(defvar transpose-subr-end1)
-(defvar transpose-subr-end2)
-
-(defun transpose-subr (mover arg)
- (let (transpose-subr-start1
- transpose-subr-end1
- transpose-subr-start2
- transpose-subr-end2)
- (if (= arg 0)
- (progn
- (save-excursion
- (funcall mover 1)
- (setq transpose-subr-end2 (point))
- (funcall mover -1)
- (setq transpose-subr-start2 (point))
- (goto-char (mark))
- (funcall mover 1)
- (setq transpose-subr-end1 (point))
- (funcall mover -1)
- (setq transpose-subr-start1 (point))
- (transpose-subr-1))
- (exchange-point-and-mark))
- (if (> arg 0)
- (progn
- (funcall mover -1)
- (setq transpose-subr-start1 (point))
- (funcall mover 1)
- (setq transpose-subr-end1 (point))
- (funcall mover arg)
- (setq transpose-subr-end2 (point))
- (funcall mover (- arg))
- (setq transpose-subr-start2 (point))
- (transpose-subr-1)
- (goto-char transpose-subr-end2))
- (funcall mover -1)
- (setq transpose-subr-start2 (point))
- (funcall mover 1)
- (setq transpose-subr-end2 (point))
- (funcall mover (1- arg))
- (setq transpose-subr-start1 (point))
- (funcall mover (- arg))
- (setq transpose-subr-end1 (point))
- (transpose-subr-1)))))
-
-(defun transpose-subr-1 ()
- (if (> (min transpose-subr-end1 transpose-subr-end2)
- (max transpose-subr-start1 transpose-subr-start2))
- (error "Don't have two things to transpose"))
- (let* ((word1 (buffer-substring transpose-subr-start1 transpose-subr-end1))
- (len1 (length word1))
- (word2 (buffer-substring transpose-subr-start2 transpose-subr-end2))
- (len2 (length word2)))
- (delete-region transpose-subr-start2 transpose-subr-end2)
- (goto-char transpose-subr-start2)
- (insert word1)
- (goto-char (if (< transpose-subr-start1 transpose-subr-start2)
- transpose-subr-start1
- (+ transpose-subr-start1 (- len1 len2))))
- (delete-region (point) (+ (point) len1))
- (insert word2)))
-
+(defun transpose-subr (mover arg &optional special)
+ (let ((aux (if special mover
+ (lambda (x)
+ (cons (progn (funcall mover x) (point))
+ (progn (funcall mover (- x)) (point))))))
+ pos1 pos2)
+ (cond
+ ((= arg 0)
+ (save-excursion
+ (setq pos1 (funcall aux 1))
+ (goto-char (mark))
+ (setq pos2 (funcall aux 1))
+ (transpose-subr-1 pos1 pos2))
+ (exchange-point-and-mark))
+ ((> arg 0)
+ (setq pos1 (funcall aux -1))
+ (setq pos2 (funcall aux arg))
+ (transpose-subr-1 pos1 pos2)
+ (goto-char (car pos2)))
+ (t
+ (setq pos1 (funcall aux -1))
+ (goto-char (car pos1))
+ (setq pos2 (funcall aux arg))
+ (transpose-subr-1 pos1 pos2)))))
+
+(defun transpose-subr-1 (pos1 pos2)
+ (when (> (car pos1) (cdr pos1)) (setq pos1 (cons (cdr pos1) (car pos1))))
+ (when (> (car pos2) (cdr pos2)) (setq pos2 (cons (cdr pos2) (car pos2))))
+ (when (> (car pos1) (car pos2))
+ (let ((swap pos1))
+ (setq pos1 pos2 pos2 swap)))
+ (if (> (cdr pos1) (car pos2)) (error "Don't have two things to transpose"))
+ (atomic-change-group
+ (let (word2)
+ (setq word2 (delete-and-extract-region (car pos2) (cdr pos2)))
+ (goto-char (car pos2))
+ (insert (delete-and-extract-region (car pos1) (cdr pos1)))
+ (goto-char (car pos1))
+ (insert word2))))
+\f
(defun backward-word (arg)
"Move backward until encountering the beginning of a word.
With argument, do this that many times."
(forward-word (- arg)))
(defun mark-word (arg)
- "Set mark arg words away from point."
+ "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")
- (push-mark
- (save-excursion
- (forward-word arg)
- (point))
- nil t))
+ (cond ((and (eq last-command this-command) (mark t))
+ (set-mark
+ (save-excursion
+ (goto-char (mark))
+ (forward-word arg)
+ (point))))
+ (t
+ (push-mark
+ (save-excursion
+ (forward-word arg)
+ (point))
+ nil t))))
(defun kill-word (arg)
"Kill characters forward until encountering the end of a word.
(setq start (point)))
(buffer-substring-no-properties start end)))
(buffer-substring-no-properties start end)))))
-
+\f
(defcustom fill-prefix nil
- "*String for filling to insert at front of new line, or nil for none.
-Setting this variable automatically makes it local to the current buffer."
+ "*String for filling to insert at front of new line, or nil for none."
:type '(choice (const :tag "None" nil)
string)
:group 'fill)
(save-excursion (unjustify-current-line)))
;; Choose a fill-prefix automatically.
- (if (and adaptive-fill-mode
- (or (null fill-prefix) (string= fill-prefix "")))
- (let ((prefix
- (fill-context-prefix
- (save-excursion (backward-paragraph 1) (point))
- (save-excursion (forward-paragraph 1) (point)))))
- (and prefix (not (equal prefix ""))
- (setq fill-prefix prefix))))
-
+ (when (and adaptive-fill-mode
+ (or (null fill-prefix) (string= fill-prefix "")))
+ (let ((prefix
+ (fill-context-prefix
+ (save-excursion (backward-paragraph 1) (point))
+ (save-excursion (forward-paragraph 1) (point)))))
+ (and prefix (not (equal prefix ""))
+ ;; Use auto-indentation rather than a guessed empty prefix.
+ (not (and fill-indent-according-to-mode
+ (string-match "\\`[ \t]*\\'" prefix)))
+ (setq fill-prefix prefix))))
+
(while (and (not give-up) (> (current-column) fc))
;; Determine where to split the line.
(let* (after-prefix
(fill-point
- (let ((opoint (point))
- bounce
- (first t))
+ (let ((opoint (point)))
(save-excursion
(beginning-of-line)
(setq after-prefix (point))
(looking-at (regexp-quote fill-prefix))
(setq after-prefix (match-end 0)))
(move-to-column (1+ fc))
- ;; Move back to the point where we can break the line.
- ;; We break the line between word or
- ;; after/before the character which has character
- ;; category `|'. We search space, \c| followed by
- ;; a character, or \c| following a character. If
- ;; not found, place the point at beginning of line.
- (while (or first
- ;; If this is after period and a single space,
- ;; move back once more--we don't want to break
- ;; the line there and make it look like a
- ;; sentence end.
- (and (not (bobp))
- (not bounce)
- sentence-end-double-space
- (save-excursion (forward-char -1)
- (and (looking-at "\\. ")
- (not (looking-at "\\. ")))))
- (and (not (bobp))
- (not bounce)
- fill-nobreak-predicate
- (funcall fill-nobreak-predicate)))
- (setq first nil)
- (re-search-backward "[ \t]\\|\\c|.\\|.\\c|\\|^")
- ;; If we find nowhere on the line to break it,
- ;; break after one word. Set bounce to t
- ;; so we will not keep going in this while loop.
- (if (<= (point) after-prefix)
- (progn
- (goto-char after-prefix)
- (re-search-forward "[ \t]" opoint t)
- (setq bounce t))
- (if (looking-at "[ \t]")
- ;; Break the line at word boundary.
- (skip-chars-backward " \t")
- ;; Break the line after/before \c|.
- (forward-char 1))))
- (if enable-multibyte-characters
- ;; If we are going to break the line after or
- ;; before a non-ascii character, we may have
- ;; to run a special function for the charset
- ;; of the character to find the correct break
- ;; point.
- (if (not (and (eq (charset-after (1- (point))) 'ascii)
- (eq (charset-after (point)) 'ascii)))
- (fill-find-break-point after-prefix)))
-
- ;; Let fill-point be set to the place where we end up.
- ;; But move back before any whitespace here.
- (skip-chars-backward " \t")
+ (fill-move-to-break-point after-prefix)
(point)))))
;; See whether the place we found is any good.
(if (save-excursion
(goto-char fill-point)
- (and (not (bolp))
- ;; There is no use breaking at end of line.
- (not (save-excursion (skip-chars-forward " ") (eolp)))
- ;; It is futile to split at the end of the prefix
- ;; since we would just insert the prefix again.
- (not (and after-prefix (<= (point) after-prefix)))
- ;; Don't split right after a comment starter
- ;; since we would just make another comment starter.
- (not (and comment-start-skip
- (let ((limit (point)))
- (beginning-of-line)
- (and (re-search-forward comment-start-skip
- limit t)
- (eq (point) limit)))))))
- ;; Ok, we have a useful place to break the line. Do it.
- (let ((prev-column (current-column)))
- ;; If point is at the fill-point, do not `save-excursion'.
- ;; Otherwise, if a comment prefix or fill-prefix is inserted,
- ;; point will end up before it rather than after it.
- (if (save-excursion
- (skip-chars-backward " \t")
- (= (point) fill-point))
- (funcall comment-line-break-function t)
+ (or (bolp)
+ ;; There is no use breaking at end of line.
+ (save-excursion (skip-chars-forward " ") (eolp))
+ ;; It is futile to split at the end of the prefix
+ ;; since we would just insert the prefix again.
+ (and after-prefix (<= (point) after-prefix))
+ ;; Don't split right after a comment starter
+ ;; since we would just make another comment starter.
+ (and comment-start-skip
+ (let ((limit (point)))
+ (beginning-of-line)
+ (and (re-search-forward comment-start-skip
+ limit t)
+ (eq (point) limit))))))
+ ;; No good place to break => stop trying.
+ (setq give-up t)
+ ;; Ok, we have a useful place to break the line. Do it.
+ (let ((prev-column (current-column)))
+ ;; If point is at the fill-point, do not `save-excursion'.
+ ;; Otherwise, if a comment prefix or fill-prefix is inserted,
+ ;; point will end up before it rather than after it.
+ (if (save-excursion
+ (skip-chars-backward " \t")
+ (= (point) fill-point))
+ (funcall comment-line-break-function t)
+ (save-excursion
+ (goto-char fill-point)
+ (funcall comment-line-break-function t)))
+ ;; Now do justification, if required
+ (if (not (eq justify 'left))
(save-excursion
- (goto-char fill-point)
- (funcall comment-line-break-function t)))
- ;; Now do justification, if required
- (if (not (eq justify 'left))
- (save-excursion
- (end-of-line 0)
- (justify-current-line justify nil t)))
- ;; If making the new line didn't reduce the hpos of
- ;; the end of the line, then give up now;
- ;; trying again will not help.
- (if (>= (current-column) prev-column)
- (setq give-up t)))
- ;; No good place to break => stop trying.
- (setq give-up t))))
+ (end-of-line 0)
+ (justify-current-line justify nil t)))
+ ;; If making the new line didn't reduce the hpos of
+ ;; the end of the line, then give up now;
+ ;; trying again will not help.
+ (if (>= (current-column) prev-column)
+ (setq give-up t))))))
;; Justify last line.
(justify-current-line justify t t)
t)))
"The function to use for `auto-fill-function' if Auto Fill mode is turned on.
Some major modes set this.")
+;; FIXME: turn into a proper minor mode.
+;; Add a global minor mode version of it.
(defun auto-fill-mode (&optional arg)
"Toggle Auto Fill mode.
With arg, turn Auto Fill mode on if and only if arg is positive.
(error "set-fill-column requires an explicit argument")
(message "Fill column set to %d (was %d)" arg fill-column)
(setq fill-column arg)))
-
+\f
(defun set-selective-display (arg)
"Set `selective-display' to ARG; clear it if no arg.
When the value of `selective-display' is a number > 0,
(prin1 selective-display t)
(princ "." t))
+(defvaralias 'indicate-unused-lines 'indicate-empty-lines)
+(defvaralias 'default-indicate-unused-lines 'default-indicate-empty-lines)
+
+(defun toggle-truncate-lines (arg)
+ "Toggle whether to fold or truncate long lines on the screen.
+With arg, truncate long lines iff arg is positive.
+Note that in side-by-side windows, truncation is always enabled."
+ (interactive "P")
+ (setq truncate-lines
+ (if (null arg)
+ (not truncate-lines)
+ (> (prefix-numeric-value arg) 0)))
+ (force-mode-line-update)
+ (unless truncate-lines
+ (let ((buffer (current-buffer)))
+ (walk-windows (lambda (window)
+ (if (eq buffer (window-buffer window))
+ (set-window-hscroll window 0)))
+ nil t)))
+ (message "Truncate long lines %s"
+ (if truncate-lines "enabled" "disabled")))
+
(defvar overwrite-mode-textual " Ovwrt"
"The string displayed in the mode line when in overwrite mode.")
(defvar overwrite-mode-binary " Bin Ovwrt"
'overwrite-mode-binary))
(force-mode-line-update))
-(defcustom line-number-mode t
- "*Non-nil means display line number in mode line."
- :type 'boolean
- :group 'editing-basics)
-
-(defun line-number-mode (arg)
+(define-minor-mode line-number-mode
"Toggle Line Number mode.
With arg, turn Line Number mode on iff arg is positive.
When Line Number mode is enabled, the line number appears
Line numbers do not appear for very large buffers and buffers
with very long lines; see variables `line-number-display-limit'
and `line-number-display-limit-width'."
- (interactive "P")
- (setq line-number-mode
- (if (null arg) (not line-number-mode)
- (> (prefix-numeric-value arg) 0)))
- (force-mode-line-update))
-
-(defcustom column-number-mode nil
- "*Non-nil means display column number in mode line."
- :type 'boolean
- :group 'editing-basics)
+ :init-value t :global t :group 'editing-basics :require nil)
-(defun column-number-mode (arg)
+(define-minor-mode column-number-mode
"Toggle Column Number mode.
With arg, turn Column Number mode on iff arg is positive.
When Column Number mode is enabled, the column number appears
in the mode line."
- (interactive "P")
- (setq column-number-mode
- (if (null arg) (not column-number-mode)
- (> (prefix-numeric-value arg) 0)))
- (force-mode-line-update))
-
+ :global t :group 'editing-basics :require nil)
+\f
(defgroup paren-blinking nil
"Blinking matching of parens and expressions."
:prefix "blink-matching-"
;Turned off because it makes dbx bomb out.
(setq blink-paren-function 'blink-matching-open)
-
+\f
;; This executes C-g typed while Emacs is waiting for a command.
;; Quitting out of a program does not go through here;
;; that happens in the QUIT macro at the C code level.
At top-level, as an editor command, this simply beeps."
(interactive)
(deactivate-mark)
+ (setq defining-kbd-macro nil)
(signal 'quit nil))
(define-key global-map "\C-g" 'keyboard-quit)
((string-match "^ \\*" (buffer-name (current-buffer)))
(bury-buffer))))
+(defun play-sound-file (file &optional volume device)
+ "Play sound stored in FILE.
+VOLUME and DEVICE correspond to the keywords of the sound
+specification for `play-sound'."
+ (interactive "fPlay sound file: ")
+ (let ((sound (list :file file)))
+ (if volume
+ (plist-put sound :volume volume))
+ (if device
+ (plist-put sound :device device))
+ (push 'sound sound)
+ (play-sound sound)))
+
(define-key global-map "\e\e\e" 'keyboard-escape-quit)
(defcustom read-mail-command 'rmail
(function :tag "Other"))
:group 'mail)
-(defun define-mail-user-agent (symbol composefunc sendfunc
- &optional abortfunc hookvar)
- "Define a symbol to identify a mail-sending package for `mail-user-agent'.
-
-SYMBOL can be any Lisp symbol. Its function definition and/or
-value as a variable do not matter for this usage; we use only certain
-properties on its property list, to encode the rest of the arguments.
-
-COMPOSEFUNC is program callable function that composes an outgoing
-mail message buffer. This function should set up the basics of the
-buffer without requiring user interaction. It should populate the
-standard mail headers, leaving the `to:' and `subject:' headers blank
-by default.
-
-COMPOSEFUNC should accept several optional arguments--the same
-arguments that `compose-mail' takes. See that function's documentation.
-
-SENDFUNC is the command a user would run to send the message.
-
-Optional ABORTFUNC is the command a user would run to abort the
-message. For mail packages that don't have a separate abort function,
-this can be `kill-buffer' (the equivalent of omitting this argument).
-
-Optional HOOKVAR is a hook variable that gets run before the message
-is actually sent. Callers that use the `mail-user-agent' may
-install a hook function temporarily on this hook variable.
-If HOOKVAR is nil, `mail-send-hook' is used.
-
-The properties used on SYMBOL are `composefunc', `sendfunc',
-`abortfunc', and `hookvar'."
- (put symbol 'composefunc composefunc)
- (put symbol 'sendfunc sendfunc)
- (put symbol 'abortfunc (or abortfunc 'kill-buffer))
- (put symbol 'hookvar (or hookvar 'mail-send-hook)))
-
(define-mail-user-agent 'sendmail-user-agent
'sendmail-user-agent-compose
'mail-send-and-exit)
(defun rfc822-goto-eoh ()
;; Go to header delimiter line in a mail message, following RFC822 rules
(goto-char (point-min))
- (while (looking-at "^[^: \n]+:\\|^[ \t]")
- (forward-line 1))
- (point))
+ (when (re-search-forward
+ "^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move)
+ (goto-char (match-beginning 0))))
(defun sendmail-user-agent-compose (&optional to subject other-headers continue
switch-function yank-action
(defvar set-variable-value-history nil
"History of values entered with `set-variable'.")
-(defun set-variable (var val)
+(defun set-variable (var val &optional make-local)
"Set VARIABLE to VALUE. VALUE is a Lisp object.
When using this interactively, enter a Lisp object for VALUE.
If you want VALUE to be a string, you must surround it with doublequotes.
it were the arg to `interactive' (which see) to interactively read VALUE.
If VARIABLE has been defined with `defcustom', then the type information
-in the definition is used to check that VALUE is valid."
+in the definition is used to check that VALUE is valid.
+
+With a prefix argument, set VARIABLE to VALUE buffer-locally."
(interactive
(let* ((default-var (variable-at-point))
(var (if (symbolp default-var)
(read-variable "Set variable: ")))
(minibuffer-help-form '(describe-variable var))
(prop (get var 'variable-interactive))
- (prompt (format "Set %s to value: " var))
+ (prompt (format "Set %s%s to value: " var
+ (cond ((local-variable-p var)
+ " (buffer-local)")
+ ((or current-prefix-arg
+ (local-variable-if-set-p var))
+ " buffer-locally")
+ (t " globally"))))
(val (if prop
;; Use VAR's `variable-interactive' property
;; as an interactive spec for prompting.
(read
(read-string prompt nil
'set-variable-value-history)))))
- (list var val)))
+ (list var val current-prefix-arg)))
(let ((type (get var 'custom-type)))
(when type
(unless (widget-apply type :match val)
(error "Value `%S' does not match type %S of %S"
val (car type) var))))
+
+ (if make-local
+ (make-local-variable var))
+
(set var val)
;; Force a thorough redisplay for the case that the variable
;; that can be found before POINT.
(defun choose-completion-delete-max-match (string)
(let ((opoint (point))
- (len (min (length string)
- (- (point) (point-min)))))
- (goto-char (- (point) (length string)))
+ len)
+ ;; Try moving back by the length of the string.
+ (goto-char (max (- (point) (length string))
+ (minibuffer-prompt-end)))
+ ;; See how far back we were actually able to move. That is the
+ ;; upper bound on how much we can match and delete.
+ (setq len (- opoint (point)))
(if completion-ignore-case
(setq string (downcase string)))
(while (and (> len 0)
- (let ((tail (buffer-substring (point)
- (+ (point) len))))
+ (let ((tail (buffer-substring (point) opoint)))
(if completion-ignore-case
(setq tail (downcase tail)))
(not (string= tail (substring string 0 len)))))
(forward-char 1))
(delete-char len)))
-;; Switch to BUFFER and insert the completion choice CHOICE.
-;; BASE-SIZE, if non-nil, says how many characters of BUFFER's text
-;; to keep. If it is nil, use choose-completion-delete-max-match instead.
+(defvar choose-completion-string-functions nil
+ "Functions that may override the normal insertion of a completion choice.
+These functions are called in order with four arguments:
+CHOICE - the string to insert in the buffer,
+BUFFER - the buffer in which the choice should be inserted,
+MINI-P - non-nil iff BUFFER is a minibuffer, and
+BASE-SIZE - the number of characters in BUFFER before
+the string being completed.
+
+If a function in the list returns non-nil, that function is supposed
+to have inserted the CHOICE in the BUFFER, and possibly exited
+the minibuffer; no further functions will be called.
+
+If all functions in the list return nil, that means to use
+the default method of inserting the completion in BUFFER.")
-;; If BUFFER is the minibuffer, exit the minibuffer
-;; unless it is reading a file name and CHOICE is a directory,
-;; or completion-no-auto-exit is non-nil.
(defun choose-completion-string (choice &optional buffer base-size)
+ "Switch to BUFFER and insert the completion choice CHOICE.
+BASE-SIZE, if non-nil, says how many characters of BUFFER's text
+to keep. If it is nil, we call `choose-completion-delete-max-match'
+to decide what to delete."
+
+ ;; If BUFFER is the minibuffer, exit the minibuffer
+ ;; unless it is reading a file name and CHOICE is a directory,
+ ;; or completion-no-auto-exit is non-nil.
+
(let ((buffer (or buffer completion-reference-buffer))
- (mini-p (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer))))
+ (mini-p (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
+ (buffer-name buffer))))
;; If BUFFER is a minibuffer, barf unless it's the currently
;; active minibuffer.
(if (and mini-p
(not (equal buffer
(window-buffer (active-minibuffer-window))))))
(error "Minibuffer is not active for completion")
- ;; Insert the completion into the buffer where completion was requested.
- (set-buffer buffer)
- (if base-size
- (delete-region (+ base-size (if mini-p
- (minibuffer-prompt-end)
- (point-min)))
- (point))
- (choose-completion-delete-max-match choice))
- (insert choice)
- (remove-text-properties (- (point) (length choice)) (point)
- '(mouse-face nil))
- ;; Update point in the window that BUFFER is showing in.
- (let ((window (get-buffer-window buffer t)))
- (set-window-point window (point)))
- ;; If completing for the minibuffer, exit it with this choice.
- (and (not completion-no-auto-exit)
- (equal buffer (window-buffer (minibuffer-window)))
- minibuffer-completion-table
- ;; If this is reading a file name, and the file name chosen
- ;; is a directory, don't exit the minibuffer.
- (if (and (eq minibuffer-completion-table 'read-file-name-internal)
- (file-directory-p (field-string (point-max))))
- (let ((mini (active-minibuffer-window)))
- (select-window mini)
- (when minibuffer-auto-raise
- (raise-frame (window-frame mini))))
- (exit-minibuffer))))))
+ (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)
+ (point-min)))
+ (point))
+ (choose-completion-delete-max-match choice))
+ (insert choice)
+ (remove-text-properties (- (point) (length choice)) (point)
+ '(mouse-face nil))
+ ;; Update point in the window that BUFFER is showing in.
+ (let ((window (get-buffer-window buffer t)))
+ (set-window-point window (point)))
+ ;; If completing for the minibuffer, exit it with this choice.
+ (and (not completion-no-auto-exit)
+ (equal buffer (window-buffer (minibuffer-window)))
+ minibuffer-completion-table
+ ;; If this is reading a file name, and the file name chosen
+ ;; is a directory, don't exit the minibuffer.
+ (if (and (eq minibuffer-completion-table 'read-file-name-internal)
+ (file-directory-p (field-string (point-max))))
+ (let ((mini (active-minibuffer-window)))
+ (select-window mini)
+ (when minibuffer-auto-raise
+ (raise-frame (window-frame mini))))
+ (exit-minibuffer)))))))
(defun completion-list-mode ()
"Major mode for buffers showing lists of possible completions.
(completion-list-mode)
(make-local-variable 'completion-reference-buffer)
(setq completion-reference-buffer mainbuf)
- (if (eq minibuffer-completion-table 'read-file-name-internal)
+ (if minibuffer-completing-file-name
;; For file name completion,
;; use the number of chars before the start of the
;; last file name component.
(save-excursion
(set-buffer mainbuf)
(goto-char (point-max))
- (skip-chars-backward (format "^%c" directory-sep-char))
+ (skip-chars-backward "^/")
(- (point) (minibuffer-prompt-end))))
;; Otherwise, in minibuffer, the whole input is being completed.
(save-match-data
;;; bindings.
;; Also tell read-char how to handle these keys.
-(mapcar
+(mapc
(lambda (keypad-normal)
(let ((keypad (nth 0 keypad-normal))
(normal (nth 1 keypad-normal)))
(kp-decimal ?.)
(kp-divide ?/)
(kp-equal ?=)))
-
+\f
;;;;
;;;; forking a twin copy of a buffer.
;;;;
(setq newname (substring newname 0 (match-beginning 0))))
(when (memq (process-status process) '(run stop open))
(let* ((process-connection-type (process-tty-name process))
- (old-kwoq (process-kill-without-query process nil))
(new-process
(if (memq (process-status process) '(open))
- (apply 'open-network-stream newname
- (if (process-buffer process) (current-buffer))
- (process-contact process))
+ (let ((args (process-contact process t)))
+ (setq args (plist-put args :name newname))
+ (setq args (plist-put args :buffer
+ (if (process-buffer process) (current-buffer))))
+ (apply 'make-network-process args))
(apply 'start-process newname
(if (process-buffer process) (current-buffer))
(process-command process)))))
- (process-kill-without-query new-process old-kwoq)
- (process-kill-without-query process old-kwoq)
+ (set-process-query-on-exit-flag
+ new-process (process-query-on-exit-flag process))
(set-process-inherit-coding-system-flag
new-process (process-inherit-coding-system-flag process))
(set-process-filter new-process (process-filter process))
(set-process-sentinel new-process (process-sentinel process))
new-process)))
-;; things to maybe add (currently partly covered by `funcall mode':
+;; things to maybe add (currently partly covered by `funcall mode'):
;; - syntax-table
;; - overlays
(defun clone-buffer (&optional newname display-flag)
If DISPLAY-FLAG is non-nil, the new buffer is shown with `pop-to-buffer'.
This runs the normal hook `clone-buffer-hook' in the new buffer
after it has been set up properly in other respects."
- (interactive (list (if current-prefix-arg (read-string "Name: "))
- t))
+ (interactive
+ (progn
+ (if buffer-file-name
+ (error "Cannot clone a file-visiting buffer"))
+ (if (get major-mode 'no-clone)
+ (error "Cannot clone a buffer in %s mode" mode-name))
+ (list (if current-prefix-arg (read-string "Name: "))
+ t)))
(if buffer-file-name
(error "Cannot clone a file-visiting buffer"))
(if (get major-mode 'no-clone)
Optional last arg NORECORD non-nil means do not put this buffer at the
front of the list of recently selected ones."
- (interactive (list (if current-prefix-arg
- (read-string "BName of indirect buffer: "))
- t))
+ (interactive
+ (progn
+ (if (get major-mode 'no-clone-indirect)
+ (error "Cannot indirectly clone a buffer in %s mode" mode-name))
+ (list (if current-prefix-arg
+ (read-string "BName of indirect buffer: "))
+ t)))
+ (if (get major-mode 'no-clone-indirect)
+ (error "Cannot indirectly clone a buffer in %s mode" mode-name))
(setq newname (or newname (buffer-name)))
(if (string-match "<[0-9]+>\\'" newname)
(setq newname (substring newname 0 (match-beginning 0))))
Optional second arg NORECORD non-nil means do not put this buffer at
the front of the list of recently selected ones."
(interactive "bClone buffer in other window: ")
- (let ((popup-windows t))
+ (let ((pop-up-windows t))
(set-buffer buffer)
(clone-indirect-buffer nil t norecord)))
(define-key ctl-x-4-map "c" 'clone-indirect-buffer-other-window)
-
-
-;;; Syntax stuff.
-
-(defconst syntax-code-table
- '((?\ 0 "whitespace")
- (?- 0 "whitespace")
- (?. 1 "punctuation")
- (?w 2 "word")
- (?_ 3 "symbol")
- (?\( 4 "open parenthesis")
- (?\) 5 "close parenthesis")
- (?\' 6 "expression prefix")
- (?\" 7 "string quote")
- (?$ 8 "paired delimiter")
- (?\\ 9 "escape")
- (?/ 10 "character quote")
- (?< 11 "comment start")
- (?> 12 "comment end")
- (?@ 13 "inherit")
- (nil 14 "comment fence")
- (nil 15 "string fence"))
- "Alist of forms (CHAR CODE DESCRIPTION) mapping characters to syntax info.
-CHAR is a character that is allowed as first char in the string
-specifying the syntax when calling `modify-syntax-entry'. CODE is the
-corresponing syntax code as it is stored in a syntax cell, and
-can be used as value of a `syntax-table' property.
-DESCRIPTION is the descriptive string for the syntax.")
-
-
+\f
;;; Handling of Backspace and Delete keys.
(defcustom normal-erase-is-backspace nil
(if normal-erase-is-backspace "forward" "backward"))))
-;;; Misc
-
-(defun byte-compiling-files-p ()
- "Return t if currently byte-compiling files."
- (and (boundp 'byte-compile-current-file)
- (stringp byte-compile-current-file)))
-
-
-;;; Minibuffer prompt stuff.
+;; Minibuffer prompt stuff.
;(defun minibuffer-prompt-modification (start end)
; (error "You cannot modify the prompt"))
; 'insert-in-front-hooks '(minibuffer-prompt-insertion)))
;
+(provide 'simple)
;;; simple.el ends here