;;; simple.el --- basic editing commands for Emacs
-;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 1997
+;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 1999
;; Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
(not before-change-functions)
;; Make sure there are no markers here.
(not (buffer-has-markers-at (1- (point))))
+ (not (buffer-has-markers-at (point)))
;; Make sure no text properties want to know
;; where the change was.
(not (get-char-property (1- (point)) 'modification-hooks))
(self-insert-command (prefix-numeric-value arg))
;; If we get an error in self-insert-command, put point at right place.
(if flag (forward-char 1))))
- ;; If we did *not* get an error, cancel that forward-char.
- (if flag (backward-char 1))
+ ;; Even if we did *not* get an error, keep that forward-char;
+ ;; all further processing should apply to the newline that the user
+ ;; thinks he inserted.
+
;; Mark the newline(s) `hard'.
(if use-hard-newlines
- (set-hard-newline-properties
+ (set-hard-newline-properties
(- (point) (if arg (prefix-numeric-value arg) 1)) (point)))
;; If the newline leaves the previous line blank,
;; and we have a left margin, delete that from the blank line.
(and (looking-at "[ \t]$")
(> (current-left-margin) 0)
(delete-region (point) (progn (end-of-line) (point))))))
- (if flag (forward-char 1))
;; Indent the line after the newline, except in one case:
;; when we added the newline at the beginning of a line
;; which starts a page.
(eq overwrite-mode 'overwrite-mode-binary))
(read-quoted-char)
(read-char))))
- ;; Assume character codes 0200 - 0377 stand for
- ;; European characters in Latin-1, and convert them
- ;; to Emacs characters.
- (and enable-multibyte-characters
- (>= char ?\200)
- (<= char ?\377)
- (setq char (+ nonascii-insert-offset 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)))
(delete-region (point) (+ (point) (length fill-prefix))))
(fixup-whitespace))))
+(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."
(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.
+ nil -- just delete one character."
+ :type '(choice (const untabify) (const hungry) (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")
- (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 arg killp))
+ (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 zap-to-char (arg char)
"Kill up to and including ARG'th occurrence of CHAR.
(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 a non-ASCII multibyte character,
+also give its encoding in the buffer's selected coding system,
+if any.
+
+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.
+
+Each language environment may show different external character components."
(interactive "P")
(let* ((char (following-char))
(beg (point-min))
pos total percent beg end col hscroll)
(message "point=%d of %d(%d%%) column %d %s"
pos total percent col hscroll))
- (let ((str (if detail (format " %s" (split-char char)) "")))
- (if (or (/= beg 1) (/= end (1+ total)))
- (message "Char: %s (0%o, %d, 0x%x) %s point=%d of %d(%d%%) <%d - %d> column %d %s"
+ (let* ((coding-system buffer-file-coding-system)
+ (encoding
+ (encode-coding-string (char-to-string char) coding-system t))
+ (encoding-string-hex
+ (mapconcat (lambda (ch) (format "0x%x" ch)) encoding " "))
+ (encoding-msg
+ (if (and coding-system
+ (not (and (= (length encoding) 1)
+ (= (aref encoding 0) char))))
+ (format "(0%o, %d, 0x%x, ext %s)"
+ char char char
+ encoding-string-hex)
+ (format "(0%o, %d, 0x%x)"
+ char char char))))
+ (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 %s %s %s"
+ (if (< char 256)
+ (single-key-description char)
+ (char-to-string char))
+ encoding-msg (or 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"
(if (< char 256)
(single-key-description char)
(char-to-string char))
- char char char str pos total percent beg end col hscroll)
- (message "Char: %s (0%o, %d, 0x%x)%s point=%d of %d(%d%%) column %d %s"
- (if (< char 256)
- (single-key-description char)
- (char-to-string char))
- char char char str pos total percent col hscroll))))))
+ encoding-msg pos total percent col hscroll)))))))
(defun fundamental-mode ()
"Major mode not specialized for anything in particular.
(defun minibuffer-history-initialize ()
(setq minibuffer-text-before-history nil))
+(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-matching-history-element] and \\[next-matching-history-element]\
+ commands ignore case when searching it, regardless of `case-fold-search'."
+ :type '(repeat variable)
+ :group 'minibuffer)
+
(defun previous-matching-history-element (regexp n)
"Find the previous history element that matches REGEXP.
\(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."
+An uppercase letter in REGEXP makes the search case-sensitive.
+See also `minibuffer-history-case-insensitive-variables'."
(interactive
(let* ((enable-recursive-minibuffers t)
(regexp (read-from-minibuffer "Previous element matching (regexp): "
(let ((history (symbol-value minibuffer-history-variable))
(case-fold-search
(if (isearch-no-upper-case-p regexp t) ; assume isearch.el is dumped
- ;; Respect the user's setting for case-fold-search:
- case-fold-search
+ ;; 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))
(null minibuffer-text-before-history))
(setq minibuffer-text-before-history (buffer-string)))
(if (< narg minimum)
- (error "End of history; no next item"))
+ (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)
(defun undo (&optional arg)
"Undo some previous changes.
Repeat this command to undo more changes.
-A numeric argument serves as a repeat count."
- (interactive "*p")
+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."
+ (interactive "*P")
;; If we don't get all the way thru, make last-command indicate that
;; for the following command.
(setq this-command t)
(or (eq (selected-window) (minibuffer-window))
(message "Undo!"))
(or (eq last-command 'undo)
- (progn (undo-start)
+ (progn (if (or arg (and transient-mark-mode mark-active))
+ (undo-start (region-beginning) (region-end))
+ (undo-start))
(undo-more 1)))
- (undo-more (or arg 1))
+ (undo-more (if 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)
(defvar pending-undo-list nil
"Within a run of consecutive undo commands, list remaining to be undone.")
-(defun undo-start ()
- "Set `pending-undo-list' to the front of the undo list.
-The next call to `undo-more' will undo the most recently made change."
- (if (eq buffer-undo-list t)
- (error "No undo information in this buffer"))
- (setq pending-undo-list buffer-undo-list))
+(defvar undo-in-progress nil
+ "Non-nil while performing an undo.
+Some change-hooks test this variable to do something different.")
(defun undo-more (count)
"Undo back N undo-boundaries beyond what was already undone recently.
then call `undo-more' one or more times to undo them."
(or pending-undo-list
(error "No further undo information"))
- (setq pending-undo-list (primitive-undo count pending-undo-list)))
+ (let ((undo-in-progress t))
+ (setq pending-undo-list (primitive-undo count pending-undo-list))))
+
+;; Deep copy of a list
+(defun undo-copy-list (list)
+ "Make a copy of undo list LIST."
+ (mapcar 'undo-copy-list-1 list))
+(defun undo-copy-list-1 (elt)
+ (if (consp elt)
+ (cons (car elt) (undo-copy-list-1 (cdr elt)))
+ elt))
+
+(defun undo-start (&optional beg end)
+ "Set `pending-undo-list' to the front of the undo list.
+The next call to `undo-more' will undo the most recently made change.
+If BEG and END are specified, then only undo elements
+that apply to text between BEG and END are used; other undo elements
+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
+ (if (and beg end (not (= beg end)))
+ (undo-make-selective-list (min beg end) (max beg end))
+ buffer-undo-list)))
+
+(defvar undo-adjusted-markers)
+
+(defun undo-make-selective-list (start end)
+ "Return a list of undo elements for the region START to END.
+The elements come from `buffer-undo-list', but we keep only
+the elements inside this region, and discard those outside this region.
+If we find an element that crosses an edge of this region,
+we stop and ignore all further elements."
+ (let ((undo-list-copy (undo-copy-list buffer-undo-list))
+ (undo-list (list nil))
+ undo-adjusted-markers
+ some-rejected
+ undo-elt undo-elt temp-undo-list delta)
+ (while undo-list-copy
+ (setq undo-elt (car undo-list-copy))
+ (let ((keep-this
+ (cond ((and (consp undo-elt) (eq (car undo-elt) t))
+ ;; This is a "was unmodified" element.
+ ;; Keep it if we have kept everything thus far.
+ (not some-rejected))
+ (t
+ (undo-elt-in-region undo-elt start end)))))
+ (if keep-this
+ (progn
+ (setq end (+ end (cdr (undo-delta undo-elt))))
+ ;; Don't put two nils together in the list
+ (if (not (and (eq (car undo-list) nil)
+ (eq undo-elt nil)))
+ (setq undo-list (cons undo-elt undo-list))))
+ (if (undo-elt-crosses-region undo-elt start end)
+ (setq undo-list-copy nil)
+ (setq some-rejected t)
+ (setq temp-undo-list (cdr undo-list-copy))
+ (setq delta (undo-delta undo-elt))
+
+ (when (/= (cdr delta) 0)
+ (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
+
+ (while temp-undo-list
+ (setq undo-elt (car temp-undo-list))
+ (cond ((integerp undo-elt)
+ (if (>= undo-elt position)
+ (setcar temp-undo-list (- undo-elt offset))))
+ ((atom undo-elt) nil)
+ ((stringp (car undo-elt))
+ ;; (TEXT . POSITION)
+ (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)
+ (- text-pos offset))))))
+ ((integerp (car undo-elt))
+ ;; (BEGIN . END)
+ (when (>= (car undo-elt) position)
+ (setcar undo-elt (- (car undo-elt) offset))
+ (setcdr undo-elt (- (cdr undo-elt) offset))))
+ ((null (car undo-elt))
+ ;; (nil PROPERTY VALUE BEG . END)
+ (let ((tail (nthcdr 3 undo-elt)))
+ (when (>= (car tail) position)
+ (setcar tail (- (car tail) offset))
+ (setcdr tail (- (cdr tail) offset))))))
+ (setq temp-undo-list (cdr temp-undo-list))))))))
+ (setq undo-list-copy (cdr undo-list-copy)))
+ (nreverse undo-list)))
+
+(defun undo-elt-in-region (undo-elt start end)
+ "Determine whether UNDO-ELT falls inside the region START ... END.
+If it crosses the edge, we return nil."
+ (cond ((integerp undo-elt)
+ (and (>= undo-elt start)
+ (< undo-elt end)))
+ ((eq undo-elt nil)
+ t)
+ ((atom undo-elt)
+ nil)
+ ((stringp (car undo-elt))
+ ;; (TEXT . POSITION)
+ (and (>= (abs (cdr undo-elt)) start)
+ (< (abs (cdr undo-elt)) end)))
+ ((and (consp undo-elt) (markerp (car undo-elt)))
+ ;; This is a marker-adjustment element (MARKER . ADJUSTMENT).
+ ;; See if MARKER is inside the region.
+ (let ((alist-elt (assq (car undo-elt) undo-adjusted-markers)))
+ (unless alist-elt
+ (setq alist-elt (cons (car undo-elt)
+ (marker-position (car undo-elt))))
+ (setq undo-adjusted-markers
+ (cons alist-elt undo-adjusted-markers)))
+ (and (cdr alist-elt)
+ (>= (cdr alist-elt) start)
+ (< (cdr alist-elt) end))))
+ ((null (car undo-elt))
+ ;; (nil PROPERTY VALUE BEG . END)
+ (let ((tail (nthcdr 3 undo-elt)))
+ (and (>= (car tail) start)
+ (< (cdr tail) end))))
+ ((integerp (car undo-elt))
+ ;; (BEGIN . END)
+ (and (>= (car undo-elt) start)
+ (< (cdr undo-elt) end)))))
+
+(defun undo-elt-crosses-region (undo-elt start end)
+ "Test whether UNDO-ELT crosses one edge of that region START ... END.
+This assumes we have already decided that UNDO-ELT
+is not *inside* the region START...END."
+ (cond ((atom undo-elt) nil)
+ ((null (car undo-elt))
+ ;; (nil PROPERTY VALUE BEG . END)
+ (let ((tail (nthcdr 3 undo-elt)))
+ (not (or (< (car tail) end)
+ (> (cdr tail) start)))))
+ ((integerp (car undo-elt))
+ ;; (BEGIN . END)
+ (not (or (< (car undo-elt) end)
+ (> (cdr undo-elt) start))))))
+
+;; Return the first affected buffer position and the delta for an undo element
+;; delta is defined as the change in subsequent buffer positions if we *did*
+;; the undo.
+(defun undo-delta (undo-elt)
+ (if (consp undo-elt)
+ (cond ((stringp (car undo-elt))
+ ;; (TEXT . POSITION)
+ (cons (abs (cdr undo-elt)) (length (car undo-elt))))
+ ((integerp (car undo-elt))
+ ;; (BEGIN . END)
+ (cons (car undo-elt) (- (car undo-elt) (cdr undo-elt))))
+ (t
+ '(0 . 0)))
+ '(0 . 0)))
+\f
(defvar shell-command-history nil
"History list for some commands that read shell commands.")
))
(shell-command-on-region (point) (point) command output-buffer)
))))))
-
+\f
;; We have a sentinel to prevent insertion of a termination message
;; in the buffer itself.
(defun shell-command-sentinel (process signal)
(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)
"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]
`buffer-file-coding-system'. If the output is going to replace the region,
then it is decoded from that same coding system.
-The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER, REPLACE,
-ERROR-BUFFER. If REPLACE is non-nil, that means insert the output
-in place of text from START to END, putting point and mark around it.
-Noninteractive callers can specify coding systems by binding
-`coding-system-for-read' and `coding-system-for-write'.
+The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER,
+REPLACE, ERROR-BUFFER. Noninteractive callers can specify coding
+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*'
insert output in the current buffer.
In either case, the output is inserted after point (leaving mark after it).
-If optional fifth argument ERROR-BUFFER is non-nil, it is a buffer
+If REPLACE, the optional fifth argument, is non-nil, that means insert
+the output in place of text from START to END, putting point and mark
+around it.
+
+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-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
(list (region-beginning) (region-end)
string
current-prefix-arg
- current-prefix-arg)))
+ current-prefix-arg
+ shell-command-on-region-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))
- (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))
- (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))
- (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
- (message "(Shell command completed with no output)"))
- (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)))))
+ 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*"))
+ ;; 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.
+ (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 (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)))
+ exit-status))
(defun shell-command-to-string (command)
"Execute shell command COMMAND and return its output as a string."
interaction; you may want to use them instead of manipulating the kill
ring directly.")
-(defcustom kill-ring-max 30
+(defcustom kill-ring-max 60
"*Maximum length of kill ring before oldest elements are thrown away."
:type 'integer
:group 'killing)
;; However, there's no harm in putting
;; the region's text in the kill ring, anyway.
(copy-region-as-kill beg end)
- ;; This should always barf, and give us the correct error.
+ ;; Set this-command now, so it will be set even if we get an error.
+ (setq this-command 'kill-region)
+ ;; This should barf, if appropriate, and give us the correct error.
(if kill-read-only-ok
(message "Read only text copied to kill ring")
- (setq this-command 'kill-region)
;; Signal an error if the buffer is read-only.
(barf-if-buffer-read-only)
;; If the buffer isn't read-only, the text is.
(kill-append (buffer-substring beg end) (< end beg))
(kill-new (buffer-substring beg end)))
(if transient-mark-mode
- (setq mark-active nil))
+ (setq deactivate-mark t))
nil)
(defun kill-ring-save (beg end)
(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
(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)
+ (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.
(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
+ (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)
+ (if (string= "" ce)
nil
(if (eq numarg t)
(progn
;; this is questionable if comment-end ends in whitespace
;; that is pretty brain-damaged though
(skip-chars-backward " \t")
- (save-excursion
- (backward-char (length ce))
- (if (looking-at (regexp-quote ce))
- (delete-char (length ce))))))))
- (forward-line 1))
+ (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)))))))
+ (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.
Setting this variable automatically makes it local to the current buffer.")
-;; This function is the auto-fill-function of a buffer
+;; This function is used as the auto-fill-function of a buffer
;; when Auto-Fill mode is enabled.
;; It returns t if it really did any work.
+;; (Actually some major modes use a different auto-fill function,
+;; but this one is the default one.)
(defun do-auto-fill ()
(let (fc justify bol give-up
(fill-prefix fill-prefix))
(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 at. We break the line between word or
+ ;; 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| follwoing a character. If
+ ;; 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,
sentence-end-double-space
(save-excursion (forward-char -1)
(and (looking-at "\\. ")
- (not (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,
(skip-chars-backward " \t")
;; Break the line after/before \c|.
(forward-char 1))))
- (if (and enable-kinsoku enable-multibyte-characters)
- (kinsoku (save-excursion
- (forward-line 0) (point))))
+ (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")
(point)))))
;; See whether the place we found is any good.
(defun set-fill-column (arg)
"Set `fill-column' to specified argument.
+Use \\[universal-argument] followed by a number to specify a column.
Just \\[universal-argument] as argument means to use the current column."
(interactive "P")
(if (consp arg)
"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)
(matching-paren (char-after blinkpos))))))
(if mismatch (setq blinkpos nil))
(if blinkpos
- (progn
+ ;; Don't log messages about paren matching.
+ (let (message-log-max)
(goto-char blinkpos)
(if (pos-visible-in-window-p)
(and blink-matching-paren-on-screen
;; Quitting out of a program does not go through here;
;; that happens in the QUIT macro at the C code level.
(defun keyboard-quit ()
- "Signal a quit condition.
+ "Signal a `quit' condition.
During execution of Lisp code, this character causes a quit directly.
At top-level, as an editor command, this simply beeps."
(interactive)
(put symbol 'hookvar (or hookvar 'mail-send-hook)))
(defun assoc-ignore-case (key alist)
- "Like `assoc', but assumes KEY is a string and ignores case when comparing."
- (setq key (downcase key))
+ "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 (equal key (downcase (car (car alist))))
+ (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))
'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))
+
(defun sendmail-user-agent-compose (&optional to subject other-headers continue
switch-function yank-action
send-actions)
continue
(error "Message aborted"))
(save-excursion
- (goto-char (point-min))
- (search-forward mail-header-separator)
- (beginning-of-line)
+ (rfc822-goto-eoh)
(while other-headers
(if (not (member (car (car other-headers)) '("in-reply-to" "cc")))
(insert (car (car other-headers)) ": "
If VARIABLE has been defined with `defcustom', then the type information
in the definition is used to check that VALUE is valid."
- (interactive (let* ((var (read-variable "Set variable: "))
+ (interactive
+ (let* ((default-var (variable-at-point))
+ (var (if (symbolp default-var)
+ (read-variable (format "Set variable (default %s): " default-var)
+ default-var)
+ (read-variable "Set variable: ")))
(minibuffer-help-form '(describe-variable var))
(prop (get var 'variable-interactive))
(prompt (format "Set %s to value: " var))
(setq completion-base-size nil)
(run-hooks 'completion-list-mode-hook))
-(defvar completion-fixup-function nil
- "A function to customize how completions are identified in completion lists.
-`completion-setup-function' calls this function with no arguments
-each time it has found what it thinks is one completion.
-Point is at the end of the completion in the completion list buffer.
-If this function moves point, it can alter the end of that completion.")
-
(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
"Click \\[mouse-choose-completion] on a completion to select it.\n")))
(insert (substitute-command-keys
"In this buffer, type \\[choose-completion] to \
-select the completion near point.\n\n"))
- (forward-line 1)
- (while (re-search-forward "[^ \t\n]+\\( [^ \t\n]+\\)*" nil t)
- (let ((beg (match-beginning 0))
- (end (point)))
- (if completion-fixup-function
- (funcall completion-fixup-function))
- (put-text-property beg (point) 'mouse-face 'highlight)
- (goto-char end))))))
+select the completion near point.\n\n")))))
(add-hook 'completion-setup-hook 'completion-setup-function)
;; to the following event.
(defun event-apply-alt-modifier (ignore-prompt)
+ "Add the Alt modifier to the following event.
+For example, type \\[event-apply-alt-modifier] & to enter Alt-&."
(vector (event-apply-modifier (read-event) 'alt 22 "A-")))
(defun event-apply-super-modifier (ignore-prompt)
+ "Add the Super modifier to the following event.
+For example, type \\[event-apply-super-modifier] & to enter Super-&."
(vector (event-apply-modifier (read-event) 'super 23 "s-")))
(defun event-apply-hyper-modifier (ignore-prompt)
+ "Add the Hyper modifier to the following event.
+For example, type \\[event-apply-hyper-modifier] & to enter Hyper-&."
(vector (event-apply-modifier (read-event) 'hyper 24 "H-")))
(defun event-apply-shift-modifier (ignore-prompt)
+ "Add the Shift modifier to the following event.
+For example, type \\[event-apply-shift-modifier] & to enter Shift-&."
(vector (event-apply-modifier (read-event) 'shift 25 "S-")))
(defun event-apply-control-modifier (ignore-prompt)
+ "Add the Ctrl modifier to the following event.
+For example, type \\[event-apply-control-modifier] & to enter Ctrl-&."
(vector (event-apply-modifier (read-event) 'control 26 "C-")))
(defun event-apply-meta-modifier (ignore-prompt)
+ "Add the Meta modifier to the following event.
+For example, type \\[event-apply-meta-modifier] & to enter Meta-&."
(vector (event-apply-modifier (read-event) 'meta 27 "M-")))
(defun event-apply-modifier (event symbol lshiftby prefix)