;;; simple.el --- basic editing commands for Emacs
-;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 1998
+;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99, 2000
;; 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))
+\f
+;; 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'.
;; 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)))
(if (and (listp sticky) (not (memq 'hard sticky)))
(put-text-property from (point) 'rear-nonsticky
(cons 'hard sticky)))))
-
+\f
(defun open-line (arg)
"Insert a newline and leave point before it.
If there is a fill prefix and/or a left-margin, insert them on the new line
(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.
(delete-region (point) (+ (point) (length fill-prefix))))
(fixup-whitespace))))
-(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))))
-
+(defalias 'join-line #'delete-indentation) ; easier to find
+\f
(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 newline-and-indent ()
"Insert a newline, then indent according to major mode.
Indentation is done using the value of `indent-line-function'.
(indent-according-to-mode))
(newline)
(indent-according-to-mode))
+\f
+(defun quoted-insert (arg)
+ "Read next input character and insert it.
+This is useful for inserting control characters.
-;; 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)))
+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.
-;; 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))))
+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.
-(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 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)))))
+\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-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))
+(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 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 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 ()
+ "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))))
+\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-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."
(interactive "r")
(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,
(1+ done)
done)))
(- (buffer-size) (forward-line (buffer-size)))))))
-
+\f
(defun what-cursor-position (&optional detail)
"Print info on cursor position (on screen and within buffer).
-With prefix argument, print detailed info of a character on cursor position.
+Also describe the character after point, and give its character code
+in octal, decimal and hex.
-For the detailed information, Emacs internal character code, Emacs
-internal character components (the character set name and position
-code(s)), and the corresponding external character components (the
-external character set name and external character code(s)) are shown
-in this order.
+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))
- (if detail
- (let* ((internal (split-char char))
- (charset (char-charset char))
- (slot (assq charset charset-origin-alist))
- external)
- (if slot
- (setq external (list (nth 1 slot) (funcall (nth 2 slot) char)))
- (if (eq charset 'composition)
- (setq internal '("composite-character"))
- (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 (0%o, %d, 0x%x) %s %s"
- (if (< char 256)
- (single-key-description char)
- (char-to-string char))
- char char char (or internal "") (or external "")))
+ (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 about CHAR.
+ (describe-char-after (point)))
(if (or (/= beg 1) (/= end (1+ total)))
- (message "Char: %s (0%o, %d, 0x%x) point=%d of %d(%d%%) <%d - %d> column %d %s"
+ (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))
- char char char pos total percent beg end col hscroll)
- (message "Char: %s (0%o, %d, 0x%x) point=%d of %d(%d%%) column %d %s"
+ (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)
- (char-to-string char))
- char char char 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))
-
+ (buffer-substring-no-properties (point) (1+ (point))))
+ encoding-msg pos total percent col hscroll))))))
+\f
(defvar read-expression-map (cons 'keymap minibuffer-local-map)
"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'."
+ :group 'lisp
+ :type 'integer
+ :version "21.1")
+
+(defcustom eval-expression-print-length 12
+ "*Value to use for `print-length' when printing value in `eval-expression'."
+ :group 'lisp
+ :type '(choice (const 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
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.
(prefix-numeric-value current-prefix-arg))))
(if (and (zerop minibuffer-history-position)
(null minibuffer-text-before-history))
- (setq minibuffer-text-before-history (buffer-string)))
+ (setq minibuffer-text-before-history (field-string (point-max))))
(let ((history (symbol-value minibuffer-history-variable))
(case-fold-search
(if (isearch-no-upper-case-p regexp t) ; assume isearch.el is dumped
(nth (1- pos) history)))
(setq n (+ n (if (< n 0) 1 -1)))))
(setq minibuffer-history-position pos)
- (erase-buffer)
+ (goto-char (point-max))
+ (delete-field)
(let ((elt (nth (1- pos) history)))
(insert (if (eq minibuffer-history-sexp-flag (minibuffer-depth))
(let ((print-level nil))
(prin1-to-string elt))
elt)))
- (goto-char (point-min)))
+ (goto-char (field-beginning)))
(if (or (eq (car (car command-history)) 'previous-matching-history-element)
(eq (car (car command-history)) 'next-matching-history-element))
(setq command-history (cdr command-history))))
(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 (field-string (point-max))))
(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)
+ (goto-char (point-max))
+ (delete-field)
(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 (field-beginning)))))
(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 (field-beginning) (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)))))
+;; These two functions are for compatibility with the old subrs of the
+;; same name.
+
+(defun minibuffer-prompt-width ()
+ "Return the display width of the minibuffer prompt.
+Return 0 if current buffer is not a mini-buffer."
+ ;; Return the width of everything before the field at the end of
+ ;; the buffer; this should be 0 for normal buffers.
+ (1- (field-beginning (point-max))))
+
+(defun minibuffer-prompt-end ()
+ "Return the buffer position of the end of the minibuffer prompt.
+Return 0 if current buffer is not a mini-buffer."
+ (field-beginning (point-max)))
+
+\f
;Put this on C-x u, so we can force that rather than C-_ into startup msg
(defalias 'advertised-undo 'undo)
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 ((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.
If COMMAND ends in ampersand, execute it asynchronously.
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 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)))))
+ (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)))))
;; 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)
- ))))))
+ (shell-command-on-region (point) (point) command
+ output-buffer nil error-buffer)))))))
\f
;; 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))))
error-buffer)
"Execute string COMMAND in inferior shell with region as input.
Normally display output (if any) in temp buffer `*Shell Command Output*';
-Prefix arg means replace the region with it.
+Prefix arg means replace the region with it. Return the exit code of
+COMMAND.
To specify a coding system for converting non-ASCII characters
in the input and output to the shell command, use \\[universal-coding-system-argument]
If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
or buffer name to which to direct the command's standard error output.
-If it is nil, error output is mingled with regular output."
+If it is nil, error output is mingled with regular output.
+In an interactive call, the variable `shell-command-default-error-buffer'
+specifies the value of ERROR-BUFFER."
(interactive (let ((string
;; Do this before calling region-beginning
;; and region-end, in case subprocess output
(list (region-beginning) (region-end)
string
current-prefix-arg
- current-prefix-arg)))
+ current-prefix-arg
+ shell-command-default-error-buffer)))
(let ((error-file
- (if error-buffer
- (concat (file-name-directory temp-file-name-pattern)
- (make-temp-name "scor"))
- nil)))
- (if (or replace
- (and output-buffer
- (not (or (bufferp output-buffer) (stringp output-buffer))))
- (equal (buffer-name (current-buffer)) "*Shell Command Output*"))
- ;; 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))
- (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)))
- ;; Don't muck with mark unless REPLACE says we should.
- (and replace swap (exchange-point-and-mark)))
- ;; No prefix argument: put the output in a temp buffer,
- ;; replacing its entire contents.
- (let ((buffer (get-buffer-create
- (or output-buffer "*Shell Command Output*")))
- (success nil)
- (exit-status nil))
- (unwind-protect
- (if (eq buffer (current-buffer))
- ;; If the input is the same buffer as the output,
- ;; delete everything but the specified region,
- ;; then replace that region with the output.
- (progn (setq buffer-read-only nil)
- (delete-region (max start end) (point-max))
- (delete-region (point-min) (min start end))
- (setq exit-status
- (call-process-region (point-min) (point-max)
- shell-file-name t
- (if error-file
- (list t error-file)
- t)
- nil shell-command-switch command))
- (setq success t))
- ;; Clear the output buffer, then run the command with output there.
- (save-excursion
- (set-buffer buffer)
- (setq buffer-read-only nil)
- (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 t))
- ;; 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
+ (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)))))
+ ;; 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))
+ (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)))
+ ;; Don't muck with mark unless REPLACE says we should.
+ (and replace swap (exchange-point-and-mark)))
+ ;; No prefix argument: put the output in a temp buffer,
+ ;; replacing its entire contents.
+ (let ((buffer (get-buffer-create
+ (or output-buffer "*Shell Command Output*")))
+ (success nil))
+ (unwind-protect
+ (if (eq buffer (current-buffer))
+ ;; If the input is the same buffer as the output,
+ ;; delete everything but the specified region,
+ ;; then replace that region with the output.
+ (progn (setq buffer-read-only nil)
+ (delete-region (max start end) (point-max))
+ (delete-region (point-min) (min start end))
+ (setq exit-status
+ (call-process-region (point-min) (point-max)
+ shell-file-name t
+ (if error-file
+ (list t error-file)
+ t)
+ nil shell-command-switch
+ command)))
+ ;; Clear the output buffer, then run the command with
+ ;; output there.
+ (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 (and exit-status (equal 0 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 (and error-file
+ (< 0 (nth 7 (file-attributes error-file))))
+ (message "(Shell command %sed with some error output)"
+ (if (equal 0 exit-status)
+ "succeed"
+ "fail"))
(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)))))
-
+ (if (equal 0 exit-status)
+ "succeed"
+ "fail")))
+ (kill-buffer buffer))
+ ((= 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)))))))
+ (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))))
((eq arg '-)
;; Treat -0 as just -, so that -01 will work.
(setq prefix-arg (if (zerop digit) '- (- digit))))
- (t
- (setq prefix-arg digit))))
- (setq universal-argument-num-events (length (this-command-keys)))
- (setq overriding-terminal-local-map universal-argument-map))
-
-;; For backward compatibility, minus with no modifiers is an ordinary
-;; command if digits have already been entered.
-(defun universal-argument-minus (arg)
- (interactive "P")
- (if (integerp arg)
- (universal-argument-other-key arg)
- (negative-argument arg)))
-
-;; Anything else terminates the argument and is left in the queue to be
-;; executed as a command.
-(defun universal-argument-other-key (arg)
- (interactive "P")
- (setq prefix-arg arg)
- (let* ((key (this-command-keys))
- (keylist (listify-key-sequence key)))
- (setq unread-command-events
- (append (nthcdr universal-argument-num-events keylist)
- unread-command-events)))
- (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)))
+ (t
+ (setq prefix-arg digit))))
+ (setq universal-argument-num-events (length (this-command-keys)))
+ (setq overriding-terminal-local-map universal-argument-map))
+
+;; For backward compatibility, minus with no modifiers is an ordinary
+;; command if digits have already been entered.
+(defun universal-argument-minus (arg)
+ (interactive "P")
+ (if (integerp arg)
+ (universal-argument-other-key arg)
+ (negative-argument arg)))
+
+;; Anything else terminates the argument and is left in the queue to be
+;; executed as a command.
+(defun universal-argument-other-key (arg)
+ (interactive "P")
+ (setq prefix-arg arg)
+ (let* ((key (this-command-keys))
+ (keylist (listify-key-sequence key)))
+ (setq unread-command-events
+ (append (nthcdr universal-argument-num-events keylist)
+ unread-command-events)))
+ (reset-this-command-lengths)
+ (setq overriding-terminal-local-map nil))
\f
;;;; Window system cut and paste hooks.
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
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)
(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)))
+\f
+;; Yanking.
(defun yank-pop (arg)
"Replace just-yanked stretch of killed text with a different stretch.
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))
+ :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))))
+\f
+;; 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.
+
+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
(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)))))
((beginning-of-buffer end-of-buffer) (ding)))
(line-move (- arg)))
nil)
-
+\f
(defcustom track-eol nil
"*Non-nil means vertical motion starting at end of line keeps to ends of lines.
This means moving to the end of each line moved onto.
;; with intangibility and point-motion hooks enabled this time.
(goto-char opoint)
(setq inhibit-point-motion-hooks nil)
- (goto-char new)
+ (goto-char (constrain-to-field new opoint nil t
+ 'inhibit-line-move-field-capture))
;; If intangibility processing moved us to a different line,
;; readjust the horizontal position within the line we ended up at.
(when (or (< (point) line-beg) (> (point) line-end))
(setq new (point)))
(goto-char (point-min))
(setq inhibit-point-motion-hooks nil)
- (goto-char new)
+ (goto-char (constrain-to-field new opoint nil t
+ 'inhibit-line-move-field-capture))
)))
nil)
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.
(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 (start1 end1 start2 end2)
+ (let (transpose-subr-start1
+ transpose-subr-end1
+ transpose-subr-start2
+ transpose-subr-end2)
(if (= arg 0)
(progn
(save-excursion
(funcall mover 1)
- (setq end2 (point))
+ (setq transpose-subr-end2 (point))
(funcall mover -1)
- (setq start2 (point))
+ (setq transpose-subr-start2 (point))
(goto-char (mark))
(funcall mover 1)
- (setq end1 (point))
+ (setq transpose-subr-end1 (point))
(funcall mover -1)
- (setq start1 (point))
+ (setq transpose-subr-start1 (point))
(transpose-subr-1))
(exchange-point-and-mark))
(if (> arg 0)
(progn
(funcall mover -1)
- (setq start1 (point))
+ (setq transpose-subr-start1 (point))
(funcall mover 1)
- (setq end1 (point))
+ (setq transpose-subr-end1 (point))
(funcall mover arg)
- (setq end2 (point))
+ (setq transpose-subr-end2 (point))
(funcall mover (- arg))
- (setq start2 (point))
+ (setq transpose-subr-start2 (point))
(transpose-subr-1)
- (goto-char end2))
+ (goto-char transpose-subr-end2))
(funcall mover -1)
- (setq start2 (point))
+ (setq transpose-subr-start2 (point))
(funcall mover 1)
- (setq end2 (point))
+ (setq transpose-subr-end2 (point))
(funcall mover (1- arg))
- (setq start1 (point))
+ (setq transpose-subr-start1 (point))
(funcall mover (- arg))
- (setq end1 (point))
+ (setq transpose-subr-end1 (point))
(transpose-subr-1)))))
(defun transpose-subr-1 ()
- (if (> (min end1 end2) (max start1 start2))
+ (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 start1 end1))
+ (let* ((word1 (buffer-substring transpose-subr-start1 transpose-subr-end1))
(len1 (length word1))
- (word2 (buffer-substring start2 end2))
+ (word2 (buffer-substring transpose-subr-start2 transpose-subr-end2))
(len2 (length word2)))
- (delete-region start2 end2)
- (goto-char start2)
+ (delete-region transpose-subr-start2 transpose-subr-end2)
+ (goto-char transpose-subr-start2)
(insert word1)
- (goto-char (if (< start1 start2) start1
- (+ start1 (- len1 len2))))
+ (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)))
- (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)
- (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)
- 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))))
- (when comment-padding
- (setq cs (concat cs (make-string comment-padding ? ))))
- ;; Loop over all lines from BEG to END.
- (narrow-to-region beg end)
- (goto-char beg)
- (while (not (eobp))
- (if (or (eq numarg t) (< numarg 0))
- (progn
- ;; Delete comment start from beginning of line.
- (if (eq numarg t)
- (while (looking-at (regexp-quote cs))
- (delete-char (length cs)))
- (let ((count numarg))
- (while (and (> 1 (setq count (1+ count)))
- (looking-at (regexp-quote cs)))
- (delete-char (length cs)))))
- ;; 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))
- ;; 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)))))))
\f
(defun backward-word (arg)
"Move backward until encountering the end of a word.
(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))))
(funcall comment-line-break-function t)))
;; Now do justification, if required
(if (not (eq justify 'left))
- (save-excursion
+ (save-excursion
(end-of-line 0)
(justify-current-line justify nil t)))
;; If making the new line didn't reduce the hpos of
(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.
"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)
"Set `fill-column' to specified argument.
Use \\[universal-argument] followed by a number to specify a column.
(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,
"Toggle Line Number mode.
With arg, turn Line Number mode on iff arg is positive.
When Line Number mode is enabled, the line number appears
-in the mode line."
+in the mode line.
+
+Line numbers do not appear for very large buffers, see variable
+`line-number-display-limit'."
(interactive "P")
(setq line-number-mode
(if (null arg) (not line-number-mode)
(bury-buffer))))
(define-key global-map "\e\e\e" 'keyboard-escape-quit)
+
+(defcustom input-mode-8-bit t
+ "Control acceptance of 8-bit keyboard input.
+This may be useful for inputting non-ASCII characters if your keyboard
+can generate them. It is not necessary to change this under a window
+system which can distinguish 8-bit characters and Meta keys.
+Setting this variable directly does not take effect;
+use either M-x customize or the function `set-input-mode'."
+ :set (lambda (symbol value)
+ (let ((mode (current-input-mode)))
+ (set-input-mode (nth 0 mode) (nth 1 mode) value)))
+ :initialize 'custom-initialize-default
+ :type '(choice (const :tag "8-bit input for a Meta key" t)
+ (const :tag "Direct 8-bit character input" 0)
+ (const :tag "Assume top bit is parity and ignore" nil))
+ :version "21.1"
+ :link '(custom-manual "Single-Byte European Support")
+ :group 'keyboard)
\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.
+
+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)
(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
(require 'wid-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
;; 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)))
+ (file-directory-p (field-string (point-max))))
(select-window (active-minibuffer-window))
(exit-minibuffer))))))
(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
(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))
+ (old-kwoq (process-kill-without-query process nil))
+ (new-process
+ (if (memq (process-status process) '(open))
+ (apply 'open-network-stream newname
+ (if (process-buffer process) (current-buffer))
+ (process-contact process))
+ (apply 'start-process newname
+ (if (process-buffer process) (current-buffer))
+ (process-command process)))))
+ (process-kill-without-query new-process old-kwoq)
+ (process-kill-without-query process old-kwoq)
+ (set-process-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 (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 (list (if current-prefix-arg
+ (read-string "BName of indirect buffer: "))
+ t))
+ (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))
+ 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)
+
+\f
+;;; Syntax stuff.
+
+(defconst syntax-code-table
+ '((?\ 0 "whitespace")
+ (?- 0 "whitespace")
+ (?. 1 "punctuation")
+ (?w 2 "word")
+ (?_ 3 "symbol")
+ (?\( 4 "open parenthesis")
+ (?\) 5 "close parenthesis")
+ (?\' 6 "expression prefix")
+ (?\" 7 "string quote")
+ (?$ 8 "paired delimiter")
+ (?\\ 9 "escape")
+ (?/ 10 "character quote")
+ (?< 11 "comment start")
+ (?> 12 "comment end")
+ (?@ 13 "inherit")
+ (nil 14 "comment fence")
+ (nil 15 "string fence"))
+ "Alist of forms (CHAR CODE DESCRIPTION) mapping characters to syntax info.
+CHAR is a character that is allowed as first char in the string
+specifying the syntax when calling `modify-syntax-entry'. CODE is the
+corresponing syntax code as it is stored in a syntax cell, and
+can be used as value of a `syntax-table' property.
+DESCRIPTION is the descriptive string for the syntax.")
+
+(defconst syntax-flag-table
+ '((?1 . #b10000000000000000)
+ (?2 . #b100000000000000000)
+ (?3 . #b1000000000000000000)
+ (?4 . #b10000000000000000000)
+ (?p . #b100000000000000000000)
+ (?b . #b1000000000000000000000)
+ (?n . #b10000000000000000000000))
+ "Alist of pairs (CHAR . FLAG) mapping characters to syntax flags.
+CHAR is a character that is allowed as second or following character
+in the string argument to `modify-syntax-entry' specifying the syntax.
+FLAG is the corresponding syntax flag value that is stored in a
+syntax table.")
+
+(defun string-to-syntax (string)
+ "Convert a syntax specification STRING into syntax cell form.
+STRING should be a string as it is allowed as argument of
+`modify-syntax-entry'. Value is the equivalent cons cell
+\(CODE . MATCHING-CHAR) that can be used as value of a `syntax-table'
+text property."
+ (let* ((first-char (aref string 0))
+ (code (or (nth 1 (assq first-char syntax-code-table))
+ (error "Invalid syntax specification `%s'" string)))
+ (length (length string))
+ (i 1)
+ matching-char)
+ ;; Determine the matching character, if any.
+ (when (and (> length 1)
+ (memq first-char '(?\( ?\))))
+ (setq matching-char (aref string i)
+ i (1+ i)))
+ ;; Add any flags to the syntax code.
+ (while (< i length)
+ (let ((flag (or (assq (aref string i) syntax-flag-table)
+ (error "Invalid syntax flag in `%s'" string))))
+ (setq code (logior flag code))
+ (setq i (1+ i))))
+
+ (cons code matching-char)))
+
;;; simple.el ends here
HCoop / bpt / emacs.git / blobdiff