;;; 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.
(eq overwrite-mode 'overwrite-mode-binary))
(read-quoted-char)
(read-char))))
+ ;; Assume character codes 0200 - 0377 stand for
+ ;; European characters in Latin-1, and convert them
+ ;; to Emacs characters.
+ (and enable-multibyte-characters
+ (>= char ?\200)
+ (<= char ?\377)
+ (setq char (+ nonascii-insert-offset char)))
(if (> arg 0)
(if (eq overwrite-mode 'overwrite-mode-binary)
(delete-char 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."
(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.")
-(defvar 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)
-(defvar 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.")
-(defvar 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.
(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)
-(defvar 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.
(setq arg (1+ arg))))
(let ((buffer-invisibility-spec nil))
(move-to-column (or goal-column temporary-goal-column))))
+ (setq new (point))
+ ;; If we are moving into some intangible text,
+ ;; look for following text on the same line which isn't intangible
+ ;; and move there.
+ (let ((after (and (< new (point-max))
+ (get-char-property new 'intangible)))
+ (before (and (> new (point-min))
+ (get-char-property (1- new) 'intangible)))
+ line-end)
+ (when (and before (eq before after))
+ (setq line-end (save-excursion (end-of-line) (point)))
+ (goto-char (point-min))
+ (let ((inhibit-point-motion-hooks nil))
+ (goto-char new))
+ (if (<= new line-end)
+ (setq new (point)))))
;; Remember where we moved to, go back home,
;; then do the motion over again
;; in just one step, with intangibility and point-motion hooks
;; enabled this time.
- (setq new (point))
(goto-char opoint)
(setq inhibit-point-motion-hooks nil)
(goto-char new)))
;;; 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."
(delete-region (point) (+ (point) len1))
(insert word2)))
\f
-(defvar 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)
-(defvar 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)
-(defvar 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)
-(defvar 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)
(defvar comment-indent-hook nil
"Obsolete variable for function to compute desired indentation for a comment.
This function is called with no args with point at the beginning of
the comment's starting delimiter.")
-(defvar 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)
-(defvar 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."
(buffer-substring start end)))
(buffer-substring start end)))))
\f
-(defvar 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)
-(defvar 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.
(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]*$")))
+ (save-excursion (forward-paragraph 1) (point)))))
(and prefix (not (equal prefix ""))
(setq fill-prefix prefix))))
;; 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)))))))
+ (forward-char 1))))
+ (if (and enable-kinsoku enable-multibyte-characters)
+ (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,
"Set `fill-column' to specified argument.
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"))))
+ (if (consp arg)
+ (setq arg (current-column)))
+ (if (not (integerp arg))
+ ;; Disallow missing argument; it's probably a typo for C-x C-f.
+ (error "set-fill-column requires an explicit argument")
+ (message "Fill column set to %d (was %d)" arg fill-column)
+ (setq fill-column arg)))
\f
-(defvar 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)
-(defvar 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)
-(defvar 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)
-(defvar 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
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)
(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))))
SEND-ACTIONS is a list of actions to call when the message is sent.
Each action has the form (FUNCTION . ARGS)."
- (interactive)
+ (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.
(completion-list-mode)
(make-local-variable 'completion-reference-buffer)
(setq completion-reference-buffer mainbuf)
-;;; The value 0 is right in most cases, but not for file name completion.
-;;; so this has to be turned off.
-;;; (setq completion-base-size 0)
+ (if (eq minibuffer-completion-table 'read-file-name-internal)
+ ;; For file name completion,
+ ;; use the number of chars before the start of the
+ ;; last file name component.
+ (setq completion-base-size
+ (save-excursion
+ (set-buffer mainbuf)
+ (goto-char (point-max))
+ (skip-chars-backward (format "^%c" directory-sep-char))
+ (- (point) (point-min))))
+ ;; Otherwise, the whole input is the text being completed.
+ (setq completion-base-size 0))
(goto-char (point-min))
(if window-system
(insert (substitute-command-keys
HCoop / bpt / emacs.git / blobdiff