;;; simple.el --- basic editing commands for Emacs
-;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 1999
+;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;;; Code:
+(eval-when-compile
+ (autoload 'widget-convert "wid-edit")
+ (autoload 'shell-mode "shell")
+ (require 'cl))
+
+
(defgroup killing nil
"Killing and yanking commands"
:group 'editing)
-(defgroup fill-comments nil
- "Indenting and filling of comments."
- :prefix "comment-"
- :group 'fill)
-
(defgroup paren-matching nil
"Highlight (un)matching of parens and expressions."
:group 'matching)
+(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))
+
+;; Making and deleting lines.
+
(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'.
-With arg, insert that many newlines.
-In Auto Fill mode, if no numeric arg, break the preceding line if it's long."
+If `use-hard-newlines' is non-nil, the newline is marked with the
+text-property `hard'.
+With ARG, insert that many newlines.
+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
;; try_window_id than inserting at the beginning of a line, and the textual
;; result is the same. So, if we're at beginning of line, pretend to be at
;; the end of the previous line.
- (let ((flag (and (not (bobp))
+ (let ((flag (and (not (bobp))
(bolp)
;; Make sure no functions want to be told about
;; the range of the changes.
- (not after-change-function)
- (not before-change-function)
(not after-change-functions)
(not before-change-functions)
;; Make sure there are no markers here.
(not (get-char-property (1- (point)) 'invisible))
;; Make sure the newline before point has the same
;; properties as the char before it (if any).
- (< (or (previous-property-change (point)) -2)
+ (< (or (previous-property-change (point)) -2)
(- (point) 2))))
(was-page-start (and (bolp)
(looking-at page-delimiter)))
(interactive "*p")
(let* ((do-fill-prefix (and fill-prefix (bolp)))
(do-left-margin (and (bolp) (> (current-left-margin) 0)))
- (loc (point)))
+ (loc (point))
+ ;; Don't expand an abbrev before point.
+ (abbrev-mode nil))
(newline arg)
(goto-char loc)
(while (> arg 0)
(indent-to col 0)
(goto-char pos)))
-(defun quoted-insert (arg)
- "Read next input character and insert it.
-This is useful for inserting control characters.
-
-If the first character you type after this command is an octal digit,
-you should type a sequence of octal digits which specify a character code.
-Any nondigit terminates the sequence. If the terminator is a RET,
-it is discarded; any other terminator is used itself as input.
-The variable `read-quoted-char-radix' specifies the radix for this feature;
-set it to 10 or 16 to use decimal or hex instead of octal.
-
-In overwrite mode, this function inserts the character anyway, and
-does not handle octal digits specially. This means that if you use
-overwrite as your normal editing mode, you can use this function to
-insert characters when necessary.
-
-In binary overwrite mode, this function does overwrite, and octal
-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))))
- ;; Assume character codes 0240 - 0377 stand for characters in some
- ;; single-byte character set, and convert them to Emacs
- ;; characters.
- (if (and enable-multibyte-characters
- (>= char ?\240)
- (<= char ?\377))
- (setq char (unibyte-char-to-multibyte char)))
- (if (> arg 0)
- (if (eq overwrite-mode 'overwrite-mode-binary)
- (delete-char arg)))
- (while (> arg 0)
- (insert-and-inherit char)
- (setq arg (1- arg)))))
-
(defun delete-indentation (&optional arg)
"Join this line to previous and fix up whitespace at join.
If there is a fill prefix, delete it from the beginning of this line.
(defalias 'join-line #'delete-indentation) ; easier to find
-(defun fixup-whitespace ()
- "Fixup white space between objects around point.
-Leave one space or none, according to the context."
- (interactive "*")
- (save-excursion
- (delete-horizontal-space)
- (if (or (looking-at "^\\|\\s)")
- (save-excursion (forward-char -1)
- (looking-at "$\\|\\s(\\|\\s'")))
- nil
- (insert ?\ ))))
-
-(defun delete-horizontal-space ()
- "Delete all spaces and tabs around point."
- (interactive "*")
- (skip-chars-backward " \t")
- (delete-region (point) (progn (skip-chars-forward " \t") (point))))
-
-(defun just-one-space ()
- "Delete all spaces and tabs around point, leaving one space."
- (interactive "*")
- (skip-chars-backward " \t")
- (if (= (following-char) ? )
- (forward-char 1)
- (insert ? ))
- (delete-region (point) (progn (skip-chars-forward " \t") (point))))
-
(defun delete-blank-lines ()
"On blank line, delete all surrounding blank lines, leaving just one.
On isolated blank line, delete that one.
(if (looking-at "^[ \t]*\n\\'")
(delete-region (point) (point-max)))))
-(defun back-to-indentation ()
- "Move point to the first non-whitespace character on this line."
- (interactive)
- (beginning-of-line 1)
- (skip-chars-forward " \t"))
+(defun delete-trailing-whitespace ()
+ "Delete all the trailing whitespace across the current buffer.
+All whitespace after the last non-whitespace character in a line is deleted.
+This respects narrowing, created by \\[narrow-to-region] and friends.
+A formfeed is not considered whitespace by this function."
+ (interactive "*")
+ (save-match-data
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "\\s-$" nil t)
+ (skip-syntax-backward "-" (save-excursion (forward-line 0) (point)))
+ ;; Don't delete formfeeds, even if they are considered whitespace.
+ (save-match-data
+ (if (looking-at ".*\f")
+ (goto-char (match-end 0))))
+ (delete-region (point) (match-end 0))))))
(defun newline-and-indent ()
"Insert a newline, then indent according to major mode.
In some text modes, where TAB inserts a tab, this command indents to the
column specified by the function `current-left-margin'."
(interactive "*")
- (delete-region (point) (progn (skip-chars-backward " \t") (point)))
+ (delete-horizontal-space t)
(newline)
(indent-according-to-mode))
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-region (point) (progn (skip-chars-backward " \t") (point)))
- (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)))
-;; Internal subroutine of delete-char
-(defun kill-forward-chars (arg)
- (if (listp arg) (setq arg (car arg)))
- (if (eq arg '-) (setq arg -1))
- (kill-region (point) (forward-point arg)))
+(defun quoted-insert (arg)
+ "Read next input character and insert it.
+This is useful for inserting control characters.
-;; Internal subroutine of backward-delete-char
-(defun kill-backward-chars (arg)
- (if (listp arg) (setq arg (car arg)))
- (if (eq arg '-) (setq arg -1))
- (kill-region (point) (forward-point (- arg))))
+If the first character you type after this command is an octal digit,
+you should type a sequence of octal digits which specify a character code.
+Any nondigit terminates the sequence. If the terminator is a RET,
+it is discarded; any other terminator is used itself as input.
+The variable `read-quoted-char-radix' specifies the radix for this feature;
+set it to 10 or 16 to use decimal or hex instead of octal.
-(defcustom backward-delete-char-untabify-method 'untabify
- "*The method for untabifying when deleting backward.
-Can be `untabify' -- turn a tab to many spaces, then delete one space.
- `hungry' -- delete all whitespace, both tabs and spaces.
- nil -- just delete one character."
- :type '(choice (const untabify) (const hungry) (const nil))
- :group 'killing)
+In overwrite mode, this function inserts the character anyway, and
+does not handle octal digits specially. This means that if you use
+overwrite as your normal editing mode, you can use this function to
+insert characters when necessary.
-(defun backward-delete-char-untabify (arg &optional killp)
- "Delete characters backward, changing tabs into spaces.
-The exact behavior depends on `backward-delete-char-untabify-method'.
-Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
-Interactively, ARG is the prefix arg (default 1)
-and KILLP is t if a prefix arg was specified."
- (interactive "*p\nP")
- (when (eq backward-delete-char-untabify-method 'untabify)
- (let ((count arg))
- (save-excursion
- (while (and (> count 0) (not (bobp)))
- (if (= (preceding-char) ?\t)
- (let ((col (current-column)))
- (forward-char -1)
- (setq col (- col (current-column)))
- (insert-char ?\ col)
- (delete-char 1)))
- (forward-char -1)
- (setq count (1- count))))))
- (delete-backward-char
- (if (eq backward-delete-char-untabify-method 'hungry)
- (let ((wh (- (point) (save-excursion (skip-chars-backward " \t")
- (point)))))
- (+ arg (if (zerop wh) 0 (1- wh))))
- arg)
- killp))
+In binary overwrite mode, this function does overwrite, and octal
+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))))
+ ;; Assume character codes 0240 - 0377 stand for characters in some
+ ;; single-byte character set, and convert them to Emacs
+ ;; characters.
+ (if (and enable-multibyte-characters
+ (>= char ?\240)
+ (<= char ?\377))
+ (setq char (unibyte-char-to-multibyte char)))
+ (if (> arg 0)
+ (if (eq overwrite-mode 'overwrite-mode-binary)
+ (delete-char arg)))
+ (while (> arg 0)
+ (insert-and-inherit char)
+ (setq arg (1- arg)))))
-(defun zap-to-char (arg char)
- "Kill up to and including ARG'th occurrence of CHAR.
-Goes backward if ARG is negative; error if CHAR not found."
- (interactive "p\ncZap to char: ")
- (kill-region (point) (progn
- (search-forward (char-to-string char) nil nil arg)
-; (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
- (point))))
+(defun forward-to-indentation (arg)
+ "Move forward ARG lines and position at first nonblank character."
+ (interactive "p")
+ (forward-line arg)
+ (skip-chars-forward " \t"))
+
+(defun backward-to-indentation (arg)
+ "Move backward ARG lines and position at first nonblank character."
+ (interactive "p")
+ (forward-line (- arg))
+ (skip-chars-forward " \t"))
+
+(defun back-to-indentation ()
+ "Move point to the first non-whitespace character on this line."
+ (interactive)
+ (beginning-of-line 1)
+ (skip-chars-forward " \t"))
+
+(defun fixup-whitespace ()
+ "Fixup white space between objects around point.
+Leave one space or none, according to the context."
+ (interactive "*")
+ (save-excursion
+ (delete-horizontal-space)
+ (if (or (looking-at "^\\|\\s)")
+ (save-excursion (forward-char -1)
+ (looking-at "$\\|\\s(\\|\\s'")))
+ nil
+ (insert ?\ ))))
+
+(defun delete-horizontal-space (&optional backward-only)
+ "Delete all spaces and tabs around point.
+If BACKWARD-ONLY is non-nil, only delete spaces before point."
+ (interactive "*")
+ (let ((orig-pos (point)))
+ (delete-region
+ (if backward-only
+ orig-pos
+ (progn
+ (skip-chars-forward " \t")
+ (constrain-to-field nil orig-pos t)))
+ (progn
+ (skip-chars-backward " \t")
+ (constrain-to-field nil orig-pos)))))
+(defun just-one-space ()
+ "Delete all spaces and tabs around point, leaving one space."
+ (interactive "*")
+ (let ((orig-pos (point)))
+ (skip-chars-backward " \t")
+ (constrain-to-field nil orig-pos)
+ (if (= (following-char) ? )
+ (forward-char 1)
+ (insert ? ))
+ (delete-region
+ (point)
+ (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.
(point-max))))
;; If we went to a place in the middle of the buffer,
;; adjust it to the beginning of a line.
- (if arg (forward-line 1)
- ;; If the end of the buffer is not already on the screen,
- ;; then scroll specially to put it near, but not at, the bottom.
- (if (let ((old-point (point)))
- (save-excursion
- (goto-char (window-start))
- (vertical-motion (window-height))
- (< (point) old-point)))
- (progn
- (overlay-recenter (point))
- (recenter -3)))))
+ (cond (arg (forward-line 1))
+ ((> (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))
+ (recenter -3))))
(defun mark-whole-buffer ()
"Put point at beginning and mark at end of buffer.
(push-mark (point))
(push-mark (point-max) nil t)
(goto-char (point-min)))
+\f
+
+;; Counting lines, one way or another.
+
+(defun goto-line (arg)
+ "Goto line ARG, counting from line 1 at beginning of buffer."
+ (interactive "NGoto line: ")
+ (setq arg (prefix-numeric-value arg))
+ (save-restriction
+ (widen)
+ (goto-char 1)
+ (if (eq selective-display t)
+ (re-search-forward "[\n\C-m]" nil 'end (1- arg))
+ (forward-line (1- arg)))))
(defun count-lines-region (start end)
"Print number of lines and characters in the region."
(save-restriction
(goto-char (point-min))
(widen)
- (beginning-of-line)
+ (forward-line 0)
(setq start (point))
(goto-char opoint)
- (beginning-of-line)
+ (forward-line 0)
(if (/= start 1)
(message "line %d (narrowed line %d)"
(1+ (count-lines 1 (point)))
(1+ (count-lines start (point))))
(message "Line %d" (1+ (count-lines 1 (point)))))))))
-
(defun count-lines (start end)
"Return number of lines between START and END.
This is usually the number of newlines between them,
(defun what-cursor-position (&optional detail)
"Print info on cursor position (on screen and within buffer).
Also describe the character after point, and give its character code
-in octal, decimal and hex. For a non-ASCII multibyte character,
-also give its encoding in the buffer's selected coding system,
-if any.
+in octal, decimal and hex.
-With prefix argument, print additional details about that character,
-instead of the cursor position. This includes the character set name,
-the codes that identify the character within that character set,
-and the corresponding external character components.
+For a non-ASCII multibyte character, also give its encoding in the
+buffer's selected coding system if the coding system encodes the
+character safely. If the character is encoded into one byte, that
+code is shown in hex. If the character is encoded into more than one
+byte, just \"...\" is shown.
-Each language environment may show different external character components."
+In addition, with prefix argument, show details about that character
+in *Help* buffer. See also the command `describe-char-after'."
(interactive "P")
(let* ((char (following-char))
(beg (point-min))
(col (current-column)))
(if (= pos end)
(if (or (/= beg 1) (/= end (1+ total)))
- (message "point=%d of %d(%d%%) <%d - %d> column %d %s"
+ (message "point=%d of %d (%d%%) <%d - %d> column %d %s"
pos total percent beg end col hscroll)
- (message "point=%d of %d(%d%%) column %d %s"
+ (message "point=%d of %d (%d%%) column %d %s"
pos total percent col hscroll))
- (let ((charset (char-charset char))
- (coding-system buffer-file-coding-system)
- slot external encoding-msg)
- ;; To decided an external character code, we use
- ;; charset-origin-alist property of buffer-file-coding-system.
- ;; But, if buffer-file-coding-system is nil of undecided, use
- ;; that property of default-buffer-file-coding-system. If
- ;; that property value is nil, we don't show external
- ;; character code.
- (if (or (not coding-system)
- (eq (coding-system-type coding-system) t))
- (setq coding-system default-buffer-file-coding-system))
- (if (and coding-system
- (setq slot
- (coding-system-get coding-system 'charset-origin-alist))
- (setq slot (assq charset slot)))
- (setq external (list (nth 1 slot) (funcall (nth 2 slot) char))))
- (setq encoding-msg
- (if external
- (format "(0%o, %d, 0x%x, ext 0x%x)"
- char char char (nth 1 external))
- (format "(0%o, %d, 0x%x)" char char char)))
+ (let ((coding buffer-file-coding-system)
+ encoded encoding-msg)
+ (if (or (not coding)
+ (eq (coding-system-type coding) t))
+ (setq coding default-buffer-file-coding-system))
+ (if (not (char-valid-p char))
+ (setq encoding-msg
+ (format "(0%o, %d, 0x%x, invalid)" char char char))
+ (setq encoded (and (>= char 128) (encode-coding-char char coding)))
+ (setq encoding-msg
+ (if encoded
+ (format "(0%o, %d, 0x%x, file %s)"
+ char char char
+ (if (> (length encoded) 1)
+ "..."
+ (encoded-string-description encoded coding)))
+ (format "(0%o, %d, 0x%x)" char char char))))
(if detail
- ;; We show the detailed information of CHAR.
- (let (internal)
- (if (eq charset 'composition)
- ;; For a composite character, we show the components
- ;; only.
- (setq internal (concat "(composition of \""
- (decompose-composite-char char)
- "\")")
- external nil)
- (setq internal (split-char char))
- (unless external
- (setq external (cons (charset-short-name charset)
- (copy-sequence (cdr internal))))
- (if (= (charset-iso-graphic-plane charset) 1)
- (progn
- (setcar (cdr external) (+ (nth 1 external) 128))
- (if (nth 2 external)
- (setcar (nthcdr 2 external)
- (+ (nth 2 external) 128)))))))
- (message "Char: %s %s %s %s"
- (if (< char 256)
- (single-key-description char)
- (char-to-string char))
- encoding-msg internal (or external "")))
- (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)
- (char-to-string char))
- encoding-msg pos total percent beg end col hscroll)
- (message "Char: %s %s point=%d of %d(%d%%) column %d %s"
+ ;; We show the detailed information about CHAR.
+ (describe-char-after (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)
- (char-to-string char))
- encoding-msg pos total percent col hscroll)))))))
-
-(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))
-
-(defvar read-expression-map (cons 'keymap minibuffer-local-map)
+ (buffer-substring-no-properties (point) (1+ (point))))
+ encoding-msg pos total percent beg end col hscroll)
+ (message "Char: %s %s point=%d of %d (%d%%) column %d %s"
+ (if (< char 256)
+ (single-key-description char)
+ (buffer-substring-no-properties (point) (1+ (point))))
+ 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)
+ (set-keymap-parent m minibuffer-local-map)
+ m)
"Minibuffer keymap used for reading Lisp expressions.")
-(define-key read-expression-map "\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'.
+A value of nil means no limit."
+ :group 'lisp
+ :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'.
+A value of nil means no limit."
+ :group 'lisp
+ :type '(choice (const :tag "No Limit" nil) integer)
+ :version "21.1")
+
+(defcustom eval-expression-debug-on-error t
+ "*Non-nil means set `debug-on-error' when evaluating in `eval-expression'.
+If nil, don't change the value of `debug-on-error'."
+ :group 'lisp
+ :type 'boolean
+ :version "21.1")
+
;; 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
&optional eval-expression-insert-value)
- "Evaluate EXPRESSION and print value in minibuffer.
-Value is also consed on to front of the variable `values'."
+ "Evaluate EVAL-EXPRESSION-ARG and print value in the echo area.
+Value is also consed on to front of the variable `values'.
+Optional argument EVAL-EXPRESSION-INSERT-VALUE, if non-nil, means
+insert the result into the current buffer instead of printing it in
+the echo area."
(interactive
(list (read-from-minibuffer "Eval: "
nil read-expression-map t
'read-expression-history)
current-prefix-arg))
- (setq values (cons (eval eval-expression-arg) values))
- (prin1 (car values)
- (if eval-expression-insert-value (current-buffer) t)))
+
+ (if (null eval-expression-debug-on-error)
+ (setq values (cons (eval eval-expression-arg) values))
+ (let ((old-value (make-symbol "t")) new-value)
+ ;; Bind debug-on-error to something unique so that we can
+ ;; detect when evaled code changes it.
+ (let ((debug-on-error old-value))
+ (setq values (cons (eval eval-expression-arg) values))
+ (setq new-value debug-on-error))
+ ;; If evaled code has changed the value of debug-on-error,
+ ;; propagate that change to the global binding.
+ (unless (eq old-value new-value)
+ (setq debug-on-error new-value))))
+
+ (let ((print-length eval-expression-print-length)
+ (print-level eval-expression-print-level))
+ (prin1 (car values)
+ (if eval-expression-insert-value (current-buffer) t))))
(defun edit-and-eval-command (prompt command)
"Prompting with PROMPT, let user edit COMMAND and eval result.
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
(defun minibuffer-history-initialize ()
(setq minibuffer-text-before-history nil))
+(defun minibuffer-avoid-prompt (new old)
+ "A point-motion hook for the minibuffer, that moves point out of the prompt."
+ (constrain-to-field nil (point-max)))
+
(defcustom minibuffer-history-case-insensitive-variables nil
"*Minibuffer history variables for which matching should ignore case.
If a history variable is a member of this list, then the
\(Previous history elements refer to earlier actions.)
With prefix argument N, search for Nth previous match.
If N is negative, find the next or Nth next match.
-An uppercase letter in REGEXP makes the search case-sensitive.
+Normally, history elements are matched case-insensitively if
+`case-fold-search' is non-nil, but an uppercase letter in REGEXP
+makes the search case-sensitive.
See also `minibuffer-history-case-insensitive-variables'."
(interactive
(let* ((enable-recursive-minibuffers t)
(error "No previous history search regexp"))
regexp)
(prefix-numeric-value current-prefix-arg))))
- (if (and (zerop minibuffer-history-position)
- (null minibuffer-text-before-history))
- (setq minibuffer-text-before-history (buffer-string)))
- (let ((history (symbol-value minibuffer-history-variable))
- (case-fold-search
- (if (isearch-no-upper-case-p regexp t) ; assume isearch.el is dumped
- ;; On some systems, ignore case for file names.
- (if (memq minibuffer-history-variable
- minibuffer-history-case-insensitive-variables)
- t
- ;; Respect the user's setting for case-fold-search:
- case-fold-search)
- nil))
- prevpos
- (pos minibuffer-history-position))
- (while (/= n 0)
- (setq prevpos pos)
- (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
- (if (= pos prevpos)
+ (unless (zerop n)
+ (if (and (zerop minibuffer-history-position)
+ (null minibuffer-text-before-history))
+ (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
+ ;; On some systems, ignore case for file names.
+ (if (memq minibuffer-history-variable
+ minibuffer-history-case-insensitive-variables)
+ t
+ ;; Respect the user's setting for case-fold-search:
+ case-fold-search)
+ nil))
+ prevpos
+ match-string
+ match-offset
+ (pos minibuffer-history-position))
+ (while (/= n 0)
+ (setq prevpos pos)
+ (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
+ (when (= pos prevpos)
(error (if (= pos 1)
"No later matching history item"
"No earlier matching history item")))
- (if (string-match regexp
- (if (eq minibuffer-history-sexp-flag
- (minibuffer-depth))
- (let ((print-level nil))
- (prin1-to-string (nth (1- pos) history)))
- (nth (1- pos) history)))
- (setq n (+ n (if (< n 0) 1 -1)))))
- (setq minibuffer-history-position pos)
- (erase-buffer)
- (let ((elt (nth (1- pos) history)))
- (insert (if (eq minibuffer-history-sexp-flag (minibuffer-depth))
+ (setq match-string
+ (if (eq minibuffer-history-sexp-flag (minibuffer-depth))
(let ((print-level nil))
- (prin1-to-string elt))
- elt)))
- (goto-char (point-min)))
- (if (or (eq (car (car command-history)) 'previous-matching-history-element)
- (eq (car (car command-history)) 'next-matching-history-element))
+ (prin1-to-string (nth (1- pos) history)))
+ (nth (1- pos) history)))
+ (setq match-offset
+ (if (< n 0)
+ (and (string-match regexp match-string)
+ (match-end 0))
+ (and (string-match (concat ".*\\(" regexp "\\)") match-string)
+ (match-beginning 1))))
+ (when match-offset
+ (setq n (+ n (if (< n 0) 1 -1)))))
+ (setq minibuffer-history-position pos)
+ (goto-char (point-max))
+ (delete-minibuffer-contents)
+ (insert match-string)
+ (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)
\(The next history element refers to a more recent action.)
With prefix argument N, search for Nth next match.
If N is negative, find the previous or Nth previous match.
-An uppercase letter in REGEXP makes the search case-sensitive."
+Normally, history elements are matched case-insensitively if
+`case-fold-search' is non-nil, but an uppercase letter in REGEXP
+makes the search case-sensitive."
(interactive
(let* ((enable-recursive-minibuffers t)
(regexp (read-from-minibuffer "Next element matching (regexp): "
(prefix-numeric-value current-prefix-arg))))
(previous-matching-history-element regexp (- n)))
+(defvar minibuffer-temporary-goal-position nil)
+
(defun next-history-element (n)
"Insert the next element of the minibuffer history into the minibuffer."
(interactive "p")
(or (zerop n)
(let ((narg (- minibuffer-history-position n))
(minimum (if minibuffer-default -1 0))
- elt)
+ elt minibuffer-returned-to-present)
(if (and (zerop minibuffer-history-position)
(null minibuffer-text-before-history))
- (setq minibuffer-text-before-history (buffer-string)))
+ (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"))
- (erase-buffer)
+ (unless (memq last-command '(next-history-element
+ previous-history-element))
+ (let ((prompt-end (minibuffer-prompt-end)))
+ (set (make-local-variable 'minibuffer-temporary-goal-position)
+ (cond ((<= (point) prompt-end) prompt-end)
+ ((eobp) nil)
+ (t (point))))))
+ (goto-char (point-max))
+ (delete-minibuffer-contents)
(setq minibuffer-history-position narg)
(cond ((= narg -1)
(setq elt minibuffer-default))
((= narg 0)
(setq elt (or minibuffer-text-before-history ""))
+ (setq minibuffer-returned-to-present t)
(setq minibuffer-text-before-history nil))
(t (setq elt (nth (1- minibuffer-history-position)
(symbol-value minibuffer-history-variable)))))
(insert
- (if (eq minibuffer-history-sexp-flag (minibuffer-depth))
+ (if (and (eq minibuffer-history-sexp-flag (minibuffer-depth))
+ (not minibuffer-returned-to-present))
(let ((print-level nil))
(prin1-to-string elt))
elt))
- (goto-char (point-min)))))
+ (goto-char (or minibuffer-temporary-goal-position (point-max))))))
(defun previous-history-element (n)
"Inserts the previous element of the minibuffer history into the minibuffer."
(next-history-element (- n)))
(defun next-complete-history-element (n)
- "Get next element of history which is a completion of minibuffer contents."
+ "Get next history element which completes the minibuffer before the point.
+The contents of the minibuffer after the point are deleted, and replaced
+by the new completion."
(interactive "p")
(let ((point-at-start (point)))
(next-matching-history-element
- (concat "^" (regexp-quote (buffer-substring (point-min) (point)))) n)
+ (concat
+ "^" (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.
;; This is still sensical, because the text before point has not changed.
(defun previous-complete-history-element (n)
"\
-Get previous element of history which is a completion of minibuffer contents."
+Get previous history element which completes the minibuffer before the point.
+The contents of the minibuffer after the point are deleted, and replaced
+by the new completion."
(interactive "p")
(next-complete-history-element (- n)))
-\f
-(defun goto-line (arg)
- "Goto line ARG, counting from line 1 at beginning of buffer."
- (interactive "NGoto line: ")
- (setq arg (prefix-numeric-value arg))
- (save-restriction
- (widen)
- (goto-char 1)
- (if (eq selective-display t)
- (re-search-forward "[\n\C-m]" nil 'end (1- arg))
- (forward-line (1- arg)))))
+;; 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- (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)
Repeat this command to undo more changes.
A numeric argument serves as a repeat count.
-Just C-u as argument requests selective undo,
-limited to changes within the current region.
-Likewise in Transient Mark mode when the mark is active."
+In Transient Mark mode when the mark is active, only undo changes within
+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!"))
- (or (eq last-command 'undo)
- (progn (if (or arg (and transient-mark-mode mark-active))
- (undo-start (region-beginning) (region-end))
- (undo-start))
- (undo-more 1)))
- (undo-more (if arg (prefix-numeric-value arg) 1))
+ (unless (eq last-command 'undo)
+ (if (if transient-mark-mode mark-active (and arg (not (numberp arg))))
+ (undo-start (region-beginning) (region-end))
+ (undo-start))
+ ;; get rid of initial undo boundary
+ (undo-more 1))
+ (undo-more
+ (if (or transient-mark-mode (numberp arg))
+ (prefix-numeric-value arg)
+ 1))
;; Don't specify a position in the undo record for the undo command.
;; Instead, undoing this should move point to where the change is.
(let ((tail buffer-undo-list)
- done)
- (while (and tail (not done) (not (null (car tail))))
- (if (integerp (car tail))
- (progn
- (setq done t)
- (setq buffer-undo-list (delq (car tail) buffer-undo-list))))
- (setq tail (cdr tail))))
+ (prev nil))
+ (while (car tail)
+ (when (integerp (car tail))
+ (let ((pos (car tail)))
+ (if (null prev)
+ (setq buffer-undo-list (cdr tail))
+ (setcdr prev (cdr tail)))
+ (setq tail (cdr tail))
+ (while (car tail)
+ (if (eq pos (car tail))
+ (if prev
+ (setcdr prev (cdr tail))
+ (setq buffer-undo-list (cdr tail)))
+ (setq prev tail))
+ (setq tail (cdr tail)))
+ (setq tail nil)))
+ (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.")
are ignored. If BEG and END are nil, all undo elements are used."
(if (eq buffer-undo-list t)
(error "No undo information in this buffer"))
- (setq pending-undo-list
+ (setq pending-undo-list
(if (and beg end (not (= beg end)))
(undo-make-selective-list (min beg end) (max beg end))
buffer-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))
(let ((text-pos (abs (cdr undo-elt)))
(point-at-end (< (cdr undo-elt) 0 )))
(if (>= text-pos position)
- (setcdr undo-elt (* (if point-at-end -1 1)
+ (setcdr undo-elt (* (if point-at-end -1 1)
(- text-pos offset))))))
((integerp (car undo-elt))
;; (BEGIN . END)
(defvar shell-command-switch "-c"
"Switch used to have the shell execute its command line argument.")
-(defun shell-command (command &optional output-buffer)
+(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'
+is run interactively. A value of nil means that output to stderr and
+stdout will be intermixed in the output stream.")
+
+(defun shell-command (command &optional output-buffer error-buffer)
"Execute string COMMAND in inferior shell; display output, if any.
+With prefix argument, insert the COMMAND's output at point.
If COMMAND ends in ampersand, execute it asynchronously.
The output appears in the buffer `*Async Shell Command*'.
That buffer is in shell mode.
-Otherwise, COMMAND is executed synchronously. The output appears in the
-buffer `*Shell Command Output*'.
-If the output is one line, it is displayed in the echo area *as well*,
-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.
+Otherwise, COMMAND is executed synchronously. The output appears in
+the buffer `*Shell Command Output*'. If the output is short enough to
+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.
To specify a coding system for converting non-ASCII characters
in the shell command output, use \\[universal-coding-system-argument]
If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
If OUTPUT-BUFFER is not a buffer and not nil,
insert output in current buffer. (This cannot be done asynchronously.)
-In either case, the output is inserted after point (leaving mark after it)."
+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.
+In an interactive call, the variable `shell-command-default-error-buffer'
+specifies the value of ERROR-BUFFER."
+
(interactive (list (read-from-minibuffer "Shell command: "
nil nil nil 'shell-command-history)
- current-prefix-arg))
+ current-prefix-arg
+ shell-command-default-error-buffer))
;; Look for a handler in case default-directory is a remote file name.
(let ((handler
(find-file-name-handler (directory-file-name default-directory)
'shell-command)))
(if handler
- (funcall handler 'shell-command command output-buffer)
+ (funcall handler 'shell-command command output-buffer error-buffer)
(if (and output-buffer
(not (or (bufferp output-buffer) (stringp output-buffer))))
- (progn (barf-if-buffer-read-only)
- (push-mark)
- ;; We do not use -f for csh; we will not support broken use of
- ;; .cshrcs. Even the BSD csh manual says to use
- ;; "if ($?prompt) exit" before things which are not useful
- ;; non-interactively. Besides, if someone wants their other
- ;; aliases for shell commands then they can still have them.
- (call-process shell-file-name nil t nil
- shell-command-switch command)
- ;; This is like exchange-point-and-mark, but doesn't
- ;; activate the mark. It is cleaner to avoid activation,
- ;; even though the command loop would deactivate the mark
- ;; because we inserted text.
- (goto-char (prog1 (mark t)
- (set-marker (mark-marker) (point)
- (current-buffer)))))
+ ;; Output goes in current buffer.
+ (let ((error-file
+ (if error-buffer
+ (make-temp-file
+ (expand-file-name "scor"
+ (or small-temporary-file-directory
+ temporary-file-directory)))
+ nil)))
+ (barf-if-buffer-read-only)
+ (push-mark nil t)
+ ;; We do not use -f for csh; we will not support broken use of
+ ;; .cshrcs. Even the BSD csh manual says to use
+ ;; "if ($?prompt) exit" before things which are not useful
+ ;; non-interactively. Besides, if someone wants their other
+ ;; aliases for shell commands then they can still have them.
+ (call-process shell-file-name nil
+ (if error-file
+ (list t error-file)
+ t)
+ nil shell-command-switch command)
+ (when (and error-file (file-exists-p error-file))
+ (if (< 0 (nth 7 (file-attributes error-file)))
+ (with-current-buffer (get-buffer-create error-buffer)
+ (let ((pos-from-end (- (point-max) (point))))
+ (or (bobp)
+ (insert "\f\n"))
+ ;; Do no formatting while reading error file,
+ ;; because that can run a shell command, and we
+ ;; don't want that to cause an infinite recursion.
+ (format-insert-file error-file nil)
+ ;; Put point after the inserted errors.
+ (goto-char (- (point-max) pos-from-end)))
+ (display-buffer (current-buffer))))
+ (delete-file error-file))
+ ;; This is like exchange-point-and-mark, but doesn't
+ ;; activate the mark. It is cleaner to avoid activation,
+ ;; even though the command loop would deactivate the mark
+ ;; because we inserted text.
+ (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)
(erase-buffer)
(display-buffer buffer)
(setq default-directory directory)
- (setq proc (start-process "Shell" buffer shell-file-name
+ (setq proc (start-process "Shell" buffer shell-file-name
shell-command-switch command))
(setq mode-line-process '(":%s"))
(require 'shell) (shell-mode)
(set-process-sentinel proc 'shell-command-sentinel)
))
- (shell-command-on-region (point) (point) command output-buffer)
- ))))))
-\f
+ (shell-command-on-region (point) (point) command
+ output-buffer nil error-buffer)))))))
+
+(defun display-message-or-buffer (message
+ &optional buffer-name not-this-window frame)
+ "Display MESSAGE in the echo area if possible, otherwise in a pop-up buffer.
+MESSAGE may be either a string or a buffer.
+
+A buffer is displayed using `display-buffer' if MESSAGE is too long for
+the maximum height of the echo area, as defined by `max-mini-window-height'
+if `resize-mini-windows' is non-nil.
+
+Returns either the string shown in the echo area, or when a pop-up
+buffer is used, the window used to display it.
+
+If MESSAGE is a string, then the optional argument BUFFER-NAME is the
+name of the buffer used to display it in the case where a pop-up buffer
+is used, defaulting to `*Message*'. In the case where MESSAGE is a
+string and it is displayed in the echo area, it is not specified whether
+the contents are inserted into the buffer anyway.
+
+Optional arguments NOT-THIS-WINDOW and FRAME are as for `display-buffer',
+and only used if a buffer is displayed."
+ (cond ((and (stringp message) (not (string-match "\n" message)))
+ ;; Trivial case where we can use the echo area
+ (message "%s" message))
+ ((and (stringp message)
+ (= (string-match "\n" message) (1- (length message))))
+ ;; Trivial case where we can just remove single trailing newline
+ (message "%s" (substring message 0 (1- (length message)))))
+ (t
+ ;; General case
+ (with-current-buffer
+ (if (bufferp message)
+ message
+ (get-buffer-create (or buffer-name "*Message*")))
+
+ (unless (bufferp message)
+ (erase-buffer)
+ (insert message))
+
+ (let ((lines
+ (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)))
+ ;; Echo area
+ (goto-char (point-max))
+ (when (bolp)
+ (backward-char 1))
+ (message "%s" (buffer-substring (point-min) (point))))
+ (t
+ ;; Buffer
+ (goto-char (point-min))
+ (display-buffer (current-buffer)
+ not-this-window frame))))))))
+
+
;; We have a sentinel to prevent insertion of a termination message
;; in the buffer itself.
(defun shell-command-sentinel (process signal)
(if (memq (process-status process) '(exit signal))
- (message "%s: %s."
+ (message "%s: %s."
(car (cdr (cdr (process-command process))))
(substring signal 0 -1))))
-(defvar shell-command-on-region-default-error-buffer nil
- "*Name of buffer that `shell-command-on-region' uses for stderr.
-This buffer is used when `shell-command-on-region' is run interactively.
-A nil value for this variable means that output to stderr and stdout
-will be intermixed in the output stream.")
-
(defun shell-command-on-region (start end command
&optional output-buffer replace
error-buffer)
systems by binding `coding-system-for-read' and
`coding-system-for-write'.
-If the output is one line, it is displayed in the echo area,
-but it is nonetheless available in buffer `*Shell Command Output*'
-even though that buffer is not automatically displayed.
+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 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.
-In an interactive call, the variable
-`shell-command-on-region-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)))
+In an interactive call, the variable `shell-command-default-error-buffer'
+specifies the value of ERROR-BUFFER."
+ (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)
string
current-prefix-arg
current-prefix-arg
- shell-command-on-region-default-error-buffer)))
+ shell-command-default-error-buffer)))
(let ((error-file
- (if error-buffer
- (concat (file-name-directory temp-file-name-pattern)
- (make-temp-name "scor"))
+ (if error-buffer
+ (make-temp-file
+ (expand-file-name "scor"
+ (or small-temporary-file-directory
+ temporary-file-directory)))
nil))
exit-status)
(if (or replace
(and output-buffer
- (not (or (bufferp output-buffer) (stringp output-buffer))))
- (equal (buffer-name (current-buffer)) "*Shell Command Output*"))
+ (not (or (bufferp output-buffer) (stringp output-buffer)))))
;; Replace specified region with output from command.
(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))
- (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,
(delete-region (point-min) (min start end))
(setq exit-status
(call-process-region (point-min) (point-max)
- shell-file-name t
+ shell-file-name t
(if error-file
(list t error-file)
t)
command)))
;; Clear the output buffer, then run the command with
;; output there.
- (save-excursion
- (set-buffer buffer)
- (setq buffer-read-only nil)
- (erase-buffer))
+ (let ((directory default-directory))
+ (save-excursion
+ (set-buffer buffer)
+ (setq buffer-read-only nil)
+ (if (not output-buffer)
+ (setq default-directory directory))
+ (erase-buffer)))
(setq exit-status
(call-process-region start end shell-file-name nil
(if error-file
(list buffer error-file)
buffer)
nil shell-command-switch command)))
- (setq success (zerop exit-status))
- ;; Report the amount of output.
- (let ((lines (save-excursion
- (set-buffer buffer)
- (if (= (buffer-size) 0)
- 0
- (count-lines (point-min) (point-max))))))
- (cond ((= lines 0)
- (if success
- (message "(Shell command %sed with no output)"
- (if (equal 0 exit-status)
- "succeed"
- "fail")))
- (kill-buffer buffer))
- ((and success (= lines 1))
- (message "%s"
- (save-excursion
- (set-buffer buffer)
- (goto-char (point-min))
- (buffer-substring (point)
- (progn (end-of-line) (point))))))
- (t
- (save-excursion
- (set-buffer buffer)
- (goto-char (point-min)))
- (display-buffer buffer)))))))
- (if (and error-file (file-exists-p error-file))
- (save-excursion
- (set-buffer (get-buffer-create error-buffer))
- ;; Do no formatting while reading error file, for fear of looping.
- (format-insert-file error-file nil)
- (delete-file error-file)))
+ (setq success (and exit-status (equal 0 exit-status)))
+ ;; Report the output.
+ (with-current-buffer buffer
+ (setq mode-line-process
+ (if (not success)
+ (concat (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?
+ (let ((output
+ (if (and error-file
+ (< 0 (nth 7 (file-attributes error-file))))
+ "some error output"
+ "no output")))
+ (if (equal 0 exit-status)
+ (message "(Shell command succeeded with %s)"
+ output)
+ (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 (get-buffer-create error-buffer)
+ (let ((pos-from-end (- (point-max) (point))))
+ (or (bobp)
+ (insert "\f\n"))
+ ;; Do no formatting while reading error file,
+ ;; because that can run a shell command, and we
+ ;; don't want that to cause an infinite recursion.
+ (format-insert-file error-file nil)
+ ;; Put point after the inserted errors.
+ (goto-char (- (point-max) pos-from-end)))
+ (display-buffer (current-buffer))))
+ (delete-file error-file))
exit-status))
-
+
(defun shell-command-to-string (command)
"Execute shell command COMMAND and return its output as a string."
(with-output-to-string
(define-key map [?7] 'digit-argument)
(define-key map [?8] 'digit-argument)
(define-key map [?9] 'digit-argument)
+ (define-key map [kp-0] 'digit-argument)
+ (define-key map [kp-1] 'digit-argument)
+ (define-key map [kp-2] 'digit-argument)
+ (define-key map [kp-3] 'digit-argument)
+ (define-key map [kp-4] 'digit-argument)
+ (define-key map [kp-5] 'digit-argument)
+ (define-key map [kp-6] 'digit-argument)
+ (define-key map [kp-7] 'digit-argument)
+ (define-key map [kp-8] 'digit-argument)
+ (define-key map [kp-9] 'digit-argument)
+ (define-key map [kp-subtract] 'universal-argument-minus)
map)
"Keymap used while processing \\[universal-argument].")
"Part of the numeric argument for the next command.
\\[universal-argument] following digits or minus sign ends the argument."
(interactive "P")
- (let ((digit (- (logand last-command-char ?\177) ?0)))
+ (let* ((char (if (integerp last-command-char)
+ last-command-char
+ (get last-command-char 'ascii-character)))
+ (digit (- (logand char ?\177) ?0)))
(cond ((integerp arg)
(setq prefix-arg (+ (* arg 10)
(if (< arg 0) (- digit) digit))))
(reset-this-command-lengths)
(setq overriding-terminal-local-map nil))
\f
-(defun forward-to-indentation (arg)
- "Move forward ARG lines and position at first nonblank character."
- (interactive "p")
- (forward-line arg)
- (skip-chars-forward " \t"))
-
-(defun backward-to-indentation (arg)
- "Move backward ARG lines and position at first nonblank character."
- (interactive "p")
- (forward-line (- arg))
- (skip-chars-forward " \t"))
-
-(defcustom kill-whole-line nil
- "*If non-nil, `kill-line' with no arg at beg of line kills the whole line."
- :type 'boolean
- :group 'killing)
-
-(defun kill-line (&optional arg)
- "Kill the rest of the current line; if no nonblanks there, kill thru newline.
-With prefix argument, kill that many lines from point.
-Negative arguments kill lines backward.
-
-When calling from a program, nil means \"no arg\",
-a number counts as a prefix arg.
-
-To kill a whole line, when point is not at the beginning, type \
-\\[beginning-of-line] \\[kill-line] \\[kill-line].
-
-If `kill-whole-line' is non-nil, then this command kills the whole line
-including its terminating newline, when used at the beginning of a line
-with no argument. As a consequence, you can always kill a whole line
-by typing \\[beginning-of-line] \\[kill-line]."
- (interactive "P")
- (kill-region (point)
- ;; It is better to move point to the other end of the kill
- ;; before killing. That way, in a read-only buffer, point
- ;; moves across the text that is copied to the kill ring.
- ;; The choice has no effect on undo now that undo records
- ;; the value of point from before the command was run.
- (progn
- (if arg
- (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)))
- (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))))
- (or (zerop (forward-line 1))
- (signal 'end-of-buffer nil)))
- (setq arg (1- arg)))
- (let ((first t))
- (while (or first (< arg 0))
- (if (zerop arg)
- (beginning-of-line)
- (or (zerop (forward-line -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)))))
- (goto-char
- (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)))))
- ((beginning-of-buffer end-of-buffer)
- nil)))
-
-(defun end-of-visible-line ()
- "Move to end of current visible line."
- (end-of-line)
- ;; 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)))))
- (if (get-text-property (point) 'invisible)
- (goto-char (next-single-property-change (point) 'invisible))
- (goto-char (next-overlay-change (point))))
- (end-of-line)))
-\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
-\f
;;;; The kill ring data structure.
(defvar kill-ring nil
(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."
(and (fboundp 'menu-bar-update-yank-menu)
(menu-bar-update-yank-menu string (and replace (car kill-ring))))
- (if replace
+ (if (and replace kill-ring)
(setcar kill-ring string)
(setq kill-ring (cons string kill-ring))
(if (> (length kill-ring) kill-ring-max)
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.
If N is zero, `interprogram-paste-function' is set, and calling it
returns a string, then that string is added to the front of the
kill ring and returned as the latest kill.
-If optional arg DO-NOT-MOVE is non-nil, then don't actually move the
+If optional arg DO-NOT-MOVE is non-nil, then don't actually move the
yanking point; just return the Nth kill forward."
(let ((interprogram-paste (and (= n 0)
interprogram-paste-function
(car ARGth-kill-element)))))
-\f
+
;;;; Commands for manipulating the kill ring.
(defcustom kill-read-only-ok nil
"Kill between point and mark.
The text is deleted but saved in the kill ring.
The command \\[yank] can retrieve it from there.
-\(If you want to kill and then yank immediately, use \\[copy-region-as-kill].)
+\(If you want to kill and then yank immediately, use \\[kill-ring-save].)
+
+If you want to append the killed region to the last killed text,
+use \\[append-next-kill] before \\[kill-region].
+
If the buffer is read-only, Emacs will beep and refrain from deleting
the text, but put the text in the kill ring anyway. This means that
you can use the killing commands to copy text from a read-only buffer.
to make one entry in the kill ring."
(interactive "r")
(condition-case nil
- ;; Don't let the undo list be truncated before we can even access it.
- (let ((undo-strong-limit (+ (- (max beg end) (min beg end)) 100))
- (old-list buffer-undo-list)
- tail
- ;; If we can't rely on finding the killed text
- ;; in the undo list, save it now as a string.
- (string (if (or (eq buffer-undo-list t)
- (= beg end))
- (buffer-substring beg end))))
- (delete-region beg end)
- ;; Search back in buffer-undo-list for this string,
- ;; in case a change hook made property changes.
- (setq tail buffer-undo-list)
- (unless string
- (while (not (stringp (car (car tail))))
- (setq tail (cdr tail)))
- ;; If we did not already make the string to use,
- ;; use the same one that undo made for us.
- (setq string (car (car tail))))
- ;; Add that string to the kill ring, one way or another.
- (if (eq last-command 'kill-region)
- (kill-append string (< end beg))
- (kill-new string))
+ (let ((string (delete-and-extract-region beg end)))
+ (when string ;STRING is nil if BEG = END
+ ;; Add that string to the kill ring, one way or another.
+ (if (eq last-command 'kill-region)
+ (kill-append string (< end beg))
+ (kill-new string)))
(setq this-command 'kill-region))
((buffer-read-only text-read-only)
;; The code above failed because the buffer, or some of the characters
(if (eq last-command 'kill-region)
(kill-append (buffer-substring beg end) (< end beg))
(kill-new (buffer-substring beg end)))
- (if transient-mark-mode
+ (if transient-mark-mode
(setq deactivate-mark t))
nil)
If `interprogram-cut-function' is non-nil, also save the text for a window
system cut and paste.
+If you want to append the killed line to the last killed text,
+use \\[append-next-kill] before \\[kill-ring-save].
+
This command is similar to `copy-region-as-kill', except that it gives
visual feedback indicating the extent of the region being copied."
(interactive "r")
;; 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)
(message "Saved text from \"%s\""
(substring killed-text 0 message-len))))))))
-(defun append-next-kill ()
- "Cause following command, if it kills, to append to previous kill."
- (interactive)
- (if (interactive-p)
+(defun append-next-kill (&optional interactive)
+ "Cause following command, if it kills, to append to previous kill.
+The argument is used for internal purposes; do not supply one."
+ (interactive "p")
+ ;; We don't use (interactive-p), since that breaks kbd macros.
+ (if interactive
(progn
(setq this-command 'kill-region)
(message "If the next command is a kill, it will append"))
(setq last-command 'kill-region)))
+;; Yanking.
+
(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'.
(set-marker (mark-marker) (point) (current-buffer))))))
nil)
-(defun yank (&optional arg)
- "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 argument N, reinsert the Nth most recently killed stretch of killed
-text.
-See also the command \\[yank-pop]."
- (interactive "*P")
- ;; 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))))
- (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
- ;; loop would deactivate the mark because we inserted text.
- (goto-char (prog1 (mark t)
- (set-marker (mark-marker) (point) (current-buffer)))))
- ;; If we do get all the way thru, make this-command indicate that.
- (setq this-command 'yank)
- nil)
+(defun yank (&optional arg)
+ "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 argument N, reinsert the Nth most recently killed stretch of killed
+text.
+See also the command \\[yank-pop]."
+ (interactive "*P")
+ ;; 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))
+ ;; Clear `field' property for the sake of copying from the
+ ;; minibuffer prompt or a *shell* prompt.
+ (remove-text-properties opoint (point) '(read-only nil field nil))))
+ (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
+ ;; loop would deactivate the mark because we inserted text.
+ (goto-char (prog1 (mark t)
+ (set-marker (mark-marker) (point) (current-buffer)))))
+ ;; If we do get all the way thru, make this-command indicate that.
+ (setq this-command 'yank)
+ nil)
+
+(defun rotate-yank-pointer (arg)
+ "Rotate the yanking point in the kill ring.
+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
+(defun kill-forward-chars (arg)
+ (if (listp arg) (setq arg (car arg)))
+ (if (eq arg '-) (setq arg -1))
+ (kill-region (point) (forward-point arg)))
+
+;; Internal subroutine of backward-delete-char
+(defun kill-backward-chars (arg)
+ (if (listp arg) (setq arg (car arg)))
+ (if (eq arg '-) (setq arg -1))
+ (kill-region (point) (forward-point (- arg))))
+
+(defcustom backward-delete-char-untabify-method 'untabify
+ "*The method for untabifying when deleting backward.
+Can be `untabify' -- turn a tab to many spaces, then delete one space;
+ `hungry' -- delete all whitespace, both tabs and spaces;
+ `all' -- delete all whitespace, including tabs, spaces and newlines;
+ nil -- just delete one character."
+ :type '(choice (const untabify) (const hungry) (const all) (const nil))
+ :version "20.3"
+ :group 'killing)
+
+(defun backward-delete-char-untabify (arg &optional killp)
+ "Delete characters backward, changing tabs into spaces.
+The exact behavior depends on `backward-delete-char-untabify-method'.
+Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
+Interactively, ARG is the prefix arg (default 1)
+and KILLP is t if a prefix arg was specified."
+ (interactive "*p\nP")
+ (when (eq backward-delete-char-untabify-method 'untabify)
+ (let ((count arg))
+ (save-excursion
+ (while (and (> count 0) (not (bobp)))
+ (if (= (preceding-char) ?\t)
+ (let ((col (current-column)))
+ (forward-char -1)
+ (setq col (- col (current-column)))
+ (insert-char ?\ col)
+ (delete-char 1)))
+ (forward-char -1)
+ (setq count (1- count))))))
+ (delete-backward-char
+ (let ((skip (cond ((eq backward-delete-char-untabify-method 'hungry) " \t")
+ ((eq backward-delete-char-untabify-method 'all)
+ " \t\n\r"))))
+ (if skip
+ (let ((wh (- (point) (save-excursion (skip-chars-backward skip)
+ (point)))))
+ (+ arg (if (zerop wh) 0 (1- wh))))
+ arg))
+ killp))
+
+(defun zap-to-char (arg char)
+ "Kill up to and including ARG'th occurrence of CHAR.
+Case is ignored if `case-fold-search' is non-nil in the current buffer.
+Goes backward if ARG is negative; error if CHAR not found."
+ (interactive "p\ncZap to char: ")
+ (kill-region (point) (progn
+ (search-forward (char-to-string char) nil nil arg)
+; (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
+ (point))))
+
+;; kill-line and its subroutines.
+
+(defcustom kill-whole-line nil
+ "*If non-nil, `kill-line' with no arg at beg of line kills the whole line."
+ :type 'boolean
+ :group 'killing)
+
+(defun kill-line (&optional arg)
+ "Kill the rest of the current line; if no nonblanks there, kill thru newline.
+With prefix argument, kill that many lines from point.
+Negative arguments kill lines backward.
+With zero argument, kills the text before point on the current line.
-(defun rotate-yank-pointer (arg)
- "Rotate the yanking point in the kill ring.
-With argument, rotate that many kills forward (or backward, if negative)."
- (interactive "p")
- (current-kill arg))
+When calling from a program, nil means \"no arg\",
+a number counts as a prefix arg.
+
+To kill a whole line, when point is not at the beginning, type \
+\\[beginning-of-line] \\[kill-line] \\[kill-line].
+
+If `kill-whole-line' is non-nil, then this command kills the whole line
+including its terminating newline, when used at the beginning of a line
+with no argument. As a consequence, you can always kill a whole line
+by typing \\[beginning-of-line] \\[kill-line].
+
+If you want to append the killed line to the last killed text,
+use \\[append-next-kill] before \\[kill-line].
+
+If the buffer is read-only, Emacs will beep and refrain from deleting
+the line, but put the line in the kill ring anyway. This means that
+you can use this command to copy text from a read-only buffer."
+ (interactive "P")
+ (kill-region (point)
+ ;; It is better to move point to the other end of the kill
+ ;; before killing. That way, in a read-only buffer, point
+ ;; moves across the text that is copied to the kill ring.
+ ;; The choice has no effect on undo now that undo records
+ ;; the value of point from before the command was run.
+ (progn
+ (if arg
+ (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)))
+ (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))))
+ (or (zerop (forward-line 1))
+ (signal 'end-of-buffer nil)))
+ (setq arg (1- arg)))
+ (let ((first t))
+ (while (or first (< arg 0))
+ (if (zerop arg)
+ (beginning-of-line)
+ (or (zerop (forward-line -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)))))
+ (goto-char
+ (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)))))
+ ((beginning-of-buffer end-of-buffer)
+ nil)))
+(defun end-of-visible-line ()
+ "Move to end of current visible line."
+ (end-of-line)
+ ;; 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)))))
+ (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.
-BUFFER may be a buffer or a buffer name."
+BUFFER may be a buffer or a buffer name.
+
+This function is meant for the user to run interactively.
+Don't call it from programs!"
(interactive
(list
(progn
(region-beginning) (region-end)))
(let ((oldbuf (current-buffer)))
(save-excursion
- (set-buffer (get-buffer-create buffer))
- (insert-buffer-substring oldbuf start end))))
+ (let* ((append-to (get-buffer-create buffer))
+ (windows (get-buffer-window-list append-to t t))
+ point)
+ (set-buffer append-to)
+ (setq point (point))
+ (barf-if-buffer-read-only)
+ (insert-buffer-substring oldbuf start end)
+ (dolist (window windows)
+ (when (= (window-point window) point)
+ (set-window-point window (point))))))))
(defun prepend-to-buffer (buffer start end)
"Prepend to specified buffer the text of the region.
(let ((oldbuf (current-buffer)))
(save-excursion
(set-buffer (get-buffer-create buffer))
+ (barf-if-buffer-read-only)
(save-excursion
(insert-buffer-substring oldbuf start end)))))
(let ((oldbuf (current-buffer)))
(save-excursion
(set-buffer (get-buffer-create buffer))
+ (barf-if-buffer-read-only)
(erase-buffer)
(save-excursion
(insert-buffer-substring oldbuf start end)))))
Changing the buffer \"deactivates\" the mark.
So do certain other operations that set the mark
but whose main purpose is something else--for example,
-incremental search, \\[beginning-of-buffer], and \\[end-of-buffer]."
+incremental search, \\[beginning-of-buffer], and \\[end-of-buffer].
+
+You can also deactivate the mark by typing \\[keyboard-quit] or
+\\[keyboard-escape-quit].
+
+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."
(interactive "P")
(setq transient-mark-mode
(if (null arg)
(goto-char position)
(switch-to-buffer buffer)))
\f
-(defcustom next-line-add-newlines t
+(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))
- (let ((opoint (point)))
- (end-of-line)
- (if (eobp)
- (newline 1)
- (goto-char opoint)
- (line-move arg)))
+ (if (save-excursion (end-of-line) (eobp))
+ ;; When adding a newline, don't expand an abbrev.
+ (let ((abbrev-mode nil))
+ (end-of-line)
+ (insert "\n"))
+ (line-move arg))
(if (interactive-p)
(condition-case nil
(line-move arg)
(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 new)
- ;; 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 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)))
- (goto-char (point-min))
- (setq inhibit-point-motion-hooks nil)
- (goto-char new)
- )))
+ (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)
+
+ ;; Move to the desired column.
+ (line-move-to-column column)
+
+ (let ((new (point))
+ (line-beg (save-excursion (beginning-of-line) (point)))
+ (line-end (save-excursion (end-of-line) (point))))
+
+ ;; Process intangibility within a line.
+ ;; Move to the chosen destination position from above,
+ ;; with intangibility processing enabled.
+
+ (goto-char (point-min))
+ (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))))
+
+ ;; 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 intangibility processing 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.
(put 'set-goal-column 'disabled t)
goal-column))
nil)
\f
-;;; Partial support for horizontal autoscrolling. Someday, this feature
-;;; will be built into the C level and all the (hscroll-point-visible) calls
-;;; will go away.
-
-(defcustom hscroll-step 0
- "*The number of columns to try scrolling a window by when point moves out.
-If that fails to bring point back on frame, point is centered instead.
-If this is zero, point is always centered after it moves off frame."
- :type '(choice (const :tag "Alway Center" 0)
- (integer :format "%v" 1))
- :group 'editing-basics)
-
-(defun hscroll-point-visible ()
- "Scrolls the selected window horizontally to make point visible."
- (save-excursion
- (set-buffer (window-buffer))
- (if (not (or truncate-lines
- (> (window-hscroll) 0)
- (and truncate-partial-width-windows
- (< (window-width) (frame-width)))))
- ;; Point is always visible when lines are wrapped.
- ()
- ;; If point is on the invisible part of the line before window-start,
- ;; then hscrolling can't bring it back, so reset window-start first.
- (and (< (point) (window-start))
- (let ((ws-bol (save-excursion
- (goto-char (window-start))
- (beginning-of-line)
- (point))))
- (and (>= (point) ws-bol)
- (set-window-start nil ws-bol))))
- (let* ((here (hscroll-window-column))
- (left (min (window-hscroll) 1))
- (right (1- (window-width))))
- ;; Allow for the truncation glyph, if we're not exactly at eol.
- (if (not (and (= here right)
- (= (following-char) ?\n)))
- (setq right (1- right)))
- (cond
- ;; If too far away, just recenter. But don't show too much
- ;; white space off the end of the line.
- ((or (< here (- left hscroll-step))
- (> here (+ right hscroll-step)))
- (let ((eol (save-excursion (end-of-line) (hscroll-window-column))))
- (scroll-left (min (- here (/ (window-width) 2))
- (- eol (window-width) -5)))))
- ;; Within range. Scroll by one step (or maybe not at all).
- ((< here left)
- (scroll-right hscroll-step))
- ((> here right)
- (scroll-left hscroll-step)))))))
-
-;; This function returns the window's idea of the display column of point,
-;; assuming that the window is already known to be truncated rather than
-;; wrapped, and that we've already handled the case where point is on the
-;; part of the line before window-start. We ignore window-width; if point
-;; is beyond the right margin, we want to know how far. The return value
-;; includes the effects of window-hscroll, window-start, and the prompt
-;; string in the minibuffer. It may be negative due to hscroll.
-(defun hscroll-window-column ()
- (let* ((hscroll (window-hscroll))
- (startpos (save-excursion
- (beginning-of-line)
- (if (= (point) (save-excursion
- (goto-char (window-start))
- (beginning-of-line)
- (point)))
- (goto-char (window-start)))
- (point)))
- (hpos (+ (if (and (eq (selected-window) (minibuffer-window))
- (= 1 (window-start))
- (= startpos (point-min)))
- (minibuffer-prompt-width)
- 0)
- (min 0 (- 1 hscroll))))
- val)
- (car (cdr (compute-motion startpos (cons hpos 0)
- (point) (cons 0 1)
- 1000000 (cons hscroll 0) nil)))))
-
-
-;; rms: (1) The definitions of arrow keys should not simply restate
-;; what keys they are. The arrow keys should run the ordinary commands.
-;; (2) The arrow keys are just one of many common ways of moving point
-;; within a line. Real horizontal autoscrolling would be a good feature,
-;; but supporting it only for arrow keys is too incomplete to be desirable.
-
-;;;;; Make arrow keys do the right thing for improved terminal support
-;;;;; When we implement true horizontal autoscrolling, right-arrow and
-;;;;; left-arrow can lose the (if truncate-lines ...) clause and become
-;;;;; aliases. These functions are bound to the corresponding keyboard
-;;;;; events in loaddefs.el.
-
-;;(defun right-arrow (arg)
-;; "Move right one character on the screen (with prefix ARG, that many chars).
-;;Scroll right if needed to keep point horizontally onscreen."
-;; (interactive "P")
-;; (forward-char arg)
-;; (hscroll-point-visible))
-
-;;(defun left-arrow (arg)
-;; "Move left one character on the screen (with prefix ARG, that many chars).
-;;Scroll left if needed to keep point horizontally onscreen."
-;; (interactive "P")
-;; (backward-char arg)
-;; (hscroll-point-visible))
(defun scroll-other-window-down (lines)
"Scroll the \"other window\" down.
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)))
-\f
-(defcustom comment-column 32
- "*Column to indent right-margin comments to.
-Setting this variable automatically makes it local to the current buffer.
-Each mode establishes a different default value for this variable; you
-can set the value for a particular mode using that mode's hook."
- :type 'integer
- :group 'fill-comments)
-(make-variable-buffer-local 'comment-column)
-
-(defcustom comment-start nil
- "*String to insert to start a new comment, or nil if no comment syntax."
- :type '(choice (const :tag "None" nil)
- string)
- :group 'fill-comments)
-
-(defcustom comment-start-skip nil
- "*Regexp to match the start of a comment plus everything up to its body.
-If there are any \\(...\\) pairs, the comment delimiter text is held to begin
-at the place matched by the close of the first pair."
- :type '(choice (const :tag "None" nil)
- regexp)
- :group 'fill-comments)
-
-(defcustom comment-end ""
- "*String to insert to end a new comment.
-Should be an empty string if comments are terminated by end-of-line."
- :type 'string
- :group 'fill-comments)
-
-(defvar comment-indent-hook nil
- "Obsolete variable for function to compute desired indentation for a comment.
-This function is called with no args with point at the beginning of
-the comment's starting delimiter.")
-
-(defvar comment-indent-function
- '(lambda () comment-column)
- "Function to compute desired indentation for a comment.
-This function is called with no args with point at the beginning of
-the comment's starting delimiter.")
-
-(defcustom block-comment-start nil
- "*String to insert to start a new comment on a line by itself.
-If nil, use `comment-start' instead.
-Note that the regular expression `comment-start-skip' should skip this string
-as well as the `comment-start' string."
- :type '(choice (const :tag "Use comment-start" nil)
- string)
- :group 'fill-comments)
-
-(defcustom block-comment-end nil
- "*String to insert to end a new comment on a line by itself.
-Should be an empty string if comments are terminated by end-of-line.
-If nil, use `comment-end' instead."
- :type '(choice (const :tag "Use comment-end" nil)
- string)
- :group 'fill-comments)
-
-(defun indent-for-comment ()
- "Indent this line's comment to comment column, or insert an empty comment."
- (interactive "*")
- (let* ((empty (save-excursion (beginning-of-line)
- (looking-at "[ \t]*$")))
- (starter (or (and empty block-comment-start) comment-start))
- (ender (or (and empty block-comment-end) comment-end)))
+(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
- ((null starter)
- (error "No comment syntax defined"))
- ((null comment-start-skip)
- (error "This mode doesn't define `comment-start-skip'"))
- (t (let* ((eolpos (save-excursion (end-of-line) (point)))
- cpos indent begpos)
- (beginning-of-line)
- (if (re-search-forward comment-start-skip eolpos 'move)
- (progn (setq cpos (point-marker))
- ;; Find the start of the comment delimiter.
- ;; If there were paren-pairs in comment-start-skip,
- ;; position at the end of the first pair.
- (if (match-end 1)
- (goto-char (match-end 1))
- ;; If comment-start-skip matched a string with
- ;; internal whitespace (not final whitespace) then
- ;; the delimiter start at the end of that
- ;; whitespace. Otherwise, it starts at the
- ;; beginning of what was matched.
- (skip-syntax-backward " " (match-beginning 0))
- (skip-syntax-backward "^ " (match-beginning 0)))))
- (setq begpos (point))
- ;; Compute desired indent.
- (if (= (current-column)
- (setq indent (if comment-indent-hook
- (funcall comment-indent-hook)
- (funcall comment-indent-function))))
- (goto-char begpos)
- ;; If that's different from current, change it.
- (skip-chars-backward " \t")
- (delete-region (point) begpos)
- (indent-to indent))
- ;; An existing comment?
- (if cpos
- (progn (goto-char cpos)
- (set-marker cpos nil))
- ;; No, insert one.
- (insert starter)
- (save-excursion
- (insert ender))))))))
-
-(defun set-comment-column (arg)
- "Set the comment column based on point.
-With no arg, set the comment column to the current column.
-With just minus as arg, kill any comment on this line.
-With any other arg, set comment column to indentation of the previous comment
- and then align or create a comment on this line at that column."
- (interactive "P")
- (if (eq arg '-)
- (kill-comment nil)
- (if arg
- (progn
- (save-excursion
- (beginning-of-line)
- (re-search-backward comment-start-skip)
- (beginning-of-line)
- (re-search-forward comment-start-skip)
- (goto-char (match-beginning 0))
- (setq comment-column (current-column))
- (message "Comment column set to %d" comment-column))
- (indent-for-comment))
- (setq comment-column (current-column))
- (message "Comment column set to %d" comment-column))))
-
-(defun kill-comment (arg)
- "Kill the comment on this line, if any.
-With argument, kill comments on that many lines starting with this one."
- ;; this function loses in a lot of situations. it incorrectly recognises
- ;; comment delimiters sometimes (ergo, inside a string), doesn't work
- ;; with multi-line comments, can kill extra whitespace if comment wasn't
- ;; through end-of-line, et cetera.
- (interactive "P")
- (or comment-start-skip (error "No comment syntax defined"))
- (let ((count (prefix-numeric-value arg)) endc)
- (while (> count 0)
+ ((= arg 0)
(save-excursion
- (end-of-line)
- (setq endc (point))
- (beginning-of-line)
- (and (string< "" comment-end)
- (setq endc
- (progn
- (re-search-forward (regexp-quote comment-end) endc 'move)
- (skip-chars-forward " \t")
- (point))))
- (beginning-of-line)
- (if (re-search-forward comment-start-skip endc t)
- (progn
- (goto-char (match-beginning 0))
- (skip-chars-backward " \t")
- (kill-region (point) endc)
- ;; to catch comments a line beginnings
- (indent-according-to-mode))))
- (if arg (forward-line 1))
- (setq count (1- count)))))
-
-(defvar comment-padding 1
- "Number of spaces `comment-region' puts between comment chars and text.
-
-Extra spacing between the comment characters and the comment text
-makes the comment easier to read. Default is 1. Nil means 0 and is
-more efficient.")
-
-(defun comment-region (beg end &optional arg)
- "Comment or uncomment each line in the region.
-With just C-u prefix arg, uncomment each line in region.
-Numeric prefix arg ARG means use ARG comment characters.
-If ARG is negative, delete that many comment characters instead.
-Comments are terminated on each line, even for syntax in which newline does
-not end the comment. Blank lines do not get comments."
- ;; if someone wants it to only put a comment-start at the beginning and
- ;; comment-end at the end then typing it, C-x C-x, closing it, C-x C-x
- ;; is easy enough. No option is made here for other than commenting
- ;; every line.
- (interactive "r\nP")
- (or comment-start (error "No comment syntax is defined"))
- (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
- (save-excursion
- (save-restriction
- (let ((cs comment-start) (ce comment-end)
- (cp (when comment-padding
- (make-string comment-padding ? )))
- numarg)
- (if (consp arg) (setq numarg t)
- (setq numarg (prefix-numeric-value arg))
- ;; For positive arg > 1, replicate the comment delims now,
- ;; then insert the replicated strings just once.
- (while (> numarg 1)
- (setq cs (concat cs comment-start)
- ce (concat ce comment-end))
- (setq numarg (1- numarg))))
- ;; Loop over all lines from BEG to END.
- (narrow-to-region beg end)
- (goto-char beg)
- (if (or (eq numarg t) (< numarg 0))
- (while (not (eobp))
- (let (found-comment)
- ;; Delete comment start from beginning of line.
- (if (eq numarg t)
- (while (looking-at (regexp-quote cs))
- (setq found-comment t)
- (delete-char (length cs)))
- (let ((count numarg))
- (while (and (> 1 (setq count (1+ count)))
- (looking-at (regexp-quote cs)))
- (setq found-comment t)
- (delete-char (length cs)))))
- ;; Delete comment padding from beginning of line
- (when (and found-comment comment-padding
- (looking-at (regexp-quote cp)))
- (delete-char comment-padding))
- ;; Delete comment end from end of line.
- (if (string= "" ce)
- nil
- (if (eq numarg t)
- (progn
- (end-of-line)
- ;; This is questionable if comment-end ends in
- ;; whitespace. That is pretty brain-damaged,
- ;; though.
- (while (progn (skip-chars-backward " \t")
- (and (>= (- (point) (point-min)) (length ce))
- (save-excursion
- (backward-char (length ce))
- (looking-at (regexp-quote ce)))))
- (delete-char (- (length ce)))))
- (let ((count numarg))
- (while (> 1 (setq count (1+ count)))
- (end-of-line)
- ;; this is questionable if comment-end ends in whitespace
- ;; that is pretty brain-damaged though
- (skip-chars-backward " \t")
- (if (>= (- (point) (point-min)) (length ce))
- (save-excursion
- (backward-char (length ce))
- (if (looking-at (regexp-quote ce))
- (delete-char (length ce)))))))))
- (forward-line 1)))
-
- (when comment-padding
- (setq cs (concat cs cp)))
- (while (not (eobp))
- ;; Insert at beginning and at end.
- (if (looking-at "[ \t]*$") ()
- (insert cs)
- (if (string= "" ce) ()
- (end-of-line)
- (insert ce)))
- (search-forward "\n" nil 'move)))))))
+ (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 end of a word.
-With argument, do this that many times.
-In programs, it is faster to call `forward-word' with negative arg."
+ "Move backward until encountering the beginning of a word.
+With argument, do this that many times."
(interactive "p")
(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.
(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)
regexp)
:group 'fill)
-(defvar comment-line-break-function 'indent-new-comment-line
+(defvar comment-line-break-function 'comment-indent-new-line
"*Mode-specific function which line breaks and continues a comment.
This function is only called during auto-filling of a comment section.
(null (setq fc (current-fill-column)))
(and (eq justify 'left)
(<= (current-column) fc))
- (save-excursion (beginning-of-line)
+ (save-excursion (beginning-of-line)
(setq bol (point))
(and auto-fill-inhibit-regexp
(looking-at auto-fill-inhibit-regexp))))
(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)))
+ t)))
(defvar normal-auto-fill-function 'do-auto-fill
"The function to use for `auto-fill-function' if Auto Fill mode is turned on.
(defun turn-on-auto-fill ()
"Unconditionally turn on Auto Fill mode."
(auto-fill-mode 1))
+
+(defun turn-off-auto-fill ()
+ "Unconditionally turn off Auto Fill mode."
+ (auto-fill-mode -1))
+
(custom-add-option 'text-mode-hook 'turn-on-auto-fill)
(defun set-fill-column (arg)
(message "Fill column set to %d (was %d)" arg fill-column)
(setq fill-column arg)))
\f
-(defcustom comment-multi-line nil
- "*Non-nil means \\[indent-new-comment-line] should continue same comment
-on new line, with no new terminator or starter.
-This is obsolete because you might as well use \\[newline-and-indent]."
- :type 'boolean
- :group 'fill-comments)
-
-(defun indent-new-comment-line (&optional soft)
- "Break line at point and indent, continuing comment if within one.
-This indents the body of the continued comment
-under the previous comment line.
-
-This command is intended for styles where you write a comment per line,
-starting a new comment (and terminating it if necessary) on each line.
-If you want to continue one comment across several lines, use \\[newline-and-indent].
-
-If a fill column is specified, it overrides the use of the comment column
-or comment indentation.
-
-The inserted newline is marked hard if `use-hard-newlines' is true,
-unless optional argument SOFT is non-nil."
- (interactive)
- (let (comcol comstart)
- (skip-chars-backward " \t")
- (delete-region (point)
- (progn (skip-chars-forward " \t")
- (point)))
- (if soft (insert-and-inherit ?\n) (newline 1))
- (if fill-prefix
- (progn
- (indent-to-left-margin)
- (insert-and-inherit fill-prefix))
- (if (not comment-multi-line)
- (save-excursion
- (if (and comment-start-skip
- (let ((opoint (point)))
- (forward-line -1)
- (re-search-forward comment-start-skip opoint t)))
- ;; The old line is a comment.
- ;; Set WIN to the pos of the comment-start.
- ;; But if the comment is empty, look at preceding lines
- ;; to find one that has a nonempty comment.
-
- ;; If comment-start-skip contains a \(...\) pair,
- ;; the real comment delimiter starts at the end of that pair.
- (let ((win (or (match-end 1) (match-beginning 0))))
- (while (and (eolp) (not (bobp))
- (let (opoint)
- (beginning-of-line)
- (setq opoint (point))
- (forward-line -1)
- (re-search-forward comment-start-skip opoint t)))
- (setq win (or (match-end 1) (match-beginning 0))))
- ;; Indent this line like what we found.
- (goto-char win)
- (setq comcol (current-column))
- (setq comstart
- (buffer-substring (point) (match-end 0)))))))
- (if comcol
- (let ((comment-column comcol)
- (comment-start comstart)
- (comment-end comment-end))
- (and comment-end (not (equal comment-end ""))
- ; (if (not comment-multi-line)
- (progn
- (forward-char -1)
- (insert comment-end)
- (forward-char 1))
- ; (setq comment-column (+ comment-column (length comment-start))
- ; comment-start "")
- ; )
- )
- (if (not (eolp))
- (setq comment-end ""))
- (insert-and-inherit ?\n)
- (forward-char -1)
- (indent-for-comment)
- (save-excursion
- ;; Make sure we delete the newline inserted above.
- (end-of-line)
- (delete-char 1)))
- (indent-according-to-mode)))))
-\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,
(> (prefix-numeric-value arg) 0))
'overwrite-mode-binary))
(force-mode-line-update))
-\f
+
(defcustom line-number-mode t
"*Non-nil means display line number in mode line."
:type 'boolean
When Line Number mode is enabled, the line number appears
in the mode line.
-Line numbers do not appear for very large buffers, see variable
-`line-number-display-limit'."
+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)
(if (null arg) (not column-number-mode)
(> (prefix-numeric-value arg) 0)))
(force-mode-line-update))
-
+\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.
((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)
-\f
+
+(defcustom read-mail-command 'rmail
+ "*Your preference for a mail reading package.
+This is used by some keybindings which support reading mail.
+See also `mail-user-agent' concerning sending mail."
+ :type '(choice (function-item rmail)
+ (function-item gnus)
+ (function-item mh-rmail)
+ (function :tag "Other"))
+ :version "21.1"
+ :group 'mail)
+
(defcustom mail-user-agent 'sendmail-user-agent
"*Your preference for a mail composition package.
-Various Emacs Lisp packages (e.g. reporter) require you to compose an
+Various Emacs Lisp packages (e.g. Reporter) require you to compose an
outgoing email message. This variable lets you specify which
mail-sending package you prefer.
Valid values include:
- sendmail-user-agent -- use the default Emacs Mail package
- mh-e-user-agent -- use the Emacs interface to the MH mail system
- message-user-agent -- use the GNUS mail sending package
+ `sendmail-user-agent' -- use the default Emacs Mail package.
+ See Info node `(emacs)Sending Mail'.
+ `mh-e-user-agent' -- use the Emacs interface to the MH mail system.
+ See Info node `(mh-e)'.
+ `message-user-agent' -- use the Gnus Message package.
+ See Info node `(message)'.
+ `gnus-user-agent' -- like `message-user-agent', but with Gnus
+ paraphernalia, particularly the Gcc: header for
+ archiving.
Additional valid symbols may be available; check with the author of
-your package for details."
+your package for details. The function should return non-nil if it
+succeeds.
+
+See also `read-mail-command' concerning reading mail."
:type '(radio (function-item :tag "Default Emacs mail"
:format "%t\n"
sendmail-user-agent)
(function-item :tag "Emacs interface to MH"
:format "%t\n"
mh-e-user-agent)
- (function-item :tag "Gnus mail sending package"
+ (function-item :tag "Gnus Message package"
:format "%t\n"
message-user-agent)
+ (function-item :tag "Gnus Message with full Gnus features"
+ :format "%t\n"
+ gnus-user-agent)
(function :tag "Other"))
:group 'mail)
(put symbol 'abortfunc (or abortfunc 'kill-buffer))
(put symbol 'hookvar (or hookvar 'mail-send-hook)))
-(defun assoc-ignore-case (key alist)
- "Like `assoc', but ignores differences in case and text representation.
-KEY must be a string. Upper-case and lower-case letters are treated as equal.
-Unibyte strings are converted to multibyte for comparison."
- (let (element)
- (while (and alist (not element))
- (if (eq t (compare-strings key 0 nil (car (car alist)) 0 nil t))
- (setq element (car alist)))
- (setq alist (cdr alist)))
- element))
-
-(defun assoc-ignore-representation (key alist)
- "Like `assoc', but ignores differences in text representation.
-KEY must be a string.
-Unibyte strings are converted to multibyte for comparison."
- (let (element)
- (while (and alist (not element))
- (if (eq t (compare-strings key 0 nil (car (car alist)) 0 nil))
- (setq element (car alist)))
- (setq alist (cdr alist)))
- element))
-
(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
(same-window-regexps nil))
(funcall switch-function "*mail*")))
(let ((cc (cdr (assoc-ignore-case "cc" other-headers)))
- (in-reply-to (cdr (assoc-ignore-case "in-reply-to" other-headers))))
+ (in-reply-to (cdr (assoc-ignore-case "in-reply-to" other-headers)))
+ (body (cdr (assoc-ignore-case "body" other-headers))))
(or (mail continue to subject in-reply-to cc yank-action send-actions)
continue
(error "Message aborted"))
(save-excursion
(rfc822-goto-eoh)
(while other-headers
- (if (not (member (car (car other-headers)) '("in-reply-to" "cc")))
+ (unless (member-ignore-case (car (car other-headers))
+ '("in-reply-to" "cc" "body"))
(insert (car (car other-headers)) ": "
(cdr (car other-headers)) "\n"))
(setq other-headers (cdr other-headers)))
+ (when body
+ (forward-line 1)
+ (insert body))
t)))
(define-mail-user-agent 'mh-e-user-agent
(list nil nil nil current-prefix-arg))
(compose-mail to subject other-headers continue
'switch-to-buffer-other-frame yank-action send-actions))
-\f
+
(defvar set-variable-value-history nil
"History of values entered with `set-variable'.")
(let ((type (get var 'custom-type)))
(when type
;; Match with custom type.
- (require 'wid-edit)
+ (require 'cus-edit)
(setq type (widget-convert type))
(unless (widget-apply type :match val)
- (error "Value `%S' does not match type %S of %S"
+ (error "Value `%S' does not match type %S of %S"
val (car type) var))))
- (set var val))
-\f
+ (set var val)
+
+ ;; Force a thorough redisplay for the case that the variable
+ ;; has an effect on the display, like `tab-width' has.
+ (force-mode-line-update))
+
;; Define the major mode for lists of completions.
(defvar completion-list-mode-map nil
"Move to the next item in the completion list.
With prefix argument N, move N items (negative N means move backward)."
(interactive "p")
- (while (and (> n 0) (not (eobp)))
- (let ((prop (get-text-property (point) 'mouse-face))
- (end (point-max)))
+ (let ((beg (point-min)) (end (point-max)))
+ (while (and (> n 0) (not (eobp)))
;; If in a completion, move to the end of it.
- (if prop
- (goto-char (next-single-property-change (point) 'mouse-face nil end)))
+ (when (get-text-property (point) 'mouse-face)
+ (goto-char (next-single-property-change (point) 'mouse-face nil end)))
;; Move to start of next one.
- (goto-char (next-single-property-change (point) 'mouse-face nil end)))
- (setq n (1- n)))
- (while (and (< n 0) (not (bobp)))
- (let ((prop (get-text-property (1- (point)) 'mouse-face))
- (end (point-min)))
- ;; If in a completion, move to the start of it.
- (if prop
+ (unless (get-text-property (point) 'mouse-face)
+ (goto-char (next-single-property-change (point) 'mouse-face nil end)))
+ (setq n (1- n)))
+ (while (and (< n 0) (not (bobp)))
+ (let ((prop (get-text-property (1- (point)) 'mouse-face)))
+ ;; If in a completion, move to the start of it.
+ (when (and prop (eq prop (get-text-property (point) 'mouse-face)))
(goto-char (previous-single-property-change
- (point) 'mouse-face nil end)))
- ;; Move to end of the previous completion.
- (goto-char (previous-single-property-change (point) 'mouse-face nil end))
- ;; Move to the start of that one.
- (goto-char (previous-single-property-change (point) 'mouse-face nil end)))
- (setq n (1+ n))))
+ (point) 'mouse-face nil beg)))
+ ;; Move to end of the previous completion.
+ (unless (or (bobp) (get-text-property (1- (point)) 'mouse-face))
+ (goto-char (previous-single-property-change
+ (point) 'mouse-face nil beg)))
+ ;; Move to the start of that one.
+ (goto-char (previous-single-property-change
+ (point) 'mouse-face nil beg))
+ (setq n (1+ n))))))
(defun choose-completion ()
"Choose the completion that point is in or next to."
;; 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)
- (let ((buffer (or buffer completion-reference-buffer)))
+ (let ((buffer (or buffer completion-reference-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 (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer))
+ (if (and mini-p
(or (not (active-minibuffer-window))
(not (equal buffer
(window-buffer (active-minibuffer-window))))))
;; Insert the completion into the buffer where completion was requested.
(set-buffer buffer)
(if base-size
- (delete-region (+ base-size (point-min)) (point))
+ (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)
;; 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 (buffer-string)))
- (select-window (active-minibuffer-window))
+ (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 ()
(setq completion-base-size nil)
(run-hooks 'completion-list-mode-hook))
+(defun completion-list-mode-finish ()
+ "Finish setup of the completions buffer.
+Called from `temp-buffer-show-hook'."
+ (when (eq major-mode 'completion-list-mode)
+ (toggle-read-only 1)))
+
+(add-hook 'temp-buffer-show-hook 'completion-list-mode-finish)
+
(defvar completion-setup-hook nil
"Normal hook run at the end of setting up a completion list buffer.
When this hook is run, the current buffer is the one in which the
(set-buffer mainbuf)
(goto-char (point-max))
(skip-chars-backward (format "^%c" directory-sep-char))
- (- (point) (point-min))))
+ (- (point) (minibuffer-prompt-end))))
;; Otherwise, in minibuffer, the whole input is being completed.
(save-match-data
(if (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
(buffer-name mainbuf))
(setq completion-base-size 0))))
(goto-char (point-min))
- (if window-system
+ (if (display-mouse-p)
(insert (substitute-command-keys
"Click \\[mouse-choose-completion] on a completion to select it.\n")))
(insert (substitute-command-keys
(goto-char (point-min))
(search-forward "\n\n")
(forward-line 1))))
-\f
+
;; Support keyboard commands to turn on various modifiers.
;; These functions -- which are not commands -- each add one modifier
(define-key function-key-map [?\C-x ?@ ?a] 'event-apply-alt-modifier)
(define-key function-key-map [?\C-x ?@ ?S] 'event-apply-shift-modifier)
(define-key function-key-map [?\C-x ?@ ?c] 'event-apply-control-modifier)
-\f
+
;;;; Keypad support.
;;; Make the keypad keys act like ordinary typing keys. If people add
;;; 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-divide ?/)
(kp-equal ?=)))
+;;;;
+;;;; forking a twin copy of a buffer.
+;;;;
+
+(defvar clone-buffer-hook nil
+ "Normal hook to run in the new buffer at the end of `clone-buffer'.")
+
+(defun clone-process (process &optional newname)
+ "Create a twin copy of PROCESS.
+If NEWNAME is nil, it defaults to PROCESS' name;
+NEWNAME is modified by adding or incrementing <N> at the end as necessary.
+If PROCESS is associated with a buffer, the new process will be associated
+ with the current buffer instead.
+Returns nil if PROCESS has already terminated."
+ (setq newname (or newname (process-name process)))
+ (if (string-match "<[0-9]+>\\'" newname)
+ (setq newname (substring newname 0 (match-beginning 0))))
+ (when (memq (process-status process) '(run stop open))
+ (let* ((process-connection-type (process-tty-name process))
+ (new-process
+ (if (memq (process-status process) '(open))
+ (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)))))
+ (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'):
+;; - syntax-table
+;; - overlays
+(defun clone-buffer (&optional newname display-flag)
+ "Create a twin copy of the current buffer.
+If NEWNAME is nil, it defaults to the current buffer's name;
+NEWNAME is modified by adding or incrementing <N> at the end as necessary.
+
+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
+ (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)
+ (error "Cannot 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))))
+ (let ((buf (current-buffer))
+ (ptmin (point-min))
+ (ptmax (point-max))
+ (pt (point))
+ (mk (if mark-active (mark t)))
+ (modified (buffer-modified-p))
+ (mode major-mode)
+ (lvars (buffer-local-variables))
+ (process (get-buffer-process (current-buffer)))
+ (new (generate-new-buffer (or newname (buffer-name)))))
+ (save-restriction
+ (widen)
+ (with-current-buffer new
+ (insert-buffer-substring buf)))
+ (with-current-buffer new
+ (narrow-to-region ptmin ptmax)
+ (goto-char pt)
+ (if mk (set-mark mk))
+ (set-buffer-modified-p modified)
+
+ ;; Clone the old buffer's process, if any.
+ (when process (clone-process process))
+
+ ;; Now set up the major mode.
+ (funcall mode)
+
+ ;; Set up other local variables.
+ (mapcar (lambda (v)
+ (condition-case () ;in case var is read-only
+ (if (symbolp v)
+ (makunbound v)
+ (set (make-local-variable (car v)) (cdr v)))
+ (error nil)))
+ lvars)
+
+ ;; Run any hooks (typically set up by the major mode
+ ;; for cloning to work properly).
+ (run-hooks 'clone-buffer-hook))
+ (if display-flag (pop-to-buffer new))
+ new))
+
+
+(defun clone-indirect-buffer (newname display-flag &optional norecord)
+ "Create an indirect buffer that is a twin copy of the current buffer.
+
+Give the indirect buffer name NEWNAME. Interactively, read NEW-NAME
+from the minibuffer when invoked with a prefix arg. If NEWNAME is nil
+or if not called with a prefix arg, NEWNAME defaults to the current
+buffer's name. The name is modified by adding a `<N>' suffix to it
+or by incrementing the N in an existing suffix.
+
+DISPLAY-FLAG non-nil means show the new buffer with `pop-to-buffer'.
+This is always done when called interactively.
+
+Optional last arg NORECORD non-nil means do not put this buffer at the
+front of the list of recently selected ones."
+ (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))))
+ (let* ((name (generate-new-buffer-name newname))
+ (buffer (make-indirect-buffer (current-buffer) name t)))
+ (when display-flag
+ (pop-to-buffer buffer norecord))
+ buffer))
+
+
+(defun clone-indirect-buffer-other-window (buffer &optional norecord)
+ "Create an indirect buffer that is a twin copy of BUFFER.
+Select the new buffer in another window.
+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))
+ (set-buffer buffer)
+ (clone-indirect-buffer nil t norecord)))
+
+(define-key ctl-x-4-map "c" 'clone-indirect-buffer-other-window)
+
+
+;;; Handling of Backspace and Delete keys.
+
+(defcustom normal-erase-is-backspace nil
+ "If non-nil, Delete key deletes forward and Backspace key deletes backward.
+
+On window systems, the default value of this option is chosen
+according to the keyboard used. If the keyboard has both a Backspace
+key and a Delete key, and both are mapped to their usual meanings, the
+option's default value is set to t, so that Backspace can be used to
+delete backward, and Delete can be used to delete forward.
+
+If not running under a window system, customizing this option accomplishes
+a similar effect by mapping C-h, which is usually generated by the
+Backspace key, to DEL, and by mapping DEL to C-d via
+`keyboard-translate'. The former functionality of C-h is available on
+the F1 key. You should probably not use this setting if you don't
+have both Backspace, Delete and F1 keys.
+
+Setting this variable with setq doesn't take effect. Programmatically,
+call `normal-erase-is-backspace-mode' (which see) instead."
+ :type 'boolean
+ :group 'editing-basics
+ :version "21.1"
+ :set (lambda (symbol value)
+ ;; The fboundp is because of a problem with :set when
+ ;; dumping Emacs. It doesn't really matter.
+ (if (fboundp 'normal-erase-is-backspace-mode)
+ (normal-erase-is-backspace-mode (or value 0))
+ (set-default symbol value))))
+
+
+(defun normal-erase-is-backspace-mode (&optional arg)
+ "Toggle the Erase and Delete mode of the Backspace and Delete keys.
+
+With numeric arg, turn the mode on if and only if ARG is positive.
+
+On window systems, when this mode is on, Delete is mapped to C-d and
+Backspace is mapped to DEL; when this mode is off, both Delete and
+Backspace are mapped to DEL. (The remapping goes via
+`function-key-map', so binding Delete or Backspace in the global or
+local keymap will override that.)
+
+In addition, on window systems, the bindings of C-Delete, M-Delete,
+C-M-Delete, C-Backspace, M-Backspace, and C-M-Backspace are changed in
+the global keymap in accordance with the functionality of Delete and
+Backspace. For example, if Delete is remapped to C-d, which deletes
+forward, C-Delete is bound to `kill-word', but if Delete is remapped
+to DEL, which deletes backward, C-Delete is bound to
+`backward-kill-word'.
+
+If not running on a window system, a similar effect is accomplished by
+remapping C-h (normally produced by the Backspace key) and DEL via
+`keyboard-translate': if this mode is on, C-h is mapped to DEL and DEL
+to C-d; if it's off, the keys are not remapped.
+
+When not running on a window system, and this mode is turned on, the
+former functionality of C-h is available on the F1 key. You should
+probably not turn on this mode on a text-only terminal if you don't
+have both Backspace, Delete and F1 keys.
+
+See also `normal-erase-is-backspace'."
+ (interactive "P")
+ (setq normal-erase-is-backspace
+ (if arg
+ (> (prefix-numeric-value arg) 0)
+ (not normal-erase-is-backspace)))
+
+ (cond ((or (memq window-system '(x w32 mac pc))
+ (memq system-type '(ms-dos windows-nt)))
+ (let ((bindings
+ `(([C-delete] [C-backspace])
+ ([M-delete] [M-backspace])
+ ([C-M-delete] [C-M-backspace])
+ (,esc-map
+ [C-delete] [C-backspace])))
+ (old-state (lookup-key function-key-map [delete])))
+
+ (if normal-erase-is-backspace
+ (progn
+ (define-key function-key-map [delete] [?\C-d])
+ (define-key function-key-map [kp-delete] [?\C-d])
+ (define-key function-key-map [backspace] [?\C-?]))
+ (define-key function-key-map [delete] [?\C-?])
+ (define-key function-key-map [kp-delete] [?\C-?])
+ (define-key function-key-map [backspace] [?\C-?]))
+
+ ;; Maybe swap bindings of C-delete and C-backspace, etc.
+ (unless (equal old-state (lookup-key function-key-map [delete]))
+ (dolist (binding bindings)
+ (let ((map global-map))
+ (when (keymapp (car binding))
+ (setq map (car binding) binding (cdr binding)))
+ (let* ((key1 (nth 0 binding))
+ (key2 (nth 1 binding))
+ (binding1 (lookup-key map key1))
+ (binding2 (lookup-key map key2)))
+ (define-key map key1 binding2)
+ (define-key map key2 binding1)))))))
+ (t
+ (if normal-erase-is-backspace
+ (progn
+ (keyboard-translate ?\C-h ?\C-?)
+ (keyboard-translate ?\C-? ?\C-d))
+ (keyboard-translate ?\C-h ?\C-h)
+ (keyboard-translate ?\C-? ?\C-?))))
+
+ (run-hooks 'normal-erase-is-backspace-hook)
+ (if (interactive-p)
+ (message "Delete key deletes %s"
+ (if normal-erase-is-backspace "forward" "backward"))))
+
+
+;;; make-network-process wrappers
+
+(if (featurep 'make-network-process)
+ (progn
+
+(defun open-network-stream (name buffer host service)
+ "Open a TCP connection for a service to a host.
+Returns a subprocess-object to represent the connection.
+Input and output work as for subprocesses; `delete-process' closes it.
+Args are NAME BUFFER HOST SERVICE.
+NAME is name for process. It is modified if necessary to make it unique.
+BUFFER is the buffer (or buffer-name) to associate with the process.
+ Process output goes at end of that buffer, unless you specify
+ an output stream or filter function to handle the output.
+ BUFFER may be also nil, meaning that this process is not associated
+ with any buffer
+Third arg is name of the host to connect to, or its IP address.
+Fourth arg SERVICE is name of the service desired, or an integer
+specifying a port number to connect to."
+ (make-network-process :name name :buffer buffer
+ :host host :service service))
+
+(defun open-network-stream-nowait (name buffer host service &optional sentinel filter)
+ "Initiate connection to a TCP connection for a service to a host.
+It returns nil if non-blocking connects are not supported; otherwise,
+it returns a subprocess-object to represent the connection.
+
+This function is similar to `open-network-stream', except that this
+function returns before the connection is established. When the
+connection is completed, the sentinel function will be called with
+second arg matching `open' (if successful) or `failed' (on error).
+
+Args are NAME BUFFER HOST SERVICE SENTINEL FILTER.
+NAME, BUFFER, HOST, and SERVICE are as for `open-network-stream'.
+Optional args, SENTINEL and FILTER specifies the sentinel and filter
+functions to be used for this network stream."
+ (if (featurep 'make-network-process '(:nowait t))
+ (make-network-process :name name :buffer buffer :nowait t
+ :host host :service service
+ :filter filter :sentinel sentinel)))
+
+(defun open-network-stream-server (name buffer service &optional sentinel filter)
+ "Create a network server process for a TCP service.
+It returns nil if server processes are not supported; otherwise,
+it returns a subprocess-object to represent the server.
+
+When a client connects to the specified service, a new subprocess
+is created to handle the new connection, and the sentinel function
+is called for the new process.
+
+Args are NAME BUFFER SERVICE SENTINEL FILTER.
+NAME is name for the server process. Client processes are named by
+appending the ip-address and port number of the client to NAME.
+BUFFER is the buffer (or buffer-name) to associate with the server
+process. Client processes will not get a buffer if a process filter
+is specified or BUFFER is nil; otherwise, a new buffer is created for
+the client process. The name is similar to the process name.
+Third arg SERVICE is name of the service desired, or an integer
+specifying a port number to connect to. It may also be t to selected
+an unused port number for the server.
+Optional args, SENTINEL and FILTER specifies the sentinel and filter
+functions to be used for the client processes; the server process
+does not use these function."
+ (if (featurep 'make-network-process '(:server t))
+ (make-network-process :name name :buffer buffer
+ :service service :server t :noquery t)))
+
+)) ;; (featurep 'make-network-process)
+
+
+;; compatibility
+
+(defun process-kill-without-query (process &optional flag)
+ "Say no query needed if PROCESS is running when Emacs is exited.
+Optional second argument if non-nil says to require a query.
+Value is t if a query was formerly required.
+New code should not use this function; use `process-query-on-exit-flag'
+or `set-process-query-on-exit-flag' instead."
+ (let ((old (process-query-on-exit-flag process)))
+ (set-process-query-on-exit-flag process nil)
+ old))
+
+;;; 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.
+
+;(defun minibuffer-prompt-modification (start end)
+; (error "You cannot modify the prompt"))
+;
+;
+;(defun minibuffer-prompt-insertion (start end)
+; (let ((inhibit-modification-hooks t))
+; (delete-region start end)
+; ;; Discard undo information for the text insertion itself
+; ;; and for the text deletion.above.
+; (when (consp buffer-undo-list)
+; (setq buffer-undo-list (cddr buffer-undo-list)))
+; (message "You cannot modify the prompt")))
+;
+;
+;(setq minibuffer-prompt-properties
+; (list 'modification-hooks '(minibuffer-prompt-modification)
+; 'insert-in-front-hooks '(minibuffer-prompt-insertion)))
+;
+
;;; simple.el ends here