X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/7fcce20f6949bffc680fd8bd828344fdf04b5748..80070cca29719721131a14f1760619d5228ca677:/lisp/simple.el diff --git a/lisp/simple.el b/lisp/simple.el index 4d1369dded..f06a279c9c 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1,8 +1,7 @@ ;;; simple.el --- basic editing commands for Emacs ;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -;; 2000, 2001, 2002, 2003, 2004, 2005 -;; Free Software Foundation, Inc. +;; 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal @@ -21,8 +20,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -35,6 +34,8 @@ (autoload 'widget-convert "wid-edit") (autoload 'shell-mode "shell")) +(defvar compilation-current-error) + (defcustom idle-update-delay 0.5 "*Idle time delay before updating various things on the screen. Various Emacs features that update auxiliary information when point moves @@ -51,8 +52,6 @@ wait this many seconds after Emacs becomes idle before doing an update." "Highlight (un)matching of parens and expressions." :group 'matching) -(define-key global-map [?\C-x right] 'next-buffer) -(define-key global-map [?\C-x left] 'prev-buffer) (defun next-buffer () "Switch to the next buffer in cyclic order." (interactive) @@ -76,7 +75,7 @@ wait this many seconds after Emacs becomes idle before doing an update." ;;; next-error support framework (defgroup next-error nil - "next-error support framework." + "`next-error' support framework." :group 'compilation :version "22.1") @@ -88,8 +87,8 @@ wait this many seconds after Emacs becomes idle before doing an update." (defcustom next-error-highlight 0.1 "*Highlighting of locations in selected source buffers. -If number, highlight the locus in next-error face for given time in seconds. -If t, use persistent overlays fontified in next-error face. +If number, highlight the locus in `next-error' face for given time in seconds. +If t, use persistent overlays fontified in `next-error' face. If nil, don't highlight the locus in the source buffer. If `fringe-arrow', indicate the locus by the fringe arrow." :type '(choice (number :tag "Delay") @@ -101,8 +100,8 @@ If `fringe-arrow', indicate the locus by the fringe arrow." (defcustom next-error-highlight-no-select 0.1 "*Highlighting of locations in non-selected source buffers. -If number, highlight the locus in next-error face for given time in seconds. -If t, use persistent overlays fontified in next-error face. +If number, highlight the locus in `next-error' face for given time in seconds. +If t, use persistent overlays fontified in `next-error' face. If nil, don't highlight the locus in the source buffer. If `fringe-arrow', indicate the locus by the fringe arrow." :type '(choice (number :tag "Delay") @@ -112,10 +111,19 @@ If `fringe-arrow', indicate the locus by the fringe arrow." :group 'next-error :version "22.1") +(defcustom next-error-hook nil + "*List of hook functions run by `next-error' after visiting source file." + :type 'hook + :group 'next-error) + (defvar next-error-highlight-timer nil) +(defvar next-error-overlay-arrow-position nil) +(put 'next-error-overlay-arrow-position 'overlay-arrow-string "=>") +(add-to-list 'overlay-arrow-variable-list 'next-error-overlay-arrow-position) + (defvar next-error-last-buffer nil - "The most recent next-error buffer. + "The most recent `next-error' buffer. A buffer becomes most recent when its compilation, grep, or similar mode is started, or when it is used with \\[next-error] or \\[compile-goto-error].") @@ -136,7 +144,7 @@ to navigate in it.") &optional avoid-current extra-test-inclusive extra-test-exclusive) - "Test if BUFFER is a next-error capable buffer. + "Test if BUFFER is a `next-error' capable buffer. If AVOID-CURRENT is non-nil, treat the current buffer as an absolute last resort only. @@ -146,7 +154,7 @@ that normally would not qualify. If it returns t, the buffer in question is treated as usable. The function EXTRA-TEST-EXCLUSIVE, if non-nil is called in each buffer -that would normally be considered usable. if it returns nil, +that would normally be considered usable. If it returns nil, that buffer is rejected." (and (buffer-name buffer) ;First make sure it's live. (not (and avoid-current (eq buffer (current-buffer)))) @@ -163,11 +171,11 @@ that buffer is rejected." (defun next-error-find-buffer (&optional avoid-current extra-test-inclusive extra-test-exclusive) - "Return a next-error capable buffer. + "Return a `next-error' capable buffer. If AVOID-CURRENT is non-nil, treat the current buffer as an absolute last resort only. -The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffers +The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer that normally would not qualify. If it returns t, the buffer in question is treated as usable. @@ -216,7 +224,7 @@ that buffer is rejected." (error "No next-error capable buffer found"))) (defun next-error (&optional arg reset) - "Visit next next-error message and corresponding source code. + "Visit next `next-error' message and corresponding source code. If all the error messages parsed so far have been processed already, the message buffer is checked for new ones. @@ -238,9 +246,10 @@ To specify use of a particular buffer for error messages, type \\[next-error] in that buffer when it is the only one displayed in the current frame. -Once \\[next-error] has chosen the buffer for error messages, -it stays with that buffer until you use it in some other buffer which -uses Compilation mode or Compilation Minor mode. +Once \\[next-error] has chosen the buffer for error messages, it +runs `next-error-hook' with `run-hooks', and stays with that buffer +until you use it in some other buffer which uses Compilation mode +or Compilation Minor mode. See variables `compilation-parse-errors-function' and \`compilation-error-regexp-alist' for customization ideas." @@ -249,15 +258,14 @@ See variables `compilation-parse-errors-function' and (when (setq next-error-last-buffer (next-error-find-buffer)) ;; we know here that next-error-function is a valid symbol we can funcall (with-current-buffer next-error-last-buffer - (funcall next-error-function (prefix-numeric-value arg) reset)))) + (funcall next-error-function (prefix-numeric-value arg) reset) + (run-hooks 'next-error-hook)))) (defalias 'goto-next-locus 'next-error) (defalias 'next-match 'next-error) -(define-key ctl-x-map "`" 'next-error) - (defun previous-error (&optional n) - "Visit previous next-error message and corresponding source code. + "Visit previous `next-error' message and corresponding source code. Prefix arg N says how many error messages to move backwards (or forwards, if negative). @@ -275,7 +283,7 @@ This operates on the output from the \\[compile] command, for instance." (next-error n t)) (defun next-error-no-select (&optional n) - "Move point to the next error in the next-error buffer and highlight match. + "Move point to the next error in the `next-error' buffer and highlight match. Prefix arg N says how many error messages to move forwards (or backwards, if negative). Finds and highlights the source line like \\[next-error], but does not @@ -286,7 +294,7 @@ select the source buffer." (pop-to-buffer next-error-last-buffer)) (defun previous-error-no-select (&optional n) - "Move point to the previous error in the next-error buffer and highlight match. + "Move point to the previous error in the `next-error' buffer and highlight match. Prefix arg N says how many error messages to move backwards (or forwards, if negative). Finds and highlights the source line like \\[previous-error], but does not @@ -302,11 +310,11 @@ select the source buffer." When turned on, cursor motion in the compilation, grep, occur or diff buffer causes automatic display of the corresponding source code location." - nil " Fol" nil + :group 'next-error :init-value nil :lighter " Fol" (if (not next-error-follow-minor-mode) (remove-hook 'post-command-hook 'next-error-follow-mode-post-command-hook t) (add-hook 'post-command-hook 'next-error-follow-mode-post-command-hook nil t) - (make-variable-buffer-local 'next-error-follow-last-line))) + (make-local-variable 'next-error-follow-last-line))) ;;; Used as a `post-command-hook' by `next-error-follow-mode' ;;; for the *Compilation* *grep* and *Occur* buffers. @@ -327,7 +335,8 @@ location." Other major modes are defined by comparison with this one." (interactive) (kill-all-local-variables) - (run-hooks 'after-change-major-mode-hook)) + (unless delay-mode-hooks + (run-hooks 'after-change-major-mode-hook))) ;; Making and deleting lines. @@ -418,8 +427,8 @@ than the value of `fill-column' and ARG is nil." (defun open-line (n) "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 -if the line would have been blank. +If there is a fill prefix and/or a `left-margin', insert them +on the new line if the line would have been blank. With arg N, insert N newlines." (interactive "*p") (let* ((do-fill-prefix (and fill-prefix (bolp))) @@ -441,7 +450,7 @@ With arg N, insert N newlines." (defun split-line (&optional arg) "Split current line, moving portion beyond point vertically down. If the current line starts with `fill-prefix', insert it on the new -line as well. With prefix ARG, don't insert fill-prefix on new line. +line as well. With prefix ARG, don't insert `fill-prefix' on new line. When called from Lisp code, ARG may be a prefix string to copy." (interactive "*P") @@ -639,7 +648,7 @@ Leave one space or none, according to the context." (save-excursion (forward-char -1) (looking-at "$\\|\\s(\\|\\s'"))) nil - (insert ?\ )))) + (insert ?\s)))) (defun delete-horizontal-space (&optional backward-only) "Delete all spaces and tabs around point. @@ -663,9 +672,9 @@ If BACKWARD-ONLY is non-nil, only delete spaces before point." (skip-chars-backward " \t") (constrain-to-field nil orig-pos) (dotimes (i (or n 1)) - (if (= (following-char) ?\ ) + (if (= (following-char) ?\s) (forward-char 1) - (insert ?\ ))) + (insert ?\s))) (delete-region (point) (progn @@ -920,21 +929,21 @@ in *Help* buffer. See also the command `describe-char'." (defvar read-expression-history nil) (defcustom eval-expression-print-level 4 - "*Value to use for `print-level' when printing value in `eval-expression'. + "Value for `print-level' while printing value in `eval-expression'. A value of nil means no limit." :group 'lisp :type '(choice (const :tag "No Limit" nil) integer) :version "21.1") (defcustom eval-expression-print-length 12 - "*Value to use for `print-length' when printing value in `eval-expression'. + "Value for `print-length' while printing value in `eval-expression'. A value of nil means no limit." :group 'lisp :type '(choice (const :tag "No Limit" nil) integer) :version "21.1") (defcustom eval-expression-debug-on-error t - "*Non-nil means set `debug-on-error' when evaluating in `eval-expression'. + "If non-nil set `debug-on-error' to t in `eval-expression'. If nil, don't change the value of `debug-on-error'." :group 'lisp :type 'boolean @@ -1266,7 +1275,7 @@ by the new completion." ;; For compatibility with the old subr of the same name. (defun minibuffer-prompt-width () "Return the display width of the minibuffer prompt. -Return 0 if current buffer is not a mini-buffer." +Return 0 if current buffer is not a minibuffer." ;; Return the width of everything before the field at the end of ;; the buffer; this should be 0 for normal buffers. (1- (minibuffer-prompt-end))) @@ -1275,7 +1284,9 @@ Return 0 if current buffer is not a mini-buffer." (defalias 'advertised-undo 'undo) (defconst undo-equiv-table (make-hash-table :test 'eq :weakness t) - "Table mapping redo records to the corresponding undo one.") + "Table mapping redo records to the corresponding undo one. +A redo record for undo-in-region maps to t. +A redo record for ordinary undo maps to the following (earlier) undo.") (defvar undo-in-region nil "Non-nil if `pending-undo-list' is not just a tail of `buffer-undo-list'.") @@ -1285,7 +1296,7 @@ Return 0 if current buffer is not a mini-buffer." (defvar pending-undo-list nil "Within a run of consecutive undo commands, list remaining to be undone. -t if we undid all the way to the end of it.") +If t, we undid all the way to the end of it.") (defun undo (&optional arg) "Undo some previous changes. @@ -1335,7 +1346,7 @@ as an argument limits undo to changes within the current region." (message (if undo-in-region (if equiv "Redo in region!" "Undo in region!") (if equiv "Redo!" "Undo!")))) - (when (and equiv undo-no-redo) + (when (and (consp equiv) undo-no-redo) ;; The equiv entry might point to another redo record if we have done ;; undo-redo-undo-redo-... so skip to the very last equiv. (while (let ((next (gethash equiv undo-equiv-table))) @@ -1346,10 +1357,13 @@ as an argument limits undo to changes within the current region." (prefix-numeric-value arg) 1)) ;; Record the fact that the just-generated undo records come from an - ;; undo operation, so we can skip them later on. + ;; undo operation--that is, they are redo records. + ;; In the ordinary case (not within a region), map the redo + ;; record to the following undos. ;; I don't know how to do that in the undo-in-region case. - (unless undo-in-region - (puthash buffer-undo-list pending-undo-list undo-equiv-table)) + (puthash buffer-undo-list + (if undo-in-region t pending-undo-list) + undo-equiv-table) ;; Don't specify a position in the undo record for the undo command. ;; Instead, undoing this should move point to where the change is. (let ((tail buffer-undo-list) @@ -1389,24 +1403,21 @@ A numeric argument serves as a repeat count. Contrary to `undo', this will not redo a previous undo." (interactive "*p") (let ((undo-no-redo t)) (undo arg))) -;; Richard said that we should not use C-x and I have -;; no idea whereas to bind it. Any suggestion welcome. -stef -;; (define-key ctl-x-map "U" 'undo-only) (defvar undo-in-progress nil "Non-nil while performing an undo. Some change-hooks test this variable to do something different.") -(defun undo-more (count) +(defun undo-more (n) "Undo back N undo-boundaries beyond what was already undone recently. Call `undo-start' to get ready to undo recent changes, then call `undo-more' one or more times to undo them." (or (listp pending-undo-list) - (error (format "No further undo information%s" - (if (and transient-mark-mode mark-active) - " for region" "")))) + (error (concat "No further undo information" + (and transient-mark-mode mark-active + " for region")))) (let ((undo-in-progress t)) - (setq pending-undo-list (primitive-undo count pending-undo-list)) + (setq pending-undo-list (primitive-undo n pending-undo-list)) (if (null pending-undo-list) (setq pending-undo-list t)))) @@ -2245,7 +2256,7 @@ is nil, the buffer substring is returned unaltered. If DELETE is non-nil, the text between BEG and END is deleted from the buffer. -Point is temporarily set to BEG before caling +Point is temporarily set to BEG before calling `buffer-substring-filters', in case the functions need to know where the text came from. @@ -2335,7 +2346,7 @@ handler, if non-nil, is stored as a `yank-handler' text property on STRING). When the yank handler has a non-nil PARAM element, the original STRING argument is not used by `insert-for-yank'. However, since Lisp code -may access and use elements from the kill-ring directly, the STRING +may access and use elements from the kill ring directly, the STRING argument should still be a \"useful\" string for such uses." (if (> (length string) 0) (if yank-handler @@ -2539,7 +2550,7 @@ The argument is used for internal purposes; do not supply one." ;; This is actually used in subr.el but defcustom does not work there. (defcustom yank-excluded-properties '(read-only invisible intangible field mouse-face help-echo local-map keymap - yank-handler) + yank-handler follow-link) "*Text properties to discard when yanking. The value should be a list of text properties to discard or t, which means to discard all text properties." @@ -2566,7 +2577,11 @@ With argument N, insert the Nth previous kill. If N is negative, this is a more recent kill. The sequence of kills wraps around, so that after the oldest one -comes the newest one." +comes the newest one. + +When this command inserts killed text into the buffer, it honors +`yank-excluded-properties' and `yank-handler' as described in the +doc string for `insert-for-yank-1', which see." (interactive "*p") (if (not (eq last-command 'yank)) (error "Previous command was not a yank")) @@ -2598,6 +2613,11 @@ killed OR yanked. Put point at end, and set mark at beginning. With just \\[universal-argument] as argument, same but put point at beginning (and mark at end). With argument N, reinsert the Nth most recently killed stretch of killed text. + +When this command inserts killed text into the buffer, it honors +`yank-excluded-properties' and `yank-handler' as described in the +doc string for `insert-for-yank-1', which see. + See also the command \\[yank-pop]." (interactive "*P") (setq yank-window-start (window-start)) @@ -2665,7 +2685,7 @@ and KILLP is t if a prefix arg was specified." (let ((col (current-column))) (forward-char -1) (setq col (- col (current-column))) - (insert-char ?\ col) + (insert-char ?\s col) (delete-char 1))) (forward-char -1) (setq count (1- count)))))) @@ -2752,7 +2772,7 @@ even beep.)" "Kill current line. With prefix arg, kill that many lines starting from the current line. If arg is negative, kill backward. Also kill the preceding newline. -\(This is meant to make C-x z work well with negative arguments.\) +\(This is meant to make \\[repeat] work well with negative arguments.\) If arg is zero, kill current line but exclude the trailing newline." (interactive "p") (if (and (> arg 0) (eobp) (save-excursion (forward-visible-line 0) (eobp))) @@ -2999,7 +3019,7 @@ the user to see that the mark has moved, and you want the previous mark position to be lost. Normally, when a new mark is set, the old one should go on the stack. -This is why most applications should use push-mark, not set-mark. +This is why most applications should use `push-mark', not `set-mark'. Novice Emacs Lisp programmers often try to use the mark for the wrong purposes. The mark saves a location for the user's convenience. @@ -3197,6 +3217,14 @@ Invoke \\[apropos-documentation] and type \"transient\" or commands which are sensitive to the Transient Mark mode." :global t :group 'editing-basics :require nil) +(defvar widen-automatically t + "Non-nil means it is ok for commands to call `widen' when they want to. +Some commands will do this in order to go to positions outside +the current accessible part of the buffer. + +If `widen-automatically' is nil, these commands will do something else +as a fallback, and won't change the buffer bounds.") + (defun pop-global-mark () "Pop off global mark ring and jump to the top location." (interactive) @@ -3213,7 +3241,9 @@ commands which are sensitive to the Transient Mark mode." (set-buffer buffer) (or (and (>= position (point-min)) (<= position (point-max))) - (widen)) + (if widen-automatically + (widen) + (error "Global mark position is outside accessible part of buffer"))) (goto-char position) (switch-to-buffer buffer))) @@ -3321,34 +3351,43 @@ Outline mode sets this." (or (memq prop buffer-invisibility-spec) (assq prop buffer-invisibility-spec))))) -;; Perform vertical scrolling of tall images if necessary. -;; Don't vscroll in a keyboard macro. +;; This is like line-move-1 except that it also performs +;; vertical scrolling of tall images if appropriate. +;; That is not really a clean thing to do, since it mixes +;; scrolling with cursor motion. But so far we don't have +;; a cleaner solution to the problem of making C-n do something +;; useful given a tall image. (defun line-move (arg &optional noerror to-end try-vscroll) (if (and auto-window-vscroll try-vscroll + ;; But don't vscroll in a keyboard macro. (not defining-kbd-macro) (not executing-kbd-macro)) (let ((forward (> arg 0)) (part (nth 2 (pos-visible-in-window-p (point) nil t)))) (if (and (consp part) - (> (setq part (if forward (cdr part) (car part))) 0)) + (> (if forward (cdr part) (car part)) 0)) (set-window-vscroll nil (if forward (+ (window-vscroll nil t) - (min part + (min (cdr part) (* (frame-char-height) arg))) (max 0 (- (window-vscroll nil t) - (min part + (min (car part) (* (frame-char-height) (- arg)))))) t) (set-window-vscroll nil 0) (when (line-move-1 arg noerror to-end) - (sit-for 0) - (if (and (not forward) - (setq part (nth 2 (pos-visible-in-window-p - (line-beginning-position) nil t))) - (> (cdr part) 0)) - (set-window-vscroll nil (cdr part) t)) + (when (not forward) + ;; Update display before calling pos-visible-in-window-p, + ;; because it depends on window-start being up-to-date. + (sit-for 0) + ;; If the current line is partly hidden at the bottom, + ;; scroll it partially up so as to unhide the bottom. + (if (and (setq part (nth 2 (pos-visible-in-window-p + (line-beginning-position) nil t))) + (> (cdr part) 0)) + (set-window-vscroll nil (cdr part) t))) t))) (line-move-1 arg noerror to-end))) @@ -3401,19 +3440,42 @@ Outline mode sets this." (goto-char (next-char-property-change (point)))) ;; Now move a line. (end-of-line) - (and (zerop (vertical-motion 1)) - (if (not noerror) - (signal 'end-of-buffer nil) - (setq done t))) + ;; If there's no invisibility here, move over the newline. + (cond + ((eobp) + (if (not noerror) + (signal 'end-of-buffer nil) + (setq done t))) + ((and (> arg 1) ;; Use vertical-motion for last move + (not (integerp selective-display)) + (not (line-move-invisible-p (point)))) + ;; We avoid vertical-motion when possible + ;; because that has to fontify. + (forward-line 1)) + ;; Otherwise move a more sophisticated way. + ((zerop (vertical-motion 1)) + (if (not noerror) + (signal 'end-of-buffer nil) + (setq done t)))) (unless done (setq arg (1- arg)))) + ;; The logic of this is the same as the loop above, + ;; it just goes in the other direction. (while (and (< arg 0) (not done)) (beginning-of-line) - - (if (zerop (vertical-motion -1)) - (if (not noerror) - (signal 'beginning-of-buffer nil) - (setq done t))) + (cond + ((bobp) + (if (not noerror) + (signal 'beginning-of-buffer nil) + (setq done t))) + ((and (< arg -1) ;; Use vertical-motion for last move + (not (integerp selective-display)) + (not (line-move-invisible-p (1- (point))))) + (forward-line -1)) + ((zerop (vertical-motion -1)) + (if (not noerror) + (signal 'beginning-of-buffer nil) + (setq done t)))) (unless done (setq arg (1+ arg)) (while (and ;; Don't move over previous invis lines @@ -3430,8 +3492,8 @@ Outline mode sets this." ;; at least go to end of line. (end-of-line)) ((< arg 0) - ;; If we did not move down as far as desired, - ;; at least go to end of line. + ;; If we did not move up as far as desired, + ;; at least go to beginning of line. (beginning-of-line)) (t (line-move-finish (or goal-column temporary-goal-column) @@ -3606,9 +3668,18 @@ The goal column is stored in the variable `goal-column'." (setq goal-column nil) (message "No goal column")) (setq goal-column (current-column)) - (message (substitute-command-keys - "Goal column %d (use \\[set-goal-column] with an arg to unset it)") - goal-column)) + ;; The older method below can be erroneous if `set-goal-column' is bound + ;; to a sequence containing % + ;;(message (substitute-command-keys + ;;"Goal column %d (use \\[set-goal-column] with an arg to unset it)") + ;;goal-column) + (message "%s" + (concat + (format "Goal column %d " goal-column) + (substitute-command-keys + "(use \\[set-goal-column] with an arg to unset it)"))) + + ) nil) @@ -3622,7 +3693,6 @@ For more details, see the documentation for `scroll-other-window'." (if (eq lines '-) nil (if (null lines) '- (- (prefix-numeric-value lines)))))) -(define-key esc-map [?\C-\S-v] 'scroll-other-window-down) (defun beginning-of-buffer-other-window (arg) "Move point to the beginning of the buffer in the other window. @@ -3874,9 +3944,7 @@ If optional arg REALLY-WORD is non-nil, it finds just a word." This function is only called during auto-filling of a comment section. The function should take a single optional argument, which is a flag -indicating whether it should use soft newlines. - -Setting this variable automatically makes it local to the current buffer.") +indicating whether it should use soft newlines.") ;; This function is used as the auto-fill-function of a buffer ;; when Auto-Fill mode is enabled. @@ -4017,7 +4085,7 @@ Just \\[universal-argument] as argument means to use the current column." (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") + (error "set-fill-column requires an explicit argument") (message "Fill column set to %d (was %d)" arg fill-column) (setq fill-column arg))) @@ -4097,7 +4165,7 @@ with the character typed. typing characters do. Note that binary overwrite mode is not its own minor mode; it is a -specialization of overwrite-mode, entered by setting the +specialization of overwrite mode, entered by setting the `overwrite-mode' variable to `overwrite-mode-binary'." (interactive "P") (setq overwrite-mode @@ -4150,8 +4218,9 @@ when it is off screen)." :group 'paren-blinking) (defcustom blink-matching-paren-distance (* 25 1024) - "*If non-nil, is maximum distance to search for matching open-paren." - :type 'integer + "*If non-nil, maximum distance to search backwards for matching open-paren. +If nil, search stops at the beginning of the accessible portion of the buffer." + :type '(choice (const nil) integer) :group 'paren-blinking) (defcustom blink-matching-delay 1 @@ -4167,87 +4236,90 @@ when it is off screen)." (defun blink-matching-open () "Move cursor momentarily to the beginning of the sexp before point." (interactive) - (and (> (point) (1+ (point-min))) - blink-matching-paren - ;; Verify an even number of quoting characters precede the close. - (= 1 (logand 1 (- (point) - (save-excursion - (forward-char -1) - (skip-syntax-backward "/\\") - (point))))) - (let* ((oldpos (point)) - (blinkpos) - (mismatch) - matching-paren) - (save-excursion - (save-restriction - (if blink-matching-paren-distance - (narrow-to-region (max (point-min) - (- (point) blink-matching-paren-distance)) - oldpos)) - (condition-case () - (let ((parse-sexp-ignore-comments - (and parse-sexp-ignore-comments - (not blink-matching-paren-dont-ignore-comments)))) - (setq blinkpos (scan-sexps oldpos -1))) - (error nil))) - (and blinkpos - (not (eq (car (syntax-after blinkpos)) 8)) ;Not syntax '$'. - (setq matching-paren - (let ((syntax (syntax-after blinkpos))) - (and (consp syntax) - (eq (logand (car syntax) 255) 4) - (cdr syntax))) - mismatch - (or (null matching-paren) - (/= (char-after (1- oldpos)) - matching-paren)))) - (if mismatch (setq blinkpos nil)) - (if blinkpos - ;; Don't log messages about paren matching. - (let (message-log-max) - (goto-char blinkpos) - (if (pos-visible-in-window-p) - (and blink-matching-paren-on-screen - (sit-for blink-matching-delay)) - (goto-char blinkpos) - (message - "Matches %s" - ;; Show what precedes the open in its line, if anything. - (if (save-excursion - (skip-chars-backward " \t") - (not (bolp))) - (buffer-substring (progn (beginning-of-line) (point)) - (1+ blinkpos)) - ;; Show what follows the open in its line, if anything. - (if (save-excursion - (forward-char 1) - (skip-chars-forward " \t") - (not (eolp))) - (buffer-substring blinkpos - (progn (end-of-line) (point))) - ;; Otherwise show the previous nonblank line, - ;; if there is one. - (if (save-excursion - (skip-chars-backward "\n \t") - (not (bobp))) - (concat - (buffer-substring (progn + (when (and (> (point) (1+ (point-min))) + blink-matching-paren + ;; Verify an even number of quoting characters precede the close. + (= 1 (logand 1 (- (point) + (save-excursion + (forward-char -1) + (skip-syntax-backward "/\\") + (point)))))) + (let* ((oldpos (point)) + blinkpos + message-log-max ; Don't log messages about paren matching. + matching-paren + open-paren-line-string) + (save-excursion + (save-restriction + (if blink-matching-paren-distance + (narrow-to-region (max (point-min) + (- (point) blink-matching-paren-distance)) + oldpos)) + (condition-case () + (let ((parse-sexp-ignore-comments + (and parse-sexp-ignore-comments + (not blink-matching-paren-dont-ignore-comments)))) + (setq blinkpos (scan-sexps oldpos -1))) + (error nil))) + (and blinkpos + ;; Not syntax '$'. + (not (eq (syntax-class (syntax-after blinkpos)) 8)) + (setq matching-paren + (let ((syntax (syntax-after blinkpos))) + (and (consp syntax) + (eq (syntax-class syntax) 4) + (cdr syntax))))) + (cond + ((or (null matching-paren) + (/= (char-before oldpos) + matching-paren)) + (message "Mismatched parentheses")) + ((not blinkpos) + (if (not blink-matching-paren-distance) + (message "Unmatched parenthesis"))) + ((pos-visible-in-window-p blinkpos) + ;; Matching open within window, temporarily move to blinkpos but only + ;; if `blink-matching-paren-on-screen' is non-nil. + (when blink-matching-paren-on-screen + (save-excursion + (goto-char blinkpos) + (sit-for blink-matching-delay)))) + (t + (save-excursion + (goto-char blinkpos) + (setq open-paren-line-string + ;; Show what precedes the open in its line, if anything. + (if (save-excursion + (skip-chars-backward " \t") + (not (bolp))) + (buffer-substring (line-beginning-position) + (1+ blinkpos)) + ;; Show what follows the open in its line, if anything. + (if (save-excursion + (forward-char 1) + (skip-chars-forward " \t") + (not (eolp))) + (buffer-substring blinkpos + (line-end-position)) + ;; Otherwise show the previous nonblank line, + ;; if there is one. + (if (save-excursion + (skip-chars-backward "\n \t") + (not (bobp))) + (concat + (buffer-substring (progn (skip-chars-backward "\n \t") - (beginning-of-line) - (point)) - (progn (end-of-line) - (skip-chars-backward " \t") - (point))) - ;; Replace the newline and other whitespace with `...'. - "..." - (buffer-substring blinkpos (1+ blinkpos))) - ;; There is nothing to show except the char itself. - (buffer-substring blinkpos (1+ blinkpos)))))))) - (cond (mismatch - (message "Mismatched parentheses")) - ((not blink-matching-paren-distance) - (message "Unmatched parenthesis")))))))) + (line-beginning-position)) + (progn (end-of-line) + (skip-chars-backward " \t") + (point))) + ;; Replace the newline and other whitespace with `...'. + "..." + (buffer-substring blinkpos (1+ blinkpos))) + ;; There is nothing to show except the char itself. + (buffer-substring blinkpos (1+ blinkpos))))))) + (message "Matches %s" + (substring-no-properties open-paren-line-string)))))))) ;Turned off because it makes dbx bomb out. (setq blink-paren-function 'blink-matching-open) @@ -4266,8 +4338,6 @@ At top-level, as an editor command, this simply beeps." (setq defining-kbd-macro nil) (signal 'quit nil)) -(define-key global-map "\C-g" 'keyboard-quit) - (defvar buffer-quit-function nil "Function to call to \"quit\" the current buffer, or nil if none. \\[keyboard-escape-quit] calls this function when its more local actions @@ -4310,7 +4380,6 @@ specification for `play-sound'." (push 'sound sound) (play-sound sound))) -(define-key global-map "\e\e\e" 'keyboard-escape-quit) (defcustom read-mail-command 'rmail "*Your preference for a mail reading package. @@ -4457,10 +4526,11 @@ Each action has the form (FUNCTION . ARGS)." (defvar set-variable-value-history nil "History of values entered with `set-variable'.") -(defun set-variable (var val &optional make-local) +(defun set-variable (variable value &optional make-local) "Set VARIABLE to VALUE. VALUE is a Lisp object. -When using this interactively, enter a Lisp object for VALUE. -If you want VALUE to be a string, you must surround it with doublequotes. +VARIABLE should be a user option variable name, a Lisp variable +meant to be customized by users. You should enter VALUE in Lisp syntax, +so 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 @@ -4473,45 +4543,52 @@ With a prefix argument, set VARIABLE to VALUE buffer-locally." (interactive (let* ((default-var (variable-at-point)) (var (if (symbolp default-var) - (read-variable (format "Set variable (default %s): " default-var) - default-var) - (read-variable "Set variable: "))) + (read-variable (format "Set variable (default %s): " default-var) + default-var) + (read-variable "Set variable: "))) (minibuffer-help-form '(describe-variable var)) (prop (get var 'variable-interactive)) - (prompt (format "Set %s%s to value: " var + (obsolete (car (get var 'byte-obsolete-variable))) + (prompt (format "Set %s %s to value: " var (cond ((local-variable-p var) - " (buffer-local)") + "(buffer-local)") ((or current-prefix-arg (local-variable-if-set-p var)) - " buffer-locally") - (t " globally")))) - (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))))) + "buffer-locally") + (t "globally")))) + (val (progn + (when obsolete + (message (concat "`%S' is obsolete; " + (if (symbolp obsolete) "use `%S' instead" "%s")) + var obsolete) + (sit-for 3)) + (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 current-prefix-arg))) - (and (custom-variable-p var) - (not (get var 'custom-type)) - (custom-load-symbol var)) - (let ((type (get var 'custom-type))) + (and (custom-variable-p variable) + (not (get variable 'custom-type)) + (custom-load-symbol variable)) + (let ((type (get variable 'custom-type))) (when type ;; Match with custom type. (require 'cus-edit) (setq type (widget-convert type)) - (unless (widget-apply type :match val) + (unless (widget-apply type :match value) (error "Value `%S' does not match type %S of %S" - val (car type) var)))) + value (car type) variable)))) (if make-local - (make-local-variable var)) + (make-local-variable variable)) - (set var val) + (set variable value) ;; Force a thorough redisplay for the case that the variable ;; has an effect on the display, like `tab-width' has. @@ -4723,7 +4800,7 @@ Use \\\\[mouse-choose-completion] to select one\ (setq major-mode 'completion-list-mode) (make-local-variable 'completion-base-size) (setq completion-base-size nil) - (run-hooks 'completion-list-mode-hook)) + (run-mode-hooks 'completion-list-mode-hook)) (defun completion-list-mode-finish () "Finish setup of the completions buffer. @@ -4792,7 +4869,11 @@ of the differing parts is, by contrast, slightly highlighted." (- (point) (minibuffer-prompt-end))))) ;; Otherwise, in minibuffer, the whole input is being completed. (if (minibufferp mainbuf) - (setq completion-base-size 0))) + (if (and (symbolp minibuffer-completion-table) + (get minibuffer-completion-table 'completion-base-size-function)) + (setq completion-base-size + (funcall (get minibuffer-completion-table 'completion-base-size-function))) + (setq completion-base-size 0)))) ;; Put faces on first uncommon characters and common parts. (when completion-base-size (let* ((common-string-length @@ -4931,7 +5012,7 @@ PREFIX is the string that represents this modifier in an event type symbol." (define-key function-key-map (vector keypad) (vector normal)))) '((kp-0 ?0) (kp-1 ?1) (kp-2 ?2) (kp-3 ?3) (kp-4 ?4) (kp-5 ?5) (kp-6 ?6) (kp-7 ?7) (kp-8 ?8) (kp-9 ?9) - (kp-space ?\ ) + (kp-space ?\s) (kp-tab ?\t) (kp-enter ?\r) (kp-multiply ?*) @@ -5063,7 +5144,7 @@ after it has been set up properly in other respects." (defun clone-indirect-buffer (newname display-flag &optional norecord) "Create an indirect buffer that is a twin copy of the current buffer. -Give the indirect buffer name NEWNAME. Interactively, read NEW-NAME +Give the indirect buffer name NEWNAME. Interactively, read NEWNAME from the minibuffer when invoked with a prefix arg. If NEWNAME is nil or if not called with a prefix arg, NEWNAME defaults to the current buffer's name. The name is modified by adding a `' suffix to it @@ -5072,7 +5153,7 @@ or by incrementing the N in an existing suffix. DISPLAY-FLAG non-nil means show the new buffer with `pop-to-buffer'. This is always done when called interactively. -Optional last arg NORECORD non-nil means do not put this buffer at the +Optional third arg NORECORD non-nil means do not put this buffer at the front of the list of recently selected ones." (interactive (progn @@ -5103,7 +5184,6 @@ the front of the list of recently selected ones." (set-buffer buffer) (clone-indirect-buffer nil t norecord))) -(define-key ctl-x-4-map "c" 'clone-indirect-buffer-other-window) ;;; Handling of Backspace and Delete keys. @@ -5238,6 +5318,7 @@ Enabling Visible mode makes all invisible text temporarily visible. Disabling Visible mode turns off that effect. Visible mode works by saving the value of `buffer-invisibility-spec' and setting it to nil." :lighter " Vis" + :group 'editing-basics (when (local-variable-p 'vis-mode-saved-buffer-invisibility-spec) (setq buffer-invisibility-spec vis-mode-saved-buffer-invisibility-spec) (kill-local-variable 'vis-mode-saved-buffer-invisibility-spec))