;;; simple.el --- basic editing commands for Emacs
-;; Copyright (C) 1985, 86, 87, 93, 94, 95 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 1997
+;; Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;; Code:
+(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."
+ :prefix "paren-"
+ :prefix "blink-matching-"
+ :group 'matching)
+
+
(defun newline (&optional arg)
"Insert a newline, and move to left margin of the new line if it's blank.
The newline is marked with the text-property `hard'.
With arg, insert that many newlines.
In Auto Fill mode, if no numeric arg, break the preceding line if it's long."
(interactive "*P")
+ (barf-if-buffer-read-only)
;; Inserting a newline at the end of a line produces better redisplay in
;; try_window_id than inserting at the beginning of a line, and the textual
;; result is the same. So, if we're at beginning of line, pretend to be at
;; the end of the previous line.
(let ((flag (and (not (bobp))
(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 (buffer-has-markers-at (1- (point))))
+ ;; Make sure no text properties want to know
+ ;; where the change was.
+ (not (get-char-property (1- (point)) 'modification-hooks))
+ (not (get-char-property (1- (point)) 'insert-behind-hooks))
+ (or (eobp)
+ (not (get-char-property (point) 'insert-in-front-hooks)))
+ ;; Make sure the newline before point isn't intangible.
+ (not (get-char-property (1- (point)) 'intangible))
+ ;; Make sure the newline before point isn't read-only.
+ (not (get-char-property (1- (point)) 'read-only))
+ ;; Make sure the newline before point isn't invisible.
+ (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)
(- (point) 2))))
(was-page-start (and (bolp)
(if flag (backward-char 1))
;; Mark the newline(s) `hard'.
(if use-hard-newlines
- (let* ((from (- (point) (if arg (prefix-numeric-value arg) 1)))
- (sticky (get-text-property from 'rear-nonsticky)))
- (put-text-property from (point) 'hard 't)
- ;; If rear-nonsticky is not "t", add 'hard to rear-nonsticky list
- (if (and (listp sticky) (not (memq 'hard sticky)))
- (put-text-property from (point) 'rear-nonsticky
- (cons 'hard sticky)))))
+ (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.
(or flag
(move-to-left-margin nil t)))
nil)
+(defun set-hard-newline-properties (from to)
+ (let ((sticky (get-text-property from 'rear-nonsticky)))
+ (put-text-property from to 'hard 't)
+ ;; If rear-nonsticky is not "t", add 'hard to rear-nonsticky list
+ (if (and (listp sticky) (not (memq 'hard sticky)))
+ (put-text-property from (point) 'rear-nonsticky
+ (cons 'hard sticky)))))
+
(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)))
+(defcustom quoted-insert-character-offset (- (make-char 'latin-iso8859-1) 128)
+ "*Offset added by \\[quoted-insert] to character codes 0200 and above."
+ :tag 'integer
+ :group 'i18n)
+
(defun quoted-insert (arg)
"Read next input character and insert it.
This is useful for inserting control characters.
(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 (+ quoted-insert-character-offset char)))
(if (> arg 0)
(if (eq overwrite-mode 'overwrite-mode-binary)
(delete-char arg)))
(defun kill-forward-chars (arg)
(if (listp arg) (setq arg (car arg)))
(if (eq arg '-) (setq arg -1))
- (kill-region (point) (+ (point) arg)))
+ (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) (- (point) arg)))
+ (kill-region (point) (forward-point (- arg))))
(defun backward-delete-char-untabify (arg &optional killp)
"Delete characters backward, changing tabs into spaces.
(delete-char 1)))
(forward-char -1)
(setq count (1- count)))))
- (delete-backward-char arg killp)
- ;; In overwrite mode, back over columns while clearing them out,
- ;; unless at end of line.
- (and overwrite-mode (not (eolp))
- (save-excursion (insert-char ?\ arg))))
+ (delete-backward-char arg killp))
(defun zap-to-char (arg char)
"Kill up to and including ARG'th occurrence of CHAR.
(count-lines start end) (- end start)))
(defun what-line ()
- "Print the current line number (in the buffer) of point."
+ "Print the current buffer line number and narrowed line number of point."
(interactive)
- (save-restriction
- (widen)
+ (let ((opoint (point)) start)
(save-excursion
- (beginning-of-line)
- (message "Line %d"
- (1+ (count-lines 1 (point)))))))
+ (save-restriction
+ (goto-char (point-min))
+ (widen)
+ (beginning-of-line)
+ (setq start (point))
+ (goto-char opoint)
+ (beginning-of-line)
+ (if (/= start 1)
+ (message "line %d (narrowed line %d)"
+ (1+ (count-lines 1 (point)))
+ (1+ (count-lines start (point))))
+ (message "Line %d" (1+ (count-lines 1 (point)))))))))
+
(defun count-lines (start end)
"Return number of lines between START and END.
done)))
(- (buffer-size) (forward-line (buffer-size)))))))
-(defun what-cursor-position ()
- "Print info on cursor position (on screen and within buffer)."
- (interactive)
+(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."
+ (interactive "P")
(let* ((char (following-char))
(beg (point-min))
(end (point-max))
pos total percent beg end col hscroll)
(message "point=%d of %d(%d%%) column %d %s"
pos total percent col hscroll))
- (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"
- (single-key-description 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"
- (single-key-description char) char char char 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"
+ (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))))))
(defun fundamental-mode ()
"Major mode not specialized for anything in particular.
"Minibuffer keymap used for reading Lisp expressions.")
(define-key read-expression-map "\M-\t" 'lisp-complete-symbol)
-(put 'eval-expression 'disabled t)
-
(defvar read-expression-history nil)
;; We define this, rather than making `eval' interactive,
;; for the sake of completion of names like eval-region, eval-current-buffer.
-(defun eval-expression (expression)
+(defun eval-expression (eval-expression-arg)
"Evaluate EXPRESSION and print value in minibuffer.
Value is also consed on to front of the variable `values'."
(interactive
(list (read-from-minibuffer "Eval: "
nil read-expression-map t
'read-expression-history)))
- (setq values (cons (eval expression) values))
+ (setq values (cons (eval eval-expression-arg) values))
(prin1 (car values) t))
(defun edit-and-eval-command (prompt command)
read-expression-map t
'(command-history . 1))))
;; If command was added to command-history as a string,
- ;; get rid of that. We want only evallable expressions there.
+ ;; get rid of that. We want only evaluable expressions there.
(if (stringp (car command-history))
(setq command-history (cdr command-history)))
to get different commands to edit and resubmit."
(interactive "p")
(let ((elt (nth (1- arg) command-history))
- (minibuffer-history-position arg)
- (minibuffer-history-sexp-flag t)
newcmd)
(if elt
(progn
(setq newcmd
- (let ((print-level nil))
+ (let ((print-level nil)
+ (minibuffer-history-position arg)
+ (minibuffer-history-sexp-flag t))
(read-from-minibuffer
"Redo: " (prin1-to-string elt) read-expression-map t
(cons 'command-history arg))))
;; If command was added to command-history as a string,
- ;; get rid of that. We want only evallable expressions there.
+ ;; get rid of that. We want only evaluable expressions there.
(if (stringp (car command-history))
(setq command-history (cdr command-history)))
("\er" . previous-matching-history-element)
("\es" . next-matching-history-element)))
+(defvar minibuffer-text-before-history nil
+ "Text that was in this minibuffer before any history commands.
+This is nil if there have not yet been any history commands
+in this use of the minibuffer.")
+
+(add-hook 'minibuffer-setup-hook 'minibuffer-history-initialize)
+
+(defun minibuffer-history-initialize ()
+ (setq minibuffer-text-before-history nil))
+
(defun previous-matching-history-element (regexp n)
"Find the previous history element that matches REGEXP.
\(Previous history elements refer to earlier actions.)
(error "No previous history search regexp"))
regexp)
(prefix-numeric-value current-prefix-arg))))
+ (if (and (zerop minibuffer-history-position)
+ (null minibuffer-text-before-history))
+ (setq minibuffer-text-before-history (buffer-string)))
(let ((history (symbol-value minibuffer-history-variable))
prevpos
(pos minibuffer-history-position))
"Insert the next element of the minibuffer history into the minibuffer."
(interactive "p")
(or (zerop n)
- (let ((narg (min (max 1 (- minibuffer-history-position n))
- (length (symbol-value minibuffer-history-variable)))))
- (if (or (zerop narg)
- (= minibuffer-history-position narg))
- (error (if (if (zerop narg)
- (> n 0)
- (= minibuffer-history-position 1))
- "End of history; no next item"
- "Beginning of history; no preceding item"))
- (erase-buffer)
- (setq minibuffer-history-position narg)
- (let ((elt (nth (1- minibuffer-history-position)
- (symbol-value minibuffer-history-variable))))
- (insert
- (if minibuffer-history-sexp-flag
- (let ((print-level nil))
- (prin1-to-string elt))
- elt)))
- (goto-char (point-min))))))
+ (let ((narg (- minibuffer-history-position n))
+ (minimum (if minibuffer-default -1 0))
+ elt)
+ (if (and (zerop 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 (> narg (length (symbol-value minibuffer-history-variable)))
+ (error "Beginning of history; no preceding item"))
+ (erase-buffer)
+ (setq minibuffer-history-position narg)
+ (cond ((= narg -1)
+ (setq elt minibuffer-default))
+ ((= narg 0)
+ (setq elt minibuffer-text-before-history)
+ (setq minibuffer-text-before-history nil))
+ (t (setq elt (nth (1- minibuffer-history-position)
+ (symbol-value minibuffer-history-variable)))))
+ (insert
+ (if minibuffer-history-sexp-flag
+ (let ((print-level nil))
+ (prin1-to-string elt))
+ elt))
+ (goto-char (point-min)))))
(defun previous-history-element (n)
"Inserts the previous element of the minibuffer history into the minibuffer."
(forward-line (1- arg)))))
;Put this on C-x u, so we can force that rather than C-_ into startup msg
-(define-function 'advertised-undo 'undo)
+(defalias 'advertised-undo 'undo)
(defun undo (&optional arg)
"Undo some previous changes.
If COMMAND ends in ampersand, execute it asynchronously.
The output appears in the buffer `*Async Shell Command*'.
+That buffer is in shell mode.
-Otherwise, COMMAND is executed synchronously. The output appears
-in the buffer `*Shell Command Output*'.
+Otherwise, COMMAND is executed synchronously. The output appears in the
+buffer `*Shell Command Output*'.
If the output is one line, it is displayed in the echo area *as well*,
but it is nonetheless available in buffer `*Shell Command Output*',
even though that buffer is not automatically displayed.
(interactive (list (read-from-minibuffer "Shell command: "
nil nil nil 'shell-command-history)
current-prefix-arg))
- (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)))))
- ;; Preserve the match data in case called from a program.
- (let ((data (match-data)))
- (unwind-protect
+ ;; 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)
+ (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)))))
+ ;; Preserve the match data in case called from a program.
+ (save-match-data
(if (string-match "[ \t]*&[ \t]*$" command)
;; Command ending with ampersand means asynchronous.
(let ((buffer (get-buffer-create
- (or output-buffer "*Asynch Shell Command*")))
+ (or output-buffer "*Async Shell Command*")))
(directory default-directory)
proc)
;; Remove the ampersand.
(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)
- (set-process-filter proc 'shell-command-filter)
))
- (shell-command-on-region (point) (point) command nil))
- (store-match-data data)))))
+ (shell-command-on-region (point) (point) command output-buffer)
+ ))))))
;; We have a sentinel to prevent insertion of a termination message
;; in the buffer itself.
(defun shell-command-sentinel (process signal)
- (if (and (memq (process-status process) '(exit signal))
- (buffer-name (process-buffer process)))
- (progn
- (message "%s: %s."
- (car (cdr (cdr (process-command process))))
- (substring signal 0 -1))
- (save-excursion
- (set-buffer (process-buffer process))
- (setq mode-line-process nil))
- (delete-process process))))
-
-(defun shell-command-filter (proc string)
- ;; Do save-excursion by hand so that we can leave point numerically unchanged
- ;; despite an insertion immediately after it.
- (let* ((obuf (current-buffer))
- (buffer (process-buffer proc))
- opoint
- (window (get-buffer-window buffer))
- (pos (window-start window)))
- (unwind-protect
- (progn
- (set-buffer buffer)
- (or (= (point) (point-max))
- (setq opoint (point)))
- (goto-char (point-max))
- (insert-before-markers string))
- ;; insert-before-markers moved this marker: set it back.
- (set-window-start window pos)
- ;; Finish our save-excursion.
- (if opoint
- (goto-char opoint))
- (set-buffer obuf))))
+ (if (memq (process-status process) '(exit signal))
+ (message "%s: %s."
+ (car (cdr (cdr (process-command process))))
+ (substring signal 0 -1))))
(defun shell-command-on-region (start end command
&optional output-buffer replace)
(read-from-minibuffer "Shell command on region: "
nil nil nil
'shell-command-history)))
+ ;; call-interactively recognizes region-beginning and
+ ;; region-end specially, leaving them in the history.
(list (region-beginning) (region-end)
string
current-prefix-arg
current-prefix-arg)))
(if (or replace
(and output-buffer
- (not (or (bufferp output-buffer) (stringp 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 (< (point) (mark)))))
+ (let ((swap (and replace (< start end))))
;; Don't muck with mark unless REPLACE says we should.
(goto-char start)
(and replace (push-mark))
;; delete everything but the specified region,
;; then replace that region with the output.
(progn (setq buffer-read-only nil)
- (delete-region end (point-max))
- (delete-region (point-min) start)
+ (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 t nil
shell-command-switch command)
(buffer-substring (point)
(progn (end-of-line) (point))))))
(t
- (set-window-start (display-buffer buffer) 1))))))))
+ (save-excursion
+ (set-buffer buffer)
+ (goto-char (point-min)))
+ (display-buffer buffer))))))))
+
+(defun shell-command-to-string (command)
+ "Execute shell command COMMAND and return its output as a string."
+ (with-output-to-string
+ (with-current-buffer
+ standard-output
+ (call-process shell-file-name nil t nil shell-command-switch command))))
\f
-(defconst universal-argument-map
+(defvar universal-argument-map
(let ((map (make-sparse-keymap)))
(define-key map [t] 'universal-argument-other-key)
(define-key map (vector meta-prefix-char t) 'universal-argument-other-key)
\\[universal-argument] following the digits or minus sign ends the argument.
\\[universal-argument] without digits or minus sign provides 4 as argument.
Repeating \\[universal-argument] without digits or minus sign
- multiplies the argument by 4 each time."
+ multiplies the argument by 4 each time.
+For some commands, just \\[universal-argument] by itself serves as a flag
+which is different in effect from any particular numeric argument.
+These commands include \\[set-mark-command] and \\[start-kbd-macro]."
(interactive)
(setq prefix-arg (list 4))
(setq universal-argument-num-events (length (this-command-keys)))
(interactive "P")
(if (consp arg)
(setq prefix-arg (list (* 4 (car arg))))
- (setq prefix-arg arg)
- (setq overriding-terminal-local-map nil))
+ (if (eq arg '-)
+ (setq prefix-arg (list -4))
+ (setq prefix-arg arg)
+ (setq overriding-terminal-local-map nil)))
(setq universal-argument-num-events (length (this-command-keys))))
(defun negative-argument (arg)
(let* ((key (this-command-keys))
(keylist (listify-key-sequence key)))
(setq unread-command-events
- (nthcdr universal-argument-num-events keylist)))
+ (append (nthcdr universal-argument-num-events keylist)
+ unread-command-events)))
(reset-this-command-lengths)
(setq overriding-terminal-local-map nil))
\f
(forward-line (- arg))
(skip-chars-forward " \t"))
-(defvar kill-whole-line nil
- "*If non-nil, `kill-line' with no arg at beg of line kills the whole line.")
+(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.
;; the value of point from before the command was run.
(progn
(if arg
- (forward-line (prefix-numeric-value 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-line 1)
- (end-of-line)))
+ (forward-visible-line 1)
+ (end-of-visible-line)))
(point))))
+
+(defun forward-visible-line (arg)
+ "Move forward by ARG lines, ignoring currently invisible newlines only."
+ (condition-case nil
+ (progn
+ (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)))))
+ (if (get-text-property (point) 'invisible)
+ (goto-char (next-single-property-change (point) 'invisible))
+ (goto-char (next-overlay-change (point))))
+ (or (zerop (forward-line 1))
+ (signal 'end-of-buffer nil)))
+ (setq arg (1- arg)))
+ (while (< arg 0)
+ (or (zerop (vertical-motion -1))
+ (signal 'beginning-of-buffer nil))
+ (while (and (not (bobp))
+ (let ((prop
+ (get-char-property (1- (point)) 'invisible)))
+ (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))))
+ (if (get-text-property (1- (point)) 'invisible)
+ (goto-char (previous-single-property-change (point) 'invisible))
+ (goto-char (previous-overlay-change (point))))
+ (or (zerop (vertical-motion -1))
+ (signal 'beginning-of-buffer 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))))
+ (forward-char 1)
+ (end-of-line)))
\f
;;;; Window system cut and paste hooks.
interaction; you may want to use them instead of manipulating the kill
ring directly.")
-(defconst kill-ring-max 30
- "*Maximum length of kill ring before oldest elements are thrown away.")
+(defcustom kill-ring-max 30
+ "*Maximum length of kill ring before oldest elements are thrown away."
+ :type 'integer
+ :group 'killing)
(defvar kill-ring-yank-pointer nil
"The tail of the kill ring whose car is the last thing yanked.")
(setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
(setq kill-ring-yank-pointer kill-ring)
(if interprogram-cut-function
- (funcall interprogram-cut-function string t)))
+ (funcall interprogram-cut-function string (not replace))))
(defun kill-append (string before-p)
"Append STRING to the end of the latest kill in the kill ring.
\f
;;;; Commands for manipulating the kill ring.
-(defvar kill-read-only-ok nil
- "*Non-nil means don't signal an error for killing read-only text.")
+(defcustom kill-read-only-ok nil
+ "*Non-nil means don't signal an error for killing read-only text."
+ :type 'boolean
+ :group 'killing)
+
+(put 'text-read-only 'error-conditions
+ '(text-read-only buffer-read-only error))
+(put 'text-read-only 'error-message "Text is read-only")
(defun kill-region (beg end)
"Kill between point and mark.
;; If the buffer is read-only, we should beep, in case the person
;; just isn't aware of this. However, there's no harm in putting
;; the region's text in the kill ring, anyway.
- ((or (and buffer-read-only (not inhibit-read-only))
- (text-property-not-all beg end 'read-only nil))
+ ((and (not inhibit-read-only)
+ (or buffer-read-only
+ (text-property-not-all beg end 'read-only nil)))
(copy-region-as-kill beg end)
;; This should always barf, and give us the correct error.
(if kill-read-only-ok
(message "Read only text copied to kill ring")
(setq this-command 'kill-region)
- (barf-if-buffer-read-only)))
+ ;; Signal an error if the buffer is read-only.
+ (barf-if-buffer-read-only)
+ ;; If the buffer isn't read-only, the text is.
+ (signal 'text-read-only (list (current-buffer)))))
;; In certain cases, we can arrange for the undo list and the kill
;; ring to share the same string object. This code does that.
(if (not (eq last-command 'yank))
(error "Previous command was not a yank"))
(setq this-command 'yank)
- (let ((before (< (point) (mark t))))
+ (let ((inhibit-read-only t)
+ (before (< (point) (mark t))))
(delete-region (point) (mark t))
(set-marker (mark-marker) (point) (current-buffer))
(insert (current-kill arg))
"Insert after point the contents of BUFFER.
Puts mark after the inserted text.
BUFFER may be a buffer or a buffer name."
- (interactive (list (progn (barf-if-buffer-read-only)
- (read-buffer "Insert buffer: "
- (other-buffer (current-buffer) t)
- t))))
+ (interactive
+ (list
+ (progn
+ (barf-if-buffer-read-only)
+ (read-buffer "Insert buffer: "
+ (if (eq (selected-window) (next-window (selected-window)))
+ (other-buffer (current-buffer))
+ (window-buffer (next-window (selected-window))))
+ t))))
(or (bufferp buffer)
(setq buffer (get-buffer buffer)))
(let (start end newmark)
(make-variable-buffer-local 'mark-ring)
(put 'mark-ring 'permanent-local t)
-(defconst mark-ring-max 16
- "*Maximum size of mark ring. Start discarding off end if gets this big.")
+(defcustom mark-ring-max 16
+ "*Maximum size of mark ring. Start discarding off end if gets this big."
+ :type 'integer
+ :group 'editing-basics)
(defvar global-mark-ring nil
"The list of saved global marks, most recent first.")
-(defconst global-mark-ring-max 16
+(defcustom global-mark-ring-max 16
"*Maximum size of global mark ring. \
-Start discarding off end if gets this big.")
+Start discarding off end if gets this big."
+ :type 'integer
+ :group 'editing-basics)
(defun set-mark-command (arg)
"Set mark at where point is, or jump to mark.
(move-marker (car (nthcdr global-mark-ring-max global-mark-ring))
nil)
(setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil))))
- (or nomsg executing-macro (> (minibuffer-depth) 0)
+ (or nomsg executing-kbd-macro (> (minibuffer-depth) 0)
(message "Mark set"))
(if (or activate (not transient-mark-mode))
(set-mark (mark t)))
(if (null (mark t)) (ding))
(setq mark-ring (cdr mark-ring)))))
-(define-function 'exchange-dot-and-mark 'exchange-point-and-mark)
+(defalias 'exchange-dot-and-mark 'exchange-point-and-mark)
(defun exchange-point-and-mark ()
"Put the mark where point is now, and point where the mark is now.
This command works even when the mark is not active,
(setq transient-mark-mode
(if (null arg)
(not transient-mark-mode)
- (> (prefix-numeric-value arg) 0))))
+ (> (prefix-numeric-value arg) 0)))
+ (if (interactive-p)
+ (if transient-mark-mode
+ (message "Transient Mark mode enabled")
+ (message "Transient Mark mode disabled"))))
(defun pop-global-mark ()
"Pop off global mark ring and jump to the top location."
(goto-char position)
(switch-to-buffer buffer)))
\f
-(defvar next-line-add-newlines t
- "*If non-nil, `next-line' inserts newline to avoid `end of buffer' error.")
+(defcustom next-line-add-newlines t
+ "*If non-nil, `next-line' inserts newline to avoid `end of buffer' error."
+ :type 'boolean
+ :group 'editing-basics)
(defun next-line (arg)
"Move cursor vertically down ARG lines.
If there is no line in the buffer after this one, behavior depends on the
value of `next-line-add-newlines'. If non-nil, it inserts a newline character
to create a line, and moves the cursor to that line. Otherwise it moves the
-cursor to the end of the buffer (if already at the end of the buffer, an error
-is signaled).
+cursor to the end of the buffer.
The command \\[set-goal-column] can be used to create
a semipermanent goal column to which this command always moves.
(line-move (- arg)))
nil)
-(defconst track-eol nil
+(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.
-The beginning of a blank line does not count as the end of a line.")
-
-(defvar goal-column nil
- "*Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil.")
+The beginning of a blank line does not count as the end of a line."
+ :type 'boolean
+ :group 'editing-basics)
+
+(defcustom goal-column nil
+ "*Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil."
+ :type '(choice integer
+ (const :tag "None" nil))
+ :group 'editing-basics)
(make-variable-buffer-local 'goal-column)
(defvar temporary-goal-column 0
at the start of current run of vertical motion commands.
When the `track-eol' feature is doing its job, the value is 9999.")
-(defvar line-move-ignore-invisible nil
+(defcustom line-move-ignore-invisible nil
"*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines.
-Outline mode sets this.")
+Outline mode sets this."
+ :type 'boolean
+ :group 'editing-basics)
;; This is the guts of next-line and previous-line.
;; Arg says how many lines to move.
(goto-char (previous-single-property-change (point) 'invisible))
(goto-char (previous-overlay-change (point)))))
(setq arg (1+ arg))))
- (move-to-column (or goal-column temporary-goal-column)))
+ (let ((buffer-invisibility-spec nil))
+ (move-to-column (or goal-column temporary-goal-column))))
;; Remember where we moved to, go back home,
;; then do the motion over again
;; in just one step, with intangibility and point-motion hooks
;;; will be built into the C level and all the (hscroll-point-visible) calls
;;; will go away.
-(defvar hscroll-step 0
+(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.")
+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."
;; (hscroll-point-visible))
(defun scroll-other-window-down (lines)
- "Scroll the \"other window\" down."
+ "Scroll the \"other window\" down.
+For more details, see the documentation for `scroll-other-window'."
(interactive "P")
(scroll-other-window
;; Just invert the argument's meaning.
(if (eq lines '-) nil
(if (null lines) '-
(- (prefix-numeric-value lines))))))
+(define-key esc-map [?\C-\S-v] 'scroll-other-window-down)
(defun beginning-of-buffer-other-window (arg)
"Move point to the beginning of the buffer in the other window.
(defun transpose-subr-1 ()
(if (> (min end1 end2) (max start1 start2))
(error "Don't have two things to transpose"))
- (let ((word1 (buffer-substring start1 end1))
- (word2 (buffer-substring start2 end2)))
+ (let* ((word1 (buffer-substring start1 end1))
+ (len1 (length word1))
+ (word2 (buffer-substring start2 end2))
+ (len2 (length word2)))
(delete-region start2 end2)
(goto-char start2)
(insert word1)
(goto-char (if (< start1 start2) start1
- (+ start1 (- (length word1) (length word2)))))
- (delete-char (length word1))
+ (+ start1 (- len1 len2))))
+ (delete-region (point) (+ (point) len1))
(insert word2)))
\f
-(defconst comment-column 32
+(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.")
+can set the value for a particular mode using that mode's hook."
+ :type 'integer
+ :group 'fill-comments)
(make-variable-buffer-local 'comment-column)
-(defconst comment-start nil
- "*String to insert to start a new comment, or nil if no comment syntax.")
+(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)
-(defconst comment-start-skip nil
+(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.")
+at the place matched by the close of the first pair."
+ :type '(choice (const :tag "None" nil)
+ regexp)
+ :group 'fill-comments)
-(defconst comment-end ""
+(defcustom comment-end ""
"*String to insert to end a new comment.
-Should be an empty string if comments are terminated by end-of-line.")
+Should be an empty string if comments are terminated by end-of-line."
+ :type 'string
+ :group 'fill-comments)
-(defconst comment-indent-hook nil
+(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.")
-(defconst comment-indent-function
+(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.")
-(defconst block-comment-start nil
+(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.")
+as well as the `comment-start' string."
+ :type '(choice (const :tag "Use comment-start" nil)
+ string)
+ :group 'fill-comments)
-(defconst block-comment-end nil
+(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.")
+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."
;; This is questionable if comment-end ends in
;; whitespace. That is pretty brain-damaged,
;; though.
- (skip-chars-backward " \t")
- (if (and (>= (- (point) (point-min)) (length ce))
- (save-excursion
- (backward-char (length ce))
- (looking-at (regexp-quote ce))))
+ (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)))
(buffer-substring start end)))
(buffer-substring start end)))))
\f
-(defconst fill-prefix nil
+(defcustom fill-prefix nil
"*String for filling to insert at front of new line, or nil for none.
-Setting this variable automatically makes it local to the current buffer.")
+Setting this variable automatically makes it local to the current buffer."
+ :type '(choice (const :tag "None" nil)
+ string)
+ :group 'fill)
(make-variable-buffer-local 'fill-prefix)
-(defconst auto-fill-inhibit-regexp nil
- "*Regexp to match lines which should not be auto-filled.")
+(defcustom auto-fill-inhibit-regexp nil
+ "*Regexp to match lines which should not be auto-filled."
+ :type '(choice (const :tag "None" nil)
+ regexp)
+ :group 'fill)
+;; This function is the auto-fill-function of a buffer
+;; when Auto-Fill mode is enabled.
+;; It returns t if it really did any work.
(defun do-auto-fill ()
- (let (fc justify bol give-up)
+ (let (fc justify bol give-up
+ (fill-prefix fill-prefix))
(if (or (not (setq justify (current-justification)))
- (and (setq fc (current-fill-column)) ; make sure this gets set
- (eq justify 'left)
- (<= (current-column) (setq fc (current-fill-column))))
+ (null (setq fc (current-fill-column)))
+ (and (eq justify 'left)
+ (<= (current-column) fc))
(save-excursion (beginning-of-line)
(setq bol (point))
(and auto-fill-inhibit-regexp
nil ;; Auto-filling not required
(if (memq justify '(full center right))
(save-excursion (unjustify-current-line)))
+
+ ;; Choose a fill-prefix automatically.
+ (if (and adaptive-fill-mode
+ (or (null fill-prefix) (string= fill-prefix "")))
+ (let ((prefix
+ (fill-context-prefix
+ (save-excursion (backward-paragraph 1) (point))
+ (save-excursion (forward-paragraph 1) (point))
+ ;; Don't accept a non-whitespace fill prefix
+ ;; from the first line of a paragraph.
+ "^[ \t]*$")))
+ (and prefix (not (equal prefix ""))
+ (setq fill-prefix prefix))))
+
(while (and (not give-up) (> (current-column) fc))
- ;; Determine where to split the line.
- (let ((fill-point
- (let ((opoint (point))
- bounce
- (first t))
- (save-excursion
- (move-to-column (1+ fc))
- ;; Move back to a word boundary.
- (while (or first
- ;; If this is after period and a single space,
- ;; move back once more--we don't want to break
- ;; the line there and make it look like a
- ;; sentence end.
- (and (not (bobp))
- (not bounce)
- sentence-end-double-space
- (save-excursion (forward-char -1)
- (and (looking-at "\\. ")
- (not (looking-at "\\. "))))))
- (setq first nil)
- (skip-chars-backward "^ \t\n")
- ;; If we find nowhere on the line to break it,
- ;; break after one word. Set bounce to t
- ;; so we will not keep going in this while loop.
- (if (bolp)
- (progn
- (re-search-forward "[ \t]" opoint t)
- (setq bounce t)))
- (skip-chars-backward " \t"))
- ;; Let fill-point be set to the place where we end up.
- (point)))))
- ;; If that place is not the beginning of the line,
- ;; break the line there.
- (if (save-excursion
- (goto-char fill-point)
- (not (bolp)))
- (let ((prev-column (current-column)))
- ;; If point is at the fill-point, do not `save-excursion'.
- ;; Otherwise, if a comment prefix or fill-prefix is inserted,
- ;; point will end up before it rather than after it.
- (if (save-excursion
- (skip-chars-backward " \t")
- (= (point) fill-point))
- (indent-new-comment-line t)
- (save-excursion
- (goto-char fill-point)
- (indent-new-comment-line t)))
- ;; Now do justification, if required
- (if (not (eq justify 'left))
- (save-excursion
- (end-of-line 0)
- (justify-current-line justify nil t)))
- ;; If making the new line didn't reduce the hpos of
- ;; the end of the line, then give up now;
- ;; trying again will not help.
- (if (>= (current-column) prev-column)
- (setq give-up t)))
- ;; No place to break => stop trying.
- (setq give-up t))))
- ;; justify last line
- (justify-current-line justify t t))))
+ ;; Determine where to split the line.
+ (let ((fill-point
+ (let ((opoint (point))
+ bounce
+ (first t)
+ after-prefix)
+ (save-excursion
+ (beginning-of-line)
+ (setq after-prefix (point))
+ (and fill-prefix
+ (looking-at (regexp-quote fill-prefix))
+ (setq after-prefix (match-end 0)))
+ (move-to-column (1+ fc))
+ ;; Move back to the point where we can break the
+ ;; line at. 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
+ ;; not found, place the point at beginning of line.
+ (while (or first
+ ;; If this is after period and a single space,
+ ;; move back once more--we don't want to break
+ ;; the line there and make it look like a
+ ;; sentence end.
+ (and (not (bobp))
+ (not bounce)
+ sentence-end-double-space
+ (save-excursion (forward-char -1)
+ (and (looking-at "\\. ")
+ (not (looking-at "\\. "))))))
+ (setq first nil)
+ (re-search-backward "[ \t]\\|\\c|.\\|.\\c|\\|^")
+ ;; If we find nowhere on the line to break it,
+ ;; break after one word. Set bounce to t
+ ;; so we will not keep going in this while loop.
+ (if (<= (point) after-prefix)
+ (progn
+ (re-search-forward "[ \t]" opoint t)
+ (setq bounce t))
+ (if (looking-at "[ \t]")
+ ;; Break the line at word boundary.
+ (skip-chars-backward " \t")
+ ;; Break the line after/before \c|.
+ (forward-char 1)
+ (if do-kinsoku
+ (kinsoku (save-excursion
+ (forward-line 0) (point)))))))
+ ;; Let fill-point be set to the place where we end up.
+ (point)))))
+ ;; If that place is not the beginning of the line,
+ ;; break the line there.
+ (if (save-excursion
+ (goto-char fill-point)
+ (not (bolp)))
+ (let ((prev-column (current-column)))
+ ;; If point is at the fill-point, do not `save-excursion'.
+ ;; Otherwise, if a comment prefix or fill-prefix is inserted,
+ ;; point will end up before it rather than after it.
+ (if (save-excursion
+ (skip-chars-backward " \t")
+ (= (point) fill-point))
+ (indent-new-comment-line t)
+ (save-excursion
+ (goto-char fill-point)
+ (indent-new-comment-line t)))
+ ;; Now do justification, if required
+ (if (not (eq justify 'left))
+ (save-excursion
+ (end-of-line 0)
+ (justify-current-line justify nil t)))
+ ;; If making the new line didn't reduce the hpos of
+ ;; the end of the line, then give up now;
+ ;; trying again will not help.
+ (if (>= (current-column) prev-column)
+ (setq give-up t)))
+ ;; No place to break => stop trying.
+ (setq give-up t))))
+ ;; Justify last line.
+ (justify-current-line justify 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.
+Some major modes set this.")
(defun auto-fill-mode (&optional arg)
- "Toggle auto-fill mode.
-With arg, turn Auto-Fill mode on if and only if arg is positive.
-In Auto-Fill mode, inserting a space at a column beyond `current-fill-column'
-automatically breaks the line at a previous space."
+ "Toggle Auto Fill mode.
+With arg, turn Auto Fill mode on if and only if arg is positive.
+In Auto Fill mode, inserting a space at a column beyond `current-fill-column'
+automatically breaks the line at a previous space.
+
+The value of `normal-auto-fill-function' specifies the function to use
+for `auto-fill-function' when turning Auto Fill mode on."
(interactive "P")
(prog1 (setq auto-fill-function
(if (if (null arg)
(not auto-fill-function)
(> (prefix-numeric-value arg) 0))
- 'do-auto-fill
+ normal-auto-fill-function
nil))
(force-mode-line-update)))
(auto-fill-mode 1))
(defun set-fill-column (arg)
- "Set `fill-column' to current column, or to argument if given.
-The variable `fill-column' has a separate value for each buffer."
+ "Set `fill-column' to specified argument.
+Just \\[universal-argument] as argument means to use the current column."
(interactive "P")
- (setq fill-column (if (integerp arg) arg (current-column)))
- (message "fill-column set to %d" fill-column))
+ (cond ((integerp arg)
+ (message "Fill column set to %d (was %d)" arg fill-column)
+ (setq fill-column arg))
+ ((consp arg)
+ (message "Fill column set to %d (was %d)" arg fill-column)
+ (setq fill-column (current-column)))
+ ;; Disallow missing argument; it's probably a typo for C-x C-f.
+ (t
+ (error "set-fill-column requires an explicit argument"))))
\f
-(defconst comment-multi-line nil
+(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].")
+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.
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)
(progn (skip-chars-forward " \t")
(point)))
(if soft (insert-and-inherit ?\n) (newline 1))
- (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)
+ (if fill-prefix
+ (progn
+ (indent-to-left-margin)
+ (insert-and-inherit fill-prefix))
+ (if (not comment-multi-line)
(save-excursion
- ;; Make sure we delete the newline inserted above.
- (end-of-line)
- (delete-char 1)))
- (if (null fill-prefix)
- (indent-according-to-mode)
- (indent-to-left-margin)
- (insert-and-inherit fill-prefix)))))
+ (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.
(prin1 selective-display t)
(princ "." t))
-(defconst overwrite-mode-textual " Ovwrt"
+(defvar overwrite-mode-textual " Ovwrt"
"The string displayed in the mode line when in overwrite mode.")
-(defconst overwrite-mode-binary " Bin Ovwrt"
+(defvar overwrite-mode-binary " Bin Ovwrt"
"The string displayed in the mode line when in binary overwrite mode.")
(defun overwrite-mode (arg)
'overwrite-mode-binary))
(force-mode-line-update))
\f
-(defvar line-number-mode nil
- "*Non-nil means display line number in mode line.")
+(defcustom line-number-mode t
+ "*Non-nil means display line number in mode line."
+ :type 'boolean
+ :group 'editing-basics)
(defun line-number-mode (arg)
"Toggle Line Number mode.
(> (prefix-numeric-value arg) 0)))
(force-mode-line-update))
-(defvar blink-matching-paren t
- "*Non-nil means show matching open-paren when close-paren is inserted.")
+(defcustom column-number-mode nil
+ "*Non-nil means display column number in mode line."
+ :type 'boolean
+ :group 'editing-basics)
-(defconst blink-matching-paren-distance 12000
- "*If non-nil, is maximum distance to search for matching open-paren.")
+(defun column-number-mode (arg)
+ "Toggle Column Number mode.
+With arg, turn Column Number mode on iff arg is positive.
+When Column Number mode is enabled, the column number appears
+in the mode line."
+ (interactive "P")
+ (setq column-number-mode
+ (if (null arg) (not column-number-mode)
+ (> (prefix-numeric-value arg) 0)))
+ (force-mode-line-update))
-(defconst blink-matching-delay 1
- "*The number of seconds that `blink-matching-open' will delay at a match.")
+(defcustom blink-matching-paren t
+ "*Non-nil means show matching open-paren when close-paren is inserted."
+ :type 'boolean
+ :group 'paren-matching)
+
+(defcustom blink-matching-paren-on-screen t
+ "*Non-nil means show matching open-paren when it is on screen.
+nil means don't show it (but the open-paren can still be shown
+when it is off screen."
+ :type 'boolean
+ :group 'paren-matching)
+
+(defcustom blink-matching-paren-distance 12000
+ "*If non-nil, is maximum distance to search for matching open-paren."
+ :type 'integer
+ :group 'paren-matching)
+
+(defcustom blink-matching-delay 1
+ "*The number of seconds that `blink-matching-open' will delay at a match."
+ :type 'integer
+ :group 'paren-matching)
+
+(defcustom blink-matching-paren-dont-ignore-comments nil
+ "*Non-nil means `blink-matching-paren' should not ignore comments."
+ :type 'boolean
+ :group 'paren-matching)
(defun blink-matching-open ()
"Move cursor momentarily to the beginning of the sexp before point."
(- (point) blink-matching-paren-distance))
oldpos))
(condition-case ()
- (setq blinkpos (scan-sexps oldpos -1))
+ (let ((parse-sexp-ignore-comments
+ (and parse-sexp-ignore-comments
+ (not blink-matching-paren-dont-ignore-comments))))
+ (setq blinkpos (scan-sexps oldpos -1)))
(error nil)))
- (and blinkpos (/= (char-syntax (char-after blinkpos))
- ?\$)
+ (and blinkpos
+ (/= (char-syntax (char-after blinkpos))
+ ?\$)
(setq mismatch
- (/= (char-after (1- oldpos))
- (matching-paren (char-after blinkpos)))))
+ (or (null (matching-paren (char-after blinkpos)))
+ (/= (char-after (1- oldpos))
+ (matching-paren (char-after blinkpos))))))
(if mismatch (setq blinkpos nil))
(if blinkpos
(progn
(goto-char blinkpos)
(if (pos-visible-in-window-p)
- (sit-for blink-matching-delay)
+ (and blink-matching-paren-on-screen
+ (sit-for blink-matching-delay))
(goto-char blinkpos)
(message
"Matches %s"
((and transient-mark-mode
mark-active)
(deactivate-mark))
+ ((> (recursion-depth) 0)
+ (exit-recursive-edit))
(buffer-quit-function
(funcall buffer-quit-function))
((not (one-window-p t))
- (delete-other-windows))))
+ (delete-other-windows))
+ ((string-match "^ \\*" (buffer-name (current-buffer)))
+ (bury-buffer))))
(define-key global-map "\e\e\e" 'keyboard-escape-quit)
\f
+(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
+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
+
+Additional valid symbols may be available; check with the author of
+your package for details."
+ :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"
+ :format "%t\n"
+ message-user-agent)
+ (function :tag "Other"))
+ :group 'mail)
+
+(defun define-mail-user-agent (symbol composefunc sendfunc
+ &optional abortfunc hookvar)
+ "Define a symbol to identify a mail-sending package for `mail-user-agent'.
+
+SYMBOL can be any Lisp symbol. Its function definition and/or
+value as a variable do not matter for this usage; we use only certain
+properties on its property list, to encode the rest of the arguments.
+
+COMPOSEFUNC is program callable function that composes an outgoing
+mail message buffer. This function should set up the basics of the
+buffer without requiring user interaction. It should populate the
+standard mail headers, leaving the `to:' and `subject:' headers blank
+by default.
+
+COMPOSEFUNC should accept several optional arguments--the same
+arguments that `compose-mail' takes. See that function's documentation.
+
+SENDFUNC is the command a user would run to send the message.
+
+Optional ABORTFUNC is the command a user would run to abort the
+message. For mail packages that don't have a separate abort function,
+this can be `kill-buffer' (the equivalent of omitting this argument).
+
+Optional HOOKVAR is a hook variable that gets run before the message
+is actually sent. Callers that use the `mail-user-agent' may
+install a hook function temporarily on this hook variable.
+If HOOKVAR is nil, `mail-send-hook' is used.
+
+The properties used on SYMBOL are `composefunc', `sendfunc',
+`abortfunc', and `hookvar'."
+ (put symbol 'composefunc composefunc)
+ (put symbol 'sendfunc sendfunc)
+ (put symbol 'abortfunc (or abortfunc 'kill-buffer))
+ (put symbol 'hookvar (or hookvar 'mail-send-hook)))
+
+(defun assoc-ignore-case (key alist)
+ "Like `assoc', but assumes KEY is a string and ignores case when comparing."
+ (setq key (downcase key))
+ (let (element)
+ (while (and alist (not element))
+ (if (equal key (downcase (car (car alist))))
+ (setq element (car alist)))
+ (setq alist (cdr alist)))
+ element))
+
+(define-mail-user-agent 'sendmail-user-agent
+ '(lambda (&optional to subject other-headers continue
+ switch-function yank-action send-actions)
+ (if switch-function
+ (let ((special-display-buffer-names nil)
+ (special-display-regexps nil)
+ (same-window-buffer-names nil)
+ (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))))
+ (or (mail continue to subject in-reply-to cc yank-action send-actions)
+ continue
+ (error "Message aborted"))
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward mail-header-separator)
+ (beginning-of-line)
+ (while other-headers
+ (if (not (member (car (car other-headers)) '("in-reply-to" "cc")))
+ (insert (car (car other-headers)) ": "
+ (cdr (car other-headers)) "\n"))
+ (setq other-headers (cdr other-headers)))
+ t)))
+ 'mail-send-and-exit)
+
+(define-mail-user-agent 'mh-e-user-agent
+ 'mh-smail-batch 'mh-send-letter 'mh-fully-kill-draft
+ 'mh-before-send-letter-hook)
+
+(defun compose-mail (&optional to subject other-headers continue
+ switch-function yank-action send-actions)
+ "Start composing a mail message to send.
+This uses the user's chosen mail composition package
+as selected with the variable `mail-user-agent'.
+The optional arguments TO and SUBJECT specify recipients
+and the initial Subject field, respectively.
+
+OTHER-HEADERS is an alist specifying additional
+header fields. Elements look like (HEADER . VALUE) where both
+HEADER and VALUE are strings.
+
+CONTINUE, if non-nil, says to continue editing a message already
+being composed.
+
+SWITCH-FUNCTION, if non-nil, is a function to use to
+switch to and display the buffer used for mail composition.
+
+YANK-ACTION, if non-nil, is an action to perform, if and when necessary,
+to insert the raw text of the message being replied to.
+It has the form (FUNCTION . ARGS). The user agent will apply
+FUNCTION to ARGS, to insert the raw text of the original message.
+\(The user agent will also run `mail-citation-hook', *after* the
+original text has been inserted in this way.)
+
+SEND-ACTIONS is a list of actions to call when the message is sent.
+Each action has the form (FUNCTION . ARGS)."
+ (interactive
+ (list nil nil nil current-prefix-arg))
+ (let ((function (get mail-user-agent 'composefunc)))
+ (funcall function to subject other-headers continue
+ switch-function yank-action send-actions)))
+
+(defun compose-mail-other-window (&optional to subject other-headers continue
+ yank-action send-actions)
+ "Like \\[compose-mail], but edit the outgoing message in another window."
+ (interactive
+ (list nil nil nil current-prefix-arg))
+ (compose-mail to subject other-headers continue
+ 'switch-to-buffer-other-window yank-action send-actions))
+
+
+(defun compose-mail-other-frame (&optional to subject other-headers continue
+ yank-action send-actions)
+ "Like \\[compose-mail], but edit the outgoing message in another frame."
+ (interactive
+ (list nil nil nil current-prefix-arg))
+ (compose-mail to subject other-headers continue
+ 'switch-to-buffer-other-frame yank-action send-actions))
+\f
+(defvar set-variable-value-history nil
+ "History of values entered with `set-variable'.")
+
(defun set-variable (var val)
"Set VARIABLE to VALUE. VALUE is a Lisp object.
-When using this interactively, supply a Lisp expression for VALUE.
+When using this interactively, enter a Lisp object for VALUE.
If you want VALUE to be a string, you must surround it with doublequotes.
+VALUE is used literally, not evaluated.
If VARIABLE has a `variable-interactive' property, that is used as if
-it were the arg to `interactive' (which see) to interactively read the value."
- (interactive
- (let* ((var (read-variable "Set variable: "))
- (minibuffer-help-form
- '(funcall myhelp))
- (myhelp
- (function
- (lambda ()
- (with-output-to-temp-buffer "*Help*"
- (prin1 var)
- (princ "\nDocumentation:\n")
- (princ (substring (documentation-property var 'variable-documentation)
- 1))
- (if (boundp var)
- (let ((print-length 20))
- (princ "\n\nCurrent value: ")
- (prin1 (symbol-value var))))
- (save-excursion
- (set-buffer standard-output)
- (help-mode))
- nil)))))
- (list var
- (let ((prop (get var 'variable-interactive)))
- (if prop
- ;; Use VAR's `variable-interactive' property
- ;; as an interactive spec for prompting.
- (call-interactively (list 'lambda '(arg)
- (list 'interactive prop)
- 'arg))
- (eval-minibuffer (format "Set %s to value: " var)))))))
+it were the arg to `interactive' (which see) to interactively read VALUE.
+
+If VARIABLE has been defined with `defcustom', then the type information
+in the definition is used to check that VALUE is valid."
+ (interactive (let* ((var (read-variable "Set variable: "))
+ (minibuffer-help-form '(describe-variable var))
+ (prop (get var 'variable-interactive))
+ (prompt (format "Set %s to value: " var))
+ (val (if prop
+ ;; Use VAR's `variable-interactive' property
+ ;; as an interactive spec for prompting.
+ (call-interactively `(lambda (arg)
+ (interactive ,prop)
+ arg))
+ (read
+ (read-string prompt nil
+ 'set-variable-value-history)))))
+ (list var val)))
+
+ (let ((type (get var 'custom-type)))
+ (when type
+ ;; Match with custom type.
+ (require 'wid-edit)
+ (setq type (widget-convert type))
+ (unless (widget-apply type :match val)
+ (error "Value `%S' does not match type %S of %S"
+ val (car type) var))))
(set var val))
\f
;; Define the major mode for lists of completions.
This is a local variable in the completion list buffer.
Initial value is nil to avoid some compiler warnings.")
+(defvar completion-no-auto-exit nil
+ "Non-nil means `choose-completion-string' should never exit the minibuffer.
+This also applies to other functions such as `choose-completion'
+and `mouse-choose-completion'.")
+
(defvar completion-base-size nil
"Number of chars at beginning of minibuffer not involved in completion.
This is a local variable in the completion list buffer
Go to the window from which completion was requested."
(interactive)
(let ((buf completion-reference-buffer))
- (delete-window (selected-window))
- (if (get-buffer-window buf)
- (select-window (get-buffer-window buf)))))
+ (if (one-window-p t)
+ (if (window-dedicated-p (selected-window))
+ (delete-frame (selected-frame)))
+ (delete-window (selected-window))
+ (if (get-buffer-window buf)
+ (select-window (get-buffer-window buf))))))
(defun previous-completion (n)
"Move to the previous item in the completion list."
(defun next-completion (n)
"Move to the next item in the completion list.
-WIth prefix argument N, move N items (negative N means move backward)."
+With prefix argument N, move N items (negative N means move backward)."
(interactive "p")
(while (and (> n 0) (not (eobp)))
- (let ((prop (get-text-property (point) 'mouse-face)))
+ (let ((prop (get-text-property (point) 'mouse-face))
+ (end (point-max)))
;; If in a completion, move to the end of it.
(if prop
- (goto-char (next-single-property-change (point) 'mouse-face)))
+ (goto-char (next-single-property-change (point) 'mouse-face nil end)))
;; Move to start of next one.
- (goto-char (next-single-property-change (point) 'mouse-face)))
+ (goto-char (next-single-property-change (point) 'mouse-face nil end)))
(setq n (1- n)))
(while (and (< n 0) (not (bobp)))
- (let ((prop (get-text-property (1- (point)) 'mouse-face)))
+ (let ((prop (get-text-property (1- (point)) 'mouse-face))
+ (end (point-min)))
;; If in a completion, move to the start of it.
(if prop
- (goto-char (previous-single-property-change (point) 'mouse-face)))
+ (goto-char (previous-single-property-change
+ (point) 'mouse-face nil end)))
;; Move to end of the previous completion.
- (goto-char (previous-single-property-change (point) 'mouse-face))
+ (goto-char (previous-single-property-change (point) 'mouse-face nil end))
;; Move to the start of that one.
- (goto-char (previous-single-property-change (point) 'mouse-face)))
+ (goto-char (previous-single-property-change (point) 'mouse-face nil end)))
(setq n (1+ n))))
(defun choose-completion ()
;; Switch to BUFFER and insert the completion choice CHOICE.
;; BASE-SIZE, if non-nil, says how many characters of BUFFER's text
;; to keep. If it is nil, use choose-completion-delete-max-match instead.
+
+;; If BUFFER is the minibuffer, exit the minibuffer
+;; unless it is reading a file name and CHOICE is a directory,
+;; or completion-no-auto-exit is non-nil.
(defun choose-completion-string (choice &optional buffer base-size)
(let ((buffer (or buffer completion-reference-buffer)))
;; If BUFFER is a minibuffer, barf unless it's the currently
(let ((window (get-buffer-window buffer t)))
(set-window-point window (point)))
;; If completing for the minibuffer, exit it with this choice.
- (and (equal buffer (window-buffer (minibuffer-window)))
+ (and (not completion-no-auto-exit)
+ (equal buffer (window-buffer (minibuffer-window)))
minibuffer-completion-table
- (exit-minibuffer)))))
+ ;; If this is reading a file name, and the file name chosen
+ ;; is a directory, don't exit the minibuffer.
+ (if (and (eq minibuffer-completion-table 'read-file-name-internal)
+ (file-directory-p (buffer-string)))
+ (select-window (active-minibuffer-window))
+ (exit-minibuffer))))))
(defun completion-list-mode ()
"Major mode for buffers showing lists of possible completions.
(defun switch-to-completions ()
"Select the completion list window."
(interactive)
+ ;; Make sure we have a completions window.
+ (or (get-buffer-window "*Completions*")
+ (minibuffer-completion-help))
(select-window (get-buffer-window "*Completions*"))
(goto-char (point-min))
(search-forward "\n\n")