;;; 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.
+ (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.
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.
(require 'shell) (shell-mode)
(set-process-sentinel proc 'shell-command-sentinel)
))
- (shell-command-on-region (point) (point) command nil)
+ (shell-command-on-region (point) (point) command output-buffer)
))))))
;; We have a sentinel to prevent insertion of a termination message
;; then replace that region with the output.
(progn (setq buffer-read-only nil)
(delete-region (max start end) (point-max))
- (delete-region (point-min) (max start end))
+ (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)
(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))
;; 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
"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.
(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.
+;; It returns t if it really did any work.
(defun do-auto-fill ()
(let (fc justify bol give-up
(fill-prefix fill-prefix))
(let ((fill-point
(let ((opoint (point))
bounce
- (first t))
+ (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 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 (bolp)
+ (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,
(setq give-up t)))
;; No place to break => stop trying.
(setq give-up t))))
- ;; justify last line
- (justify-current-line justify t 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.
(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
+(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."
;; 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.