;;; 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.
;;; 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'.
;; 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.
(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.
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)
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))))
("\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.
(defun shell-command-to-string (command)
"Execute shell command COMMAND and return its output as a string."
(with-output-to-string
- (call-process shell-file-name nil t nil "-c" command)))
+ (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)
(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.")
\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))
(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.
(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.
(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."
(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.
(looking-at (regexp-quote fill-prefix))
(setq after-prefix (match-end 0)))
(move-to-column (1+ fc))
- ;; Move back to a word boundary.
+ ;; 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
(and (looking-at "\\. ")
(not (looking-at "\\. "))))))
(setq first nil)
- (skip-chars-backward "^ \t\n")
+ (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)))
- (skip-chars-backward " \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,
Just \\[universal-argument] as argument means to use the current column."
(interactive "P")
(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")))
- (message "fill-column set to %d" fill-column))
+ (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.
(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 t
- "*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 column-number-mode nil
- "*Non-nil means display column number in mode line.")
+(defcustom column-number-mode nil
+ "*Non-nil means display column number in mode line."
+ :type 'boolean
+ :group 'editing-basics)
(defun column-number-mode (arg)
"Toggle Column 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 blink-matching-paren t
+ "*Non-nil means show matching open-paren when close-paren is inserted."
+ :type 'boolean
+ :group 'paren-matching)
-(defvar blink-matching-paren-on-screen t
+(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.")
+when it is off screen."
+ :type 'boolean
+ :group 'paren-matching)
-(defconst blink-matching-paren-distance 12000
- "*If non-nil, is maximum distance to search for matching open-paren.")
+(defcustom blink-matching-paren-distance 12000
+ "*If non-nil, is maximum distance to search for matching open-paren."
+ :type 'integer
+ :group 'paren-matching)
-(defconst blink-matching-delay 1
- "*The number of seconds that `blink-matching-open' will delay at a match.")
+(defcustom blink-matching-delay 1
+ "*The number of seconds that `blink-matching-open' will delay at a match."
+ :type 'integer
+ :group 'paren-matching)
-(defconst blink-matching-paren-dont-ignore-comments nil
- "*Non-nil means `blink-matching-paren' should not ignore comments.")
+(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."
((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
-(defvar mail-user-agent 'sendmail-user-agent
+(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
Valid values include:
- 'sendmail-user-agent -- use Emacs built-in Mail package
- 'mh-e-user-agent -- use the Emacs interface to the MH mail system
+ 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.")
+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)
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.
+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 type to send the message.
+SENDFUNC is the command a user would run to send the message.
-Optional ABORTFUNC is the command a user would type to abort the
+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. Reporter will install `reporter-bug-hook' onto this
-hook so that empty bug reports can be suppressed by raising an error.
-If not supplied, `mail-send-hook' will be used.
+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 '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 (&rest args) (or (apply 'mail args)
- (error "Message aborted")))
+ '(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."
;; 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.
+;; 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
;; If this is reading a file name, and the file name chosen
;; is a directory, don't exit the minibuffer.