/ntemacs23.1/lisp/simple.el
Emacs Lisp | 6544 lines | 5181 code | 606 blank | 757 comment | 235 complexity | 6d2a25e1237d3e531aaeefda655f008d MD5 | raw file
Possible License(s): GPL-3.0, AGPL-3.0
Large files files are truncated, but you can click here to view the full file
- ;;; 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, 2006, 2007, 2008, 2009
- ;; Free Software Foundation, Inc.
- ;; Maintainer: FSF
- ;; Keywords: internal
- ;; This file is part of GNU Emacs.
- ;; GNU Emacs is free software: you can redistribute it and/or modify
- ;; it under the terms of the GNU General Public License as published by
- ;; the Free Software Foundation, either version 3 of the License, or
- ;; (at your option) any later version.
- ;; GNU Emacs is distributed in the hope that it will be useful,
- ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- ;; GNU General Public License for more details.
- ;; You should have received a copy of the GNU General Public License
- ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
- ;;; Commentary:
- ;; A grab-bag of basic Emacs commands not specifically related to some
- ;; major mode or to file-handling.
- ;;; Code:
- ;; This is for lexical-let in apply-partially.
- (eval-when-compile (require 'cl))
- (declare-function widget-convert "wid-edit" (type &rest args))
- (declare-function 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
- wait this many seconds after Emacs becomes idle before doing an update."
- :type 'number
- :group 'display
- :version "22.1")
- (defgroup killing nil
- "Killing and yanking commands."
- :group 'editing)
- (defgroup paren-matching nil
- "Highlight (un)matching of parens and expressions."
- :group 'matching)
- (defun get-next-valid-buffer (list &optional buffer visible-ok frame)
- "Search LIST for a valid buffer to display in FRAME.
- Return nil when all buffers in LIST are undesirable for display,
- otherwise return the first suitable buffer in LIST.
- Buffers not visible in windows are preferred to visible buffers,
- unless VISIBLE-OK is non-nil.
- If the optional argument FRAME is nil, it defaults to the selected frame.
- If BUFFER is non-nil, ignore occurrences of that buffer in LIST."
- ;; This logic is more or less copied from other-buffer.
- (setq frame (or frame (selected-frame)))
- (let ((pred (frame-parameter frame 'buffer-predicate))
- found buf)
- (while (and (not found) list)
- (setq buf (car list))
- (if (and (not (eq buffer buf))
- (buffer-live-p buf)
- (or (null pred) (funcall pred buf))
- (not (eq (aref (buffer-name buf) 0) ?\s))
- (or visible-ok (null (get-buffer-window buf 'visible))))
- (setq found buf)
- (setq list (cdr list))))
- (car list)))
- (defun last-buffer (&optional buffer visible-ok frame)
- "Return the last buffer in FRAME's buffer list.
- If BUFFER is the last buffer, return the preceding buffer instead.
- Buffers not visible in windows are preferred to visible buffers,
- unless optional argument VISIBLE-OK is non-nil.
- Optional third argument FRAME nil or omitted means use the
- selected frame's buffer list.
- If no such buffer exists, return the buffer `*scratch*', creating
- it if necessary."
- (setq frame (or frame (selected-frame)))
- (or (get-next-valid-buffer (nreverse (buffer-list frame))
- buffer visible-ok frame)
- (get-buffer "*scratch*")
- (let ((scratch (get-buffer-create "*scratch*")))
- (set-buffer-major-mode scratch)
- scratch)))
- (defun next-buffer ()
- "Switch to the next buffer in cyclic order."
- (interactive)
- (let ((buffer (current-buffer)))
- (switch-to-buffer (other-buffer buffer t))
- (bury-buffer buffer)))
- (defun previous-buffer ()
- "Switch to the previous buffer in cyclic order."
- (interactive)
- (switch-to-buffer (last-buffer (current-buffer) t)))
- ;;; next-error support framework
- (defgroup next-error nil
- "`next-error' support framework."
- :group 'compilation
- :version "22.1")
- (defface next-error
- '((t (:inherit region)))
- "Face used to highlight next error locus."
- :group 'next-error
- :version "22.1")
- (defcustom next-error-highlight 0.5
- "Highlighting of locations in selected source buffers.
- If a number, highlight the locus in `next-error' face for the given time
- in seconds, or until the next command is executed.
- If t, highlight the locus until the next command is executed, or until
- some other locus replaces it.
- 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 "Highlight for specified time")
- (const :tag "Semipermanent highlighting" t)
- (const :tag "No highlighting" nil)
- (const :tag "Fringe arrow" fringe-arrow))
- :group 'next-error
- :version "22.1")
- (defcustom next-error-highlight-no-select 0.5
- "Highlighting of locations in `next-error-no-select'.
- If number, highlight the locus in `next-error' face for given time in seconds.
- If t, highlight the locus indefinitely until some other locus replaces it.
- 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 "Highlight for specified time")
- (const :tag "Semipermanent highlighting" t)
- (const :tag "No highlighting" nil)
- (const :tag "Fringe arrow" fringe-arrow))
- :group 'next-error
- :version "22.1")
- (defcustom next-error-recenter nil
- "Display the line in the visited source file recentered as specified.
- If non-nil, the value is passed directly to `recenter'."
- :type '(choice (integer :tag "Line to recenter to")
- (const :tag "Center of window" (4))
- (const :tag "No recentering" nil))
- :group 'next-error
- :version "23.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.
- 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].")
- (defvar next-error-function nil
- "Function to use to find the next error in the current buffer.
- The function is called with 2 parameters:
- ARG is an integer specifying by how many errors to move.
- RESET is a boolean which, if non-nil, says to go back to the beginning
- of the errors before moving.
- Major modes providing compile-like functionality should set this variable
- to indicate to `next-error' that this is a candidate buffer and how
- to navigate in it.")
- (make-variable-buffer-local 'next-error-function)
- (defvar next-error-move-function nil
- "Function to use to move to an error locus.
- It takes two arguments, a buffer position in the error buffer
- and a buffer position in the error locus buffer.
- The buffer for the error locus should already be current.
- nil means use goto-char using the second argument position.")
- (make-variable-buffer-local 'next-error-move-function)
- (defsubst next-error-buffer-p (buffer
- &optional avoid-current
- extra-test-inclusive
- extra-test-exclusive)
- "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.
- 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.
- The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer
- 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))))
- (with-current-buffer buffer
- (if next-error-function ; This is the normal test.
- ;; Optionally reject some buffers.
- (if extra-test-exclusive
- (funcall extra-test-exclusive)
- t)
- ;; Optionally accept some other buffers.
- (and extra-test-inclusive
- (funcall extra-test-inclusive))))))
- (defun next-error-find-buffer (&optional avoid-current
- extra-test-inclusive
- extra-test-exclusive)
- "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 buffer
- 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 buffer is rejected."
- (or
- ;; 1. If one window on the selected frame displays such buffer, return it.
- (let ((window-buffers
- (delete-dups
- (delq nil (mapcar (lambda (w)
- (if (next-error-buffer-p
- (window-buffer w)
- avoid-current
- extra-test-inclusive extra-test-exclusive)
- (window-buffer w)))
- (window-list))))))
- (if (eq (length window-buffers) 1)
- (car window-buffers)))
- ;; 2. If next-error-last-buffer is an acceptable buffer, use that.
- (if (and next-error-last-buffer
- (next-error-buffer-p next-error-last-buffer avoid-current
- extra-test-inclusive extra-test-exclusive))
- next-error-last-buffer)
- ;; 3. If the current buffer is acceptable, choose it.
- (if (next-error-buffer-p (current-buffer) avoid-current
- extra-test-inclusive extra-test-exclusive)
- (current-buffer))
- ;; 4. Look for any acceptable buffer.
- (let ((buffers (buffer-list)))
- (while (and buffers
- (not (next-error-buffer-p
- (car buffers) avoid-current
- extra-test-inclusive extra-test-exclusive)))
- (setq buffers (cdr buffers)))
- (car buffers))
- ;; 5. Use the current buffer as a last resort if it qualifies,
- ;; even despite AVOID-CURRENT.
- (and avoid-current
- (next-error-buffer-p (current-buffer) nil
- extra-test-inclusive extra-test-exclusive)
- (progn
- (message "This is the only buffer with error message locations")
- (current-buffer)))
- ;; 6. Give up.
- (error "No buffers contain error message locations")))
- (defun next-error (&optional arg reset)
- "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.
- A prefix ARG specifies how many error messages to move;
- negative means move back to previous error messages.
- Just \\[universal-argument] as a prefix means reparse the error message buffer
- and start at the first error.
- The RESET argument specifies that we should restart from the beginning.
- \\[next-error] normally uses the most recently started
- compilation, grep, or occur buffer. It can also operate on any
- buffer with output from the \\[compile], \\[grep] commands, or,
- more generally, on any buffer in Compilation mode or with
- Compilation Minor mode enabled, or any buffer in which
- `next-error-function' is bound to an appropriate function.
- 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
- 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."
- (interactive "P")
- (if (consp arg) (setq reset t arg nil))
- (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)
- (when next-error-recenter
- (recenter next-error-recenter))
- (run-hooks 'next-error-hook))))
- (defun next-error-internal ()
- "Visit the source code corresponding to the `next-error' message at point."
- (setq next-error-last-buffer (current-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 0 nil)
- (when next-error-recenter
- (recenter next-error-recenter))
- (run-hooks 'next-error-hook)))
- (defalias 'goto-next-locus 'next-error)
- (defalias 'next-match 'next-error)
- (defun previous-error (&optional n)
- "Visit previous `next-error' message and corresponding source code.
- Prefix arg N says how many error messages to move backwards (or
- forwards, if negative).
- This operates on the output from the \\[compile] and \\[grep] commands."
- (interactive "p")
- (next-error (- (or n 1))))
- (defun first-error (&optional n)
- "Restart at the first error.
- Visit corresponding source code.
- With prefix arg N, visit the source code of the Nth error.
- This operates on the output from the \\[compile] command, for instance."
- (interactive "p")
- (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.
- 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
- select the source buffer."
- (interactive "p")
- (let ((next-error-highlight next-error-highlight-no-select))
- (next-error n))
- (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.
- 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
- select the source buffer."
- (interactive "p")
- (next-error-no-select (- (or n 1))))
- ;; Internal variable for `next-error-follow-mode-post-command-hook'.
- (defvar next-error-follow-last-line nil)
- (define-minor-mode next-error-follow-minor-mode
- "Minor mode for compilation, occur and diff modes.
- When turned on, cursor motion in the compilation, grep, occur or diff
- buffer causes automatic display of the corresponding source code
- location."
- :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-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.
- (defun next-error-follow-mode-post-command-hook ()
- (unless (equal next-error-follow-last-line (line-number-at-pos))
- (setq next-error-follow-last-line (line-number-at-pos))
- (condition-case nil
- (let ((compilation-context-lines nil))
- (setq compilation-current-error (point))
- (next-error-no-select 0))
- (error t))))
- ;;;
- (defun fundamental-mode ()
- "Major mode not specialized for anything in particular.
- Other major modes are defined by comparison with this one."
- (interactive)
- (kill-all-local-variables)
- (unless delay-mode-hooks
- (run-hooks 'after-change-major-mode-hook)))
- ;; Special major modes to view specially formatted data rather than files.
- (defvar special-mode-map
- (let ((map (make-sparse-keymap)))
- (suppress-keymap map)
- (define-key map "q" 'quit-window)
- (define-key map " " 'scroll-up)
- (define-key map "\C-?" 'scroll-down)
- (define-key map "?" 'describe-mode)
- (define-key map ">" 'end-of-buffer)
- (define-key map "<" 'beginning-of-buffer)
- (define-key map "g" 'revert-buffer)
- map))
- (put 'special-mode 'mode-class 'special)
- (define-derived-mode special-mode nil "Special"
- "Parent major mode from which special major modes should inherit."
- (setq buffer-read-only t))
- ;; Making and deleting lines.
- (defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
- "Propertized string representing a hard newline character.")
- (defun newline (&optional arg)
- "Insert a newline, and move to left margin of the new line if it's blank.
- If `use-hard-newlines' is non-nil, the newline is marked with the
- text-property `hard'.
- With ARG, insert that many newlines.
- Call `auto-fill-function' if the current column number is greater
- than the value of `fill-column' and ARG is nil."
- (interactive "*P")
- (barf-if-buffer-read-only)
- ;; Inserting a newline at the end of a line produces better redisplay in
- ;; try_window_id than inserting at the beginning of a line, and the textual
- ;; result is the same. So, if we're at beginning of line, pretend to be at
- ;; the end of the previous line.
- (let ((flag (and (not (bobp))
- (bolp)
- ;; Make sure no functions want to be told about
- ;; the range of the changes.
- (not after-change-functions)
- (not before-change-functions)
- ;; Make sure there are no markers here.
- (not (buffer-has-markers-at (1- (point))))
- (not (buffer-has-markers-at (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)
- (looking-at page-delimiter)))
- (beforepos (point)))
- (if flag (backward-char 1))
- ;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
- ;; Set last-command-event to tell self-insert what to insert.
- (let ((last-command-event ?\n)
- ;; Don't auto-fill if we have a numeric argument.
- ;; Also not if flag is true (it would fill wrong line);
- ;; there is no need to since we're at BOL.
- (auto-fill-function (if (or arg flag) nil auto-fill-function)))
- (unwind-protect
- (self-insert-command (prefix-numeric-value arg))
- ;; If we get an error in self-insert-command, put point at right place.
- (if flag (forward-char 1))))
- ;; Even if we did *not* get an error, keep that forward-char;
- ;; all further processing should apply to the newline that the user
- ;; thinks he inserted.
- ;; Mark the newline(s) `hard'.
- (if use-hard-newlines
- (set-hard-newline-properties
- (- (point) (prefix-numeric-value arg)) (point)))
- ;; If the newline leaves the previous line blank,
- ;; and we have a left margin, delete that from the blank line.
- (or flag
- (save-excursion
- (goto-char beforepos)
- (beginning-of-line)
- (and (looking-at "[ \t]$")
- (> (current-left-margin) 0)
- (delete-region (point) (progn (end-of-line) (point))))))
- ;; Indent the line after the newline, except in one case:
- ;; when we added the newline at the beginning of a line
- ;; which starts a page.
- (or was-page-start
- (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 (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.
- With arg N, insert N newlines."
- (interactive "*p")
- (let* ((do-fill-prefix (and fill-prefix (bolp)))
- (do-left-margin (and (bolp) (> (current-left-margin) 0)))
- (loc (point))
- ;; Don't expand an abbrev before point.
- (abbrev-mode nil))
- (newline n)
- (goto-char loc)
- (while (> n 0)
- (cond ((bolp)
- (if do-left-margin (indent-to (current-left-margin)))
- (if do-fill-prefix (insert-and-inherit fill-prefix))))
- (forward-line 1)
- (setq n (1- n)))
- (goto-char loc)
- (end-of-line)))
- (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.
- When called from Lisp code, ARG may be a prefix string to copy."
- (interactive "*P")
- (skip-chars-forward " \t")
- (let* ((col (current-column))
- (pos (point))
- ;; What prefix should we check for (nil means don't).
- (prefix (cond ((stringp arg) arg)
- (arg nil)
- (t fill-prefix)))
- ;; Does this line start with it?
- (have-prfx (and prefix
- (save-excursion
- (beginning-of-line)
- (looking-at (regexp-quote prefix))))))
- (newline 1)
- (if have-prfx (insert-and-inherit prefix))
- (indent-to col 0)
- (goto-char pos)))
- (defun delete-indentation (&optional arg)
- "Join this line to previous and fix up whitespace at join.
- If there is a fill prefix, delete it from the beginning of this line.
- With argument, join this line to following line."
- (interactive "*P")
- (beginning-of-line)
- (if arg (forward-line 1))
- (if (eq (preceding-char) ?\n)
- (progn
- (delete-region (point) (1- (point)))
- ;; If the second line started with the fill prefix,
- ;; delete the prefix.
- (if (and fill-prefix
- (<= (+ (point) (length fill-prefix)) (point-max))
- (string= fill-prefix
- (buffer-substring (point)
- (+ (point) (length fill-prefix)))))
- (delete-region (point) (+ (point) (length fill-prefix))))
- (fixup-whitespace))))
- (defalias 'join-line #'delete-indentation) ; easier to find
- (defun delete-blank-lines ()
- "On blank line, delete all surrounding blank lines, leaving just one.
- On isolated blank line, delete that one.
- On nonblank line, delete any immediately following blank lines."
- (interactive "*")
- (let (thisblank singleblank)
- (save-excursion
- (beginning-of-line)
- (setq thisblank (looking-at "[ \t]*$"))
- ;; Set singleblank if there is just one blank line here.
- (setq singleblank
- (and thisblank
- (not (looking-at "[ \t]*\n[ \t]*$"))
- (or (bobp)
- (progn (forward-line -1)
- (not (looking-at "[ \t]*$")))))))
- ;; Delete preceding blank lines, and this one too if it's the only one.
- (if thisblank
- (progn
- (beginning-of-line)
- (if singleblank (forward-line 1))
- (delete-region (point)
- (if (re-search-backward "[^ \t\n]" nil t)
- (progn (forward-line 1) (point))
- (point-min)))))
- ;; Delete following blank lines, unless the current line is blank
- ;; and there are no following blank lines.
- (if (not (and thisblank singleblank))
- (save-excursion
- (end-of-line)
- (forward-line 1)
- (delete-region (point)
- (if (re-search-forward "[^ \t\n]" nil t)
- (progn (beginning-of-line) (point))
- (point-max)))))
- ;; Handle the special case where point is followed by newline and eob.
- ;; Delete the line, leaving point at eob.
- (if (looking-at "^[ \t]*\n\\'")
- (delete-region (point) (point-max)))))
- (defun delete-trailing-whitespace ()
- "Delete all the trailing whitespace across the current buffer.
- All whitespace after the last non-whitespace character in a line is deleted.
- This respects narrowing, created by \\[narrow-to-region] and friends.
- A formfeed is not considered whitespace by this function."
- (interactive "*")
- (save-match-data
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "\\s-$" nil t)
- (skip-syntax-backward "-" (save-excursion (forward-line 0) (point)))
- ;; Don't delete formfeeds, even if they are considered whitespace.
- (save-match-data
- (if (looking-at ".*\f")
- (goto-char (match-end 0))))
- (delete-region (point) (match-end 0))))))
- (defun newline-and-indent ()
- "Insert a newline, then indent according to major mode.
- Indentation is done using the value of `indent-line-function'.
- In programming language modes, this is the same as TAB.
- In some text modes, where TAB inserts a tab, this command indents to the
- column specified by the function `current-left-margin'."
- (interactive "*")
- (delete-horizontal-space t)
- (newline)
- (indent-according-to-mode))
- (defun reindent-then-newline-and-indent ()
- "Reindent current line, insert newline, then indent the new line.
- Indentation of both lines is done according to the current major mode,
- which means calling the current value of `indent-line-function'.
- In programming language modes, this is the same as TAB.
- In some text modes, where TAB inserts a tab, this indents to the
- column specified by the function `current-left-margin'."
- (interactive "*")
- (let ((pos (point)))
- ;; Be careful to insert the newline before indenting the line.
- ;; Otherwise, the indentation might be wrong.
- (newline)
- (save-excursion
- (goto-char pos)
- ;; We are at EOL before the call to indent-according-to-mode, and
- ;; after it we usually are as well, but not always. We tried to
- ;; address it with `save-excursion' but that uses a normal marker
- ;; whereas we need `move after insertion', so we do the save/restore
- ;; by hand.
- (setq pos (copy-marker pos t))
- (indent-according-to-mode)
- (goto-char pos)
- ;; Remove the trailing white-space after indentation because
- ;; indentation may introduce the whitespace.
- (delete-horizontal-space t))
- (indent-according-to-mode)))
- (defun quoted-insert (arg)
- "Read next input character and insert it.
- This is useful for inserting control characters.
- With argument, insert ARG copies of the character.
- If the first character you type after this command is an octal digit,
- you should type a sequence of octal digits which specify a character code.
- Any nondigit terminates the sequence. If the terminator is a RET,
- it is discarded; any other terminator is used itself as input.
- The variable `read-quoted-char-radix' specifies the radix for this feature;
- set it to 10 or 16 to use decimal or hex instead of octal.
- In overwrite mode, this function inserts the character anyway, and
- does not handle octal digits specially. This means that if you use
- overwrite as your normal editing mode, you can use this function to
- insert characters when necessary.
- In binary overwrite mode, this function does overwrite, and octal
- digits are interpreted as a character code. This is intended to be
- useful for editing binary files."
- (interactive "*p")
- (let* ((char
- ;; Avoid "obsolete" warnings for translation-table-for-input.
- (with-no-warnings
- (let (translation-table-for-input input-method-function)
- (if (or (not overwrite-mode)
- (eq overwrite-mode 'overwrite-mode-binary))
- (read-quoted-char)
- (read-char))))))
- ;; This used to assume character codes 0240 - 0377 stand for
- ;; characters in some single-byte character set, and converted them
- ;; to Emacs characters. But in 23.1 this feature is deprecated
- ;; in favor of inserting the corresponding Unicode characters.
- ;; (if (and enable-multibyte-characters
- ;; (>= char ?\240)
- ;; (<= char ?\377))
- ;; (setq char (unibyte-char-to-multibyte char)))
- (if (> arg 0)
- (if (eq overwrite-mode 'overwrite-mode-binary)
- (delete-char arg)))
- (while (> arg 0)
- (insert-and-inherit char)
- (setq arg (1- arg)))))
- (defun forward-to-indentation (&optional arg)
- "Move forward ARG lines and position at first nonblank character."
- (interactive "^p")
- (forward-line (or arg 1))
- (skip-chars-forward " \t"))
- (defun backward-to-indentation (&optional arg)
- "Move backward ARG lines and position at first nonblank character."
- (interactive "^p")
- (forward-line (- (or arg 1)))
- (skip-chars-forward " \t"))
- (defun back-to-indentation ()
- "Move point to the first non-whitespace character on this line."
- (interactive "^")
- (beginning-of-line 1)
- (skip-syntax-forward " " (line-end-position))
- ;; Move back over chars that have whitespace syntax but have the p flag.
- (backward-prefix-chars))
- (defun fixup-whitespace ()
- "Fixup white space between objects around point.
- Leave one space or none, according to the context."
- (interactive "*")
- (save-excursion
- (delete-horizontal-space)
- (if (or (looking-at "^\\|\\s)")
- (save-excursion (forward-char -1)
- (looking-at "$\\|\\s(\\|\\s'")))
- nil
- (insert ?\s))))
- (defun delete-horizontal-space (&optional backward-only)
- "Delete all spaces and tabs around point.
- If BACKWARD-ONLY is non-nil, only delete them before point."
- (interactive "*P")
- (let ((orig-pos (point)))
- (delete-region
- (if backward-only
- orig-pos
- (progn
- (skip-chars-forward " \t")
- (constrain-to-field nil orig-pos t)))
- (progn
- (skip-chars-backward " \t")
- (constrain-to-field nil orig-pos)))))
- (defun just-one-space (&optional n)
- "Delete all spaces and tabs around point, leaving one space (or N spaces)."
- (interactive "*p")
- (let ((orig-pos (point)))
- (skip-chars-backward " \t")
- (constrain-to-field nil orig-pos)
- (dotimes (i (or n 1))
- (if (= (following-char) ?\s)
- (forward-char 1)
- (insert ?\s)))
- (delete-region
- (point)
- (progn
- (skip-chars-forward " \t")
- (constrain-to-field nil orig-pos t)))))
- (defun beginning-of-buffer (&optional arg)
- "Move point to the beginning of the buffer; leave mark at previous position.
- With \\[universal-argument] prefix, do not set mark at previous position.
- With numeric arg N, put point N/10 of the way from the beginning.
- If the buffer is narrowed, this command uses the beginning and size
- of the accessible part of the buffer.
- Don't use this command in Lisp programs!
- \(goto-char (point-min)) is faster and avoids clobbering the mark."
- (interactive "^P")
- (or (consp arg)
- (region-active-p)
- (push-mark))
- (let ((size (- (point-max) (point-min))))
- (goto-char (if (and arg (not (consp arg)))
- (+ (point-min)
- (if (> size 10000)
- ;; Avoid overflow for large buffer sizes!
- (* (prefix-numeric-value arg)
- (/ size 10))
- (/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
- (point-min))))
- (if (and arg (not (consp arg))) (forward-line 1)))
- (defun end-of-buffer (&optional arg)
- "Move point to the end of the buffer; leave mark at previous position.
- With \\[universal-argument] prefix, do not set mark at previous position.
- With numeric arg N, put point N/10 of the way from the end.
- If the buffer is narrowed, this command uses the beginning and size
- of the accessible part of the buffer.
- Don't use this command in Lisp programs!
- \(goto-char (point-max)) is faster and avoids clobbering the mark."
- (interactive "^P")
- (or (consp arg) (region-active-p) (push-mark))
- (let ((size (- (point-max) (point-min))))
- (goto-char (if (and arg (not (consp arg)))
- (- (point-max)
- (if (> size 10000)
- ;; Avoid overflow for large buffer sizes!
- (* (prefix-numeric-value arg)
- (/ size 10))
- (/ (* size (prefix-numeric-value arg)) 10)))
- (point-max))))
- ;; If we went to a place in the middle of the buffer,
- ;; adjust it to the beginning of a line.
- (cond ((and arg (not (consp arg))) (forward-line 1))
- ((> (point) (window-end nil t))
- ;; If the end of the buffer is not already on the screen,
- ;; then scroll specially to put it near, but not at, the bottom.
- (overlay-recenter (point))
- (recenter -3))))
- (defun mark-whole-buffer ()
- "Put point at beginning and mark at end of buffer.
- You probably should not use this function in Lisp programs;
- it is usually a mistake for a Lisp function to use any subroutine
- that uses or sets the mark."
- (interactive)
- (push-mark (point))
- (push-mark (point-max) nil t)
- (goto-char (point-min)))
- ;; Counting lines, one way or another.
- (defun goto-line (line &optional buffer)
- "Goto LINE, counting from line 1 at beginning of buffer.
- Normally, move point in the current buffer, and leave mark at the
- previous position. With just \\[universal-argument] as argument,
- move point in the most recently selected other buffer, and switch to it.
- If there's a number in the buffer at point, it is the default for LINE.
- This function is usually the wrong thing to use in a Lisp program.
- What you probably want instead is something like:
- (goto-char (point-min)) (forward-line (1- N))
- If at all possible, an even better solution is to use char counts
- rather than line counts."
- (interactive
- (if (and current-prefix-arg (not (consp current-prefix-arg)))
- (list (prefix-numeric-value current-prefix-arg))
- ;; Look for a default, a number in the buffer at point.
- (let* ((default
- (save-excursion
- (skip-chars-backward "0-9")
- (if (looking-at "[0-9]")
- (buffer-substring-no-properties
- (point)
- (progn (skip-chars-forward "0-9")
- (point))))))
- ;; Decide if we're switching buffers.
- (buffer
- (if (consp current-prefix-arg)
- (other-buffer (current-buffer) t)))
- (buffer-prompt
- (if buffer
- (concat " in " (buffer-name buffer))
- "")))
- ;; Read the argument, offering that number (if any) as default.
- (list (read-from-minibuffer (format (if default "Goto line%s (%s): "
- "Goto line%s: ")
- buffer-prompt
- default)
- nil nil t
- 'minibuffer-history
- default)
- buffer))))
- ;; Switch to the desired buffer, one way or another.
- (if buffer
- (let ((window (get-buffer-window buffer)))
- (if window (select-window window)
- (switch-to-buffer-other-window buffer))))
- ;; Leave mark at previous position
- (or (region-active-p) (push-mark))
- ;; Move to the specified line number in that buffer.
- (save-restriction
- (widen)
- (goto-char (point-min))
- (if (eq selective-display t)
- (re-search-forward "[\n\C-m]" nil 'end (1- line))
- (forward-line (1- line)))))
- (defun count-lines-region (start end)
- "Print number of lines and characters in the region."
- (interactive "r")
- (message "Region has %d lines, %d characters"
- (count-lines start end) (- end start)))
- (defun what-line ()
- "Print the current buffer line number and narrowed line number of point."
- (interactive)
- (let ((start (point-min))
- (n (line-number-at-pos)))
- (if (= start 1)
- (message "Line %d" n)
- (save-excursion
- (save-restriction
- (widen)
- (message "line %d (narrowed line %d)"
- (+ n (line-number-at-pos start) -1) n))))))
- (defun count-lines (start end)
- "Return number of lines between START and END.
- This is usually the number of newlines between them,
- but can be one more if START is not equal to END
- and the greater of them is not at the start of a line."
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (goto-char (point-min))
- (if (eq selective-display t)
- (save-match-data
- (let ((done 0))
- (while (re-search-forward "[\n\C-m]" nil t 40)
- (setq done (+ 40 done)))
- (while (re-search-forward "[\n\C-m]" nil t 1)
- (setq done (+ 1 done)))
- (goto-char (point-max))
- (if (and (/= start end)
- (not (bolp)))
- (1+ done)
- done)))
- (- (buffer-size) (forward-line (buffer-size)))))))
- (defun line-number-at-pos (&optional pos)
- "Return (narrowed) buffer line number at position POS.
- If POS is nil, use current buffer location.
- Counting starts at (point-min), so the value refers
- to the contents of the accessible portion of the buffer."
- (let ((opoint (or pos (point))) start)
- (save-excursion
- (goto-char (point-min))
- (setq start (point))
- (goto-char opoint)
- (forward-line 0)
- (1+ (count-lines start (point))))))
- (defun what-cursor-position (&optional detail)
- "Print info on cursor position (on screen and within buffer).
- Also describe the character after point, and give its character code
- in octal, decimal and hex.
- For a non-ASCII multibyte character, also give its encoding in the
- buffer's selected coding system if the coding system encodes the
- character safely. If the character is encoded into one byte, that
- code is shown in hex. If the character is encoded into more than one
- byte, just \"...\" is shown.
- In addition, with prefix argument, show details about that character
- in *Help* buffer. See also the command `describe-char'."
- (interactive "P")
- (let* ((char (following-char))
- (beg (point-min))
- (end (point-max))
- (pos (point))
- (total (buffer-size))
- (percent (if (> total 50000)
- ;; Avoid overflow from multiplying by 100!
- (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1))
- (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1))))
- (hscroll (if (= (window-hscroll) 0)
- ""
- (format " Hscroll=%d" (window-hscroll))))
- (col (current-column)))
- (if (= pos end)
- (if (or (/= beg 1) (/= end (1+ total)))
- (message "point=%d of %d (%d%%) <%d-%d> column=%d%s"
- pos total percent beg end col hscroll)
- (message "point=%d of %d (EOB) column=%d%s"
- pos total col hscroll))
- (let ((coding buffer-file-coding-system)
- encoded encoding-msg display-prop under-display)
- (if (or (not coding)
- (eq (coding-system-type coding) t))
- (setq coding (default-value 'buffer-file-coding-system)))
- (if (eq (char-charset char) 'eight-bit)
- (setq encoding-msg
- (format "(%d, #o%o, #x%x, raw-byte)" char char char))
- ;; Check if the character is displayed with some `display'
- ;; text property. In that case, set under-display to the
- ;; buffer substring covered by that property.
- (setq display-prop (get-text-property pos 'display))
- (if display-prop
- (let ((to (or (next-single-property-change pos 'display)
- (point-max))))
- (if (< to (+ pos 4))
- (setq under-display "")
- (setq under-display "..."
- to (+ pos 4)))
- (setq under-display
- (concat (buffer-substring-no-properties pos to)
- under-display)))
- (setq encoded (and (>= char 128) (encode-coding-char char coding))))
- (setq encoding-msg
- (if display-prop
- (if (not (stringp display-prop))
- (format "(%d, #o%o, #x%x, part of display \"%s\")"
- char char char under-display)
- (format "(%d, #o%o, #x%x, part of display \"%s\"->\"%s\")"
- char char char under-display display-prop))
- (if encoded
- (format "(%d, #o%o, #x%x, file %s)"
- char char char
- (if (> (length encoded) 1)
- "..."
- (encoded-string-description encoded coding)))
- (format "(%d, #o%o, #x%x)" char char char)))))
- (if detail
- ;; We show the detailed information about CHAR.
- (describe-char (point)))
- (if (or (/= beg 1) (/= end (1+ total)))
- (message "Char: %s %s point=%d of %d (%d%%) <%d-%d> column=%d%s"
- (if (< char 256)
- (single-key-description char)
- (buffer-substring-no-properties (point) (1+ (point))))
- encoding-msg pos total percent beg end col hscroll)
- (message "Char: %s %s point=%d of %d (%d%%) column=%d%s"
- (if enable-multibyte-characters
- (if (< char 128)
- (single-key-description char)
- (buffer-substring-no-properties (point) (1+ (point))))
- (single-key-description char))
- encoding-msg pos total percent col hscroll))))))
- ;; Initialize read-expression-map. It is defined at C level.
- (let ((m (make-sparse-keymap)))
- (define-key m "\M-\t" 'lisp-complete-symbol)
- (set-keymap-parent m minibuffer-local-map)
- (setq read-expression-map m))
- (defvar read-expression-history nil)
- (defvar minibuffer-completing-symbol nil
- "Non-nil means completing a Lisp symbol in the minibuffer.")
- (defvar minibuffer-default nil
- "The current default value or list of default values in the minibuffer.
- The functions `read-from-minibuffer' and `completing-read' bind
- this variable locally.")
- (defcustom eval-expression-print-level 4
- "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 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
- "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
- :version "21.1")
- (defun eval-expression-print-format (value)
- "Format VALUE as a result of evaluated expression.
- Return a formatted string which is displayed in the echo area
- in addition to the value printed by prin1 in functions which
- display the result of expression evaluation."
- (if (and (integerp value)
- (or (not (memq this-command '(eval-last-sexp eval-print-last-sexp)))
- (eq this-command last-command)
- (if (boundp 'edebug-active) edebug-active)))
- (let ((char-string
- (if (or (if (boundp 'edebug-active) edebug-active)
- (memq this-command '(eval-last-sexp eval-print-last-sexp)))
- (prin1-char value))))
- (if char-string
- (format " (#o%o, #x%x, %s)" value value char-string)
- (format " (#o%o, #x%x)" value value)))))
- ;; We define this, rather than making `eval' interactive,
- ;; for the sake of completion of names like eval-region, eval-buffer.
- (defun eval-expression (eval-expression-arg
- &optional eval-expression-insert-value)
- "Evaluate EVAL-EXPRESSION-ARG and print value in the echo area.
- Value is also consed on to front of the variable `values'.
- Optional argument EVAL-EXPRESSION-INSERT-VALUE, if non-nil, means
- insert the result into the current buffer instead of printing it in
- the echo area. Truncates long output according to the value of the
- variables `eval-expression-print-length' and `eval-expression-print-level'.
- If `eval-expression-debug-on-error' is non-nil, which is the default,
- this command arranges for all errors to enter the debugger."
- (interactive
- (list (let ((minibuffer-completing-symbol t))
- (read-from-minibuffer "Eval: "
- nil read-expression-map t
- 'read-expression-history))
- current-prefix-arg))
- (if (null eval-expression-debug-on-error)
- (setq values (cons (eval eval-expression-arg) values))
- (let ((old-value (make-symbol "t")) new-value)
- ;; Bind debug-on-error to something unique so that we can
- ;; detect when evaled code changes it.
- (let ((debug-on-error old-value))
- (setq values (cons (eval eval-expression-arg) values))
- (setq new-value debug-on-error))
- ;; If evaled code has changed the value of debug-on-error,
- ;; propagate that change to the global binding.
- (unless (eq old-value new-value)
- (setq debug-on-error new-value))))
- (let ((print-length eval-expression-print-length)
- (print-level eval-expression-print-level))
- (if eval-expression-insert-value
- (with-no-warnings
- (let ((standard-output (current-buffer)))
- (prin1 (car values))))
- (prog1
- (prin1 (car values) t)
- (let ((str (eval-expression-print-format (car values))))
- (if str (princ str t)))))))
- (defun edit-and-eval-command (prompt command)
- "Prompting with PROMPT, let user edit COMMAND and eval result.
- COMMAND is a Lisp expression. Let user edit that expression in
- the minibuffer, then read and evaluate the result."
- (let ((command
- (let ((print-level nil)
- (minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
- (unwind-protect
- (read-from-minibuffer prompt
- (prin1-to-string command)
- read-expression-map t
- 'command-history)
- ;; If command was added to command-history as a string,
- ;; get rid of that. We want only evaluable expressions there.
- (if (stringp (car command-history))
- (setq command-history (cdr command-history)))))))
- ;; If command to be redone does not match front of history,
- ;; add it to the history.
- (or (equal command (car command-history))
- (setq command-history (cons command command-history)))
- (eval command)))
- (defun repeat-complex-command (arg)
- "Edit and re-evaluate last complex command, or ARGth from last.
- A complex command is one which used the minibuffer.
- The command is placed in the minibuffer as a Lisp form for editing.
- The result is executed, repeating the command as changed.
- If the command has been changed or is not the most recent previous
- command it is added to the front of the command history.
- You can use the minibuffer history commands \
- \\<minibuffer-local-map>\\[next-history-element] and \\[previous-history-element]
- to get different commands to edit and resubmit."
- (interactive "p")
- (let ((elt (nth (1- arg) command-history))
- newcmd)
- (if elt
- (progn
- (setq newcmd
- (let ((print-level nil)
- (minibuffer-history-position arg)
- (minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
- (unwind-protect
- (read-from-minibuffer
- "Redo: " (prin1-to-string elt) read-expression-map t
- (cons 'command-history arg))
- ;; If command was added to command-history as a
- ;; string, get rid of that. We want only
- ;; evaluable expressions there.
- (if (stringp (car command-history))
- (setq command-history (cdr command-history))))))
- ;; If command to be redone does not match front of history,
- ;; add it to the history.
- (or (equal newcmd (car command-history))
- (setq command-history (cons newcmd command-history)))
- (eval newcmd))
- (if command-history
- (error "Argument %d is beyond length of command history" arg)
- (error "There are no previous complex commands to repeat")))))
- (defvar minibuffer-history nil
- "Default minibuffer history list.
- This is used for all minibuffer input
- except when an alternate history list is specified.
- Maximum length of the history list is determined by the value
- of `history-length', which see.")
- (defvar minibuffer-history-sexp-flag nil
- "Control whether history list elements are expressions or strings.
- If the value of this variable equals current minibuffer depth,
- they are expressions; otherwise they are strings.
- \(That convention is designed to do the right thing for
- recursive uses of the minibuffer.)")
- (setq minibuffer-history-variable 'minibuffer-history)
- (setq minibuffer-history-position nil) ;; Defvar is in C code.
- (defvar minibuffer-history-search-history nil)
- (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 minibuffer-avoid-prompt (new old)
- "A point-motion hook for the minibuffer, that moves point out of the prompt."
- (constrain-to-field nil (point-max)))
- (defcustom minibuffer-history-case-insensitive-variables nil
- "Minibuffer history variables for which matching should ignore case.
- If a history variable is a member of this list, then the
- \\[previous-matching-history-element] and \\[next-matching-history-element]\
- commands ignore case when searching it, regardless of `case-fold-search'."
- :type '(repeat variable)
- :group 'minibuffer)
- (defun previous-matching-history-element (regexp n)
- "Find the previous history element that matches REGEXP.
- \(Previous history elements refer to earlier actions.)
- With prefix argument N, search for Nth previous match.
- If N is negative, find the next or Nth next match.
- Normally, history elements are matched case-insensitively if
- `case-fold-search' is non-nil, but an uppercase letter in REGEXP
- makes the search case-sensitive.
- See also `minibuffer-history-case-insensitive-variables'."
- (interactive
- (let* ((enable-recursive-minibuffers t)
- (regexp (read-from-minibuffer "Previous element matching (regexp): "
- nil
- minibuffer-local-map
- nil
- 'minibuffer-history-search-history
- (car minibuffer-history-search-history))))
- ;; Use the last regexp specified, by default, if input is empty.
- (list (if (string= regexp "")
- (if minibuffer-history-search-history
- (car minibuffer-history-search-history)
- (error "No previous history search regexp"))
- regexp)
- (prefix-numeric-value current-prefix-arg))))
- (unless (zerop n)
- (if (and (zerop minibuffer-history-position)
- (null minibuffer-text-before-history))
- (setq minibuffer-text-before-history
- (minibuffer-contents-no-properties)))
- (let ((history (symbol-value minibuffer-history-variable))
- (case-fold-search
- (if (isearch-no-upper-case-p regexp t) ; assume isearch.el is dumped
- ;; On some systems, ignore case for file names.
- (if (memq minibuffer-history-variable
- minibuffer-history-case-insensitive-variables)
- t
- ;; Respect the user's setting for case-fold-search:
- case-fold-search)
- nil))
- prevpos
- match-string
- match-offset
- (pos minibuffer-history-position))
- (while (/= n 0)
- (setq prevpos pos)
- (setq pos (min (max 1 (+ pos (if (< n 0) -…
Large files files are truncated, but you can click here to view the full file