1992-05-30 21:11:25 +00:00
|
|
|
|
;;; simple.el --- basic editing commands for Emacs
|
|
|
|
|
|
2004-12-03 22:26:13 +00:00
|
|
|
|
;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
|
2006-01-23 04:05:59 +00:00
|
|
|
|
;; 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
2002-05-02 05:41:46 +00:00
|
|
|
|
;; Maintainer: FSF
|
|
|
|
|
;; Keywords: internal
|
|
|
|
|
|
1991-12-21 09:29:41 +00:00
|
|
|
|
;; 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
|
1992-07-22 04:22:42 +00:00
|
|
|
|
;; the Free Software Foundation; either version 2, or (at your option)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
;; 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
|
1996-01-14 07:34:30 +00:00
|
|
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
2005-07-04 23:32:44 +00:00
|
|
|
|
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
|
|
|
;; Boston, MA 02110-1301, USA.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
1993-03-22 16:53:22 +00:00
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
|
|
;; A grab-bag of basic Emacs commands not specifically related to some
|
|
|
|
|
;; major mode or to file-handling.
|
|
|
|
|
|
1992-07-22 04:22:42 +00:00
|
|
|
|
;;; Code:
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
1999-11-16 13:29:51 +00:00
|
|
|
|
(eval-when-compile
|
2000-08-15 14:29:03 +00:00
|
|
|
|
(autoload 'widget-convert "wid-edit")
|
2002-06-04 23:31:58 +00:00
|
|
|
|
(autoload 'shell-mode "shell"))
|
1999-11-16 13:29:51 +00:00
|
|
|
|
|
2005-08-31 13:51:34 +00:00
|
|
|
|
(defvar compilation-current-error)
|
|
|
|
|
|
2005-03-29 20:53:19 +00:00
|
|
|
|
(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")
|
1999-11-16 13:29:51 +00:00
|
|
|
|
|
1997-05-05 11:57:31 +00:00
|
|
|
|
(defgroup killing nil
|
2004-06-10 04:20:02 +00:00
|
|
|
|
"Killing and yanking commands."
|
1997-05-05 11:57:31 +00:00
|
|
|
|
:group 'editing)
|
|
|
|
|
|
|
|
|
|
(defgroup paren-matching nil
|
|
|
|
|
"Highlight (un)matching of parens and expressions."
|
|
|
|
|
:group 'matching)
|
|
|
|
|
|
2005-12-23 21:50:38 +00:00
|
|
|
|
(defun get-next-valid-buffer (list &optional buffer visible-ok frame)
|
|
|
|
|
"Search LIST for a valid buffer to display in FRAME.
|
2005-12-16 11:35:25 +00:00
|
|
|
|
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.
|
2005-12-23 21:50:38 +00:00
|
|
|
|
If BUFFER is non-nil, ignore occurrences of that buffer in LIST."
|
2005-12-16 11:35:25 +00:00
|
|
|
|
;; 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)))
|
|
|
|
|
|
2005-12-23 21:50:38 +00:00
|
|
|
|
(defun last-buffer (&optional buffer visible-ok frame)
|
|
|
|
|
"Return the last non-hidden displayable buffer in the buffer list.
|
2005-12-16 11:35:25 +00:00
|
|
|
|
If BUFFER is non-nil, last-buffer will ignore that buffer.
|
|
|
|
|
Buffers not visible in windows are preferred to visible buffers,
|
|
|
|
|
unless optional argument VISIBLE-OK is non-nil.
|
|
|
|
|
If the optional third argument FRAME is non-nil, use that frame's
|
|
|
|
|
buffer list instead of the selected frame's buffer list.
|
|
|
|
|
If no other buffer exists, the buffer `*scratch*' is returned."
|
|
|
|
|
(setq frame (or frame (selected-frame)))
|
|
|
|
|
(or (get-next-valid-buffer (frame-parameter frame 'buried-buffer-list)
|
|
|
|
|
buffer visible-ok frame)
|
|
|
|
|
(get-next-valid-buffer (nreverse (buffer-list frame))
|
|
|
|
|
buffer visible-ok frame)
|
|
|
|
|
(progn
|
|
|
|
|
(set-buffer-major-mode (get-buffer-create "*scratch*"))
|
|
|
|
|
(get-buffer "*scratch*"))))
|
|
|
|
|
|
2002-04-27 23:16:18 +00:00
|
|
|
|
(defun next-buffer ()
|
|
|
|
|
"Switch to the next buffer in cyclic order."
|
|
|
|
|
(interactive)
|
2005-12-16 11:35:25 +00:00
|
|
|
|
(let ((buffer (current-buffer))
|
|
|
|
|
(bbl (frame-parameter nil 'buried-buffer-list)))
|
|
|
|
|
(switch-to-buffer (other-buffer buffer t))
|
|
|
|
|
(bury-buffer buffer)
|
|
|
|
|
(set-frame-parameter nil 'buried-buffer-list
|
|
|
|
|
(cons buffer (delq buffer bbl)))))
|
|
|
|
|
|
|
|
|
|
(defun previous-buffer ()
|
2002-04-27 23:16:18 +00:00
|
|
|
|
"Switch to the previous buffer in cyclic order."
|
|
|
|
|
(interactive)
|
2005-12-16 11:35:25 +00:00
|
|
|
|
(let ((buffer (last-buffer (current-buffer) t))
|
|
|
|
|
(bbl (frame-parameter nil 'buried-buffer-list)))
|
|
|
|
|
(switch-to-buffer buffer)
|
|
|
|
|
;; Clean up buried-buffer-list up to and including the chosen buffer.
|
|
|
|
|
(while (and bbl (not (eq (car bbl) buffer)))
|
|
|
|
|
(setq bbl (cdr bbl)))
|
|
|
|
|
(set-frame-parameter nil 'buried-buffer-list bbl)))
|
|
|
|
|
|
2004-09-01 18:41:06 +00:00
|
|
|
|
|
2004-04-21 21:36:15 +00:00
|
|
|
|
;;; next-error support framework
|
2004-11-08 16:59:43 +00:00
|
|
|
|
|
|
|
|
|
(defgroup next-error nil
|
(clone-indirect-buffer): Doc fix.
(fixup-whitespace, just-one-space, backward-delete-char-untabify, lambda):
"?\ " -> "?\s".
(next-error, next-error-highlight, next-error-highlight-no-select,
next-error-last-buffer, next-error-buffer-p, next-error-find-buffer, next-error,
previous-error, next-error-no-select, previous-error-no-select, open-line,
split-line, minibuffer-prompt-width, kill-new, binary-overwrite-mode):
Fix typos in docstrings.
(set-fill-column): Fix typo in message.
2005-07-20 22:29:53 +00:00
|
|
|
|
"`next-error' support framework."
|
2004-11-08 16:59:43 +00:00
|
|
|
|
:group 'compilation
|
2005-02-09 15:50:47 +00:00
|
|
|
|
:version "22.1")
|
2004-11-08 16:59:43 +00:00
|
|
|
|
|
|
|
|
|
(defface next-error
|
|
|
|
|
'((t (:inherit region)))
|
|
|
|
|
"Face used to highlight next error locus."
|
|
|
|
|
:group 'next-error
|
2005-02-09 15:50:47 +00:00
|
|
|
|
:version "22.1")
|
2004-11-08 16:59:43 +00:00
|
|
|
|
|
2006-09-24 20:38:47 +00:00
|
|
|
|
(defcustom next-error-highlight 0.5
|
2004-11-08 16:59:43 +00:00
|
|
|
|
"*Highlighting of locations in selected source buffers.
|
(clone-indirect-buffer): Doc fix.
(fixup-whitespace, just-one-space, backward-delete-char-untabify, lambda):
"?\ " -> "?\s".
(next-error, next-error-highlight, next-error-highlight-no-select,
next-error-last-buffer, next-error-buffer-p, next-error-find-buffer, next-error,
previous-error, next-error-no-select, previous-error-no-select, open-line,
split-line, minibuffer-prompt-width, kill-new, binary-overwrite-mode):
Fix typos in docstrings.
(set-fill-column): Fix typo in message.
2005-07-20 22:29:53 +00:00
|
|
|
|
If number, highlight the locus in `next-error' face for given time in seconds.
|
2006-09-11 19:05:46 +00:00
|
|
|
|
If t, highlight the locus indefinitely until some other locus replaces it.
|
2004-11-08 16:59:43 +00:00
|
|
|
|
If nil, don't highlight the locus in the source buffer.
|
|
|
|
|
If `fringe-arrow', indicate the locus by the fringe arrow."
|
2006-09-11 19:05:46 +00:00
|
|
|
|
:type '(choice (number :tag "Highlight for specified time")
|
2006-09-11 22:33:46 +00:00
|
|
|
|
(const :tag "Semipermanent highlighting" t)
|
2004-11-08 16:59:43 +00:00
|
|
|
|
(const :tag "No highlighting" nil)
|
2006-09-11 19:05:46 +00:00
|
|
|
|
(const :tag "Fringe arrow" fringe-arrow))
|
2004-11-08 16:59:43 +00:00
|
|
|
|
:group 'next-error
|
2005-02-09 15:50:47 +00:00
|
|
|
|
:version "22.1")
|
2004-11-08 16:59:43 +00:00
|
|
|
|
|
2006-09-24 20:38:47 +00:00
|
|
|
|
(defcustom next-error-highlight-no-select 0.5
|
|
|
|
|
"*Highlighting of locations in `next-error-no-select'.
|
(clone-indirect-buffer): Doc fix.
(fixup-whitespace, just-one-space, backward-delete-char-untabify, lambda):
"?\ " -> "?\s".
(next-error, next-error-highlight, next-error-highlight-no-select,
next-error-last-buffer, next-error-buffer-p, next-error-find-buffer, next-error,
previous-error, next-error-no-select, previous-error-no-select, open-line,
split-line, minibuffer-prompt-width, kill-new, binary-overwrite-mode):
Fix typos in docstrings.
(set-fill-column): Fix typo in message.
2005-07-20 22:29:53 +00:00
|
|
|
|
If number, highlight the locus in `next-error' face for given time in seconds.
|
2006-09-11 19:05:46 +00:00
|
|
|
|
If t, highlight the locus indefinitely until some other locus replaces it.
|
2004-11-08 16:59:43 +00:00
|
|
|
|
If nil, don't highlight the locus in the source buffer.
|
|
|
|
|
If `fringe-arrow', indicate the locus by the fringe arrow."
|
2006-09-11 19:05:46 +00:00
|
|
|
|
:type '(choice (number :tag "Highlight for specified time")
|
2006-09-11 22:33:46 +00:00
|
|
|
|
(const :tag "Semipermanent highlighting" t)
|
2004-11-08 16:59:43 +00:00
|
|
|
|
(const :tag "No highlighting" nil)
|
2006-09-11 19:05:46 +00:00
|
|
|
|
(const :tag "Fringe arrow" fringe-arrow))
|
2004-11-08 16:59:43 +00:00
|
|
|
|
:group 'next-error
|
2005-02-09 15:50:47 +00:00
|
|
|
|
:version "22.1")
|
2004-11-08 16:59:43 +00:00
|
|
|
|
|
2005-07-09 20:46:26 +00:00
|
|
|
|
(defcustom next-error-hook nil
|
|
|
|
|
"*List of hook functions run by `next-error' after visiting source file."
|
|
|
|
|
:type 'hook
|
|
|
|
|
:group 'next-error)
|
|
|
|
|
|
2005-03-29 04:55:43 +00:00
|
|
|
|
(defvar next-error-highlight-timer nil)
|
|
|
|
|
|
2005-04-07 15:15:15 +00:00
|
|
|
|
(defvar next-error-overlay-arrow-position nil)
|
2005-05-08 19:34:28 +00:00
|
|
|
|
(put 'next-error-overlay-arrow-position 'overlay-arrow-string "=>")
|
2005-04-07 15:15:15 +00:00
|
|
|
|
(add-to-list 'overlay-arrow-variable-list 'next-error-overlay-arrow-position)
|
|
|
|
|
|
2004-04-21 21:36:15 +00:00
|
|
|
|
(defvar next-error-last-buffer nil
|
(clone-indirect-buffer): Doc fix.
(fixup-whitespace, just-one-space, backward-delete-char-untabify, lambda):
"?\ " -> "?\s".
(next-error, next-error-highlight, next-error-highlight-no-select,
next-error-last-buffer, next-error-buffer-p, next-error-find-buffer, next-error,
previous-error, next-error-no-select, previous-error-no-select, open-line,
split-line, minibuffer-prompt-width, kill-new, binary-overwrite-mode):
Fix typos in docstrings.
(set-fill-column): Fix typo in message.
2005-07-20 22:29:53 +00:00
|
|
|
|
"The most recent `next-error' buffer.
|
2004-04-21 21:36:15 +00:00
|
|
|
|
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
|
2004-04-22 22:56:08 +00:00
|
|
|
|
"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.")
|
2004-04-21 21:36:15 +00:00
|
|
|
|
|
|
|
|
|
(make-variable-buffer-local 'next-error-function)
|
|
|
|
|
|
2004-12-14 00:51:02 +00:00
|
|
|
|
(defsubst next-error-buffer-p (buffer
|
2004-12-27 16:34:43 +00:00
|
|
|
|
&optional avoid-current
|
2004-12-14 00:51:02 +00:00
|
|
|
|
extra-test-inclusive
|
2004-11-29 18:44:29 +00:00
|
|
|
|
extra-test-exclusive)
|
(clone-indirect-buffer): Doc fix.
(fixup-whitespace, just-one-space, backward-delete-char-untabify, lambda):
"?\ " -> "?\s".
(next-error, next-error-highlight, next-error-highlight-no-select,
next-error-last-buffer, next-error-buffer-p, next-error-find-buffer, next-error,
previous-error, next-error-no-select, previous-error-no-select, open-line,
split-line, minibuffer-prompt-width, kill-new, binary-overwrite-mode):
Fix typos in docstrings.
(set-fill-column): Fix typo in message.
2005-07-20 22:29:53 +00:00
|
|
|
|
"Test if BUFFER is a `next-error' capable buffer.
|
2004-12-27 16:34:43 +00:00
|
|
|
|
|
|
|
|
|
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.
|
|
|
|
|
|
2005-12-23 21:50:38 +00:00
|
|
|
|
The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer
|
2005-06-20 10:29:02 +00:00
|
|
|
|
that would normally be considered usable. If it returns nil,
|
2004-12-27 16:34:43 +00:00
|
|
|
|
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
|
2004-12-14 00:51:02 +00:00
|
|
|
|
extra-test-inclusive
|
2004-11-29 18:44:29 +00:00
|
|
|
|
extra-test-exclusive)
|
(clone-indirect-buffer): Doc fix.
(fixup-whitespace, just-one-space, backward-delete-char-untabify, lambda):
"?\ " -> "?\s".
(next-error, next-error-highlight, next-error-highlight-no-select,
next-error-last-buffer, next-error-buffer-p, next-error-find-buffer, next-error,
previous-error, next-error-no-select, previous-error-no-select, open-line,
split-line, minibuffer-prompt-width, kill-new, binary-overwrite-mode):
Fix typos in docstrings.
(set-fill-column): Fix typo in message.
2005-07-20 22:29:53 +00:00
|
|
|
|
"Return a `next-error' capable buffer.
|
2005-12-23 21:50:38 +00:00
|
|
|
|
|
2004-12-27 16:34:43 +00:00
|
|
|
|
If AVOID-CURRENT is non-nil, treat the current buffer
|
|
|
|
|
as an absolute last resort only.
|
|
|
|
|
|
2005-06-20 10:29:02 +00:00
|
|
|
|
The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer
|
2004-12-27 16:34:43 +00:00
|
|
|
|
that normally would not qualify. If it returns t, the buffer
|
|
|
|
|
in question is treated as usable.
|
|
|
|
|
|
2005-12-23 21:50:38 +00:00
|
|
|
|
The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer
|
2004-12-27 16:34:43 +00:00
|
|
|
|
that would normally be considered usable. If it returns nil,
|
|
|
|
|
that buffer is rejected."
|
2004-09-01 17:05:59 +00:00
|
|
|
|
(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
|
2004-12-27 16:34:43 +00:00
|
|
|
|
(window-buffer w)
|
|
|
|
|
avoid-current
|
2004-12-14 00:51:02 +00:00
|
|
|
|
extra-test-inclusive extra-test-exclusive)
|
2004-09-01 17:05:59 +00:00
|
|
|
|
(window-buffer w)))
|
|
|
|
|
(window-list))))))
|
|
|
|
|
(if (eq (length window-buffers) 1)
|
|
|
|
|
(car window-buffers)))
|
2004-12-27 16:34:43 +00:00
|
|
|
|
;; 2. If next-error-last-buffer is an acceptable buffer, use that.
|
2004-09-01 17:05:59 +00:00
|
|
|
|
(if (and next-error-last-buffer
|
2004-12-27 16:34:43 +00:00
|
|
|
|
(next-error-buffer-p next-error-last-buffer avoid-current
|
2004-12-14 00:51:02 +00:00
|
|
|
|
extra-test-inclusive extra-test-exclusive))
|
2004-12-27 16:34:43 +00:00
|
|
|
|
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)
|
2004-09-01 17:05:59 +00:00
|
|
|
|
(current-buffer))
|
2004-12-27 16:34:43 +00:00
|
|
|
|
;; 4. Look for any acceptable buffer.
|
2004-09-01 17:05:59 +00:00
|
|
|
|
(let ((buffers (buffer-list)))
|
|
|
|
|
(while (and buffers
|
2004-12-27 16:34:43 +00:00
|
|
|
|
(not (next-error-buffer-p
|
|
|
|
|
(car buffers) avoid-current
|
|
|
|
|
extra-test-inclusive extra-test-exclusive)))
|
2004-09-01 17:05:59 +00:00
|
|
|
|
(setq buffers (cdr buffers)))
|
2004-12-27 16:34:43 +00:00
|
|
|
|
(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
|
2006-11-28 02:21:03 +00:00
|
|
|
|
(message "This is the only buffer with error message locations")
|
2004-12-27 16:34:43 +00:00
|
|
|
|
(current-buffer)))
|
|
|
|
|
;; 6. Give up.
|
2006-11-28 02:21:03 +00:00
|
|
|
|
(error "No buffers contain error message locations")))
|
2004-04-21 21:36:15 +00:00
|
|
|
|
|
2004-09-01 16:19:04 +00:00
|
|
|
|
(defun next-error (&optional arg reset)
|
(clone-indirect-buffer): Doc fix.
(fixup-whitespace, just-one-space, backward-delete-char-untabify, lambda):
"?\ " -> "?\s".
(next-error, next-error-highlight, next-error-highlight-no-select,
next-error-last-buffer, next-error-buffer-p, next-error-find-buffer, next-error,
previous-error, next-error-no-select, previous-error-no-select, open-line,
split-line, minibuffer-prompt-width, kill-new, binary-overwrite-mode):
Fix typos in docstrings.
(set-fill-column): Fix typo in message.
2005-07-20 22:29:53 +00:00
|
|
|
|
"Visit next `next-error' message and corresponding source code.
|
2004-04-21 21:36:15 +00:00
|
|
|
|
|
|
|
|
|
If all the error messages parsed so far have been processed already,
|
|
|
|
|
the message buffer is checked for new ones.
|
|
|
|
|
|
2004-04-22 22:56:08 +00:00
|
|
|
|
A prefix ARG specifies how many error messages to move;
|
2004-04-21 21:36:15 +00:00
|
|
|
|
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.
|
|
|
|
|
|
2004-05-07 22:31:54 +00:00
|
|
|
|
The RESET argument specifies that we should restart from the beginning.
|
2004-04-21 21:36:15 +00:00
|
|
|
|
|
|
|
|
|
\\[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
|
2004-09-01 17:05:59 +00:00
|
|
|
|
`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.
|
2004-04-21 21:36:15 +00:00
|
|
|
|
|
2005-07-09 20:46:26 +00:00
|
|
|
|
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.
|
2004-04-21 21:36:15 +00:00
|
|
|
|
|
|
|
|
|
See variables `compilation-parse-errors-function' and
|
|
|
|
|
\`compilation-error-regexp-alist' for customization ideas."
|
|
|
|
|
(interactive "P")
|
2004-04-22 22:56:08 +00:00
|
|
|
|
(if (consp arg) (setq reset t arg nil))
|
2004-04-21 21:36:15 +00:00
|
|
|
|
(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
|
2005-07-09 20:46:26 +00:00
|
|
|
|
(funcall next-error-function (prefix-numeric-value arg) reset)
|
|
|
|
|
(run-hooks 'next-error-hook))))
|
2004-04-21 21:36:15 +00:00
|
|
|
|
|
2005-10-02 03:33:02 +00:00
|
|
|
|
(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)
|
|
|
|
|
(run-hooks 'next-error-hook)))
|
|
|
|
|
|
2004-04-21 21:36:15 +00:00
|
|
|
|
(defalias 'goto-next-locus 'next-error)
|
|
|
|
|
(defalias 'next-match 'next-error)
|
|
|
|
|
|
2004-09-01 16:19:04 +00:00
|
|
|
|
(defun previous-error (&optional n)
|
(clone-indirect-buffer): Doc fix.
(fixup-whitespace, just-one-space, backward-delete-char-untabify, lambda):
"?\ " -> "?\s".
(next-error, next-error-highlight, next-error-highlight-no-select,
next-error-last-buffer, next-error-buffer-p, next-error-find-buffer, next-error,
previous-error, next-error-no-select, previous-error-no-select, open-line,
split-line, minibuffer-prompt-width, kill-new, binary-overwrite-mode):
Fix typos in docstrings.
(set-fill-column): Fix typo in message.
2005-07-20 22:29:53 +00:00
|
|
|
|
"Visit previous `next-error' message and corresponding source code.
|
2004-04-21 21:36:15 +00:00
|
|
|
|
|
|
|
|
|
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")
|
2004-09-01 16:19:04 +00:00
|
|
|
|
(next-error (- (or n 1))))
|
2004-04-21 21:36:15 +00:00
|
|
|
|
|
2004-09-01 16:19:04 +00:00
|
|
|
|
(defun first-error (&optional n)
|
2004-04-21 21:36:15 +00:00
|
|
|
|
"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))
|
|
|
|
|
|
2004-09-01 16:19:04 +00:00
|
|
|
|
(defun next-error-no-select (&optional n)
|
(clone-indirect-buffer): Doc fix.
(fixup-whitespace, just-one-space, backward-delete-char-untabify, lambda):
"?\ " -> "?\s".
(next-error, next-error-highlight, next-error-highlight-no-select,
next-error-last-buffer, next-error-buffer-p, next-error-find-buffer, next-error,
previous-error, next-error-no-select, previous-error-no-select, open-line,
split-line, minibuffer-prompt-width, kill-new, binary-overwrite-mode):
Fix typos in docstrings.
(set-fill-column): Fix typo in message.
2005-07-20 22:29:53 +00:00
|
|
|
|
"Move point to the next error in the `next-error' buffer and highlight match.
|
2004-04-21 21:36:15 +00:00
|
|
|
|
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")
|
2004-09-01 18:41:06 +00:00
|
|
|
|
(let ((next-error-highlight next-error-highlight-no-select))
|
|
|
|
|
(next-error n))
|
2004-04-21 21:36:15 +00:00
|
|
|
|
(pop-to-buffer next-error-last-buffer))
|
|
|
|
|
|
2004-09-01 16:19:04 +00:00
|
|
|
|
(defun previous-error-no-select (&optional n)
|
(clone-indirect-buffer): Doc fix.
(fixup-whitespace, just-one-space, backward-delete-char-untabify, lambda):
"?\ " -> "?\s".
(next-error, next-error-highlight, next-error-highlight-no-select,
next-error-last-buffer, next-error-buffer-p, next-error-find-buffer, next-error,
previous-error, next-error-no-select, previous-error-no-select, open-line,
split-line, minibuffer-prompt-width, kill-new, binary-overwrite-mode):
Fix typos in docstrings.
(set-fill-column): Fix typo in message.
2005-07-20 22:29:53 +00:00
|
|
|
|
"Move point to the previous error in the `next-error' buffer and highlight match.
|
2004-04-21 21:36:15 +00:00
|
|
|
|
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")
|
2004-09-01 16:19:04 +00:00
|
|
|
|
(next-error-no-select (- (or n 1))))
|
2004-04-21 21:36:15 +00:00
|
|
|
|
|
2004-09-04 12:45:26 +00:00
|
|
|
|
;;; Internal variable for `next-error-follow-mode-post-command-hook'.
|
|
|
|
|
(defvar next-error-follow-last-line nil)
|
|
|
|
|
|
2004-09-04 13:06:38 +00:00
|
|
|
|
(define-minor-mode next-error-follow-minor-mode
|
2004-09-04 12:45:26 +00:00
|
|
|
|
"Minor mode for compilation, occur and diff modes.
|
2004-09-04 13:06:38 +00:00
|
|
|
|
When turned on, cursor motion in the compilation, grep, occur or diff
|
|
|
|
|
buffer causes automatic display of the corresponding source code
|
|
|
|
|
location."
|
2005-08-15 17:23:50 +00:00
|
|
|
|
:group 'next-error :init-value nil :lighter " Fol"
|
2004-09-06 18:51:57 +00:00
|
|
|
|
(if (not next-error-follow-minor-mode)
|
2004-09-04 12:45:26 +00:00
|
|
|
|
(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)
|
2005-07-29 20:55:36 +00:00
|
|
|
|
(make-local-variable 'next-error-follow-last-line)))
|
2004-09-04 12:45:26 +00:00
|
|
|
|
|
|
|
|
|
;;; 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))))
|
|
|
|
|
|
2004-09-01 18:41:06 +00:00
|
|
|
|
|
2004-04-21 21:36:15 +00:00
|
|
|
|
;;;
|
|
|
|
|
|
1999-08-16 20:42:38 +00:00
|
|
|
|
(defun fundamental-mode ()
|
|
|
|
|
"Major mode not specialized for anything in particular.
|
|
|
|
|
Other major modes are defined by comparison with this one."
|
|
|
|
|
(interactive)
|
2004-09-19 00:02:44 +00:00
|
|
|
|
(kill-all-local-variables)
|
2005-06-16 12:40:54 +00:00
|
|
|
|
(unless delay-mode-hooks
|
|
|
|
|
(run-hooks 'after-change-major-mode-hook)))
|
2000-11-22 20:59:39 +00:00
|
|
|
|
|
1999-08-16 20:42:38 +00:00
|
|
|
|
;; Making and deleting lines.
|
|
|
|
|
|
* simple.el (hard-newline): New variable.
* mail/sendmail.el (mail-setup, mail-send, mail-insert-from-field)
(sendmail-send-it, mail-do-fcc, mail-cc, mail-bcc, mail-fcc)
(mail-mail-reply-to, mail-mail-followup-to)
(mail-position-on-field, mail-signature, mail-yank-original)
(mail-attach-file): Use it.
* mail/mailheader.el (mail-header-format)
(mail-header-format-function): Likewise.
* add-log.el (add-change-log-entry, change-log-merge): Likewise.
2005-11-17 16:30:52 +00:00
|
|
|
|
(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard)))
|
|
|
|
|
|
1995-03-01 15:09:58 +00:00
|
|
|
|
(defun newline (&optional arg)
|
1995-04-09 06:47:22 +00:00
|
|
|
|
"Insert a newline, and move to left margin of the new line if it's blank.
|
2001-12-18 15:53:57 +00:00
|
|
|
|
If `use-hard-newlines' is non-nil, the newline is marked with the
|
|
|
|
|
text-property `hard'.
|
2000-09-29 03:18:24 +00:00
|
|
|
|
With ARG, insert that many newlines.
|
2001-12-18 15:53:57 +00:00
|
|
|
|
Call `auto-fill-function' if the current column number is greater
|
2003-05-06 17:52:20 +00:00
|
|
|
|
than the value of `fill-column' and ARG is nil."
|
1995-03-01 15:09:58 +00:00
|
|
|
|
(interactive "*P")
|
1995-10-06 22:40:25 +00:00
|
|
|
|
(barf-if-buffer-read-only)
|
1995-03-01 15:09:58 +00:00
|
|
|
|
;; 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.
|
1999-11-15 16:11:14 +00:00
|
|
|
|
(let ((flag (and (not (bobp))
|
1995-03-01 15:09:58 +00:00
|
|
|
|
(bolp)
|
1997-03-22 03:54:14 +00:00
|
|
|
|
;; Make sure no functions want to be told about
|
|
|
|
|
;; the range of the changes.
|
|
|
|
|
(not after-change-functions)
|
|
|
|
|
(not before-change-functions)
|
1996-10-11 03:11:00 +00:00
|
|
|
|
;; Make sure there are no markers here.
|
|
|
|
|
(not (buffer-has-markers-at (1- (point))))
|
1998-04-09 20:05:58 +00:00
|
|
|
|
(not (buffer-has-markers-at (point)))
|
1997-03-22 03:54:14 +00:00
|
|
|
|
;; 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)))
|
1996-07-04 18:55:49 +00:00
|
|
|
|
;; 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).
|
1999-11-15 16:11:14 +00:00
|
|
|
|
(< (or (previous-property-change (point)) -2)
|
1995-04-09 06:47:22 +00:00
|
|
|
|
(- (point) 2))))
|
|
|
|
|
(was-page-start (and (bolp)
|
|
|
|
|
(looking-at page-delimiter)))
|
|
|
|
|
(beforepos (point)))
|
1995-03-01 15:09:58 +00:00
|
|
|
|
(if flag (backward-char 1))
|
|
|
|
|
;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
|
|
|
|
|
;; Set last-command-char to tell self-insert what to insert.
|
|
|
|
|
(let ((last-command-char ?\n)
|
|
|
|
|
;; Don't auto-fill if we have a numeric argument.
|
1995-04-10 21:01:12 +00:00
|
|
|
|
;; 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)))
|
1995-06-27 18:58:26 +00:00
|
|
|
|
(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))))
|
1998-04-09 20:05:58 +00:00
|
|
|
|
;; 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.
|
|
|
|
|
|
1995-03-01 15:09:58 +00:00
|
|
|
|
;; Mark the newline(s) `hard'.
|
|
|
|
|
(if use-hard-newlines
|
1998-04-09 20:05:58 +00:00
|
|
|
|
(set-hard-newline-properties
|
1996-09-01 03:24:22 +00:00
|
|
|
|
(- (point) (if arg (prefix-numeric-value arg) 1)) (point)))
|
1995-04-09 06:47:22 +00:00
|
|
|
|
;; 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)))
|
1995-03-01 15:09:58 +00:00
|
|
|
|
nil)
|
|
|
|
|
|
1996-09-01 03:24:22 +00:00
|
|
|
|
(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)))))
|
2000-11-22 20:59:39 +00:00
|
|
|
|
|
2004-05-07 22:31:54 +00:00
|
|
|
|
(defun open-line (n)
|
1992-08-21 07:18:16 +00:00
|
|
|
|
"Insert a newline and leave point before it.
|
(clone-indirect-buffer): Doc fix.
(fixup-whitespace, just-one-space, backward-delete-char-untabify, lambda):
"?\ " -> "?\s".
(next-error, next-error-highlight, next-error-highlight-no-select,
next-error-last-buffer, next-error-buffer-p, next-error-find-buffer, next-error,
previous-error, next-error-no-select, previous-error-no-select, open-line,
split-line, minibuffer-prompt-width, kill-new, binary-overwrite-mode):
Fix typos in docstrings.
(set-fill-column): Fix typo in message.
2005-07-20 22:29:53 +00:00
|
|
|
|
If there is a fill prefix and/or a `left-margin', insert them
|
|
|
|
|
on the new line if the line would have been blank.
|
1992-08-31 20:22:03 +00:00
|
|
|
|
With arg N, insert N newlines."
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(interactive "*p")
|
1992-08-31 20:22:03 +00:00
|
|
|
|
(let* ((do-fill-prefix (and fill-prefix (bolp)))
|
1995-02-23 18:38:42 +00:00
|
|
|
|
(do-left-margin (and (bolp) (> (current-left-margin) 0)))
|
2001-01-26 09:23:17 +00:00
|
|
|
|
(loc (point))
|
|
|
|
|
;; Don't expand an abbrev before point.
|
|
|
|
|
(abbrev-mode nil))
|
2004-05-07 22:31:54 +00:00
|
|
|
|
(newline n)
|
1995-04-09 06:47:22 +00:00
|
|
|
|
(goto-char loc)
|
2004-05-07 22:31:54 +00:00
|
|
|
|
(while (> n 0)
|
1995-04-09 06:47:22 +00:00
|
|
|
|
(cond ((bolp)
|
|
|
|
|
(if do-left-margin (indent-to (current-left-margin)))
|
|
|
|
|
(if do-fill-prefix (insert-and-inherit fill-prefix))))
|
|
|
|
|
(forward-line 1)
|
2004-05-07 22:31:54 +00:00
|
|
|
|
(setq n (1- n)))
|
1995-04-09 06:47:22 +00:00
|
|
|
|
(goto-char loc)
|
|
|
|
|
(end-of-line)))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
2003-01-03 22:46:06 +00:00
|
|
|
|
(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
|
(clone-indirect-buffer): Doc fix.
(fixup-whitespace, just-one-space, backward-delete-char-untabify, lambda):
"?\ " -> "?\s".
(next-error, next-error-highlight, next-error-highlight-no-select,
next-error-last-buffer, next-error-buffer-p, next-error-find-buffer, next-error,
previous-error, next-error-no-select, previous-error-no-select, open-line,
split-line, minibuffer-prompt-width, kill-new, binary-overwrite-mode):
Fix typos in docstrings.
(set-fill-column): Fix typo in message.
2005-07-20 22:29:53 +00:00
|
|
|
|
line as well. With prefix ARG, don't insert `fill-prefix' on new line.
|
2003-01-03 22:46:06 +00:00
|
|
|
|
|
2004-05-07 22:31:54 +00:00
|
|
|
|
When called from Lisp code, ARG may be a prefix string to copy."
|
2003-01-03 22:46:06 +00:00
|
|
|
|
(interactive "*P")
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(skip-chars-forward " \t")
|
2003-01-06 01:17:19 +00:00
|
|
|
|
(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))))))
|
1995-01-13 08:43:40 +00:00
|
|
|
|
(newline 1)
|
2003-01-06 01:17:19 +00:00
|
|
|
|
(if have-prfx (insert-and-inherit prefix))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(indent-to col 0)
|
|
|
|
|
(goto-char pos)))
|
|
|
|
|
|
|
|
|
|
(defun delete-indentation (&optional arg)
|
|
|
|
|
"Join this line to previous and fix up whitespace at join.
|
1992-07-29 02:15:26 +00:00
|
|
|
|
If there is a fill prefix, delete it from the beginning of this line.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
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)))
|
1992-07-29 02:15:26 +00:00
|
|
|
|
;; If the second line started with the fill prefix,
|
|
|
|
|
;; delete the prefix.
|
|
|
|
|
(if (and fill-prefix
|
1992-09-30 10:31:31 +00:00
|
|
|
|
(<= (+ (point) (length fill-prefix)) (point-max))
|
1992-07-29 02:15:26 +00:00
|
|
|
|
(string= fill-prefix
|
|
|
|
|
(buffer-substring (point)
|
|
|
|
|
(+ (point) (length fill-prefix)))))
|
|
|
|
|
(delete-region (point) (+ (point) (length fill-prefix))))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(fixup-whitespace))))
|
|
|
|
|
|
1999-01-15 16:57:27 +00:00
|
|
|
|
(defalias 'join-line #'delete-indentation) ; easier to find
|
2000-11-22 20:59:39 +00:00
|
|
|
|
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(defun delete-blank-lines ()
|
|
|
|
|
"On blank line, delete all surrounding blank lines, leaving just one.
|
|
|
|
|
On isolated blank line, delete that one.
|
1994-06-07 07:47:24 +00:00
|
|
|
|
On nonblank line, delete any immediately following blank lines."
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(interactive "*")
|
|
|
|
|
(let (thisblank singleblank)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(setq thisblank (looking-at "[ \t]*$"))
|
1992-06-12 22:23:00 +00:00
|
|
|
|
;; Set singleblank if there is just one blank line here.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(setq singleblank
|
|
|
|
|
(and thisblank
|
|
|
|
|
(not (looking-at "[ \t]*\n[ \t]*$"))
|
|
|
|
|
(or (bobp)
|
|
|
|
|
(progn (forward-line -1)
|
|
|
|
|
(not (looking-at "[ \t]*$")))))))
|
1992-06-12 22:23:00 +00:00
|
|
|
|
;; Delete preceding blank lines, and this one too if it's the only one.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(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)))))
|
1992-06-12 22:23:00 +00:00
|
|
|
|
;; Delete following blank lines, unless the current line is blank
|
|
|
|
|
;; and there are no following blank lines.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(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))
|
1992-06-12 22:23:00 +00:00
|
|
|
|
(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)))))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
2000-11-22 20:59:39 +00:00
|
|
|
|
(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.
|
2001-02-10 16:34:42 +00:00
|
|
|
|
This respects narrowing, created by \\[narrow-to-region] and friends.
|
|
|
|
|
A formfeed is not considered whitespace by this function."
|
2000-11-22 20:59:39 +00:00
|
|
|
|
(interactive "*")
|
|
|
|
|
(save-match-data
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char (point-min))
|
2000-12-03 02:29:36 +00:00
|
|
|
|
(while (re-search-forward "\\s-$" nil t)
|
|
|
|
|
(skip-syntax-backward "-" (save-excursion (forward-line 0) (point)))
|
2001-01-29 20:36:26 +00:00
|
|
|
|
;; Don't delete formfeeds, even if they are considered whitespace.
|
2001-07-20 09:40:27 +00:00
|
|
|
|
(save-match-data
|
|
|
|
|
(if (looking-at ".*\f")
|
|
|
|
|
(goto-char (match-end 0))))
|
2000-12-15 16:25:51 +00:00
|
|
|
|
(delete-region (point) (match-end 0))))))
|
2000-11-22 20:59:39 +00:00
|
|
|
|
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(defun newline-and-indent ()
|
|
|
|
|
"Insert a newline, then indent according to major mode.
|
1992-08-21 07:18:16 +00:00
|
|
|
|
Indentation is done using the value of `indent-line-function'.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
In programming language modes, this is the same as TAB.
|
1992-08-21 07:18:16 +00:00
|
|
|
|
In some text modes, where TAB inserts a tab, this command indents to the
|
1995-01-19 04:21:56 +00:00
|
|
|
|
column specified by the function `current-left-margin'."
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(interactive "*")
|
2000-12-12 01:20:55 +00:00
|
|
|
|
(delete-horizontal-space t)
|
1992-04-19 08:53:55 +00:00
|
|
|
|
(newline)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(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,
|
1992-08-21 07:18:16 +00:00
|
|
|
|
which means calling the current value of `indent-line-function'.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
In programming language modes, this is the same as TAB.
|
|
|
|
|
In some text modes, where TAB inserts a tab, this indents to the
|
1995-01-19 04:21:56 +00:00
|
|
|
|
column specified by the function `current-left-margin'."
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(interactive "*")
|
2001-10-31 00:57:04 +00:00
|
|
|
|
(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)
|
2003-10-27 15:22:38 +00:00
|
|
|
|
(indent-according-to-mode)
|
|
|
|
|
(delete-horizontal-space t))
|
2001-10-31 00:57:04 +00:00
|
|
|
|
(indent-according-to-mode)))
|
2000-11-22 20:59:39 +00:00
|
|
|
|
|
1999-08-16 20:42:38 +00:00
|
|
|
|
(defun quoted-insert (arg)
|
|
|
|
|
"Read next input character and insert it.
|
|
|
|
|
This is useful for inserting control characters.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
1999-08-16 20:42:38 +00:00
|
|
|
|
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.
|
1993-04-29 13:57:52 +00:00
|
|
|
|
|
1999-08-16 20:42:38 +00:00
|
|
|
|
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.
|
1993-04-29 13:57:52 +00:00
|
|
|
|
|
1999-08-16 20:42:38 +00:00
|
|
|
|
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")
|
2005-11-28 19:59:59 +00:00
|
|
|
|
(let* ((char (let (translation-table-for-input input-method-function)
|
2002-11-06 23:27:24 +00:00
|
|
|
|
(if (or (not overwrite-mode)
|
|
|
|
|
(eq overwrite-mode 'overwrite-mode-binary))
|
|
|
|
|
(read-quoted-char)
|
|
|
|
|
(read-char)))))
|
1999-08-16 20:42:38 +00:00
|
|
|
|
;; Assume character codes 0240 - 0377 stand for characters in some
|
|
|
|
|
;; single-byte character set, and convert them to Emacs
|
|
|
|
|
;; 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)))))
|
2000-11-22 20:59:39 +00:00
|
|
|
|
|
2003-08-17 00:15:53 +00:00
|
|
|
|
(defun forward-to-indentation (&optional arg)
|
1999-08-16 20:42:38 +00:00
|
|
|
|
"Move forward ARG lines and position at first nonblank character."
|
|
|
|
|
(interactive "p")
|
2003-08-17 00:15:53 +00:00
|
|
|
|
(forward-line (or arg 1))
|
1999-08-16 20:42:38 +00:00
|
|
|
|
(skip-chars-forward " \t"))
|
1998-03-06 05:51:51 +00:00
|
|
|
|
|
2003-08-17 00:15:53 +00:00
|
|
|
|
(defun backward-to-indentation (&optional arg)
|
1999-08-16 20:42:38 +00:00
|
|
|
|
"Move backward ARG lines and position at first nonblank character."
|
|
|
|
|
(interactive "p")
|
2003-08-17 00:15:53 +00:00
|
|
|
|
(forward-line (- (or arg 1)))
|
1999-08-16 20:42:38 +00:00
|
|
|
|
(skip-chars-forward " \t"))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
1999-08-16 20:42:38 +00:00
|
|
|
|
(defun back-to-indentation ()
|
|
|
|
|
"Move point to the first non-whitespace character on this line."
|
|
|
|
|
(interactive)
|
|
|
|
|
(beginning-of-line 1)
|
2003-05-13 19:45:01 +00:00
|
|
|
|
(skip-syntax-forward " " (line-end-position))
|
2003-04-24 01:57:46 +00:00
|
|
|
|
;; Move back over chars that have whitespace syntax but have the p flag.
|
|
|
|
|
(backward-prefix-chars))
|
1999-08-16 20:42:38 +00:00
|
|
|
|
|
|
|
|
|
(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
|
(clone-indirect-buffer): Doc fix.
(fixup-whitespace, just-one-space, backward-delete-char-untabify, lambda):
"?\ " -> "?\s".
(next-error, next-error-highlight, next-error-highlight-no-select,
next-error-last-buffer, next-error-buffer-p, next-error-find-buffer, next-error,
previous-error, next-error-no-select, previous-error-no-select, open-line,
split-line, minibuffer-prompt-width, kill-new, binary-overwrite-mode):
Fix typos in docstrings.
(set-fill-column): Fix typo in message.
2005-07-20 22:29:53 +00:00
|
|
|
|
(insert ?\s))))
|
1999-08-16 20:42:38 +00:00
|
|
|
|
|
2000-12-12 01:20:55 +00:00
|
|
|
|
(defun delete-horizontal-space (&optional backward-only)
|
|
|
|
|
"Delete all spaces and tabs around point.
|
|
|
|
|
If BACKWARD-ONLY is non-nil, only delete spaces before point."
|
1999-08-16 20:42:38 +00:00
|
|
|
|
(interactive "*")
|
2001-05-18 07:13:47 +00:00
|
|
|
|
(let ((orig-pos (point)))
|
|
|
|
|
(delete-region
|
|
|
|
|
(if backward-only
|
|
|
|
|
orig-pos
|
|
|
|
|
(progn
|
|
|
|
|
(skip-chars-forward " \t")
|
|
|
|
|
(constrain-to-field nil orig-pos t)))
|
2000-12-12 01:20:55 +00:00
|
|
|
|
(progn
|
2001-05-18 07:13:47 +00:00
|
|
|
|
(skip-chars-backward " \t")
|
|
|
|
|
(constrain-to-field nil orig-pos)))))
|
1999-08-16 20:42:38 +00:00
|
|
|
|
|
2005-01-17 10:56:07 +00:00
|
|
|
|
(defun just-one-space (&optional n)
|
2005-01-15 18:08:46 +00:00
|
|
|
|
"Delete all spaces and tabs around point, leaving one space (or N spaces)."
|
|
|
|
|
(interactive "*p")
|
2001-05-18 07:13:47 +00:00
|
|
|
|
(let ((orig-pos (point)))
|
|
|
|
|
(skip-chars-backward " \t")
|
|
|
|
|
(constrain-to-field nil orig-pos)
|
2005-01-17 10:56:07 +00:00
|
|
|
|
(dotimes (i (or n 1))
|
(clone-indirect-buffer): Doc fix.
(fixup-whitespace, just-one-space, backward-delete-char-untabify, lambda):
"?\ " -> "?\s".
(next-error, next-error-highlight, next-error-highlight-no-select,
next-error-last-buffer, next-error-buffer-p, next-error-find-buffer, next-error,
previous-error, next-error-no-select, previous-error-no-select, open-line,
split-line, minibuffer-prompt-width, kill-new, binary-overwrite-mode):
Fix typos in docstrings.
(set-fill-column): Fix typo in message.
2005-07-20 22:29:53 +00:00
|
|
|
|
(if (= (following-char) ?\s)
|
2005-01-15 18:08:46 +00:00
|
|
|
|
(forward-char 1)
|
(clone-indirect-buffer): Doc fix.
(fixup-whitespace, just-one-space, backward-delete-char-untabify, lambda):
"?\ " -> "?\s".
(next-error, next-error-highlight, next-error-highlight-no-select,
next-error-last-buffer, next-error-buffer-p, next-error-find-buffer, next-error,
previous-error, next-error-no-select, previous-error-no-select, open-line,
split-line, minibuffer-prompt-width, kill-new, binary-overwrite-mode):
Fix typos in docstrings.
(set-fill-column): Fix typo in message.
2005-07-20 22:29:53 +00:00
|
|
|
|
(insert ?\s)))
|
2001-05-18 07:13:47 +00:00
|
|
|
|
(delete-region
|
|
|
|
|
(point)
|
|
|
|
|
(progn
|
|
|
|
|
(skip-chars-forward " \t")
|
|
|
|
|
(constrain-to-field nil orig-pos t)))))
|
2002-03-29 23:16:11 +00:00
|
|
|
|
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(defun beginning-of-buffer (&optional arg)
|
|
|
|
|
"Move point to the beginning of the buffer; leave mark at previous position.
|
2004-07-16 10:42:00 +00:00
|
|
|
|
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.
|
1994-11-28 19:44:16 +00:00
|
|
|
|
|
|
|
|
|
If the buffer is narrowed, this command uses the beginning and size
|
|
|
|
|
of the accessible part of the buffer.
|
1992-08-21 07:18:16 +00:00
|
|
|
|
|
|
|
|
|
Don't use this command in Lisp programs!
|
1991-12-21 09:29:41 +00:00
|
|
|
|
\(goto-char (point-min)) is faster and avoids clobbering the mark."
|
|
|
|
|
(interactive "P")
|
2004-12-14 12:17:43 +00:00
|
|
|
|
(or (consp arg)
|
2004-12-13 03:08:52 +00:00
|
|
|
|
(and transient-mark-mode mark-active)
|
|
|
|
|
(push-mark))
|
1994-11-28 19:44:16 +00:00
|
|
|
|
(let ((size (- (point-max) (point-min))))
|
2004-07-16 10:42:00 +00:00
|
|
|
|
(goto-char (if (and arg (not (consp arg)))
|
1994-11-28 19:44:16 +00:00
|
|
|
|
(+ (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))))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(if arg (forward-line 1)))
|
|
|
|
|
|
|
|
|
|
(defun end-of-buffer (&optional arg)
|
|
|
|
|
"Move point to the end of the buffer; leave mark at previous position.
|
2004-07-16 10:42:00 +00:00
|
|
|
|
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.
|
1994-11-28 19:44:16 +00:00
|
|
|
|
|
|
|
|
|
If the buffer is narrowed, this command uses the beginning and size
|
|
|
|
|
of the accessible part of the buffer.
|
1992-08-21 07:18:16 +00:00
|
|
|
|
|
|
|
|
|
Don't use this command in Lisp programs!
|
1991-12-21 09:29:41 +00:00
|
|
|
|
\(goto-char (point-max)) is faster and avoids clobbering the mark."
|
|
|
|
|
(interactive "P")
|
2004-12-14 12:17:43 +00:00
|
|
|
|
(or (consp arg)
|
2004-12-13 03:08:52 +00:00
|
|
|
|
(and transient-mark-mode mark-active)
|
|
|
|
|
(push-mark))
|
1994-11-28 19:44:16 +00:00
|
|
|
|
(let ((size (- (point-max) (point-min))))
|
2004-07-16 10:42:00 +00:00
|
|
|
|
(goto-char (if (and arg (not (consp arg)))
|
1994-11-28 19:44:16 +00:00
|
|
|
|
(- (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))))
|
1992-07-22 04:22:42 +00:00
|
|
|
|
;; If we went to a place in the middle of the buffer,
|
|
|
|
|
;; adjust it to the beginning of a line.
|
1999-11-01 11:44:58 +00:00
|
|
|
|
(cond (arg (forward-line 1))
|
2001-10-10 11:55:39 +00:00
|
|
|
|
((> (point) (window-end nil t))
|
1999-11-01 11:44:58 +00:00
|
|
|
|
;; 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))))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
|
|
|
|
(defun mark-whole-buffer ()
|
1992-06-12 22:23:00 +00:00
|
|
|
|
"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."
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(interactive)
|
|
|
|
|
(push-mark (point))
|
1993-05-16 15:39:39 +00:00
|
|
|
|
(push-mark (point-max) nil t)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(goto-char (point-min)))
|
2002-03-29 23:16:11 +00:00
|
|
|
|
|
2000-11-22 20:59:39 +00:00
|
|
|
|
|
1999-08-16 20:42:38 +00:00
|
|
|
|
;; Counting lines, one way or another.
|
|
|
|
|
|
2005-03-05 18:02:40 +00:00
|
|
|
|
(defun goto-line (arg &optional buffer)
|
|
|
|
|
"Goto line ARG, counting from line 1 at beginning of buffer.
|
2005-03-19 14:25:29 +00:00
|
|
|
|
Normally, move point in the current buffer.
|
|
|
|
|
With just \\[universal-argument] as argument, move point in the most recently
|
|
|
|
|
displayed other buffer, and switch to it. When called from Lisp code,
|
|
|
|
|
the optional argument BUFFER specifies a buffer to switch to.
|
2005-03-05 18:02:40 +00:00
|
|
|
|
|
|
|
|
|
If there's a number in the buffer at point, it is the default for ARG."
|
|
|
|
|
(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))))
|
|
|
|
|
;; Move to the specified line number in that buffer.
|
1999-08-16 20:42:38 +00:00
|
|
|
|
(save-restriction
|
|
|
|
|
(widen)
|
|
|
|
|
(goto-char 1)
|
|
|
|
|
(if (eq selective-display t)
|
|
|
|
|
(re-search-forward "[\n\C-m]" nil 'end (1- arg))
|
2005-03-05 19:12:31 +00:00
|
|
|
|
(forward-line (1- arg)))))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
|
|
|
|
(defun count-lines-region (start end)
|
1993-06-09 11:59:12 +00:00
|
|
|
|
"Print number of lines and characters in the region."
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(interactive "r")
|
|
|
|
|
(message "Region has %d lines, %d characters"
|
|
|
|
|
(count-lines start end) (- end start)))
|
|
|
|
|
|
|
|
|
|
(defun what-line ()
|
1995-08-25 14:16:26 +00:00
|
|
|
|
"Print the current buffer line number and narrowed line number of point."
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(interactive)
|
2004-12-03 22:26:13 +00:00
|
|
|
|
(let ((start (point-min))
|
2004-02-07 00:37:13 +00:00
|
|
|
|
(n (line-number-at-pos)))
|
2004-01-22 20:42:52 +00:00
|
|
|
|
(if (= start 1)
|
|
|
|
|
(message "Line %d" n)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(save-restriction
|
|
|
|
|
(widen)
|
2004-02-18 03:04:32 +00:00
|
|
|
|
(message "line %d (narrowed line %d)"
|
2004-02-07 00:37:13 +00:00
|
|
|
|
(+ n (line-number-at-pos start) -1) n))))))
|
1995-08-25 14:16:26 +00:00
|
|
|
|
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(defun count-lines (start end)
|
|
|
|
|
"Return number of lines between START and END.
|
|
|
|
|
This is usually the number of newlines between them,
|
1992-08-21 07:18:16 +00:00
|
|
|
|
but can be one more if START is not equal to END
|
1991-12-21 09:29:41 +00:00
|
|
|
|
and the greater of them is not at the start of a line."
|
1994-10-16 08:20:07 +00:00
|
|
|
|
(save-excursion
|
|
|
|
|
(save-restriction
|
|
|
|
|
(narrow-to-region start end)
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(if (eq selective-display t)
|
|
|
|
|
(save-match-data
|
1993-03-29 19:09:05 +00:00
|
|
|
|
(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)))
|
1993-11-24 04:35:28 +00:00
|
|
|
|
(goto-char (point-max))
|
|
|
|
|
(if (and (/= start end)
|
|
|
|
|
(not (bolp)))
|
|
|
|
|
(1+ done)
|
1994-10-16 08:20:07 +00:00
|
|
|
|
done)))
|
|
|
|
|
(- (buffer-size) (forward-line (buffer-size)))))))
|
2000-11-22 20:59:39 +00:00
|
|
|
|
|
2004-02-07 00:37:13 +00:00
|
|
|
|
(defun line-number-at-pos (&optional pos)
|
2004-01-22 20:42:52 +00:00
|
|
|
|
"Return (narrowed) buffer line number at position POS.
|
2006-08-20 12:16:58 +00:00
|
|
|
|
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."
|
2004-01-22 20:42:52 +00:00
|
|
|
|
(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))))))
|
|
|
|
|
|
1997-02-20 05:35:12 +00:00
|
|
|
|
(defun what-cursor-position (&optional detail)
|
|
|
|
|
"Print info on cursor position (on screen and within buffer).
|
1998-12-30 20:41:24 +00:00
|
|
|
|
Also describe the character after point, and give its character code
|
1999-02-25 13:25:07 +00:00
|
|
|
|
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.
|
1998-08-02 01:06:57 +00:00
|
|
|
|
|
2000-05-13 00:28:57 +00:00
|
|
|
|
In addition, with prefix argument, show details about that character
|
2002-06-17 16:15:09 +00:00
|
|
|
|
in *Help* buffer. See also the command `describe-char'."
|
1997-02-20 05:35:12 +00:00
|
|
|
|
(interactive "P")
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(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)))
|
2005-11-20 07:43:01 +00:00
|
|
|
|
(message "point=%d of %d (%d%%) <%d-%d> column=%d%s"
|
1991-12-21 09:29:41 +00:00
|
|
|
|
pos total percent beg end col hscroll)
|
2005-11-20 07:43:01 +00:00
|
|
|
|
(message "point=%d of %d (EOB) column=%d%s"
|
2005-11-12 00:10:56 +00:00
|
|
|
|
pos total col hscroll))
|
1999-02-25 13:25:07 +00:00
|
|
|
|
(let ((coding buffer-file-coding-system)
|
2005-10-06 06:57:41 +00:00
|
|
|
|
encoded encoding-msg display-prop under-display)
|
1999-02-25 13:25:07 +00:00
|
|
|
|
(if (or (not coding)
|
|
|
|
|
(eq (coding-system-type coding) t))
|
|
|
|
|
(setq coding default-buffer-file-coding-system))
|
1999-03-22 04:12:42 +00:00
|
|
|
|
(if (not (char-valid-p char))
|
|
|
|
|
(setq encoding-msg
|
2005-11-20 07:43:01 +00:00
|
|
|
|
(format "(%d, #o%o, #x%x, invalid)" char char char))
|
2005-10-06 06:57:41 +00:00
|
|
|
|
;; 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))))
|
1999-03-22 04:12:42 +00:00
|
|
|
|
(setq encoding-msg
|
2005-10-06 06:57:41 +00:00
|
|
|
|
(if display-prop
|
|
|
|
|
(if (not (stringp display-prop))
|
2005-11-20 07:43:01 +00:00
|
|
|
|
(format "(%d, #o%o, #x%x, part of display \"%s\")"
|
2005-10-06 06:57:41 +00:00
|
|
|
|
char char char under-display)
|
2005-11-20 07:43:01 +00:00
|
|
|
|
(format "(%d, #o%o, #x%x, part of display \"%s\"->\"%s\")"
|
2005-10-06 06:57:41 +00:00
|
|
|
|
char char char under-display display-prop))
|
|
|
|
|
(if encoded
|
2005-11-20 07:43:01 +00:00
|
|
|
|
(format "(%d, #o%o, #x%x, file %s)"
|
2005-10-06 06:57:41 +00:00
|
|
|
|
char char char
|
|
|
|
|
(if (> (length encoded) 1)
|
|
|
|
|
"..."
|
|
|
|
|
(encoded-string-description encoded coding)))
|
2005-11-20 07:43:01 +00:00
|
|
|
|
(format "(%d, #o%o, #x%x)" char char char)))))
|
1998-12-27 04:09:09 +00:00
|
|
|
|
(if detail
|
2000-05-13 00:28:57 +00:00
|
|
|
|
;; We show the detailed information about CHAR.
|
2002-06-17 16:15:09 +00:00
|
|
|
|
(describe-char (point)))
|
2000-05-13 00:28:57 +00:00
|
|
|
|
(if (or (/= beg 1) (/= end (1+ total)))
|
2005-11-20 07:43:01 +00:00
|
|
|
|
(message "Char: %s %s point=%d of %d (%d%%) <%d-%d> column=%d%s"
|
1998-08-02 01:06:57 +00:00
|
|
|
|
(if (< char 256)
|
|
|
|
|
(single-key-description char)
|
1999-12-15 00:39:33 +00:00
|
|
|
|
(buffer-substring-no-properties (point) (1+ (point))))
|
2000-05-13 00:28:57 +00:00
|
|
|
|
encoding-msg pos total percent beg end col hscroll)
|
2005-11-20 07:43:01 +00:00
|
|
|
|
(message "Char: %s %s point=%d of %d (%d%%) column=%d%s"
|
2005-10-06 06:57:41 +00:00
|
|
|
|
(if enable-multibyte-characters
|
|
|
|
|
(if (< char 128)
|
|
|
|
|
(single-key-description char)
|
|
|
|
|
(buffer-substring-no-properties (point) (1+ (point))))
|
|
|
|
|
(single-key-description char))
|
2000-05-13 00:28:57 +00:00
|
|
|
|
encoding-msg pos total percent col hscroll))))))
|
2002-03-29 23:16:11 +00:00
|
|
|
|
|
2006-10-18 10:58:39 +00:00
|
|
|
|
;; 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))
|
1992-09-14 06:53:22 +00:00
|
|
|
|
|
1993-07-26 18:32:07 +00:00
|
|
|
|
(defvar read-expression-history nil)
|
|
|
|
|
|
1999-09-14 07:00:04 +00:00
|
|
|
|
(defcustom eval-expression-print-level 4
|
2005-06-04 22:04:29 +00:00
|
|
|
|
"Value for `print-level' while printing value in `eval-expression'.
|
2001-12-18 23:39:21 +00:00
|
|
|
|
A value of nil means no limit."
|
1999-09-14 07:00:04 +00:00
|
|
|
|
:group 'lisp
|
2001-12-18 15:53:57 +00:00
|
|
|
|
:type '(choice (const :tag "No Limit" nil) integer)
|
1999-09-14 07:00:04 +00:00
|
|
|
|
:version "21.1")
|
|
|
|
|
|
|
|
|
|
(defcustom eval-expression-print-length 12
|
2005-06-04 22:04:29 +00:00
|
|
|
|
"Value for `print-length' while printing value in `eval-expression'.
|
2001-12-18 23:39:21 +00:00
|
|
|
|
A value of nil means no limit."
|
1999-09-14 07:00:04 +00:00
|
|
|
|
:group 'lisp
|
2001-12-18 15:53:57 +00:00
|
|
|
|
:type '(choice (const :tag "No Limit" nil) integer)
|
1999-09-14 07:00:04 +00:00
|
|
|
|
:version "21.1")
|
|
|
|
|
|
|
|
|
|
(defcustom eval-expression-debug-on-error t
|
2005-06-04 22:04:29 +00:00
|
|
|
|
"If non-nil set `debug-on-error' to t in `eval-expression'.
|
2000-01-12 13:06:52 +00:00
|
|
|
|
If nil, don't change the value of `debug-on-error'."
|
1999-09-14 07:00:04 +00:00
|
|
|
|
:group 'lisp
|
|
|
|
|
:type 'boolean
|
|
|
|
|
:version "21.1")
|
|
|
|
|
|
2004-05-28 21:00:14 +00:00
|
|
|
|
(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)
|
2004-06-10 04:20:02 +00:00
|
|
|
|
(or (not (memq this-command '(eval-last-sexp eval-print-last-sexp)))
|
2004-05-28 21:00:14 +00:00
|
|
|
|
(eq this-command last-command)
|
2005-01-15 18:08:46 +00:00
|
|
|
|
(if (boundp 'edebug-active) edebug-active)))
|
2004-05-28 21:00:14 +00:00
|
|
|
|
(let ((char-string
|
2005-02-10 06:47:58 +00:00
|
|
|
|
(if (or (if (boundp 'edebug-active) edebug-active)
|
2004-06-10 04:20:02 +00:00
|
|
|
|
(memq this-command '(eval-last-sexp eval-print-last-sexp)))
|
2004-05-28 21:00:14 +00:00
|
|
|
|
(prin1-char value))))
|
|
|
|
|
(if char-string
|
2005-11-01 07:18:10 +00:00
|
|
|
|
(format " (#o%o, #x%x, %s)" value value char-string)
|
|
|
|
|
(format " (#o%o, #x%x)" value value)))))
|
2004-05-28 21:00:14 +00:00
|
|
|
|
|
1993-07-26 18:32:07 +00:00
|
|
|
|
;; We define this, rather than making `eval' interactive,
|
2006-07-05 07:44:35 +00:00
|
|
|
|
;; for the sake of completion of names like eval-region, eval-buffer.
|
1997-08-24 21:28:21 +00:00
|
|
|
|
(defun eval-expression (eval-expression-arg
|
|
|
|
|
&optional eval-expression-insert-value)
|
2001-02-10 06:45:56 +00:00
|
|
|
|
"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
|
2006-04-07 23:30:42 +00:00
|
|
|
|
the echo area.
|
|
|
|
|
|
|
|
|
|
If `eval-expression-debug-on-error' is non-nil, which is the default,
|
|
|
|
|
this command arranges for all errors to enter the debugger."
|
1993-10-25 06:07:23 +00:00
|
|
|
|
(interactive
|
1993-11-19 17:43:24 +00:00
|
|
|
|
(list (read-from-minibuffer "Eval: "
|
|
|
|
|
nil read-expression-map t
|
1997-08-24 21:28:21 +00:00
|
|
|
|
'read-expression-history)
|
|
|
|
|
current-prefix-arg))
|
2000-11-22 20:59:39 +00:00
|
|
|
|
|
2000-01-12 13:06:52 +00:00
|
|
|
|
(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))))
|
2000-11-22 20:59:39 +00:00
|
|
|
|
|
1999-09-14 07:00:04 +00:00
|
|
|
|
(let ((print-length eval-expression-print-length)
|
|
|
|
|
(print-level eval-expression-print-level))
|
2003-08-17 00:15:53 +00:00
|
|
|
|
(if eval-expression-insert-value
|
|
|
|
|
(with-no-warnings
|
2003-09-22 15:11:02 +00:00
|
|
|
|
(let ((standard-output (current-buffer)))
|
|
|
|
|
(eval-last-sexp-print-value (car values))))
|
2004-05-28 21:00:14 +00:00
|
|
|
|
(prog1
|
|
|
|
|
(prin1 (car values) t)
|
|
|
|
|
(let ((str (eval-expression-print-format (car values))))
|
|
|
|
|
(if str (princ str t)))))))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
|
|
|
|
(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."
|
2002-09-24 18:40:59 +00:00
|
|
|
|
(let ((command
|
2004-01-31 15:07:40 +00:00
|
|
|
|
(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)))))))
|
1994-10-20 20:14:45 +00:00
|
|
|
|
|
|
|
|
|
;; 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)))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(eval command)))
|
|
|
|
|
|
1992-07-24 03:42:21 +00:00
|
|
|
|
(defun repeat-complex-command (arg)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
"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.
|
1992-07-24 22:37:33 +00:00
|
|
|
|
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."
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(interactive "p")
|
1992-07-24 06:09:27 +00:00
|
|
|
|
(let ((elt (nth (1- arg) command-history))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
newcmd)
|
|
|
|
|
(if elt
|
1992-09-14 06:53:22 +00:00
|
|
|
|
(progn
|
1993-10-05 01:19:12 +00:00
|
|
|
|
(setq newcmd
|
1997-01-01 03:37:37 +00:00
|
|
|
|
(let ((print-level nil)
|
|
|
|
|
(minibuffer-history-position arg)
|
1997-10-02 03:04:15 +00:00
|
|
|
|
(minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
|
2002-09-24 18:40:59 +00:00
|
|
|
|
(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))))))
|
1993-11-23 11:03:16 +00:00
|
|
|
|
|
|
|
|
|
;; 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)))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(eval newcmd))
|
2002-12-28 21:23:23 +00:00
|
|
|
|
(if command-history
|
|
|
|
|
(error "Argument %d is beyond length of command history" arg)
|
|
|
|
|
(error "There are no previous complex commands to repeat")))))
|
2002-03-29 23:16:11 +00:00
|
|
|
|
|
1992-09-14 06:53:22 +00:00
|
|
|
|
(defvar minibuffer-history nil
|
|
|
|
|
"Default minibuffer history list.
|
|
|
|
|
This is used for all minibuffer input
|
|
|
|
|
except when an alternate history list is specified.")
|
|
|
|
|
(defvar minibuffer-history-sexp-flag nil
|
2004-03-04 17:00:09 +00:00
|
|
|
|
"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.
|
2005-12-23 21:50:38 +00:00
|
|
|
|
\(That convention is designed to do the right thing for
|
2004-03-04 17:00:09 +00:00
|
|
|
|
recursive uses of the minibuffer.)")
|
1992-07-26 19:54:20 +00:00
|
|
|
|
(setq minibuffer-history-variable 'minibuffer-history)
|
2006-05-06 23:57:11 +00:00
|
|
|
|
(setq minibuffer-history-position nil) ;; Defvar is in C code.
|
1992-09-14 06:53:22 +00:00
|
|
|
|
(defvar minibuffer-history-search-history nil)
|
1992-07-26 19:54:20 +00:00
|
|
|
|
|
1997-05-05 11:54:37 +00:00
|
|
|
|
(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))
|
|
|
|
|
|
2000-11-21 15:58:33 +00:00
|
|
|
|
(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)))
|
|
|
|
|
|
1998-05-26 20:55:22 +00:00
|
|
|
|
(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)
|
|
|
|
|
|
1992-07-26 19:54:20 +00:00
|
|
|
|
(defun previous-matching-history-element (regexp n)
|
1992-09-14 06:53:22 +00:00
|
|
|
|
"Find the previous history element that matches REGEXP.
|
|
|
|
|
\(Previous history elements refer to earlier actions.)
|
|
|
|
|
With prefix argument N, search for Nth previous match.
|
1997-12-22 21:33:35 +00:00
|
|
|
|
If N is negative, find the next or Nth next match.
|
2001-02-06 19:39:07 +00:00
|
|
|
|
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.
|
1998-05-26 20:55:22 +00:00
|
|
|
|
See also `minibuffer-history-case-insensitive-variables'."
|
1992-09-14 06:53:22 +00:00
|
|
|
|
(interactive
|
1993-05-06 18:54:32 +00:00
|
|
|
|
(let* ((enable-recursive-minibuffers t)
|
|
|
|
|
(regexp (read-from-minibuffer "Previous element matching (regexp): "
|
|
|
|
|
nil
|
|
|
|
|
minibuffer-local-map
|
|
|
|
|
nil
|
2004-06-13 22:00:17 +00:00
|
|
|
|
'minibuffer-history-search-history
|
|
|
|
|
(car minibuffer-history-search-history))))
|
1993-05-06 18:54:32 +00:00
|
|
|
|
;; Use the last regexp specified, by default, if input is empty.
|
|
|
|
|
(list (if (string= regexp "")
|
1995-05-27 00:40:31 +00:00
|
|
|
|
(if minibuffer-history-search-history
|
|
|
|
|
(car minibuffer-history-search-history)
|
|
|
|
|
(error "No previous history search regexp"))
|
1993-05-06 18:54:32 +00:00
|
|
|
|
regexp)
|
1992-09-14 06:53:22 +00:00
|
|
|
|
(prefix-numeric-value current-prefix-arg))))
|
2000-10-26 04:35:48 +00:00
|
|
|
|
(unless (zerop n)
|
|
|
|
|
(if (and (zerop minibuffer-history-position)
|
|
|
|
|
(null minibuffer-text-before-history))
|
2001-10-05 12:28:31 +00:00
|
|
|
|
(setq minibuffer-text-before-history
|
2001-10-05 15:16:24 +00:00
|
|
|
|
(minibuffer-contents-no-properties)))
|
2000-10-26 04:35:48 +00:00
|
|
|
|
(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) -1 1))) (length history)))
|
|
|
|
|
(when (= pos prevpos)
|
1992-07-26 19:54:20 +00:00
|
|
|
|
(error (if (= pos 1)
|
1992-07-29 02:15:26 +00:00
|
|
|
|
"No later matching history item"
|
|
|
|
|
"No earlier matching history item")))
|
2000-10-26 04:35:48 +00:00
|
|
|
|
(setq match-string
|
|
|
|
|
(if (eq minibuffer-history-sexp-flag (minibuffer-depth))
|
1994-09-14 09:01:02 +00:00
|
|
|
|
(let ((print-level nil))
|
2000-10-26 04:35:48 +00:00
|
|
|
|
(prin1-to-string (nth (1- pos) history)))
|
|
|
|
|
(nth (1- pos) history)))
|
|
|
|
|
(setq match-offset
|
|
|
|
|
(if (< n 0)
|
|
|
|
|
(and (string-match regexp match-string)
|
|
|
|
|
(match-end 0))
|
|
|
|
|
(and (string-match (concat ".*\\(" regexp "\\)") match-string)
|
|
|
|
|
(match-beginning 1))))
|
|
|
|
|
(when match-offset
|
|
|
|
|
(setq n (+ n (if (< n 0) 1 -1)))))
|
|
|
|
|
(setq minibuffer-history-position pos)
|
|
|
|
|
(goto-char (point-max))
|
2001-10-05 12:28:31 +00:00
|
|
|
|
(delete-minibuffer-contents)
|
2000-10-26 04:35:48 +00:00
|
|
|
|
(insert match-string)
|
2001-10-05 15:16:24 +00:00
|
|
|
|
(goto-char (+ (minibuffer-prompt-end) match-offset))))
|
2001-10-31 00:57:04 +00:00
|
|
|
|
(if (memq (car (car command-history)) '(previous-matching-history-element
|
|
|
|
|
next-matching-history-element))
|
1992-09-14 06:53:22 +00:00
|
|
|
|
(setq command-history (cdr command-history))))
|
1992-07-26 19:54:20 +00:00
|
|
|
|
|
|
|
|
|
(defun next-matching-history-element (regexp n)
|
1992-09-14 06:53:22 +00:00
|
|
|
|
"Find the next history element that matches REGEXP.
|
|
|
|
|
\(The next history element refers to a more recent action.)
|
|
|
|
|
With prefix argument N, search for Nth next match.
|
1997-12-22 21:33:35 +00:00
|
|
|
|
If N is negative, find the previous or Nth previous match.
|
2001-02-06 19:39:07 +00:00
|
|
|
|
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."
|
1992-09-14 06:53:22 +00:00
|
|
|
|
(interactive
|
1993-05-06 18:54:32 +00:00
|
|
|
|
(let* ((enable-recursive-minibuffers t)
|
|
|
|
|
(regexp (read-from-minibuffer "Next element matching (regexp): "
|
|
|
|
|
nil
|
|
|
|
|
minibuffer-local-map
|
|
|
|
|
nil
|
2004-12-27 16:34:43 +00:00
|
|
|
|
'minibuffer-history-search-history
|
|
|
|
|
(car minibuffer-history-search-history))))
|
1993-05-06 18:54:32 +00:00
|
|
|
|
;; Use the last regexp specified, by default, if input is empty.
|
|
|
|
|
(list (if (string= regexp "")
|
2004-12-27 16:34:43 +00:00
|
|
|
|
(if minibuffer-history-search-history
|
|
|
|
|
(car minibuffer-history-search-history)
|
|
|
|
|
(error "No previous history search regexp"))
|
1993-05-06 18:54:32 +00:00
|
|
|
|
regexp)
|
1992-09-14 06:53:22 +00:00
|
|
|
|
(prefix-numeric-value current-prefix-arg))))
|
1992-07-26 19:54:20 +00:00
|
|
|
|
(previous-matching-history-element regexp (- n)))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
2000-10-03 17:32:34 +00:00
|
|
|
|
(defvar minibuffer-temporary-goal-position nil)
|
|
|
|
|
|
1992-07-24 03:42:21 +00:00
|
|
|
|
(defun next-history-element (n)
|
2006-05-04 01:00:24 +00:00
|
|
|
|
"Puts next element of the minibuffer history in the minibuffer.
|
|
|
|
|
With argument N, it uses the Nth following element."
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(interactive "p")
|
1995-02-12 08:27:38 +00:00
|
|
|
|
(or (zerop n)
|
1997-05-05 11:54:37 +00:00
|
|
|
|
(let ((narg (- minibuffer-history-position n))
|
|
|
|
|
(minimum (if minibuffer-default -1 0))
|
1999-06-04 18:46:17 +00:00
|
|
|
|
elt minibuffer-returned-to-present)
|
1997-05-05 11:54:37 +00:00
|
|
|
|
(if (and (zerop minibuffer-history-position)
|
|
|
|
|
(null minibuffer-text-before-history))
|
2001-10-05 12:28:31 +00:00
|
|
|
|
(setq minibuffer-text-before-history
|
|
|
|
|
(minibuffer-contents-no-properties)))
|
1997-05-05 11:54:37 +00:00
|
|
|
|
(if (< narg minimum)
|
1998-10-16 19:15:04 +00:00
|
|
|
|
(if minibuffer-default
|
|
|
|
|
(error "End of history; no next item")
|
|
|
|
|
(error "End of history; no default available")))
|
1997-05-05 11:54:37 +00:00
|
|
|
|
(if (> narg (length (symbol-value minibuffer-history-variable)))
|
|
|
|
|
(error "Beginning of history; no preceding item"))
|
2001-10-31 00:57:04 +00:00
|
|
|
|
(unless (memq last-command '(next-history-element
|
|
|
|
|
previous-history-element))
|
2001-10-05 12:28:31 +00:00
|
|
|
|
(let ((prompt-end (minibuffer-prompt-end)))
|
2000-10-03 17:32:34 +00:00
|
|
|
|
(set (make-local-variable 'minibuffer-temporary-goal-position)
|
|
|
|
|
(cond ((<= (point) prompt-end) prompt-end)
|
|
|
|
|
((eobp) nil)
|
|
|
|
|
(t (point))))))
|
1999-10-17 12:50:04 +00:00
|
|
|
|
(goto-char (point-max))
|
2001-10-05 12:28:31 +00:00
|
|
|
|
(delete-minibuffer-contents)
|
1997-05-05 11:54:37 +00:00
|
|
|
|
(setq minibuffer-history-position narg)
|
|
|
|
|
(cond ((= narg -1)
|
|
|
|
|
(setq elt minibuffer-default))
|
|
|
|
|
((= narg 0)
|
1997-09-12 20:55:34 +00:00
|
|
|
|
(setq elt (or minibuffer-text-before-history ""))
|
1999-06-04 18:46:17 +00:00
|
|
|
|
(setq minibuffer-returned-to-present t)
|
1997-05-05 11:54:37 +00:00
|
|
|
|
(setq minibuffer-text-before-history nil))
|
|
|
|
|
(t (setq elt (nth (1- minibuffer-history-position)
|
|
|
|
|
(symbol-value minibuffer-history-variable)))))
|
|
|
|
|
(insert
|
1999-06-04 18:46:17 +00:00
|
|
|
|
(if (and (eq minibuffer-history-sexp-flag (minibuffer-depth))
|
|
|
|
|
(not minibuffer-returned-to-present))
|
1997-05-05 11:54:37 +00:00
|
|
|
|
(let ((print-level nil))
|
|
|
|
|
(prin1-to-string elt))
|
|
|
|
|
elt))
|
2000-10-03 17:32:34 +00:00
|
|
|
|
(goto-char (or minibuffer-temporary-goal-position (point-max))))))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
1992-07-24 03:42:21 +00:00
|
|
|
|
(defun previous-history-element (n)
|
2006-05-04 01:00:24 +00:00
|
|
|
|
"Puts previous element of the minibuffer history in the minibuffer.
|
|
|
|
|
With argument N, it uses the Nth previous element."
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(interactive "p")
|
1992-07-24 03:49:00 +00:00
|
|
|
|
(next-history-element (- n)))
|
1993-01-25 00:45:01 +00:00
|
|
|
|
|
|
|
|
|
(defun next-complete-history-element (n)
|
1999-10-17 12:50:04 +00:00
|
|
|
|
"Get next history element which completes the minibuffer before the point.
|
|
|
|
|
The contents of the minibuffer after the point are deleted, and replaced
|
|
|
|
|
by the new completion."
|
1993-01-25 00:45:01 +00:00
|
|
|
|
(interactive "p")
|
1993-01-28 20:22:03 +00:00
|
|
|
|
(let ((point-at-start (point)))
|
|
|
|
|
(next-matching-history-element
|
1999-10-17 12:50:04 +00:00
|
|
|
|
(concat
|
2001-10-05 12:28:31 +00:00
|
|
|
|
"^" (regexp-quote (buffer-substring (minibuffer-prompt-end) (point))))
|
1999-10-17 12:50:04 +00:00
|
|
|
|
n)
|
1993-01-28 20:22:03 +00:00
|
|
|
|
;; next-matching-history-element always puts us at (point-min).
|
|
|
|
|
;; Move to the position we were at before changing the buffer contents.
|
|
|
|
|
;; This is still sensical, because the text before point has not changed.
|
|
|
|
|
(goto-char point-at-start)))
|
1993-01-25 00:45:01 +00:00
|
|
|
|
|
|
|
|
|
(defun previous-complete-history-element (n)
|
1993-12-24 02:44:13 +00:00
|
|
|
|
"\
|
1999-10-17 12:50:04 +00:00
|
|
|
|
Get previous history element which completes the minibuffer before the point.
|
|
|
|
|
The contents of the minibuffer after the point are deleted, and replaced
|
|
|
|
|
by the new completion."
|
1993-01-25 00:45:01 +00:00
|
|
|
|
(interactive "p")
|
|
|
|
|
(next-complete-history-element (- n)))
|
1999-10-17 12:50:04 +00:00
|
|
|
|
|
2001-10-05 12:28:31 +00:00
|
|
|
|
;; For compatibility with the old subr of the same name.
|
1999-10-17 12:50:04 +00:00
|
|
|
|
(defun minibuffer-prompt-width ()
|
|
|
|
|
"Return the display width of the minibuffer prompt.
|
(clone-indirect-buffer): Doc fix.
(fixup-whitespace, just-one-space, backward-delete-char-untabify, lambda):
"?\ " -> "?\s".
(next-error, next-error-highlight, next-error-highlight-no-select,
next-error-last-buffer, next-error-buffer-p, next-error-find-buffer, next-error,
previous-error, next-error-no-select, previous-error-no-select, open-line,
split-line, minibuffer-prompt-width, kill-new, binary-overwrite-mode):
Fix typos in docstrings.
(set-fill-column): Fix typo in message.
2005-07-20 22:29:53 +00:00
|
|
|
|
Return 0 if current buffer is not a minibuffer."
|
1999-10-17 12:50:04 +00:00
|
|
|
|
;; Return the width of everything before the field at the end of
|
|
|
|
|
;; the buffer; this should be 0 for normal buffers.
|
2001-10-05 12:28:31 +00:00
|
|
|
|
(1- (minibuffer-prompt-end)))
|
2002-03-29 23:16:11 +00:00
|
|
|
|
|
1991-12-21 09:29:41 +00:00
|
|
|
|
;Put this on C-x u, so we can force that rather than C-_ into startup msg
|
1996-10-12 23:54:33 +00:00
|
|
|
|
(defalias 'advertised-undo 'undo)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
2003-05-13 19:45:01 +00:00
|
|
|
|
(defconst undo-equiv-table (make-hash-table :test 'eq :weakness t)
|
2005-04-11 18:09:59 +00:00
|
|
|
|
"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.")
|
2003-05-13 19:45:01 +00:00
|
|
|
|
|
|
|
|
|
(defvar undo-in-region nil
|
|
|
|
|
"Non-nil if `pending-undo-list' is not just a tail of `buffer-undo-list'.")
|
|
|
|
|
|
|
|
|
|
(defvar undo-no-redo nil
|
|
|
|
|
"If t, `undo' doesn't go through redo entries.")
|
|
|
|
|
|
2005-01-29 17:24:41 +00:00
|
|
|
|
(defvar pending-undo-list nil
|
|
|
|
|
"Within a run of consecutive undo commands, list remaining to be undone.
|
2005-06-16 14:31:44 +00:00
|
|
|
|
If t, we undid all the way to the end of it.")
|
2005-01-29 17:24:41 +00:00
|
|
|
|
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(defun undo (&optional arg)
|
|
|
|
|
"Undo some previous changes.
|
|
|
|
|
Repeat this command to undo more changes.
|
1998-03-14 08:19:27 +00:00
|
|
|
|
A numeric argument serves as a repeat count.
|
|
|
|
|
|
2000-10-26 07:44:46 +00:00
|
|
|
|
In Transient Mark mode when the mark is active, only undo changes within
|
2003-05-13 19:45:01 +00:00
|
|
|
|
the current region. Similarly, when not in Transient Mark mode, just \\[universal-argument]
|
2000-10-26 07:44:46 +00:00
|
|
|
|
as an argument limits undo to changes within the current region."
|
1998-03-14 08:19:27 +00:00
|
|
|
|
(interactive "*P")
|
2001-12-13 07:43:28 +00:00
|
|
|
|
;; Make last-command indicate for the next command that this was an undo.
|
|
|
|
|
;; That way, another undo will undo more.
|
|
|
|
|
;; If we get to the end of the undo history and get an error,
|
|
|
|
|
;; another undo command will find the undo history empty
|
|
|
|
|
;; and will get another error. To begin undoing the undos,
|
|
|
|
|
;; you must type some other command.
|
1993-06-01 20:31:47 +00:00
|
|
|
|
(let ((modified (buffer-modified-p))
|
2005-10-29 19:48:22 +00:00
|
|
|
|
(recent-save (recent-auto-save-p))
|
|
|
|
|
message)
|
2004-03-04 17:00:09 +00:00
|
|
|
|
;; If we get an error in undo-start,
|
|
|
|
|
;; the next command should not be a "consecutive undo".
|
|
|
|
|
;; So set `this-command' to something other than `undo'.
|
|
|
|
|
(setq this-command 'undo-start)
|
|
|
|
|
|
2004-12-27 16:34:43 +00:00
|
|
|
|
(unless (and (eq last-command 'undo)
|
2005-01-29 17:24:41 +00:00
|
|
|
|
(or (eq pending-undo-list t)
|
|
|
|
|
;; If something (a timer or filter?) changed the buffer
|
|
|
|
|
;; since the previous command, don't continue the undo seq.
|
|
|
|
|
(let ((list buffer-undo-list))
|
|
|
|
|
(while (eq (car list) nil)
|
|
|
|
|
(setq list (cdr list)))
|
|
|
|
|
;; If the last undo record made was made by undo
|
|
|
|
|
;; it shows nothing else happened in between.
|
|
|
|
|
(gethash list undo-equiv-table))))
|
2003-05-13 19:45:01 +00:00
|
|
|
|
(setq undo-in-region
|
|
|
|
|
(if transient-mark-mode mark-active (and arg (not (numberp arg)))))
|
|
|
|
|
(if undo-in-region
|
2000-10-26 07:44:46 +00:00
|
|
|
|
(undo-start (region-beginning) (region-end))
|
|
|
|
|
(undo-start))
|
|
|
|
|
;; get rid of initial undo boundary
|
|
|
|
|
(undo-more 1))
|
2004-04-16 08:45:40 +00:00
|
|
|
|
;; If we got this far, the next command should be a consecutive undo.
|
2004-03-04 17:00:09 +00:00
|
|
|
|
(setq this-command 'undo)
|
2003-05-13 19:45:01 +00:00
|
|
|
|
;; Check to see whether we're hitting a redo record, and if
|
|
|
|
|
;; so, ask the user whether she wants to skip the redo/undo pair.
|
|
|
|
|
(let ((equiv (gethash pending-undo-list undo-equiv-table)))
|
|
|
|
|
(or (eq (selected-window) (minibuffer-window))
|
2005-10-29 19:48:22 +00:00
|
|
|
|
(setq message (if undo-in-region
|
|
|
|
|
(if equiv "Redo in region!" "Undo in region!")
|
|
|
|
|
(if equiv "Redo!" "Undo!"))))
|
2005-04-13 17:40:53 +00:00
|
|
|
|
(when (and (consp equiv) undo-no-redo)
|
2003-05-13 19:45:01 +00:00
|
|
|
|
;; 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)))
|
|
|
|
|
(if next (setq equiv next))))
|
|
|
|
|
(setq pending-undo-list equiv)))
|
2000-10-26 07:44:46 +00:00
|
|
|
|
(undo-more
|
|
|
|
|
(if (or transient-mark-mode (numberp arg))
|
|
|
|
|
(prefix-numeric-value arg)
|
|
|
|
|
1))
|
2003-05-13 19:45:01 +00:00
|
|
|
|
;; Record the fact that the just-generated undo records come from an
|
2005-04-11 18:09:59 +00:00
|
|
|
|
;; undo operation--that is, they are redo records.
|
|
|
|
|
;; In the ordinary case (not within a region), map the redo
|
|
|
|
|
;; record to the following undos.
|
2003-05-13 19:45:01 +00:00
|
|
|
|
;; I don't know how to do that in the undo-in-region case.
|
2005-04-11 18:09:59 +00:00
|
|
|
|
(puthash buffer-undo-list
|
|
|
|
|
(if undo-in-region t pending-undo-list)
|
|
|
|
|
undo-equiv-table)
|
1994-03-16 23:41:32 +00:00
|
|
|
|
;; 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)
|
2001-09-06 08:49:34 +00:00
|
|
|
|
(prev nil))
|
|
|
|
|
(while (car tail)
|
|
|
|
|
(when (integerp (car tail))
|
|
|
|
|
(let ((pos (car tail)))
|
2003-05-13 19:45:01 +00:00
|
|
|
|
(if prev
|
|
|
|
|
(setcdr prev (cdr tail))
|
|
|
|
|
(setq buffer-undo-list (cdr tail)))
|
2001-09-06 08:49:34 +00:00
|
|
|
|
(setq tail (cdr tail))
|
|
|
|
|
(while (car tail)
|
|
|
|
|
(if (eq pos (car tail))
|
|
|
|
|
(if prev
|
|
|
|
|
(setcdr prev (cdr tail))
|
|
|
|
|
(setq buffer-undo-list (cdr tail)))
|
|
|
|
|
(setq prev tail))
|
|
|
|
|
(setq tail (cdr tail)))
|
|
|
|
|
(setq tail nil)))
|
|
|
|
|
(setq prev tail tail (cdr tail))))
|
2004-12-27 16:34:43 +00:00
|
|
|
|
;; Record what the current undo list says,
|
|
|
|
|
;; so the next command can tell if the buffer was modified in between.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(and modified (not (buffer-modified-p))
|
2005-10-29 19:48:22 +00:00
|
|
|
|
(delete-auto-save-file-if-necessary recent-save))
|
|
|
|
|
;; Display a message announcing success.
|
|
|
|
|
(if message
|
|
|
|
|
(message message))))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
2004-12-27 16:34:43 +00:00
|
|
|
|
(defun buffer-disable-undo (&optional buffer)
|
|
|
|
|
"Make BUFFER stop keeping undo information.
|
|
|
|
|
No argument or nil as argument means do this for the current buffer."
|
|
|
|
|
(interactive)
|
2004-12-28 05:11:26 +00:00
|
|
|
|
(with-current-buffer (if buffer (get-buffer buffer) (current-buffer))
|
2004-12-31 15:13:00 +00:00
|
|
|
|
(setq buffer-undo-list t)))
|
2004-12-27 16:34:43 +00:00
|
|
|
|
|
2003-05-13 19:45:01 +00:00
|
|
|
|
(defun undo-only (&optional arg)
|
|
|
|
|
"Undo some previous changes.
|
|
|
|
|
Repeat this command to undo more changes.
|
|
|
|
|
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)))
|
|
|
|
|
|
1998-07-09 04:49:24 +00:00
|
|
|
|
(defvar undo-in-progress nil
|
|
|
|
|
"Non-nil while performing an undo.
|
|
|
|
|
Some change-hooks test this variable to do something different.")
|
|
|
|
|
|
2005-06-16 14:31:44 +00:00
|
|
|
|
(defun undo-more (n)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
"Undo back N undo-boundaries beyond what was already undone recently.
|
1992-08-21 07:18:16 +00:00
|
|
|
|
Call `undo-start' to get ready to undo recent changes,
|
|
|
|
|
then call `undo-more' one or more times to undo them."
|
2005-01-29 17:24:41 +00:00
|
|
|
|
(or (listp pending-undo-list)
|
2005-06-16 14:31:44 +00:00
|
|
|
|
(error (concat "No further undo information"
|
2006-09-30 09:50:07 +00:00
|
|
|
|
(and undo-in-region " for region"))))
|
1998-07-09 04:49:24 +00:00
|
|
|
|
(let ((undo-in-progress t))
|
2005-06-16 14:31:44 +00:00
|
|
|
|
(setq pending-undo-list (primitive-undo n pending-undo-list))
|
2005-01-29 17:24:41 +00:00
|
|
|
|
(if (null pending-undo-list)
|
|
|
|
|
(setq pending-undo-list t))))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
1998-03-14 08:19:27 +00:00
|
|
|
|
;; Deep copy of a list
|
|
|
|
|
(defun undo-copy-list (list)
|
|
|
|
|
"Make a copy of undo list LIST."
|
|
|
|
|
(mapcar 'undo-copy-list-1 list))
|
|
|
|
|
|
|
|
|
|
(defun undo-copy-list-1 (elt)
|
|
|
|
|
(if (consp elt)
|
|
|
|
|
(cons (car elt) (undo-copy-list-1 (cdr elt)))
|
|
|
|
|
elt))
|
|
|
|
|
|
|
|
|
|
(defun undo-start (&optional beg end)
|
|
|
|
|
"Set `pending-undo-list' to the front of the undo list.
|
|
|
|
|
The next call to `undo-more' will undo the most recently made change.
|
|
|
|
|
If BEG and END are specified, then only undo elements
|
|
|
|
|
that apply to text between BEG and END are used; other undo elements
|
|
|
|
|
are ignored. If BEG and END are nil, all undo elements are used."
|
|
|
|
|
(if (eq buffer-undo-list t)
|
|
|
|
|
(error "No undo information in this buffer"))
|
1999-11-15 16:11:14 +00:00
|
|
|
|
(setq pending-undo-list
|
1998-03-14 08:19:27 +00:00
|
|
|
|
(if (and beg end (not (= beg end)))
|
|
|
|
|
(undo-make-selective-list (min beg end) (max beg end))
|
|
|
|
|
buffer-undo-list)))
|
|
|
|
|
|
|
|
|
|
(defvar undo-adjusted-markers)
|
|
|
|
|
|
|
|
|
|
(defun undo-make-selective-list (start end)
|
|
|
|
|
"Return a list of undo elements for the region START to END.
|
|
|
|
|
The elements come from `buffer-undo-list', but we keep only
|
|
|
|
|
the elements inside this region, and discard those outside this region.
|
|
|
|
|
If we find an element that crosses an edge of this region,
|
|
|
|
|
we stop and ignore all further elements."
|
|
|
|
|
(let ((undo-list-copy (undo-copy-list buffer-undo-list))
|
|
|
|
|
(undo-list (list nil))
|
|
|
|
|
undo-adjusted-markers
|
|
|
|
|
some-rejected
|
|
|
|
|
undo-elt undo-elt temp-undo-list delta)
|
|
|
|
|
(while undo-list-copy
|
|
|
|
|
(setq undo-elt (car undo-list-copy))
|
|
|
|
|
(let ((keep-this
|
|
|
|
|
(cond ((and (consp undo-elt) (eq (car undo-elt) t))
|
|
|
|
|
;; This is a "was unmodified" element.
|
|
|
|
|
;; Keep it if we have kept everything thus far.
|
|
|
|
|
(not some-rejected))
|
|
|
|
|
(t
|
|
|
|
|
(undo-elt-in-region undo-elt start end)))))
|
|
|
|
|
(if keep-this
|
|
|
|
|
(progn
|
|
|
|
|
(setq end (+ end (cdr (undo-delta undo-elt))))
|
|
|
|
|
;; Don't put two nils together in the list
|
|
|
|
|
(if (not (and (eq (car undo-list) nil)
|
|
|
|
|
(eq undo-elt nil)))
|
|
|
|
|
(setq undo-list (cons undo-elt undo-list))))
|
|
|
|
|
(if (undo-elt-crosses-region undo-elt start end)
|
|
|
|
|
(setq undo-list-copy nil)
|
|
|
|
|
(setq some-rejected t)
|
|
|
|
|
(setq temp-undo-list (cdr undo-list-copy))
|
|
|
|
|
(setq delta (undo-delta undo-elt))
|
|
|
|
|
|
|
|
|
|
(when (/= (cdr delta) 0)
|
|
|
|
|
(let ((position (car delta))
|
|
|
|
|
(offset (cdr delta)))
|
|
|
|
|
|
2001-10-31 00:57:04 +00:00
|
|
|
|
;; Loop down the earlier events adjusting their buffer
|
|
|
|
|
;; positions to reflect the fact that a change to the buffer
|
|
|
|
|
;; isn't being undone. We only need to process those element
|
|
|
|
|
;; types which undo-elt-in-region will return as being in
|
|
|
|
|
;; the region since only those types can ever get into the
|
|
|
|
|
;; output
|
1998-03-14 08:19:27 +00:00
|
|
|
|
|
|
|
|
|
(while temp-undo-list
|
|
|
|
|
(setq undo-elt (car temp-undo-list))
|
|
|
|
|
(cond ((integerp undo-elt)
|
|
|
|
|
(if (>= undo-elt position)
|
|
|
|
|
(setcar temp-undo-list (- undo-elt offset))))
|
|
|
|
|
((atom undo-elt) nil)
|
|
|
|
|
((stringp (car undo-elt))
|
|
|
|
|
;; (TEXT . POSITION)
|
|
|
|
|
(let ((text-pos (abs (cdr undo-elt)))
|
|
|
|
|
(point-at-end (< (cdr undo-elt) 0 )))
|
|
|
|
|
(if (>= text-pos position)
|
1999-11-15 16:11:14 +00:00
|
|
|
|
(setcdr undo-elt (* (if point-at-end -1 1)
|
1998-03-14 08:19:27 +00:00
|
|
|
|
(- text-pos offset))))))
|
|
|
|
|
((integerp (car undo-elt))
|
|
|
|
|
;; (BEGIN . END)
|
|
|
|
|
(when (>= (car undo-elt) position)
|
|
|
|
|
(setcar undo-elt (- (car undo-elt) offset))
|
|
|
|
|
(setcdr undo-elt (- (cdr undo-elt) offset))))
|
|
|
|
|
((null (car undo-elt))
|
|
|
|
|
;; (nil PROPERTY VALUE BEG . END)
|
|
|
|
|
(let ((tail (nthcdr 3 undo-elt)))
|
|
|
|
|
(when (>= (car tail) position)
|
|
|
|
|
(setcar tail (- (car tail) offset))
|
|
|
|
|
(setcdr tail (- (cdr tail) offset))))))
|
|
|
|
|
(setq temp-undo-list (cdr temp-undo-list))))))))
|
|
|
|
|
(setq undo-list-copy (cdr undo-list-copy)))
|
|
|
|
|
(nreverse undo-list)))
|
|
|
|
|
|
|
|
|
|
(defun undo-elt-in-region (undo-elt start end)
|
|
|
|
|
"Determine whether UNDO-ELT falls inside the region START ... END.
|
|
|
|
|
If it crosses the edge, we return nil."
|
|
|
|
|
(cond ((integerp undo-elt)
|
|
|
|
|
(and (>= undo-elt start)
|
2002-09-09 00:27:30 +00:00
|
|
|
|
(<= undo-elt end)))
|
1998-03-14 08:19:27 +00:00
|
|
|
|
((eq undo-elt nil)
|
|
|
|
|
t)
|
|
|
|
|
((atom undo-elt)
|
|
|
|
|
nil)
|
|
|
|
|
((stringp (car undo-elt))
|
|
|
|
|
;; (TEXT . POSITION)
|
|
|
|
|
(and (>= (abs (cdr undo-elt)) start)
|
|
|
|
|
(< (abs (cdr undo-elt)) end)))
|
|
|
|
|
((and (consp undo-elt) (markerp (car undo-elt)))
|
|
|
|
|
;; This is a marker-adjustment element (MARKER . ADJUSTMENT).
|
|
|
|
|
;; See if MARKER is inside the region.
|
|
|
|
|
(let ((alist-elt (assq (car undo-elt) undo-adjusted-markers)))
|
|
|
|
|
(unless alist-elt
|
|
|
|
|
(setq alist-elt (cons (car undo-elt)
|
|
|
|
|
(marker-position (car undo-elt))))
|
|
|
|
|
(setq undo-adjusted-markers
|
|
|
|
|
(cons alist-elt undo-adjusted-markers)))
|
|
|
|
|
(and (cdr alist-elt)
|
|
|
|
|
(>= (cdr alist-elt) start)
|
2002-09-09 00:27:30 +00:00
|
|
|
|
(<= (cdr alist-elt) end))))
|
1998-03-14 08:19:27 +00:00
|
|
|
|
((null (car undo-elt))
|
|
|
|
|
;; (nil PROPERTY VALUE BEG . END)
|
|
|
|
|
(let ((tail (nthcdr 3 undo-elt)))
|
|
|
|
|
(and (>= (car tail) start)
|
2002-09-09 00:27:30 +00:00
|
|
|
|
(<= (cdr tail) end))))
|
1998-03-14 08:19:27 +00:00
|
|
|
|
((integerp (car undo-elt))
|
|
|
|
|
;; (BEGIN . END)
|
|
|
|
|
(and (>= (car undo-elt) start)
|
2002-09-09 00:27:30 +00:00
|
|
|
|
(<= (cdr undo-elt) end)))))
|
1998-03-14 08:19:27 +00:00
|
|
|
|
|
|
|
|
|
(defun undo-elt-crosses-region (undo-elt start end)
|
|
|
|
|
"Test whether UNDO-ELT crosses one edge of that region START ... END.
|
|
|
|
|
This assumes we have already decided that UNDO-ELT
|
|
|
|
|
is not *inside* the region START...END."
|
|
|
|
|
(cond ((atom undo-elt) nil)
|
|
|
|
|
((null (car undo-elt))
|
|
|
|
|
;; (nil PROPERTY VALUE BEG . END)
|
|
|
|
|
(let ((tail (nthcdr 3 undo-elt)))
|
2006-10-02 02:30:06 +00:00
|
|
|
|
(and (< (car tail) end)
|
|
|
|
|
(> (cdr tail) start))))
|
1998-03-14 08:19:27 +00:00
|
|
|
|
((integerp (car undo-elt))
|
|
|
|
|
;; (BEGIN . END)
|
2006-10-02 02:30:06 +00:00
|
|
|
|
(and (< (car undo-elt) end)
|
|
|
|
|
(> (cdr undo-elt) start)))))
|
1998-03-14 08:19:27 +00:00
|
|
|
|
|
|
|
|
|
;; Return the first affected buffer position and the delta for an undo element
|
|
|
|
|
;; delta is defined as the change in subsequent buffer positions if we *did*
|
|
|
|
|
;; the undo.
|
|
|
|
|
(defun undo-delta (undo-elt)
|
|
|
|
|
(if (consp undo-elt)
|
|
|
|
|
(cond ((stringp (car undo-elt))
|
|
|
|
|
;; (TEXT . POSITION)
|
|
|
|
|
(cons (abs (cdr undo-elt)) (length (car undo-elt))))
|
|
|
|
|
((integerp (car undo-elt))
|
|
|
|
|
;; (BEGIN . END)
|
|
|
|
|
(cons (car undo-elt) (- (car undo-elt) (cdr undo-elt))))
|
|
|
|
|
(t
|
|
|
|
|
'(0 . 0)))
|
|
|
|
|
'(0 . 0)))
|
2004-12-21 11:37:52 +00:00
|
|
|
|
|
2006-07-11 19:15:33 +00:00
|
|
|
|
(defcustom undo-ask-before-discard nil
|
2005-01-30 00:32:39 +00:00
|
|
|
|
"If non-nil ask about discarding undo info for the current command.
|
|
|
|
|
Normally, Emacs discards the undo info for the current command if
|
|
|
|
|
it exceeds `undo-outer-limit'. But if you set this option
|
|
|
|
|
non-nil, it asks in the echo area whether to discard the info.
|
2006-10-11 06:27:08 +00:00
|
|
|
|
If you answer no, there is a slight risk that Emacs might crash, so
|
2005-01-30 00:32:39 +00:00
|
|
|
|
only do it if you really want to undo the command.
|
|
|
|
|
|
|
|
|
|
This option is mainly intended for debugging. You have to be
|
|
|
|
|
careful if you use it for other purposes. Garbage collection is
|
|
|
|
|
inhibited while the question is asked, meaning that Emacs might
|
|
|
|
|
leak memory. So you should make sure that you do not wait
|
|
|
|
|
excessively long before answering the question."
|
|
|
|
|
:type 'boolean
|
|
|
|
|
:group 'undo
|
2005-02-09 15:50:47 +00:00
|
|
|
|
:version "22.1")
|
2005-01-30 00:32:39 +00:00
|
|
|
|
|
2004-12-29 01:33:04 +00:00
|
|
|
|
(defvar undo-extra-outer-limit nil
|
|
|
|
|
"If non-nil, an extra level of size that's ok in an undo item.
|
|
|
|
|
We don't ask the user about truncating the undo list until the
|
2005-01-30 00:32:39 +00:00
|
|
|
|
current item gets bigger than this amount.
|
|
|
|
|
|
|
|
|
|
This variable only matters if `undo-ask-before-discard' is non-nil.")
|
2004-12-29 01:33:04 +00:00
|
|
|
|
(make-variable-buffer-local 'undo-extra-outer-limit)
|
|
|
|
|
|
2005-01-30 00:32:39 +00:00
|
|
|
|
;; When the first undo batch in an undo list is longer than
|
|
|
|
|
;; undo-outer-limit, this function gets called to warn the user that
|
|
|
|
|
;; the undo info for the current command was discarded. Garbage
|
|
|
|
|
;; collection is inhibited around the call, so it had better not do a
|
|
|
|
|
;; lot of consing.
|
2004-12-21 11:37:52 +00:00
|
|
|
|
(setq undo-outer-limit-function 'undo-outer-limit-truncate)
|
|
|
|
|
(defun undo-outer-limit-truncate (size)
|
2005-01-30 00:32:39 +00:00
|
|
|
|
(if undo-ask-before-discard
|
|
|
|
|
(when (or (null undo-extra-outer-limit)
|
|
|
|
|
(> size undo-extra-outer-limit))
|
|
|
|
|
;; Don't ask the question again unless it gets even bigger.
|
|
|
|
|
;; This applies, in particular, if the user quits from the question.
|
|
|
|
|
;; Such a quit quits out of GC, but something else will call GC
|
|
|
|
|
;; again momentarily. It will call this function again,
|
|
|
|
|
;; but we don't want to ask the question again.
|
|
|
|
|
(setq undo-extra-outer-limit (+ size 50000))
|
|
|
|
|
(if (let (use-dialog-box track-mouse executing-kbd-macro )
|
2006-05-01 20:17:24 +00:00
|
|
|
|
(yes-or-no-p (format "Buffer `%s' undo info is %d bytes long; discard it? "
|
2005-01-30 00:32:39 +00:00
|
|
|
|
(buffer-name) size)))
|
|
|
|
|
(progn (setq buffer-undo-list nil)
|
|
|
|
|
(setq undo-extra-outer-limit nil)
|
|
|
|
|
t)
|
|
|
|
|
nil))
|
|
|
|
|
(display-warning '(undo discard-info)
|
|
|
|
|
(concat
|
2006-05-01 20:17:24 +00:00
|
|
|
|
(format "Buffer `%s' undo info was %d bytes long.\n"
|
2005-01-30 00:32:39 +00:00
|
|
|
|
(buffer-name) size)
|
|
|
|
|
"The undo info was discarded because it exceeded \
|
|
|
|
|
`undo-outer-limit'.
|
|
|
|
|
|
|
|
|
|
This is normal if you executed a command that made a huge change
|
|
|
|
|
to the buffer. In that case, to prevent similar problems in the
|
|
|
|
|
future, set `undo-outer-limit' to a value that is large enough to
|
|
|
|
|
cover the maximum size of normal changes you expect a single
|
|
|
|
|
command to make, but not so large that it might exceed the
|
|
|
|
|
maximum memory allotted to Emacs.
|
|
|
|
|
|
|
|
|
|
If you did not execute any such command, the situation is
|
|
|
|
|
probably due to a bug and you should report it.
|
|
|
|
|
|
|
|
|
|
You can disable the popping up of this buffer by adding the entry
|
|
|
|
|
\(undo discard-info) to the user option `warning-suppress-types'.\n")
|
|
|
|
|
:warning)
|
|
|
|
|
(setq buffer-undo-list nil)
|
|
|
|
|
t))
|
2001-10-31 00:57:04 +00:00
|
|
|
|
|
1993-07-31 06:10:44 +00:00
|
|
|
|
(defvar shell-command-history nil
|
|
|
|
|
"History list for some commands that read shell commands.")
|
|
|
|
|
|
1994-11-01 05:50:57 +00:00
|
|
|
|
(defvar shell-command-switch "-c"
|
|
|
|
|
"Switch used to have the shell execute its command line argument.")
|
|
|
|
|
|
1999-03-01 03:19:32 +00:00
|
|
|
|
(defvar shell-command-default-error-buffer nil
|
|
|
|
|
"*Buffer name for `shell-command' and `shell-command-on-region' error output.
|
2002-06-29 18:16:27 +00:00
|
|
|
|
This buffer is used when `shell-command' or `shell-command-on-region'
|
1999-03-01 03:19:32 +00:00
|
|
|
|
is run interactively. A value of nil means that output to stderr and
|
|
|
|
|
stdout will be intermixed in the output stream.")
|
|
|
|
|
|
|
|
|
|
(defun shell-command (command &optional output-buffer error-buffer)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
"Execute string COMMAND in inferior shell; display output, if any.
|
2000-11-25 08:48:13 +00:00
|
|
|
|
With prefix argument, insert the COMMAND's output at point.
|
1995-03-21 05:14:38 +00:00
|
|
|
|
|
1991-12-21 09:29:41 +00:00
|
|
|
|
If COMMAND ends in ampersand, execute it asynchronously.
|
1995-03-21 05:14:38 +00:00
|
|
|
|
The output appears in the buffer `*Async Shell Command*'.
|
1995-07-17 23:03:53 +00:00
|
|
|
|
That buffer is in shell mode.
|
1995-03-21 05:14:38 +00:00
|
|
|
|
|
2000-11-08 17:35:57 +00:00
|
|
|
|
Otherwise, COMMAND is executed synchronously. The output appears in
|
|
|
|
|
the buffer `*Shell Command Output*'. If the output is short enough to
|
|
|
|
|
display in the echo area (which is determined by the variables
|
|
|
|
|
`resize-mini-windows' and `max-mini-window-height'), it is shown
|
|
|
|
|
there, but it is nonetheless available in buffer `*Shell Command
|
2001-10-31 00:57:04 +00:00
|
|
|
|
Output*' even though that buffer is not automatically displayed.
|
1994-10-15 10:16:09 +00:00
|
|
|
|
|
1997-08-04 00:51:07 +00:00
|
|
|
|
To specify a coding system for converting non-ASCII characters
|
|
|
|
|
in the shell command output, use \\[universal-coding-system-argument]
|
|
|
|
|
before this command.
|
|
|
|
|
|
|
|
|
|
Noninteractive callers can specify coding systems by binding
|
|
|
|
|
`coding-system-for-read' and `coding-system-for-write'.
|
|
|
|
|
|
1994-10-15 10:16:09 +00:00
|
|
|
|
The optional second argument OUTPUT-BUFFER, if non-nil,
|
|
|
|
|
says to put the output in some other buffer.
|
|
|
|
|
If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
|
|
|
|
|
If OUTPUT-BUFFER is not a buffer and not nil,
|
|
|
|
|
insert output in current buffer. (This cannot be done asynchronously.)
|
1999-03-01 03:19:32 +00:00
|
|
|
|
In either case, the output is inserted after point (leaving mark after it).
|
|
|
|
|
|
2001-12-13 07:43:28 +00:00
|
|
|
|
If the command terminates without error, but generates output,
|
|
|
|
|
and you did not specify \"insert it in the current buffer\",
|
|
|
|
|
the output can be displayed in the echo area or in its buffer.
|
|
|
|
|
If the output is short enough to display in the echo area
|
|
|
|
|
\(determined by the variable `max-mini-window-height' if
|
|
|
|
|
`resize-mini-windows' is non-nil), it is shown there. Otherwise,
|
|
|
|
|
the buffer containing the output is displayed.
|
|
|
|
|
|
|
|
|
|
If there is output and an error, and you did not specify \"insert it
|
|
|
|
|
in the current buffer\", a message about the error goes at the end
|
|
|
|
|
of the output.
|
|
|
|
|
|
|
|
|
|
If there is no output, or if output is inserted in the current buffer,
|
|
|
|
|
then `*Shell Command Output*' is deleted.
|
|
|
|
|
|
1999-03-01 03:19:32 +00:00
|
|
|
|
If the optional third argument ERROR-BUFFER is non-nil, it is a buffer
|
|
|
|
|
or buffer name to which to direct the command's standard error output.
|
|
|
|
|
If it is nil, error output is mingled with regular output.
|
|
|
|
|
In an interactive call, the variable `shell-command-default-error-buffer'
|
|
|
|
|
specifies the value of ERROR-BUFFER."
|
|
|
|
|
|
1993-08-08 07:47:33 +00:00
|
|
|
|
(interactive (list (read-from-minibuffer "Shell command: "
|
|
|
|
|
nil nil nil 'shell-command-history)
|
1999-03-01 03:19:32 +00:00
|
|
|
|
current-prefix-arg
|
|
|
|
|
shell-command-default-error-buffer))
|
1996-02-21 21:25:30 +00:00
|
|
|
|
;; Look for a handler in case default-directory is a remote file name.
|
|
|
|
|
(let ((handler
|
|
|
|
|
(find-file-name-handler (directory-file-name default-directory)
|
|
|
|
|
'shell-command)))
|
|
|
|
|
(if handler
|
1999-03-01 03:19:32 +00:00
|
|
|
|
(funcall handler 'shell-command command output-buffer error-buffer)
|
1996-02-21 21:25:30 +00:00
|
|
|
|
(if (and output-buffer
|
|
|
|
|
(not (or (bufferp output-buffer) (stringp output-buffer))))
|
2001-12-13 07:43:28 +00:00
|
|
|
|
;; Output goes in current buffer.
|
1999-03-01 03:19:32 +00:00
|
|
|
|
(let ((error-file
|
1999-11-15 16:11:14 +00:00
|
|
|
|
(if error-buffer
|
1999-10-13 00:48:17 +00:00
|
|
|
|
(make-temp-file
|
1999-09-02 12:05:07 +00:00
|
|
|
|
(expand-file-name "scor"
|
|
|
|
|
(or small-temporary-file-directory
|
|
|
|
|
temporary-file-directory)))
|
1999-03-01 03:19:32 +00:00
|
|
|
|
nil)))
|
|
|
|
|
(barf-if-buffer-read-only)
|
1999-06-10 01:19:33 +00:00
|
|
|
|
(push-mark nil t)
|
1999-03-01 03:19:32 +00:00
|
|
|
|
;; We do not use -f for csh; we will not support broken use of
|
|
|
|
|
;; .cshrcs. Even the BSD csh manual says to use
|
|
|
|
|
;; "if ($?prompt) exit" before things which are not useful
|
|
|
|
|
;; non-interactively. Besides, if someone wants their other
|
|
|
|
|
;; aliases for shell commands then they can still have them.
|
1999-11-15 16:11:14 +00:00
|
|
|
|
(call-process shell-file-name nil
|
1999-03-01 03:19:32 +00:00
|
|
|
|
(if error-file
|
|
|
|
|
(list t error-file)
|
|
|
|
|
t)
|
|
|
|
|
nil shell-command-switch command)
|
|
|
|
|
(when (and error-file (file-exists-p error-file))
|
|
|
|
|
(if (< 0 (nth 7 (file-attributes error-file)))
|
|
|
|
|
(with-current-buffer (get-buffer-create error-buffer)
|
|
|
|
|
(let ((pos-from-end (- (point-max) (point))))
|
|
|
|
|
(or (bobp)
|
|
|
|
|
(insert "\f\n"))
|
|
|
|
|
;; Do no formatting while reading error file,
|
|
|
|
|
;; because that can run a shell command, and we
|
|
|
|
|
;; don't want that to cause an infinite recursion.
|
|
|
|
|
(format-insert-file error-file nil)
|
|
|
|
|
;; Put point after the inserted errors.
|
|
|
|
|
(goto-char (- (point-max) pos-from-end)))
|
|
|
|
|
(display-buffer (current-buffer))))
|
|
|
|
|
(delete-file error-file))
|
|
|
|
|
;; This is like exchange-point-and-mark, but doesn't
|
|
|
|
|
;; activate the mark. It is cleaner to avoid activation,
|
|
|
|
|
;; even though the command loop would deactivate the mark
|
|
|
|
|
;; because we inserted text.
|
|
|
|
|
(goto-char (prog1 (mark t)
|
|
|
|
|
(set-marker (mark-marker) (point)
|
|
|
|
|
(current-buffer)))))
|
2001-12-13 07:43:28 +00:00
|
|
|
|
;; Output goes in a separate buffer.
|
1996-02-21 21:25:30 +00:00
|
|
|
|
;; Preserve the match data in case called from a program.
|
|
|
|
|
(save-match-data
|
2002-06-26 08:59:32 +00:00
|
|
|
|
(if (string-match "[ \t]*&[ \t]*\\'" command)
|
1996-02-21 21:25:30 +00:00
|
|
|
|
;; Command ending with ampersand means asynchronous.
|
|
|
|
|
(let ((buffer (get-buffer-create
|
|
|
|
|
(or output-buffer "*Async Shell Command*")))
|
|
|
|
|
(directory default-directory)
|
|
|
|
|
proc)
|
|
|
|
|
;; Remove the ampersand.
|
|
|
|
|
(setq command (substring command 0 (match-beginning 0)))
|
|
|
|
|
;; If will kill a process, query first.
|
|
|
|
|
(setq proc (get-buffer-process buffer))
|
|
|
|
|
(if proc
|
|
|
|
|
(if (yes-or-no-p "A command is running. Kill it? ")
|
|
|
|
|
(kill-process proc)
|
|
|
|
|
(error "Shell command in progress")))
|
2003-05-13 19:45:01 +00:00
|
|
|
|
(with-current-buffer buffer
|
1996-02-21 21:25:30 +00:00
|
|
|
|
(setq buffer-read-only nil)
|
|
|
|
|
(erase-buffer)
|
|
|
|
|
(display-buffer buffer)
|
|
|
|
|
(setq default-directory directory)
|
1999-11-15 16:11:14 +00:00
|
|
|
|
(setq proc (start-process "Shell" buffer shell-file-name
|
1996-02-21 21:25:30 +00:00
|
|
|
|
shell-command-switch command))
|
|
|
|
|
(setq mode-line-process '(":%s"))
|
2003-05-16 21:17:52 +00:00
|
|
|
|
(require 'shell) (shell-mode)
|
1996-02-21 21:25:30 +00:00
|
|
|
|
(set-process-sentinel proc 'shell-command-sentinel)
|
|
|
|
|
))
|
1999-03-01 03:19:32 +00:00
|
|
|
|
(shell-command-on-region (point) (point) command
|
|
|
|
|
output-buffer nil error-buffer)))))))
|
2000-11-22 20:59:39 +00:00
|
|
|
|
|
2000-10-06 11:35:56 +00:00
|
|
|
|
(defun display-message-or-buffer (message
|
|
|
|
|
&optional buffer-name not-this-window frame)
|
|
|
|
|
"Display MESSAGE in the echo area if possible, otherwise in a pop-up buffer.
|
|
|
|
|
MESSAGE may be either a string or a buffer.
|
|
|
|
|
|
|
|
|
|
A buffer is displayed using `display-buffer' if MESSAGE is too long for
|
2000-11-08 17:35:57 +00:00
|
|
|
|
the maximum height of the echo area, as defined by `max-mini-window-height'
|
|
|
|
|
if `resize-mini-windows' is non-nil.
|
2000-10-06 11:35:56 +00:00
|
|
|
|
|
2000-10-08 01:37:42 +00:00
|
|
|
|
Returns either the string shown in the echo area, or when a pop-up
|
|
|
|
|
buffer is used, the window used to display it.
|
|
|
|
|
|
2000-10-06 11:35:56 +00:00
|
|
|
|
If MESSAGE is a string, then the optional argument BUFFER-NAME is the
|
|
|
|
|
name of the buffer used to display it in the case where a pop-up buffer
|
|
|
|
|
is used, defaulting to `*Message*'. In the case where MESSAGE is a
|
|
|
|
|
string and it is displayed in the echo area, it is not specified whether
|
|
|
|
|
the contents are inserted into the buffer anyway.
|
|
|
|
|
|
|
|
|
|
Optional arguments NOT-THIS-WINDOW and FRAME are as for `display-buffer',
|
|
|
|
|
and only used if a buffer is displayed."
|
2006-02-04 21:48:50 +00:00
|
|
|
|
(cond ((and (stringp message)
|
|
|
|
|
(not (string-match "\n" message))
|
|
|
|
|
(<= (length message) (frame-width)))
|
2000-10-06 11:35:56 +00:00
|
|
|
|
;; Trivial case where we can use the echo area
|
|
|
|
|
(message "%s" message))
|
|
|
|
|
((and (stringp message)
|
2006-02-04 21:48:50 +00:00
|
|
|
|
(= (string-match "\n" message) (1- (length message)))
|
|
|
|
|
(<= (1- (length message)) (frame-width)))
|
2000-10-06 11:35:56 +00:00
|
|
|
|
;; Trivial case where we can just remove single trailing newline
|
|
|
|
|
(message "%s" (substring message 0 (1- (length message)))))
|
|
|
|
|
(t
|
|
|
|
|
;; General case
|
|
|
|
|
(with-current-buffer
|
|
|
|
|
(if (bufferp message)
|
|
|
|
|
message
|
|
|
|
|
(get-buffer-create (or buffer-name "*Message*")))
|
|
|
|
|
|
|
|
|
|
(unless (bufferp message)
|
|
|
|
|
(erase-buffer)
|
|
|
|
|
(insert message))
|
|
|
|
|
|
|
|
|
|
(let ((lines
|
|
|
|
|
(if (= (buffer-size) 0)
|
|
|
|
|
0
|
2006-02-04 12:19:27 +00:00
|
|
|
|
(count-screen-lines nil nil nil (minibuffer-window)))))
|
2002-10-26 22:40:31 +00:00
|
|
|
|
(cond ((= lines 0))
|
|
|
|
|
((and (or (<= lines 1)
|
2002-06-26 08:59:32 +00:00
|
|
|
|
(<= lines
|
|
|
|
|
(if resize-mini-windows
|
|
|
|
|
(cond ((floatp max-mini-window-height)
|
|
|
|
|
(* (frame-height)
|
|
|
|
|
max-mini-window-height))
|
|
|
|
|
((integerp max-mini-window-height)
|
|
|
|
|
max-mini-window-height)
|
|
|
|
|
(t
|
|
|
|
|
1))
|
|
|
|
|
1)))
|
|
|
|
|
;; Don't use the echo area if the output buffer is
|
|
|
|
|
;; already dispayed in the selected frame.
|
2002-06-29 18:13:06 +00:00
|
|
|
|
(not (get-buffer-window (current-buffer))))
|
2000-10-06 11:35:56 +00:00
|
|
|
|
;; Echo area
|
|
|
|
|
(goto-char (point-max))
|
|
|
|
|
(when (bolp)
|
|
|
|
|
(backward-char 1))
|
|
|
|
|
(message "%s" (buffer-substring (point-min) (point))))
|
|
|
|
|
(t
|
|
|
|
|
;; Buffer
|
|
|
|
|
(goto-char (point-min))
|
2001-10-15 01:01:21 +00:00
|
|
|
|
(display-buffer (current-buffer)
|
|
|
|
|
not-this-window frame))))))))
|
2000-10-06 11:35:56 +00:00
|
|
|
|
|
|
|
|
|
|
1991-12-21 09:29:41 +00:00
|
|
|
|
;; We have a sentinel to prevent insertion of a termination message
|
|
|
|
|
;; in the buffer itself.
|
|
|
|
|
(defun shell-command-sentinel (process signal)
|
1995-07-17 23:03:53 +00:00
|
|
|
|
(if (memq (process-status process) '(exit signal))
|
1999-11-15 16:11:14 +00:00
|
|
|
|
(message "%s: %s."
|
1995-07-17 23:03:53 +00:00
|
|
|
|
(car (cdr (cdr (process-command process))))
|
|
|
|
|
(substring signal 0 -1))))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
1994-10-15 10:16:09 +00:00
|
|
|
|
(defun shell-command-on-region (start end command
|
1997-08-15 23:41:50 +00:00
|
|
|
|
&optional output-buffer replace
|
2004-08-22 16:59:57 +00:00
|
|
|
|
error-buffer display-error-buffer)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
"Execute string COMMAND in inferior shell with region as input.
|
|
|
|
|
Normally display output (if any) in temp buffer `*Shell Command Output*';
|
1999-01-23 21:50:18 +00:00
|
|
|
|
Prefix arg means replace the region with it. Return the exit code of
|
|
|
|
|
COMMAND.
|
1995-02-28 18:04:57 +00:00
|
|
|
|
|
1997-08-04 00:51:07 +00:00
|
|
|
|
To specify a coding system for converting non-ASCII characters
|
|
|
|
|
in the input and output to the shell command, use \\[universal-coding-system-argument]
|
|
|
|
|
before this command. By default, the input (from the current buffer)
|
|
|
|
|
is encoded in the same coding system that will be used to save the file,
|
|
|
|
|
`buffer-file-coding-system'. If the output is going to replace the region,
|
|
|
|
|
then it is decoded from that same coding system.
|
|
|
|
|
|
2004-08-22 16:59:57 +00:00
|
|
|
|
The noninteractive arguments are START, END, COMMAND,
|
|
|
|
|
OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER.
|
|
|
|
|
Noninteractive callers can specify coding systems by binding
|
|
|
|
|
`coding-system-for-read' and `coding-system-for-write'.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
2001-12-13 07:43:28 +00:00
|
|
|
|
If the command generates output, the output may be displayed
|
|
|
|
|
in the echo area or in a buffer.
|
|
|
|
|
If the output is short enough to display in the echo area
|
|
|
|
|
\(determined by the variable `max-mini-window-height' if
|
|
|
|
|
`resize-mini-windows' is non-nil), it is shown there. Otherwise
|
|
|
|
|
it is displayed in the buffer `*Shell Command Output*'. The output
|
|
|
|
|
is available in that buffer in both cases.
|
|
|
|
|
|
|
|
|
|
If there is output and an error, a message about the error
|
|
|
|
|
appears at the end of the output.
|
|
|
|
|
|
|
|
|
|
If there is no output, or if output is inserted in the current buffer,
|
|
|
|
|
then `*Shell Command Output*' is deleted.
|
1994-10-15 10:16:09 +00:00
|
|
|
|
|
1995-02-28 18:04:57 +00:00
|
|
|
|
If the optional fourth argument OUTPUT-BUFFER is non-nil,
|
|
|
|
|
that says to put the output in some other buffer.
|
1994-10-15 10:16:09 +00:00
|
|
|
|
If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
|
|
|
|
|
If OUTPUT-BUFFER is not a buffer and not nil,
|
|
|
|
|
insert output in the current buffer.
|
1997-08-15 23:41:50 +00:00
|
|
|
|
In either case, the output is inserted after point (leaving mark after it).
|
|
|
|
|
|
1998-10-16 18:07:03 +00:00
|
|
|
|
If REPLACE, the optional fifth argument, is non-nil, that means insert
|
|
|
|
|
the output in place of text from START to END, putting point and mark
|
|
|
|
|
around it.
|
|
|
|
|
|
1998-10-30 11:01:38 +00:00
|
|
|
|
If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
|
1997-08-15 23:41:50 +00:00
|
|
|
|
or buffer name to which to direct the command's standard error output.
|
1999-01-18 00:25:23 +00:00
|
|
|
|
If it is nil, error output is mingled with regular output.
|
2004-08-22 16:59:57 +00:00
|
|
|
|
If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there
|
|
|
|
|
were any errors. (This is always t, interactively.)
|
1999-03-01 03:19:32 +00:00
|
|
|
|
In an interactive call, the variable `shell-command-default-error-buffer'
|
|
|
|
|
specifies the value of ERROR-BUFFER."
|
2002-02-01 04:20:02 +00:00
|
|
|
|
(interactive (let (string)
|
|
|
|
|
(unless (mark)
|
|
|
|
|
(error "The mark is not set now, so there is no region"))
|
|
|
|
|
;; Do this before calling region-beginning
|
|
|
|
|
;; and region-end, in case subprocess output
|
|
|
|
|
;; relocates them while we are in the minibuffer.
|
|
|
|
|
(setq string (read-from-minibuffer "Shell command on region: "
|
|
|
|
|
nil nil nil
|
|
|
|
|
'shell-command-history))
|
1995-11-10 17:33:26 +00:00
|
|
|
|
;; call-interactively recognizes region-beginning and
|
|
|
|
|
;; region-end specially, leaving them in the history.
|
|
|
|
|
(list (region-beginning) (region-end)
|
1995-02-23 05:02:54 +00:00
|
|
|
|
string
|
|
|
|
|
current-prefix-arg
|
1999-01-18 00:25:23 +00:00
|
|
|
|
current-prefix-arg
|
2004-08-22 16:59:57 +00:00
|
|
|
|
shell-command-default-error-buffer
|
|
|
|
|
t)))
|
1997-08-15 23:41:50 +00:00
|
|
|
|
(let ((error-file
|
1999-09-02 12:05:07 +00:00
|
|
|
|
(if error-buffer
|
1999-10-13 00:48:17 +00:00
|
|
|
|
(make-temp-file
|
1999-09-02 12:05:07 +00:00
|
|
|
|
(expand-file-name "scor"
|
|
|
|
|
(or small-temporary-file-directory
|
|
|
|
|
temporary-file-directory)))
|
1999-01-23 21:50:18 +00:00
|
|
|
|
nil))
|
|
|
|
|
exit-status)
|
1999-01-18 00:25:23 +00:00
|
|
|
|
(if (or replace
|
|
|
|
|
(and output-buffer
|
1999-02-26 03:48:07 +00:00
|
|
|
|
(not (or (bufferp output-buffer) (stringp output-buffer)))))
|
1999-01-18 00:25:23 +00:00
|
|
|
|
;; Replace specified region with output from command.
|
|
|
|
|
(let ((swap (and replace (< start end))))
|
|
|
|
|
;; Don't muck with mark unless REPLACE says we should.
|
|
|
|
|
(goto-char start)
|
2002-03-09 09:06:04 +00:00
|
|
|
|
(and replace (push-mark (point) 'nomsg))
|
1999-01-23 21:50:18 +00:00
|
|
|
|
(setq exit-status
|
|
|
|
|
(call-process-region start end shell-file-name t
|
|
|
|
|
(if error-file
|
|
|
|
|
(list t error-file)
|
|
|
|
|
t)
|
|
|
|
|
nil shell-command-switch command))
|
2001-10-31 00:57:04 +00:00
|
|
|
|
;; It is rude to delete a buffer which the command is not using.
|
|
|
|
|
;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
|
|
|
|
|
;; (and shell-buffer (not (eq shell-buffer (current-buffer)))
|
|
|
|
|
;; (kill-buffer shell-buffer)))
|
1999-01-18 00:25:23 +00:00
|
|
|
|
;; Don't muck with mark unless REPLACE says we should.
|
|
|
|
|
(and replace swap (exchange-point-and-mark)))
|
|
|
|
|
;; No prefix argument: put the output in a temp buffer,
|
|
|
|
|
;; replacing its entire contents.
|
|
|
|
|
(let ((buffer (get-buffer-create
|
2002-06-29 18:08:32 +00:00
|
|
|
|
(or output-buffer "*Shell Command Output*"))))
|
1999-01-18 00:25:23 +00:00
|
|
|
|
(unwind-protect
|
|
|
|
|
(if (eq buffer (current-buffer))
|
|
|
|
|
;; If the input is the same buffer as the output,
|
|
|
|
|
;; delete everything but the specified region,
|
|
|
|
|
;; then replace that region with the output.
|
|
|
|
|
(progn (setq buffer-read-only nil)
|
|
|
|
|
(delete-region (max start end) (point-max))
|
|
|
|
|
(delete-region (point-min) (min start end))
|
|
|
|
|
(setq exit-status
|
|
|
|
|
(call-process-region (point-min) (point-max)
|
1999-11-15 16:11:14 +00:00
|
|
|
|
shell-file-name t
|
1999-01-18 00:25:23 +00:00
|
|
|
|
(if error-file
|
|
|
|
|
(list t error-file)
|
|
|
|
|
t)
|
1999-01-23 21:50:18 +00:00
|
|
|
|
nil shell-command-switch
|
|
|
|
|
command)))
|
|
|
|
|
;; Clear the output buffer, then run the command with
|
|
|
|
|
;; output there.
|
2000-04-25 19:14:45 +00:00
|
|
|
|
(let ((directory default-directory))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(set-buffer buffer)
|
|
|
|
|
(setq buffer-read-only nil)
|
|
|
|
|
(if (not output-buffer)
|
|
|
|
|
(setq default-directory directory))
|
|
|
|
|
(erase-buffer)))
|
1999-01-18 00:25:23 +00:00
|
|
|
|
(setq exit-status
|
|
|
|
|
(call-process-region start end shell-file-name nil
|
|
|
|
|
(if error-file
|
|
|
|
|
(list buffer error-file)
|
|
|
|
|
buffer)
|
1999-01-23 21:50:18 +00:00
|
|
|
|
nil shell-command-switch command)))
|
2001-12-13 07:43:28 +00:00
|
|
|
|
;; Report the output.
|
2002-02-27 23:03:34 +00:00
|
|
|
|
(with-current-buffer buffer
|
2003-02-04 12:29:42 +00:00
|
|
|
|
(setq mode-line-process
|
2002-06-29 18:08:32 +00:00
|
|
|
|
(cond ((null exit-status)
|
|
|
|
|
" - Error")
|
|
|
|
|
((stringp exit-status)
|
|
|
|
|
(format " - Signal [%s]" exit-status))
|
|
|
|
|
((not (equal 0 exit-status))
|
|
|
|
|
(format " - Exit [%d]" exit-status)))))
|
2000-10-06 11:35:56 +00:00
|
|
|
|
(if (with-current-buffer buffer (> (point-max) (point-min)))
|
|
|
|
|
;; There's some output, display it
|
2002-02-27 23:03:34 +00:00
|
|
|
|
(display-message-or-buffer buffer)
|
2000-10-06 11:35:56 +00:00
|
|
|
|
;; No output; error?
|
2002-02-20 22:33:01 +00:00
|
|
|
|
(let ((output
|
|
|
|
|
(if (and error-file
|
|
|
|
|
(< 0 (nth 7 (file-attributes error-file))))
|
|
|
|
|
"some error output"
|
|
|
|
|
"no output")))
|
2002-06-29 18:08:32 +00:00
|
|
|
|
(cond ((null exit-status)
|
|
|
|
|
(message "(Shell command failed with error)"))
|
|
|
|
|
((equal 0 exit-status)
|
|
|
|
|
(message "(Shell command succeeded with %s)"
|
|
|
|
|
output))
|
|
|
|
|
((stringp exit-status)
|
|
|
|
|
(message "(Shell command killed by signal %s)"
|
|
|
|
|
exit-status))
|
|
|
|
|
(t
|
|
|
|
|
(message "(Shell command failed with code %d and %s)"
|
|
|
|
|
exit-status output))))
|
2001-10-31 00:57:04 +00:00
|
|
|
|
;; Don't kill: there might be useful info in the undo-log.
|
|
|
|
|
;; (kill-buffer buffer)
|
|
|
|
|
))))
|
2000-10-06 11:35:56 +00:00
|
|
|
|
|
1999-03-01 03:19:32 +00:00
|
|
|
|
(when (and error-file (file-exists-p error-file))
|
|
|
|
|
(if (< 0 (nth 7 (file-attributes error-file)))
|
|
|
|
|
(with-current-buffer (get-buffer-create error-buffer)
|
|
|
|
|
(let ((pos-from-end (- (point-max) (point))))
|
|
|
|
|
(or (bobp)
|
|
|
|
|
(insert "\f\n"))
|
|
|
|
|
;; Do no formatting while reading error file,
|
|
|
|
|
;; because that can run a shell command, and we
|
|
|
|
|
;; don't want that to cause an infinite recursion.
|
|
|
|
|
(format-insert-file error-file nil)
|
|
|
|
|
;; Put point after the inserted errors.
|
|
|
|
|
(goto-char (- (point-max) pos-from-end)))
|
2004-08-22 16:59:57 +00:00
|
|
|
|
(and display-error-buffer
|
|
|
|
|
(display-buffer (current-buffer)))))
|
1999-03-01 03:19:32 +00:00
|
|
|
|
(delete-file error-file))
|
1999-01-23 21:50:18 +00:00
|
|
|
|
exit-status))
|
1999-11-15 16:11:14 +00:00
|
|
|
|
|
1996-09-24 20:04:48 +00:00
|
|
|
|
(defun shell-command-to-string (command)
|
|
|
|
|
"Execute shell command COMMAND and return its output as a string."
|
|
|
|
|
(with-output-to-string
|
1996-09-24 23:54:08 +00:00
|
|
|
|
(with-current-buffer
|
|
|
|
|
standard-output
|
|
|
|
|
(call-process shell-file-name nil t nil shell-command-switch command))))
|
2004-10-23 19:52:18 +00:00
|
|
|
|
|
|
|
|
|
(defun process-file (program &optional infile buffer display &rest args)
|
|
|
|
|
"Process files synchronously in a separate process.
|
|
|
|
|
Similar to `call-process', but may invoke a file handler based on
|
|
|
|
|
`default-directory'. The current working directory of the
|
|
|
|
|
subprocess is `default-directory'.
|
|
|
|
|
|
|
|
|
|
File names in INFILE and BUFFER are handled normally, but file
|
|
|
|
|
names in ARGS should be relative to `default-directory', as they
|
|
|
|
|
are passed to the process verbatim. \(This is a difference to
|
|
|
|
|
`call-process' which does not support file handlers for INFILE
|
|
|
|
|
and BUFFER.\)
|
|
|
|
|
|
|
|
|
|
Some file handlers might not support all variants, for example
|
|
|
|
|
they might behave as if DISPLAY was nil, regardless of the actual
|
|
|
|
|
value passed."
|
|
|
|
|
(let ((fh (find-file-name-handler default-directory 'process-file))
|
|
|
|
|
lc stderr-file)
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(if fh (apply fh 'process-file program infile buffer display args)
|
2004-10-24 09:06:05 +00:00
|
|
|
|
(when infile (setq lc (file-local-copy infile)))
|
2004-10-23 19:52:18 +00:00
|
|
|
|
(setq stderr-file (when (and (consp buffer) (stringp (cadr buffer)))
|
2004-10-25 08:31:52 +00:00
|
|
|
|
(make-temp-file "emacs")))
|
|
|
|
|
(prog1
|
|
|
|
|
(apply 'call-process program
|
|
|
|
|
(or lc infile)
|
|
|
|
|
(if stderr-file (list (car buffer) stderr-file) buffer)
|
|
|
|
|
display args)
|
|
|
|
|
(when stderr-file (copy-file stderr-file (cadr buffer)))))
|
2004-10-23 19:52:18 +00:00
|
|
|
|
(when stderr-file (delete-file stderr-file))
|
|
|
|
|
(when lc (delete-file lc)))))
|
|
|
|
|
|
|
|
|
|
|
2002-03-29 23:16:11 +00:00
|
|
|
|
|
1996-12-16 00:52:56 +00:00
|
|
|
|
(defvar universal-argument-map
|
1995-06-16 06:14:44 +00:00
|
|
|
|
(let ((map (make-sparse-keymap)))
|
|
|
|
|
(define-key map [t] 'universal-argument-other-key)
|
1995-06-19 16:15:06 +00:00
|
|
|
|
(define-key map (vector meta-prefix-char t) 'universal-argument-other-key)
|
1995-06-16 06:14:44 +00:00
|
|
|
|
(define-key map [switch-frame] nil)
|
|
|
|
|
(define-key map [?\C-u] 'universal-argument-more)
|
|
|
|
|
(define-key map [?-] 'universal-argument-minus)
|
|
|
|
|
(define-key map [?0] 'digit-argument)
|
|
|
|
|
(define-key map [?1] 'digit-argument)
|
|
|
|
|
(define-key map [?2] 'digit-argument)
|
|
|
|
|
(define-key map [?3] 'digit-argument)
|
|
|
|
|
(define-key map [?4] 'digit-argument)
|
|
|
|
|
(define-key map [?5] 'digit-argument)
|
|
|
|
|
(define-key map [?6] 'digit-argument)
|
|
|
|
|
(define-key map [?7] 'digit-argument)
|
|
|
|
|
(define-key map [?8] 'digit-argument)
|
|
|
|
|
(define-key map [?9] 'digit-argument)
|
2000-07-20 20:35:05 +00:00
|
|
|
|
(define-key map [kp-0] 'digit-argument)
|
|
|
|
|
(define-key map [kp-1] 'digit-argument)
|
|
|
|
|
(define-key map [kp-2] 'digit-argument)
|
|
|
|
|
(define-key map [kp-3] 'digit-argument)
|
|
|
|
|
(define-key map [kp-4] 'digit-argument)
|
|
|
|
|
(define-key map [kp-5] 'digit-argument)
|
|
|
|
|
(define-key map [kp-6] 'digit-argument)
|
|
|
|
|
(define-key map [kp-7] 'digit-argument)
|
|
|
|
|
(define-key map [kp-8] 'digit-argument)
|
|
|
|
|
(define-key map [kp-9] 'digit-argument)
|
|
|
|
|
(define-key map [kp-subtract] 'universal-argument-minus)
|
1995-06-16 06:14:44 +00:00
|
|
|
|
map)
|
|
|
|
|
"Keymap used while processing \\[universal-argument].")
|
|
|
|
|
|
1995-06-20 14:25:36 +00:00
|
|
|
|
(defvar universal-argument-num-events nil
|
|
|
|
|
"Number of argument-specifying events read by `universal-argument'.
|
|
|
|
|
`universal-argument-other-key' uses this to discard those events
|
|
|
|
|
from (this-command-keys), and reread only the final command.")
|
|
|
|
|
|
2003-11-01 17:02:32 +00:00
|
|
|
|
(defvar overriding-map-is-bound nil
|
|
|
|
|
"Non-nil when `overriding-terminal-local-map' is `universal-argument-map'.")
|
|
|
|
|
|
|
|
|
|
(defvar saved-overriding-map nil
|
|
|
|
|
"The saved value of `overriding-terminal-local-map'.
|
|
|
|
|
That variable gets restored to this value on exiting \"universal
|
|
|
|
|
argument mode\".")
|
|
|
|
|
|
|
|
|
|
(defun ensure-overriding-map-is-bound ()
|
|
|
|
|
"Check `overriding-terminal-local-map' is `universal-argument-map'."
|
|
|
|
|
(unless overriding-map-is-bound
|
|
|
|
|
(setq saved-overriding-map overriding-terminal-local-map)
|
|
|
|
|
(setq overriding-terminal-local-map universal-argument-map)
|
|
|
|
|
(setq overriding-map-is-bound t)))
|
|
|
|
|
|
|
|
|
|
(defun restore-overriding-map ()
|
|
|
|
|
"Restore `overriding-terminal-local-map' to its saved value."
|
|
|
|
|
(setq overriding-terminal-local-map saved-overriding-map)
|
|
|
|
|
(setq overriding-map-is-bound nil))
|
|
|
|
|
|
1995-06-14 22:30:41 +00:00
|
|
|
|
(defun universal-argument ()
|
|
|
|
|
"Begin a numeric argument for the following command.
|
|
|
|
|
Digits or minus sign following \\[universal-argument] make up the numeric argument.
|
|
|
|
|
\\[universal-argument] following the digits or minus sign ends the argument.
|
|
|
|
|
\\[universal-argument] without digits or minus sign provides 4 as argument.
|
|
|
|
|
Repeating \\[universal-argument] without digits or minus sign
|
1996-10-08 21:35:03 +00:00
|
|
|
|
multiplies the argument by 4 each time.
|
|
|
|
|
For some commands, just \\[universal-argument] by itself serves as a flag
|
1996-10-15 03:19:56 +00:00
|
|
|
|
which is different in effect from any particular numeric argument.
|
|
|
|
|
These commands include \\[set-mark-command] and \\[start-kbd-macro]."
|
1995-06-16 06:14:44 +00:00
|
|
|
|
(interactive)
|
|
|
|
|
(setq prefix-arg (list 4))
|
1995-06-20 14:25:36 +00:00
|
|
|
|
(setq universal-argument-num-events (length (this-command-keys)))
|
2003-11-01 17:02:32 +00:00
|
|
|
|
(ensure-overriding-map-is-bound))
|
1995-06-14 22:30:41 +00:00
|
|
|
|
|
1995-06-16 06:14:44 +00:00
|
|
|
|
;; A subsequent C-u means to multiply the factor by 4 if we've typed
|
|
|
|
|
;; nothing but C-u's; otherwise it means to terminate the prefix arg.
|
|
|
|
|
(defun universal-argument-more (arg)
|
1995-06-14 22:30:41 +00:00
|
|
|
|
(interactive "P")
|
1995-06-16 06:14:44 +00:00
|
|
|
|
(if (consp arg)
|
|
|
|
|
(setq prefix-arg (list (* 4 (car arg))))
|
1997-03-22 03:54:14 +00:00
|
|
|
|
(if (eq arg '-)
|
|
|
|
|
(setq prefix-arg (list -4))
|
|
|
|
|
(setq prefix-arg arg)
|
2003-11-01 17:02:32 +00:00
|
|
|
|
(restore-overriding-map)))
|
1995-06-20 14:25:36 +00:00
|
|
|
|
(setq universal-argument-num-events (length (this-command-keys))))
|
1995-06-14 22:30:41 +00:00
|
|
|
|
|
|
|
|
|
(defun negative-argument (arg)
|
|
|
|
|
"Begin a negative numeric argument for the next command.
|
|
|
|
|
\\[universal-argument] following digits or minus sign ends the argument."
|
|
|
|
|
(interactive "P")
|
1995-06-16 06:14:44 +00:00
|
|
|
|
(cond ((integerp arg)
|
|
|
|
|
(setq prefix-arg (- arg)))
|
|
|
|
|
((eq arg '-)
|
|
|
|
|
(setq prefix-arg nil))
|
|
|
|
|
(t
|
1995-06-19 16:15:06 +00:00
|
|
|
|
(setq prefix-arg '-)))
|
1995-06-20 14:25:36 +00:00
|
|
|
|
(setq universal-argument-num-events (length (this-command-keys)))
|
2003-11-01 17:02:32 +00:00
|
|
|
|
(ensure-overriding-map-is-bound))
|
1995-06-16 06:14:44 +00:00
|
|
|
|
|
|
|
|
|
(defun digit-argument (arg)
|
|
|
|
|
"Part of the numeric argument for the next command.
|
|
|
|
|
\\[universal-argument] following digits or minus sign ends the argument."
|
|
|
|
|
(interactive "P")
|
2000-07-20 20:35:05 +00:00
|
|
|
|
(let* ((char (if (integerp last-command-char)
|
|
|
|
|
last-command-char
|
|
|
|
|
(get last-command-char 'ascii-character)))
|
|
|
|
|
(digit (- (logand char ?\177) ?0)))
|
1995-06-16 06:14:44 +00:00
|
|
|
|
(cond ((integerp arg)
|
|
|
|
|
(setq prefix-arg (+ (* arg 10)
|
|
|
|
|
(if (< arg 0) (- digit) digit))))
|
|
|
|
|
((eq arg '-)
|
|
|
|
|
;; Treat -0 as just -, so that -01 will work.
|
|
|
|
|
(setq prefix-arg (if (zerop digit) '- (- digit))))
|
|
|
|
|
(t
|
1995-06-19 16:15:06 +00:00
|
|
|
|
(setq prefix-arg digit))))
|
1995-06-20 14:25:36 +00:00
|
|
|
|
(setq universal-argument-num-events (length (this-command-keys)))
|
2003-11-01 17:02:32 +00:00
|
|
|
|
(ensure-overriding-map-is-bound))
|
1995-06-16 06:14:44 +00:00
|
|
|
|
|
|
|
|
|
;; For backward compatibility, minus with no modifiers is an ordinary
|
|
|
|
|
;; command if digits have already been entered.
|
|
|
|
|
(defun universal-argument-minus (arg)
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(if (integerp arg)
|
|
|
|
|
(universal-argument-other-key arg)
|
|
|
|
|
(negative-argument arg)))
|
|
|
|
|
|
|
|
|
|
;; Anything else terminates the argument and is left in the queue to be
|
|
|
|
|
;; executed as a command.
|
|
|
|
|
(defun universal-argument-other-key (arg)
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(setq prefix-arg arg)
|
1995-06-20 14:25:36 +00:00
|
|
|
|
(let* ((key (this-command-keys))
|
|
|
|
|
(keylist (listify-key-sequence key)))
|
|
|
|
|
(setq unread-command-events
|
1995-11-11 23:56:47 +00:00
|
|
|
|
(append (nthcdr universal-argument-num-events keylist)
|
|
|
|
|
unread-command-events)))
|
1995-06-19 20:10:21 +00:00
|
|
|
|
(reset-this-command-lengths)
|
2003-11-01 17:02:32 +00:00
|
|
|
|
(restore-overriding-map))
|
2002-03-29 23:16:11 +00:00
|
|
|
|
|
2005-03-29 20:53:19 +00:00
|
|
|
|
(defvar buffer-substring-filters nil
|
|
|
|
|
"List of filter functions for `filter-buffer-substring'.
|
|
|
|
|
Each function must accept a single argument, a string, and return
|
|
|
|
|
a string. The buffer substring is passed to the first function
|
|
|
|
|
in the list, and the return value of each function is passed to
|
|
|
|
|
the next. The return value of the last function is used as the
|
|
|
|
|
return value of `filter-buffer-substring'.
|
|
|
|
|
|
|
|
|
|
If this variable is nil, no filtering is performed.")
|
|
|
|
|
|
2006-04-09 23:03:48 +00:00
|
|
|
|
(defun filter-buffer-substring (beg end &optional delete noprops)
|
2005-03-29 20:53:19 +00:00
|
|
|
|
"Return the buffer substring between BEG and END, after filtering.
|
|
|
|
|
The buffer substring is passed through each of the filter
|
|
|
|
|
functions in `buffer-substring-filters', and the value from the
|
|
|
|
|
last filter function is returned. If `buffer-substring-filters'
|
|
|
|
|
is nil, the buffer substring is returned unaltered.
|
|
|
|
|
|
|
|
|
|
If DELETE is non-nil, the text between BEG and END is deleted
|
|
|
|
|
from the buffer.
|
|
|
|
|
|
2006-04-09 23:03:48 +00:00
|
|
|
|
If NOPROPS is non-nil, final string returned does not include
|
|
|
|
|
text properties, while the string passed to the filters still
|
|
|
|
|
includes text properties from the buffer text.
|
|
|
|
|
|
2005-05-31 09:32:35 +00:00
|
|
|
|
Point is temporarily set to BEG before calling
|
2005-03-29 20:53:19 +00:00
|
|
|
|
`buffer-substring-filters', in case the functions need to know
|
|
|
|
|
where the text came from.
|
|
|
|
|
|
2006-04-09 23:03:48 +00:00
|
|
|
|
This function should be used instead of `buffer-substring',
|
|
|
|
|
`buffer-substring-no-properties', or `delete-and-extract-region'
|
|
|
|
|
when you want to allow filtering to take place. For example,
|
|
|
|
|
major or minor modes can use `buffer-substring-filters' to
|
|
|
|
|
extract characters that are special to a buffer, and should not
|
|
|
|
|
be copied into other buffers."
|
|
|
|
|
(cond
|
|
|
|
|
((or delete buffer-substring-filters)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char beg)
|
|
|
|
|
(let ((string (if delete (delete-and-extract-region beg end)
|
|
|
|
|
(buffer-substring beg end))))
|
|
|
|
|
(dolist (filter buffer-substring-filters)
|
|
|
|
|
(setq string (funcall filter string)))
|
|
|
|
|
(if noprops
|
|
|
|
|
(set-text-properties 0 (length string) nil string))
|
|
|
|
|
string)))
|
|
|
|
|
(noprops
|
|
|
|
|
(buffer-substring-no-properties beg end))
|
|
|
|
|
(t
|
|
|
|
|
(buffer-substring beg end))))
|
|
|
|
|
|
2005-03-29 20:53:19 +00:00
|
|
|
|
|
1999-08-16 20:42:38 +00:00
|
|
|
|
;;;; Window system cut and paste hooks.
|
1992-06-12 22:23:00 +00:00
|
|
|
|
|
|
|
|
|
(defvar interprogram-cut-function nil
|
|
|
|
|
"Function to call to make a killed region available to other programs.
|
|
|
|
|
|
|
|
|
|
Most window systems provide some sort of facility for cutting and
|
1993-05-24 21:19:08 +00:00
|
|
|
|
pasting text between the windows of different programs.
|
|
|
|
|
This variable holds a function that Emacs calls whenever text
|
|
|
|
|
is put in the kill ring, to make the new kill available to other
|
1992-06-12 22:23:00 +00:00
|
|
|
|
programs.
|
|
|
|
|
|
1993-05-24 21:19:08 +00:00
|
|
|
|
The function takes one or two arguments.
|
|
|
|
|
The first argument, TEXT, is a string containing
|
|
|
|
|
the text which should be made available.
|
2004-02-18 03:04:32 +00:00
|
|
|
|
The second, optional, argument PUSH, has the same meaning as the
|
|
|
|
|
similar argument to `x-set-cut-buffer', which see.")
|
1992-06-12 22:23:00 +00:00
|
|
|
|
|
|
|
|
|
(defvar interprogram-paste-function nil
|
|
|
|
|
"Function to call to get text cut from other programs.
|
|
|
|
|
|
|
|
|
|
Most window systems provide some sort of facility for cutting and
|
1993-05-24 21:19:08 +00:00
|
|
|
|
pasting text between the windows of different programs.
|
|
|
|
|
This variable holds a function that Emacs calls to obtain
|
1992-06-12 22:23:00 +00:00
|
|
|
|
text that other programs have provided for pasting.
|
|
|
|
|
|
|
|
|
|
The function should be called with no arguments. If the function
|
|
|
|
|
returns nil, then no other program has provided such text, and the top
|
|
|
|
|
of the Emacs kill ring should be used. If the function returns a
|
2004-02-18 03:04:32 +00:00
|
|
|
|
string, then the caller of the function \(usually `current-kill')
|
|
|
|
|
should put this string in the kill ring as the latest kill.
|
1992-06-24 05:09:26 +00:00
|
|
|
|
|
|
|
|
|
Note that the function should return a string only if a program other
|
|
|
|
|
than Emacs has provided a string for pasting; if Emacs provided the
|
|
|
|
|
most recent string, the function should return nil. If it is
|
|
|
|
|
difficult to tell whether Emacs or some other program provided the
|
|
|
|
|
current string, it is probably good enough to return nil if the string
|
|
|
|
|
is equal (according to `string=') to the last text Emacs provided.")
|
2002-03-29 23:16:11 +00:00
|
|
|
|
|
1992-06-12 22:23:00 +00:00
|
|
|
|
|
2000-11-22 20:59:39 +00:00
|
|
|
|
|
1992-06-12 22:23:00 +00:00
|
|
|
|
;;;; The kill ring data structure.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
|
|
|
|
(defvar kill-ring nil
|
1992-06-12 22:23:00 +00:00
|
|
|
|
"List of killed text sequences.
|
|
|
|
|
Since the kill ring is supposed to interact nicely with cut-and-paste
|
|
|
|
|
facilities offered by window systems, use of this variable should
|
|
|
|
|
interact nicely with `interprogram-cut-function' and
|
|
|
|
|
`interprogram-paste-function'. The functions `kill-new',
|
|
|
|
|
`kill-append', and `current-kill' are supposed to implement this
|
|
|
|
|
interaction; you may want to use them instead of manipulating the kill
|
|
|
|
|
ring directly.")
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
1998-10-19 18:26:28 +00:00
|
|
|
|
(defcustom kill-ring-max 60
|
1997-05-05 11:57:31 +00:00
|
|
|
|
"*Maximum length of kill ring before oldest elements are thrown away."
|
|
|
|
|
:type 'integer
|
|
|
|
|
:group 'killing)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
|
|
|
|
(defvar kill-ring-yank-pointer nil
|
|
|
|
|
"The tail of the kill ring whose car is the last thing yanked.")
|
|
|
|
|
|
2003-01-18 23:34:14 +00:00
|
|
|
|
(defun kill-new (string &optional replace yank-handler)
|
1992-06-12 22:23:00 +00:00
|
|
|
|
"Make STRING the latest kill in the kill ring.
|
2002-03-31 16:28:07 +00:00
|
|
|
|
Set `kill-ring-yank-pointer' to point to it.
|
1994-09-15 21:30:21 +00:00
|
|
|
|
If `interprogram-cut-function' is non-nil, apply it to STRING.
|
|
|
|
|
Optional second argument REPLACE non-nil means that STRING will replace
|
2003-01-18 23:34:14 +00:00
|
|
|
|
the front of the kill ring, rather than being added to the list.
|
|
|
|
|
|
|
|
|
|
Optional third arguments YANK-HANDLER controls how the STRING is later
|
2003-02-04 12:29:42 +00:00
|
|
|
|
inserted into a buffer; see `insert-for-yank' for details.
|
2003-01-27 21:44:48 +00:00
|
|
|
|
When a yank handler is specified, STRING must be non-empty (the yank
|
2004-02-18 03:04:32 +00:00
|
|
|
|
handler, if non-nil, is stored as a `yank-handler' text property on STRING).
|
2003-01-27 21:44:48 +00:00
|
|
|
|
|
|
|
|
|
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
|
(clone-indirect-buffer): Doc fix.
(fixup-whitespace, just-one-space, backward-delete-char-untabify, lambda):
"?\ " -> "?\s".
(next-error, next-error-highlight, next-error-highlight-no-select,
next-error-last-buffer, next-error-buffer-p, next-error-find-buffer, next-error,
previous-error, next-error-no-select, previous-error-no-select, open-line,
split-line, minibuffer-prompt-width, kill-new, binary-overwrite-mode):
Fix typos in docstrings.
(set-fill-column): Fix typo in message.
2005-07-20 22:29:53 +00:00
|
|
|
|
may access and use elements from the kill ring directly, the STRING
|
2003-01-27 21:44:48 +00:00
|
|
|
|
argument should still be a \"useful\" string for such uses."
|
|
|
|
|
(if (> (length string) 0)
|
2003-02-04 12:29:42 +00:00
|
|
|
|
(if yank-handler
|
2004-02-13 23:10:59 +00:00
|
|
|
|
(put-text-property 0 (length string)
|
|
|
|
|
'yank-handler yank-handler string))
|
2003-01-27 21:44:48 +00:00
|
|
|
|
(if yank-handler
|
2003-02-04 12:29:42 +00:00
|
|
|
|
(signal 'args-out-of-range
|
2003-01-27 21:44:48 +00:00
|
|
|
|
(list string "yank-handler specified for empty string"))))
|
|
|
|
|
(if (fboundp 'menu-bar-update-yank-menu)
|
|
|
|
|
(menu-bar-update-yank-menu string (and replace (car kill-ring))))
|
2000-12-11 15:33:34 +00:00
|
|
|
|
(if (and replace kill-ring)
|
1994-09-15 21:30:21 +00:00
|
|
|
|
(setcar kill-ring string)
|
2005-11-01 07:18:10 +00:00
|
|
|
|
(push string kill-ring)
|
1994-09-15 21:30:21 +00:00
|
|
|
|
(if (> (length kill-ring) kill-ring-max)
|
|
|
|
|
(setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
|
1992-06-12 22:23:00 +00:00
|
|
|
|
(setq kill-ring-yank-pointer kill-ring)
|
|
|
|
|
(if interprogram-cut-function
|
1995-08-30 19:33:08 +00:00
|
|
|
|
(funcall interprogram-cut-function string (not replace))))
|
1992-06-12 22:23:00 +00:00
|
|
|
|
|
2003-01-18 23:34:14 +00:00
|
|
|
|
(defun kill-append (string before-p &optional yank-handler)
|
1992-06-12 22:23:00 +00:00
|
|
|
|
"Append STRING to the end of the latest kill in the kill ring.
|
|
|
|
|
If BEFORE-P is non-nil, prepend STRING to the kill.
|
2004-02-18 03:04:32 +00:00
|
|
|
|
Optional third argument YANK-HANDLER, if non-nil, specifies the
|
|
|
|
|
yank-handler text property to be set on the combined kill ring
|
|
|
|
|
string. If the specified yank-handler arg differs from the
|
|
|
|
|
yank-handler property of the latest kill string, this function
|
|
|
|
|
adds the combined string to the kill ring as a new element,
|
|
|
|
|
instead of replacing the last kill with it.
|
2003-01-18 23:34:14 +00:00
|
|
|
|
If `interprogram-cut-function' is set, pass the resulting kill to it."
|
|
|
|
|
(let* ((cur (car kill-ring)))
|
|
|
|
|
(kill-new (if before-p (concat string cur) (concat cur string))
|
|
|
|
|
(or (= (length cur) 0)
|
|
|
|
|
(equal yank-handler (get-text-property 0 'yank-handler cur)))
|
|
|
|
|
yank-handler)))
|
1992-06-12 22:23:00 +00:00
|
|
|
|
|
|
|
|
|
(defun current-kill (n &optional do-not-move)
|
|
|
|
|
"Rotate the yanking point by N places, and then return that kill.
|
|
|
|
|
If N is zero, `interprogram-paste-function' is set, and calling it
|
|
|
|
|
returns a string, then that string is added to the front of the
|
|
|
|
|
kill ring and returned as the latest kill.
|
1999-11-15 16:11:14 +00:00
|
|
|
|
If optional arg DO-NOT-MOVE is non-nil, then don't actually move the
|
1992-06-12 22:23:00 +00:00
|
|
|
|
yanking point; just return the Nth kill forward."
|
|
|
|
|
(let ((interprogram-paste (and (= n 0)
|
|
|
|
|
interprogram-paste-function
|
|
|
|
|
(funcall interprogram-paste-function))))
|
|
|
|
|
(if interprogram-paste
|
|
|
|
|
(progn
|
|
|
|
|
;; Disable the interprogram cut function when we add the new
|
|
|
|
|
;; text to the kill ring, so Emacs doesn't try to own the
|
|
|
|
|
;; selection, with identical text.
|
|
|
|
|
(let ((interprogram-cut-function nil))
|
|
|
|
|
(kill-new interprogram-paste))
|
|
|
|
|
interprogram-paste)
|
|
|
|
|
(or kill-ring (error "Kill ring is empty"))
|
1993-08-10 04:14:17 +00:00
|
|
|
|
(let ((ARGth-kill-element
|
|
|
|
|
(nthcdr (mod (- n (length kill-ring-yank-pointer))
|
|
|
|
|
(length kill-ring))
|
|
|
|
|
kill-ring)))
|
1992-06-12 22:23:00 +00:00
|
|
|
|
(or do-not-move
|
|
|
|
|
(setq kill-ring-yank-pointer ARGth-kill-element))
|
|
|
|
|
(car ARGth-kill-element)))))
|
1992-05-30 21:11:25 +00:00
|
|
|
|
|
|
|
|
|
|
2000-11-22 20:59:39 +00:00
|
|
|
|
|
1992-06-12 22:23:00 +00:00
|
|
|
|
;;;; Commands for manipulating the kill ring.
|
1992-05-30 21:11:25 +00:00
|
|
|
|
|
1997-05-05 11:57:31 +00:00
|
|
|
|
(defcustom kill-read-only-ok nil
|
|
|
|
|
"*Non-nil means don't signal an error for killing read-only text."
|
|
|
|
|
:type 'boolean
|
|
|
|
|
:group 'killing)
|
1994-04-24 05:44:23 +00:00
|
|
|
|
|
1996-02-06 23:56:47 +00:00
|
|
|
|
(put 'text-read-only 'error-conditions
|
|
|
|
|
'(text-read-only buffer-read-only error))
|
|
|
|
|
(put 'text-read-only 'error-message "Text is read-only")
|
|
|
|
|
|
2003-01-18 23:34:14 +00:00
|
|
|
|
(defun kill-region (beg end &optional yank-handler)
|
2006-03-11 15:09:48 +00:00
|
|
|
|
"Kill (\"cut\") text between point and mark.
|
|
|
|
|
This deletes the text from the buffer and saves it in the kill ring.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
The command \\[yank] can retrieve it from there.
|
2001-02-16 12:09:39 +00:00
|
|
|
|
\(If you want to kill and then yank immediately, use \\[kill-ring-save].)
|
|
|
|
|
|
|
|
|
|
If you want to append the killed region to the last killed text,
|
|
|
|
|
use \\[append-next-kill] before \\[kill-region].
|
|
|
|
|
|
1993-02-01 22:31:17 +00:00
|
|
|
|
If the buffer is read-only, Emacs will beep and refrain from deleting
|
|
|
|
|
the text, but put the text in the kill ring anyway. This means that
|
|
|
|
|
you can use the killing commands to copy text from a read-only buffer.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
|
|
|
|
This is the primitive for programs to kill text (as opposed to deleting it).
|
2004-06-07 20:52:16 +00:00
|
|
|
|
Supply two arguments, character positions indicating the stretch of text
|
1991-12-21 09:29:41 +00:00
|
|
|
|
to be killed.
|
|
|
|
|
Any command that calls this function is a \"kill command\".
|
|
|
|
|
If the previous command was also a kill command,
|
|
|
|
|
the text killed this time appends to the text killed last time
|
2003-01-18 23:34:14 +00:00
|
|
|
|
to make one entry in the kill ring.
|
|
|
|
|
|
2004-02-18 03:04:32 +00:00
|
|
|
|
In Lisp code, optional third arg YANK-HANDLER, if non-nil,
|
|
|
|
|
specifies the yank-handler text property to be set on the killed
|
|
|
|
|
text. See `insert-for-yank'."
|
2006-05-21 22:56:44 +00:00
|
|
|
|
;; Pass point first, then mark, because the order matters
|
|
|
|
|
;; when calling kill-append.
|
|
|
|
|
(interactive (list (point) (mark)))
|
2006-09-04 15:03:26 +00:00
|
|
|
|
(unless (and beg end)
|
|
|
|
|
(error "The mark is not set now, so there is no region"))
|
1997-11-19 21:36:56 +00:00
|
|
|
|
(condition-case nil
|
2005-03-29 20:53:19 +00:00
|
|
|
|
(let ((string (filter-buffer-substring beg end t)))
|
1999-12-07 06:30:44 +00:00
|
|
|
|
(when string ;STRING is nil if BEG = END
|
|
|
|
|
;; Add that string to the kill ring, one way or another.
|
|
|
|
|
(if (eq last-command 'kill-region)
|
2003-01-18 23:34:14 +00:00
|
|
|
|
(kill-append string (< end beg) yank-handler)
|
|
|
|
|
(kill-new string nil yank-handler)))
|
2003-05-28 20:07:10 +00:00
|
|
|
|
(when (or string (eq last-command 'kill-region))
|
2004-02-18 03:04:32 +00:00
|
|
|
|
(setq this-command 'kill-region))
|
|
|
|
|
nil)
|
1997-11-19 21:36:56 +00:00
|
|
|
|
((buffer-read-only text-read-only)
|
|
|
|
|
;; The code above failed because the buffer, or some of the characters
|
|
|
|
|
;; in the region, are read-only.
|
|
|
|
|
;; We should beep, in case the user just isn't aware of this.
|
|
|
|
|
;; However, there's no harm in putting
|
|
|
|
|
;; the region's text in the kill ring, anyway.
|
|
|
|
|
(copy-region-as-kill beg end)
|
1998-05-19 05:22:50 +00:00
|
|
|
|
;; Set this-command now, so it will be set even if we get an error.
|
|
|
|
|
(setq this-command 'kill-region)
|
|
|
|
|
;; This should barf, if appropriate, and give us the correct error.
|
1997-11-19 21:36:56 +00:00
|
|
|
|
(if kill-read-only-ok
|
2004-02-18 03:04:32 +00:00
|
|
|
|
(progn (message "Read only text copied to kill ring") nil)
|
1997-11-19 21:36:56 +00:00
|
|
|
|
;; Signal an error if the buffer is read-only.
|
|
|
|
|
(barf-if-buffer-read-only)
|
|
|
|
|
;; If the buffer isn't read-only, the text is.
|
|
|
|
|
(signal 'text-read-only (list (current-buffer)))))))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
1994-11-09 22:10:55 +00:00
|
|
|
|
;; copy-region-as-kill no longer sets this-command, because it's confusing
|
|
|
|
|
;; to get two copies of the text when the user accidentally types M-w and
|
|
|
|
|
;; then corrects it with the intended C-w.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(defun copy-region-as-kill (beg end)
|
|
|
|
|
"Save the region as if killed, but don't kill it.
|
1997-12-21 01:52:31 +00:00
|
|
|
|
In Transient Mark mode, deactivate the mark.
|
1992-04-19 08:53:55 +00:00
|
|
|
|
If `interprogram-cut-function' is non-nil, also save the text for a window
|
|
|
|
|
system cut and paste."
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(interactive "r")
|
|
|
|
|
(if (eq last-command 'kill-region)
|
2005-03-29 20:53:19 +00:00
|
|
|
|
(kill-append (filter-buffer-substring beg end) (< end beg))
|
|
|
|
|
(kill-new (filter-buffer-substring beg end)))
|
1999-11-15 16:11:14 +00:00
|
|
|
|
(if transient-mark-mode
|
1998-03-16 08:01:15 +00:00
|
|
|
|
(setq deactivate-mark t))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
nil)
|
|
|
|
|
|
|
|
|
|
(defun kill-ring-save (beg end)
|
1993-03-11 07:07:17 +00:00
|
|
|
|
"Save the region as if killed, but don't kill it.
|
1997-12-21 01:52:31 +00:00
|
|
|
|
In Transient Mark mode, deactivate the mark.
|
1993-03-11 07:07:17 +00:00
|
|
|
|
If `interprogram-cut-function' is non-nil, also save the text for a window
|
1997-12-21 01:52:31 +00:00
|
|
|
|
system cut and paste.
|
|
|
|
|
|
2001-02-16 12:09:39 +00:00
|
|
|
|
If you want to append the killed line to the last killed text,
|
|
|
|
|
use \\[append-next-kill] before \\[kill-ring-save].
|
|
|
|
|
|
1997-12-21 01:52:31 +00:00
|
|
|
|
This command is similar to `copy-region-as-kill', except that it gives
|
|
|
|
|
visual feedback indicating the extent of the region being copied."
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(interactive "r")
|
|
|
|
|
(copy-region-as-kill beg end)
|
2004-11-08 16:59:43 +00:00
|
|
|
|
;; This use of interactive-p is correct
|
|
|
|
|
;; because the code it controls just gives the user visual feedback.
|
1992-07-22 04:22:42 +00:00
|
|
|
|
(if (interactive-p)
|
1993-05-17 21:52:21 +00:00
|
|
|
|
(let ((other-end (if (= (point) beg) end beg))
|
|
|
|
|
(opoint (point))
|
|
|
|
|
;; Inhibit quitting so we can make a quit here
|
|
|
|
|
;; look like a C-g typed as a command.
|
|
|
|
|
(inhibit-quit t))
|
|
|
|
|
(if (pos-visible-in-window-p other-end (selected-window))
|
2004-04-30 21:38:23 +00:00
|
|
|
|
(unless (and transient-mark-mode
|
|
|
|
|
(face-background 'region))
|
1993-05-17 21:52:21 +00:00
|
|
|
|
;; Swap point and mark.
|
|
|
|
|
(set-marker (mark-marker) (point) (current-buffer))
|
|
|
|
|
(goto-char other-end)
|
2004-04-27 06:45:49 +00:00
|
|
|
|
(sit-for blink-matching-delay)
|
1993-05-17 21:52:21 +00:00
|
|
|
|
;; Swap back.
|
|
|
|
|
(set-marker (mark-marker) other-end (current-buffer))
|
|
|
|
|
(goto-char opoint)
|
|
|
|
|
;; If user quit, deactivate the mark
|
|
|
|
|
;; as C-g would as a command.
|
1993-07-08 22:42:14 +00:00
|
|
|
|
(and quit-flag mark-active
|
1993-07-26 07:31:11 +00:00
|
|
|
|
(deactivate-mark)))
|
1993-05-17 21:52:21 +00:00
|
|
|
|
(let* ((killed-text (current-kill 0))
|
|
|
|
|
(message-len (min (length killed-text) 40)))
|
|
|
|
|
(if (= (point) beg)
|
|
|
|
|
;; Don't say "killed"; that is misleading.
|
|
|
|
|
(message "Saved text until \"%s\""
|
|
|
|
|
(substring killed-text (- message-len)))
|
|
|
|
|
(message "Saved text from \"%s\""
|
|
|
|
|
(substring killed-text 0 message-len))))))))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
1999-05-31 18:06:22 +00:00
|
|
|
|
(defun append-next-kill (&optional interactive)
|
|
|
|
|
"Cause following command, if it kills, to append to previous kill.
|
|
|
|
|
The argument is used for internal purposes; do not supply one."
|
|
|
|
|
(interactive "p")
|
|
|
|
|
;; We don't use (interactive-p), since that breaks kbd macros.
|
|
|
|
|
(if interactive
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(progn
|
|
|
|
|
(setq this-command 'kill-region)
|
|
|
|
|
(message "If the next command is a kill, it will append"))
|
|
|
|
|
(setq last-command 'kill-region)))
|
2002-04-19 00:05:22 +00:00
|
|
|
|
|
1999-08-16 20:42:38 +00:00
|
|
|
|
;; Yanking.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
2002-04-19 00:05:22 +00:00
|
|
|
|
;; This is actually used in subr.el but defcustom does not work there.
|
|
|
|
|
(defcustom yank-excluded-properties
|
2003-01-18 23:34:14 +00:00
|
|
|
|
'(read-only invisible intangible field mouse-face help-echo local-map keymap
|
2006-09-24 20:38:47 +00:00
|
|
|
|
yank-handler follow-link fontified)
|
2003-06-04 21:13:41 +00:00
|
|
|
|
"*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."
|
2002-04-19 00:05:22 +00:00
|
|
|
|
:type '(choice (const :tag "All" t) (repeat symbol))
|
2004-06-10 04:20:02 +00:00
|
|
|
|
:group 'killing
|
2005-02-09 15:50:47 +00:00
|
|
|
|
:version "22.1")
|
2002-04-19 00:05:22 +00:00
|
|
|
|
|
2002-11-29 15:09:37 +00:00
|
|
|
|
(defvar yank-window-start nil)
|
2003-01-18 23:34:14 +00:00
|
|
|
|
(defvar yank-undo-function nil
|
2003-01-21 21:11:12 +00:00
|
|
|
|
"If non-nil, function used by `yank-pop' to delete last stretch of yanked text.
|
|
|
|
|
Function is called with two parameters, START and END corresponding to
|
|
|
|
|
the value of the mark and point; it is guaranteed that START <= END.
|
|
|
|
|
Normally set from the UNDO element of a yank-handler; see `insert-for-yank'.")
|
2002-11-29 15:09:37 +00:00
|
|
|
|
|
2004-02-18 03:04:32 +00:00
|
|
|
|
(defun yank-pop (&optional arg)
|
1992-08-21 07:18:16 +00:00
|
|
|
|
"Replace just-yanked stretch of killed text with a different stretch.
|
|
|
|
|
This command is allowed only immediately after a `yank' or a `yank-pop'.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
At such a time, the region contains a stretch of reinserted
|
1992-08-21 07:18:16 +00:00
|
|
|
|
previously-killed text. `yank-pop' deletes that text and inserts in its
|
1991-12-21 09:29:41 +00:00
|
|
|
|
place a different stretch of killed text.
|
|
|
|
|
|
|
|
|
|
With no argument, the previous kill is inserted.
|
1992-08-21 07:18:16 +00:00
|
|
|
|
With argument N, insert the Nth previous kill.
|
|
|
|
|
If N is negative, this is a more recent kill.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
|
|
|
|
The sequence of kills wraps around, so that after the oldest one
|
2005-05-22 20:58:52 +00:00
|
|
|
|
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."
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(interactive "*p")
|
|
|
|
|
(if (not (eq last-command 'yank))
|
|
|
|
|
(error "Previous command was not a yank"))
|
|
|
|
|
(setq this-command 'yank)
|
2004-02-18 03:04:32 +00:00
|
|
|
|
(unless arg (setq arg 1))
|
1996-02-06 23:56:47 +00:00
|
|
|
|
(let ((inhibit-read-only t)
|
|
|
|
|
(before (< (point) (mark t))))
|
2003-01-18 23:59:12 +00:00
|
|
|
|
(if before
|
|
|
|
|
(funcall (or yank-undo-function 'delete-region) (point) (mark t))
|
|
|
|
|
(funcall (or yank-undo-function 'delete-region) (mark t) (point)))
|
2003-01-18 23:34:14 +00:00
|
|
|
|
(setq yank-undo-function nil)
|
1993-05-16 15:39:39 +00:00
|
|
|
|
(set-marker (mark-marker) (point) (current-buffer))
|
2002-04-19 00:05:22 +00:00
|
|
|
|
(insert-for-yank (current-kill arg))
|
2002-11-29 15:09:37 +00:00
|
|
|
|
;; Set the window start back where it was in the yank command,
|
|
|
|
|
;; if possible.
|
|
|
|
|
(set-window-start (selected-window) yank-window-start t)
|
1993-05-16 15:39:39 +00:00
|
|
|
|
(if before
|
|
|
|
|
;; This is like exchange-point-and-mark, but doesn't activate the mark.
|
|
|
|
|
;; It is cleaner to avoid activation, even though the command
|
|
|
|
|
;; loop would deactivate the mark because we inserted text.
|
|
|
|
|
(goto-char (prog1 (mark t)
|
|
|
|
|
(set-marker (mark-marker) (point) (current-buffer))))))
|
1993-03-11 07:07:17 +00:00
|
|
|
|
nil)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
|
|
|
|
(defun yank (&optional arg)
|
2006-03-11 17:01:47 +00:00
|
|
|
|
"Reinsert (\"paste\") the last stretch of killed text.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
More precisely, reinsert the stretch of killed text most recently
|
1992-08-21 07:18:16 +00:00
|
|
|
|
killed OR yanked. Put point at end, and set mark at beginning.
|
2002-09-09 22:09:14 +00:00
|
|
|
|
With just \\[universal-argument] as argument, same but put point at beginning (and mark at end).
|
1992-08-21 07:18:16 +00:00
|
|
|
|
With argument N, reinsert the Nth most recently killed stretch of killed
|
1991-12-21 09:29:41 +00:00
|
|
|
|
text.
|
2005-05-22 20:58:52 +00:00
|
|
|
|
|
|
|
|
|
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.
|
|
|
|
|
|
2006-11-01 23:11:08 +00:00
|
|
|
|
See also the command `yank-pop' (\\[yank-pop])."
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(interactive "*P")
|
2002-11-29 15:09:37 +00:00
|
|
|
|
(setq yank-window-start (window-start))
|
1994-02-13 00:16:23 +00:00
|
|
|
|
;; If we don't get all the way thru, make last-command indicate that
|
|
|
|
|
;; for the following command.
|
|
|
|
|
(setq this-command t)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(push-mark (point))
|
2002-04-19 00:05:22 +00:00
|
|
|
|
(insert-for-yank (current-kill (cond
|
|
|
|
|
((listp arg) 0)
|
2004-02-18 03:04:32 +00:00
|
|
|
|
((eq arg '-) -2)
|
2002-04-19 00:05:22 +00:00
|
|
|
|
(t (1- arg)))))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(if (consp arg)
|
1993-05-16 15:39:39 +00:00
|
|
|
|
;; This is like exchange-point-and-mark, but doesn't activate the mark.
|
|
|
|
|
;; It is cleaner to avoid activation, even though the command
|
|
|
|
|
;; loop would deactivate the mark because we inserted text.
|
|
|
|
|
(goto-char (prog1 (mark t)
|
|
|
|
|
(set-marker (mark-marker) (point) (current-buffer)))))
|
1994-02-13 00:16:23 +00:00
|
|
|
|
;; If we do get all the way thru, make this-command indicate that.
|
2003-01-18 23:34:14 +00:00
|
|
|
|
(if (eq this-command t)
|
|
|
|
|
(setq this-command 'yank))
|
1993-03-11 07:07:17 +00:00
|
|
|
|
nil)
|
1992-06-12 22:23:00 +00:00
|
|
|
|
|
|
|
|
|
(defun rotate-yank-pointer (arg)
|
|
|
|
|
"Rotate the yanking point in the kill ring.
|
|
|
|
|
With argument, rotate that many kills forward (or backward, if negative)."
|
|
|
|
|
(interactive "p")
|
|
|
|
|
(current-kill arg))
|
2002-03-29 23:16:11 +00:00
|
|
|
|
|
1999-08-16 20:42:38 +00:00
|
|
|
|
;; Some kill commands.
|
|
|
|
|
|
|
|
|
|
;; Internal subroutine of delete-char
|
|
|
|
|
(defun kill-forward-chars (arg)
|
|
|
|
|
(if (listp arg) (setq arg (car arg)))
|
|
|
|
|
(if (eq arg '-) (setq arg -1))
|
|
|
|
|
(kill-region (point) (forward-point arg)))
|
|
|
|
|
|
|
|
|
|
;; Internal subroutine of backward-delete-char
|
|
|
|
|
(defun kill-backward-chars (arg)
|
|
|
|
|
(if (listp arg) (setq arg (car arg)))
|
|
|
|
|
(if (eq arg '-) (setq arg -1))
|
|
|
|
|
(kill-region (point) (forward-point (- arg))))
|
|
|
|
|
|
|
|
|
|
(defcustom backward-delete-char-untabify-method 'untabify
|
|
|
|
|
"*The method for untabifying when deleting backward.
|
1999-11-15 16:11:14 +00:00
|
|
|
|
Can be `untabify' -- turn a tab to many spaces, then delete one space;
|
|
|
|
|
`hungry' -- delete all whitespace, both tabs and spaces;
|
|
|
|
|
`all' -- delete all whitespace, including tabs, spaces and newlines;
|
1999-08-16 20:42:38 +00:00
|
|
|
|
nil -- just delete one character."
|
1999-11-15 16:11:14 +00:00
|
|
|
|
:type '(choice (const untabify) (const hungry) (const all) (const nil))
|
2001-01-16 10:51:35 +00:00
|
|
|
|
:version "20.3"
|
1999-08-16 20:42:38 +00:00
|
|
|
|
:group 'killing)
|
|
|
|
|
|
|
|
|
|
(defun backward-delete-char-untabify (arg &optional killp)
|
|
|
|
|
"Delete characters backward, changing tabs into spaces.
|
|
|
|
|
The exact behavior depends on `backward-delete-char-untabify-method'.
|
|
|
|
|
Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
|
|
|
|
|
Interactively, ARG is the prefix arg (default 1)
|
|
|
|
|
and KILLP is t if a prefix arg was specified."
|
|
|
|
|
(interactive "*p\nP")
|
|
|
|
|
(when (eq backward-delete-char-untabify-method 'untabify)
|
|
|
|
|
(let ((count arg))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(while (and (> count 0) (not (bobp)))
|
|
|
|
|
(if (= (preceding-char) ?\t)
|
|
|
|
|
(let ((col (current-column)))
|
|
|
|
|
(forward-char -1)
|
|
|
|
|
(setq col (- col (current-column)))
|
(clone-indirect-buffer): Doc fix.
(fixup-whitespace, just-one-space, backward-delete-char-untabify, lambda):
"?\ " -> "?\s".
(next-error, next-error-highlight, next-error-highlight-no-select,
next-error-last-buffer, next-error-buffer-p, next-error-find-buffer, next-error,
previous-error, next-error-no-select, previous-error-no-select, open-line,
split-line, minibuffer-prompt-width, kill-new, binary-overwrite-mode):
Fix typos in docstrings.
(set-fill-column): Fix typo in message.
2005-07-20 22:29:53 +00:00
|
|
|
|
(insert-char ?\s col)
|
1999-08-16 20:42:38 +00:00
|
|
|
|
(delete-char 1)))
|
|
|
|
|
(forward-char -1)
|
|
|
|
|
(setq count (1- count))))))
|
|
|
|
|
(delete-backward-char
|
1999-11-15 16:11:14 +00:00
|
|
|
|
(let ((skip (cond ((eq backward-delete-char-untabify-method 'hungry) " \t")
|
|
|
|
|
((eq backward-delete-char-untabify-method 'all)
|
|
|
|
|
" \t\n\r"))))
|
|
|
|
|
(if skip
|
|
|
|
|
(let ((wh (- (point) (save-excursion (skip-chars-backward skip)
|
1999-08-16 20:42:38 +00:00
|
|
|
|
(point)))))
|
|
|
|
|
(+ arg (if (zerop wh) 0 (1- wh))))
|
1999-11-15 16:11:14 +00:00
|
|
|
|
arg))
|
1999-08-16 20:42:38 +00:00
|
|
|
|
killp))
|
|
|
|
|
|
|
|
|
|
(defun zap-to-char (arg char)
|
|
|
|
|
"Kill up to and including ARG'th occurrence of CHAR.
|
|
|
|
|
Case is ignored if `case-fold-search' is non-nil in the current buffer.
|
|
|
|
|
Goes backward if ARG is negative; error if CHAR not found."
|
2000-02-23 23:08:02 +00:00
|
|
|
|
(interactive "p\ncZap to char: ")
|
2005-12-10 01:12:25 +00:00
|
|
|
|
(if (char-table-p translation-table-for-input)
|
|
|
|
|
(setq char (or (aref translation-table-for-input char) char)))
|
1999-08-16 20:42:38 +00:00
|
|
|
|
(kill-region (point) (progn
|
|
|
|
|
(search-forward (char-to-string char) nil nil arg)
|
|
|
|
|
; (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
|
|
|
|
|
(point))))
|
2000-11-22 20:59:39 +00:00
|
|
|
|
|
1999-08-16 20:42:38 +00:00
|
|
|
|
;; kill-line and its subroutines.
|
|
|
|
|
|
|
|
|
|
(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.
|
|
|
|
|
With prefix argument, kill that many lines from point.
|
|
|
|
|
Negative arguments kill lines backward.
|
2000-10-08 06:10:40 +00:00
|
|
|
|
With zero argument, kills the text before point on the current line.
|
1999-08-16 20:42:38 +00:00
|
|
|
|
|
|
|
|
|
When calling from a program, nil means \"no arg\",
|
|
|
|
|
a number counts as a prefix arg.
|
|
|
|
|
|
|
|
|
|
To kill a whole line, when point is not at the beginning, type \
|
|
|
|
|
\\[beginning-of-line] \\[kill-line] \\[kill-line].
|
|
|
|
|
|
|
|
|
|
If `kill-whole-line' is non-nil, then this command kills the whole line
|
|
|
|
|
including its terminating newline, when used at the beginning of a line
|
|
|
|
|
with no argument. As a consequence, you can always kill a whole line
|
2001-02-06 06:54:56 +00:00
|
|
|
|
by typing \\[beginning-of-line] \\[kill-line].
|
|
|
|
|
|
2001-02-16 12:09:39 +00:00
|
|
|
|
If you want to append the killed line to the last killed text,
|
|
|
|
|
use \\[append-next-kill] before \\[kill-line].
|
|
|
|
|
|
2001-02-06 06:54:56 +00:00
|
|
|
|
If the buffer is read-only, Emacs will beep and refrain from deleting
|
|
|
|
|
the line, but put the line in the kill ring anyway. This means that
|
2003-04-21 01:35:20 +00:00
|
|
|
|
you can use this command to copy text from a read-only buffer.
|
|
|
|
|
\(If the variable `kill-read-only-ok' is non-nil, then this won't
|
|
|
|
|
even beep.)"
|
2000-02-23 23:08:02 +00:00
|
|
|
|
(interactive "P")
|
1999-08-16 20:42:38 +00:00
|
|
|
|
(kill-region (point)
|
|
|
|
|
;; It is better to move point to the other end of the kill
|
|
|
|
|
;; before killing. That way, in a read-only buffer, point
|
|
|
|
|
;; moves across the text that is copied to the kill ring.
|
|
|
|
|
;; The choice has no effect on undo now that undo records
|
|
|
|
|
;; the value of point from before the command was run.
|
|
|
|
|
(progn
|
|
|
|
|
(if arg
|
|
|
|
|
(forward-visible-line (prefix-numeric-value arg))
|
|
|
|
|
(if (eobp)
|
|
|
|
|
(signal 'end-of-buffer nil))
|
2002-09-01 13:29:34 +00:00
|
|
|
|
(let ((end
|
|
|
|
|
(save-excursion
|
|
|
|
|
(end-of-visible-line) (point))))
|
|
|
|
|
(if (or (save-excursion
|
2004-03-04 17:00:09 +00:00
|
|
|
|
;; If trailing whitespace is visible,
|
|
|
|
|
;; don't treat it as nothing.
|
|
|
|
|
(unless show-trailing-whitespace
|
|
|
|
|
(skip-chars-forward " \t" end))
|
2002-09-01 13:29:34 +00:00
|
|
|
|
(= (point) end))
|
|
|
|
|
(and kill-whole-line (bolp)))
|
|
|
|
|
(forward-visible-line 1)
|
|
|
|
|
(goto-char end))))
|
1999-08-16 20:42:38 +00:00
|
|
|
|
(point))))
|
|
|
|
|
|
2003-05-19 15:47:14 +00:00
|
|
|
|
(defun kill-whole-line (&optional arg)
|
|
|
|
|
"Kill current line.
|
2003-05-29 23:29:29 +00:00
|
|
|
|
With prefix arg, kill that many lines starting from the current line.
|
|
|
|
|
If arg is negative, kill backward. Also kill the preceding newline.
|
2005-06-20 10:29:02 +00:00
|
|
|
|
\(This is meant to make \\[repeat] work well with negative arguments.\)
|
2003-05-19 15:47:14 +00:00
|
|
|
|
If arg is zero, kill current line but exclude the trailing newline."
|
2004-05-01 20:10:19 +00:00
|
|
|
|
(interactive "p")
|
2003-05-29 23:29:29 +00:00
|
|
|
|
(if (and (> arg 0) (eobp) (save-excursion (forward-visible-line 0) (eobp)))
|
|
|
|
|
(signal 'end-of-buffer nil))
|
|
|
|
|
(if (and (< arg 0) (bobp) (save-excursion (end-of-visible-line) (bobp)))
|
|
|
|
|
(signal 'beginning-of-buffer nil))
|
|
|
|
|
(unless (eq last-command 'kill-region)
|
|
|
|
|
(kill-new "")
|
|
|
|
|
(setq last-command 'kill-region))
|
2003-05-19 15:47:14 +00:00
|
|
|
|
(cond ((zerop arg)
|
2003-05-29 23:29:29 +00:00
|
|
|
|
;; We need to kill in two steps, because the previous command
|
|
|
|
|
;; could have been a kill command, in which case the text
|
|
|
|
|
;; before point needs to be prepended to the current kill
|
|
|
|
|
;; ring entry and the text after point appended. Also, we
|
|
|
|
|
;; need to use save-excursion to avoid copying the same text
|
|
|
|
|
;; twice to the kill ring in read-only buffers.
|
|
|
|
|
(save-excursion
|
|
|
|
|
(kill-region (point) (progn (forward-visible-line 0) (point))))
|
2003-05-19 15:47:14 +00:00
|
|
|
|
(kill-region (point) (progn (end-of-visible-line) (point))))
|
|
|
|
|
((< arg 0)
|
2003-05-29 23:29:29 +00:00
|
|
|
|
(save-excursion
|
|
|
|
|
(kill-region (point) (progn (end-of-visible-line) (point))))
|
|
|
|
|
(kill-region (point)
|
|
|
|
|
(progn (forward-visible-line (1+ arg))
|
|
|
|
|
(unless (bobp) (backward-char))
|
|
|
|
|
(point))))
|
2003-05-19 15:47:14 +00:00
|
|
|
|
(t
|
2003-05-29 23:29:29 +00:00
|
|
|
|
(save-excursion
|
|
|
|
|
(kill-region (point) (progn (forward-visible-line 0) (point))))
|
|
|
|
|
(kill-region (point)
|
|
|
|
|
(progn (forward-visible-line arg) (point))))))
|
2002-09-09 00:27:30 +00:00
|
|
|
|
|
1999-08-16 20:42:38 +00:00
|
|
|
|
(defun forward-visible-line (arg)
|
|
|
|
|
"Move forward by ARG lines, ignoring currently invisible newlines only.
|
|
|
|
|
If ARG is negative, move backward -ARG lines.
|
|
|
|
|
If ARG is zero, move to the beginning of the current line."
|
|
|
|
|
(condition-case nil
|
|
|
|
|
(if (> arg 0)
|
2002-09-09 00:27:30 +00:00
|
|
|
|
(progn
|
|
|
|
|
(while (> arg 0)
|
1999-08-16 20:42:38 +00:00
|
|
|
|
(or (zerop (forward-line 1))
|
2002-09-09 00:27:30 +00:00
|
|
|
|
(signal 'end-of-buffer nil))
|
|
|
|
|
;; If the newline we just skipped is invisible,
|
|
|
|
|
;; don't count it.
|
|
|
|
|
(let ((prop
|
|
|
|
|
(get-char-property (1- (point)) 'invisible)))
|
|
|
|
|
(if (if (eq buffer-invisibility-spec t)
|
|
|
|
|
prop
|
|
|
|
|
(or (memq prop buffer-invisibility-spec)
|
|
|
|
|
(assq prop buffer-invisibility-spec)))
|
|
|
|
|
(setq arg (1+ arg))))
|
|
|
|
|
(setq arg (1- arg)))
|
|
|
|
|
;; If invisible text follows, and it is a number of complete lines,
|
|
|
|
|
;; skip it.
|
|
|
|
|
(let ((opoint (point)))
|
|
|
|
|
(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)))))
|
|
|
|
|
(goto-char
|
|
|
|
|
(if (get-text-property (point) 'invisible)
|
|
|
|
|
(or (next-single-property-change (point) 'invisible)
|
|
|
|
|
(point-max))
|
|
|
|
|
(next-overlay-change (point)))))
|
|
|
|
|
(unless (bolp)
|
|
|
|
|
(goto-char opoint))))
|
1999-08-16 20:42:38 +00:00
|
|
|
|
(let ((first t))
|
2003-05-25 01:34:37 +00:00
|
|
|
|
(while (or first (<= arg 0))
|
|
|
|
|
(if first
|
1999-08-16 20:42:38 +00:00
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(or (zerop (forward-line -1))
|
|
|
|
|
(signal 'beginning-of-buffer nil)))
|
2002-09-09 00:27:30 +00:00
|
|
|
|
;; If the newline we just moved to is invisible,
|
|
|
|
|
;; don't count it.
|
|
|
|
|
(unless (bobp)
|
|
|
|
|
(let ((prop
|
|
|
|
|
(get-char-property (1- (point)) 'invisible)))
|
2003-05-25 01:34:37 +00:00
|
|
|
|
(unless (if (eq buffer-invisibility-spec t)
|
|
|
|
|
prop
|
|
|
|
|
(or (memq prop buffer-invisibility-spec)
|
|
|
|
|
(assq prop buffer-invisibility-spec)))
|
|
|
|
|
(setq arg (1+ arg)))))
|
|
|
|
|
(setq first nil))
|
2002-09-09 00:27:30 +00:00
|
|
|
|
;; If invisible text follows, and it is a number of complete lines,
|
|
|
|
|
;; skip it.
|
|
|
|
|
(let ((opoint (point)))
|
1999-08-16 20:42:38 +00:00
|
|
|
|
(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)))))
|
|
|
|
|
(goto-char
|
|
|
|
|
(if (get-text-property (1- (point)) 'invisible)
|
|
|
|
|
(or (previous-single-property-change (point) 'invisible)
|
|
|
|
|
(point-min))
|
2002-09-09 00:27:30 +00:00
|
|
|
|
(previous-overlay-change (point)))))
|
|
|
|
|
(unless (bolp)
|
|
|
|
|
(goto-char opoint)))))
|
1999-08-16 20:42:38 +00:00
|
|
|
|
((beginning-of-buffer end-of-buffer)
|
|
|
|
|
nil)))
|
1992-06-12 22:23:00 +00:00
|
|
|
|
|
1999-08-16 20:42:38 +00:00
|
|
|
|
(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))
|
2002-09-01 13:29:34 +00:00
|
|
|
|
(save-excursion
|
|
|
|
|
(skip-chars-forward "^\n")
|
|
|
|
|
(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))))))
|
|
|
|
|
(skip-chars-forward "^\n")
|
1999-08-16 20:42:38 +00:00
|
|
|
|
(if (get-text-property (point) 'invisible)
|
|
|
|
|
(goto-char (next-single-property-change (point) 'invisible))
|
|
|
|
|
(goto-char (next-overlay-change (point))))
|
|
|
|
|
(end-of-line)))
|
2002-03-29 23:16:11 +00:00
|
|
|
|
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(defun insert-buffer (buffer)
|
|
|
|
|
"Insert after point the contents of BUFFER.
|
|
|
|
|
Puts mark after the inserted text.
|
1999-12-06 13:34:50 +00:00
|
|
|
|
BUFFER may be a buffer or a buffer name.
|
|
|
|
|
|
|
|
|
|
This function is meant for the user to run interactively.
|
2003-05-13 19:45:01 +00:00
|
|
|
|
Don't call it from programs: use `insert-buffer-substring' instead!"
|
1996-03-18 19:32:24 +00:00
|
|
|
|
(interactive
|
1996-03-18 18:50:25 +00:00
|
|
|
|
(list
|
|
|
|
|
(progn
|
|
|
|
|
(barf-if-buffer-read-only)
|
|
|
|
|
(read-buffer "Insert buffer: "
|
|
|
|
|
(if (eq (selected-window) (next-window (selected-window)))
|
|
|
|
|
(other-buffer (current-buffer))
|
|
|
|
|
(window-buffer (next-window (selected-window))))
|
|
|
|
|
t))))
|
2003-05-13 19:45:01 +00:00
|
|
|
|
(push-mark
|
|
|
|
|
(save-excursion
|
|
|
|
|
(insert-buffer-substring (get-buffer buffer))
|
|
|
|
|
(point)))
|
1993-03-02 07:33:17 +00:00
|
|
|
|
nil)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
|
|
|
|
(defun append-to-buffer (buffer start end)
|
|
|
|
|
"Append to specified buffer the text of the region.
|
|
|
|
|
It is inserted into that buffer before its point.
|
|
|
|
|
|
|
|
|
|
When calling from a program, give three arguments:
|
|
|
|
|
BUFFER (or buffer name), START and END.
|
|
|
|
|
START and END specify the portion of the current buffer to be copied."
|
1992-06-12 22:23:00 +00:00
|
|
|
|
(interactive
|
1994-11-22 19:19:42 +00:00
|
|
|
|
(list (read-buffer "Append to buffer: " (other-buffer (current-buffer) t))
|
1993-06-10 23:06:50 +00:00
|
|
|
|
(region-beginning) (region-end)))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(let ((oldbuf (current-buffer)))
|
|
|
|
|
(save-excursion
|
2000-03-17 22:33:28 +00:00
|
|
|
|
(let* ((append-to (get-buffer-create buffer))
|
|
|
|
|
(windows (get-buffer-window-list append-to t t))
|
|
|
|
|
point)
|
|
|
|
|
(set-buffer append-to)
|
|
|
|
|
(setq point (point))
|
|
|
|
|
(barf-if-buffer-read-only)
|
|
|
|
|
(insert-buffer-substring oldbuf start end)
|
|
|
|
|
(dolist (window windows)
|
|
|
|
|
(when (= (window-point window) point)
|
|
|
|
|
(set-window-point window (point))))))))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
|
|
|
|
(defun prepend-to-buffer (buffer start end)
|
|
|
|
|
"Prepend to specified buffer the text of the region.
|
|
|
|
|
It is inserted into that buffer after its point.
|
|
|
|
|
|
|
|
|
|
When calling from a program, give three arguments:
|
|
|
|
|
BUFFER (or buffer name), START and END.
|
|
|
|
|
START and END specify the portion of the current buffer to be copied."
|
|
|
|
|
(interactive "BPrepend to buffer: \nr")
|
|
|
|
|
(let ((oldbuf (current-buffer)))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(set-buffer (get-buffer-create buffer))
|
1999-07-20 16:09:54 +00:00
|
|
|
|
(barf-if-buffer-read-only)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(save-excursion
|
|
|
|
|
(insert-buffer-substring oldbuf start end)))))
|
|
|
|
|
|
|
|
|
|
(defun copy-to-buffer (buffer start end)
|
|
|
|
|
"Copy to specified buffer the text of the region.
|
|
|
|
|
It is inserted into that buffer, replacing existing text there.
|
|
|
|
|
|
|
|
|
|
When calling from a program, give three arguments:
|
|
|
|
|
BUFFER (or buffer name), START and END.
|
|
|
|
|
START and END specify the portion of the current buffer to be copied."
|
|
|
|
|
(interactive "BCopy to buffer: \nr")
|
|
|
|
|
(let ((oldbuf (current-buffer)))
|
2005-11-01 07:18:10 +00:00
|
|
|
|
(with-current-buffer (get-buffer-create buffer)
|
1999-07-20 16:09:54 +00:00
|
|
|
|
(barf-if-buffer-read-only)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(erase-buffer)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(insert-buffer-substring oldbuf start end)))))
|
2002-03-29 23:16:11 +00:00
|
|
|
|
|
1993-07-08 21:46:22 +00:00
|
|
|
|
(put 'mark-inactive 'error-conditions '(mark-inactive error))
|
|
|
|
|
(put 'mark-inactive 'error-message "The mark is not active now")
|
|
|
|
|
|
2005-03-06 20:16:01 +00:00
|
|
|
|
(defvar activate-mark-hook nil
|
|
|
|
|
"Hook run when the mark becomes active.
|
|
|
|
|
It is also run at the end of a command, if the mark is active and
|
|
|
|
|
it is possible that the region may have changed")
|
|
|
|
|
|
|
|
|
|
(defvar deactivate-mark-hook nil
|
|
|
|
|
"Hook run when the mark becomes inactive.")
|
|
|
|
|
|
1993-03-09 05:40:33 +00:00
|
|
|
|
(defun mark (&optional force)
|
2006-01-05 15:59:50 +00:00
|
|
|
|
"Return this buffer's mark value as integer, or nil if never set.
|
|
|
|
|
|
|
|
|
|
In Transient Mark mode, this function signals an error if
|
|
|
|
|
the mark is not active. However, if `mark-even-if-inactive' is non-nil,
|
|
|
|
|
or the argument FORCE is non-nil, it disregards whether the mark
|
|
|
|
|
is active, and returns an integer or nil in the usual way.
|
1993-03-09 05:40:33 +00:00
|
|
|
|
|
1991-12-21 09:29:41 +00:00
|
|
|
|
If you are using this in an editing command, you are most likely making
|
|
|
|
|
a mistake; see the documentation of `set-mark'."
|
1995-01-23 22:37:46 +00:00
|
|
|
|
(if (or force (not transient-mark-mode) mark-active mark-even-if-inactive)
|
1993-03-09 05:40:33 +00:00
|
|
|
|
(marker-position (mark-marker))
|
1993-07-08 21:46:22 +00:00
|
|
|
|
(signal 'mark-inactive nil)))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
1993-07-08 22:37:42 +00:00
|
|
|
|
;; Many places set mark-active directly, and several of them failed to also
|
|
|
|
|
;; run deactivate-mark-hook. This shorthand should simplify.
|
|
|
|
|
(defsubst deactivate-mark ()
|
|
|
|
|
"Deactivate the mark by setting `mark-active' to nil.
|
1993-07-26 07:31:11 +00:00
|
|
|
|
\(That makes a difference only in Transient Mark mode.)
|
1993-07-08 22:37:42 +00:00
|
|
|
|
Also runs the hook `deactivate-mark-hook'."
|
2002-04-14 17:27:55 +00:00
|
|
|
|
(cond
|
|
|
|
|
((eq transient-mark-mode 'lambda)
|
|
|
|
|
(setq transient-mark-mode nil))
|
|
|
|
|
(transient-mark-mode
|
|
|
|
|
(setq mark-active nil)
|
|
|
|
|
(run-hooks 'deactivate-mark-hook))))
|
1993-07-08 22:37:42 +00:00
|
|
|
|
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(defun set-mark (pos)
|
|
|
|
|
"Set this buffer's mark to POS. Don't use this function!
|
|
|
|
|
That is to say, don't use this function unless you want
|
|
|
|
|
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.
|
2005-03-29 23:17:30 +00:00
|
|
|
|
This is why most applications should use `push-mark', not `set-mark'.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
1992-08-21 07:18:16 +00:00
|
|
|
|
Novice Emacs Lisp programmers often try to use the mark for the wrong
|
1991-12-21 09:29:41 +00:00
|
|
|
|
purposes. The mark saves a location for the user's convenience.
|
|
|
|
|
Most editing commands should not alter the mark.
|
|
|
|
|
To remember a location for internal use in the Lisp program,
|
|
|
|
|
store it in a Lisp variable. Example:
|
|
|
|
|
|
|
|
|
|
(let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
|
|
|
|
|
|
1993-07-26 07:31:11 +00:00
|
|
|
|
(if pos
|
|
|
|
|
(progn
|
|
|
|
|
(setq mark-active t)
|
|
|
|
|
(run-hooks 'activate-mark-hook)
|
|
|
|
|
(set-marker (mark-marker) pos (current-buffer)))
|
1994-08-30 00:36:48 +00:00
|
|
|
|
;; Normally we never clear mark-active except in Transient Mark mode.
|
|
|
|
|
;; But when we actually clear out the mark value too,
|
|
|
|
|
;; we must clear mark-active in any mode.
|
|
|
|
|
(setq mark-active nil)
|
|
|
|
|
(run-hooks 'deactivate-mark-hook)
|
|
|
|
|
(set-marker (mark-marker) nil)))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
|
|
|
|
(defvar mark-ring nil
|
1994-09-03 23:33:50 +00:00
|
|
|
|
"The list of former marks of the current buffer, most recent first.")
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(make-variable-buffer-local 'mark-ring)
|
1994-09-03 23:33:50 +00:00
|
|
|
|
(put 'mark-ring 'permanent-local t)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
1997-05-05 11:57:31 +00:00
|
|
|
|
(defcustom mark-ring-max 16
|
|
|
|
|
"*Maximum size of mark ring. Start discarding off end if gets this big."
|
|
|
|
|
:type 'integer
|
|
|
|
|
:group 'editing-basics)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
1994-02-07 02:24:01 +00:00
|
|
|
|
(defvar global-mark-ring nil
|
|
|
|
|
"The list of saved global marks, most recent first.")
|
|
|
|
|
|
1997-05-05 11:57:31 +00:00
|
|
|
|
(defcustom global-mark-ring-max 16
|
1994-02-07 02:24:01 +00:00
|
|
|
|
"*Maximum size of global mark ring. \
|
1997-05-05 11:57:31 +00:00
|
|
|
|
Start discarding off end if gets this big."
|
|
|
|
|
:type 'integer
|
|
|
|
|
:group 'editing-basics)
|
1994-02-07 02:24:01 +00:00
|
|
|
|
|
2002-04-14 17:27:55 +00:00
|
|
|
|
(defun pop-to-mark-command ()
|
|
|
|
|
"Jump to mark, and pop a new position for mark off the ring
|
|
|
|
|
\(does not affect global mark ring\)."
|
|
|
|
|
(interactive)
|
|
|
|
|
(if (null (mark t))
|
|
|
|
|
(error "No mark set in this buffer")
|
|
|
|
|
(goto-char (mark t))
|
|
|
|
|
(pop-mark)))
|
|
|
|
|
|
2002-05-27 12:13:56 +00:00
|
|
|
|
(defun push-mark-command (arg &optional nomsg)
|
2002-04-14 17:27:55 +00:00
|
|
|
|
"Set mark at where point is.
|
2002-05-27 12:13:56 +00:00
|
|
|
|
If no prefix arg and mark is already set there, just activate it.
|
|
|
|
|
Display `Mark set' unless the optional second arg NOMSG is non-nil."
|
2002-04-14 17:27:55 +00:00
|
|
|
|
(interactive "P")
|
|
|
|
|
(let ((mark (marker-position (mark-marker))))
|
|
|
|
|
(if (or arg (null mark) (/= mark (point)))
|
2002-05-27 12:13:56 +00:00
|
|
|
|
(push-mark nil nomsg t)
|
2002-04-14 17:27:55 +00:00
|
|
|
|
(setq mark-active t)
|
2005-03-06 20:16:01 +00:00
|
|
|
|
(run-hooks 'activate-mark-hook)
|
2002-05-27 12:13:56 +00:00
|
|
|
|
(unless nomsg
|
|
|
|
|
(message "Mark activated")))))
|
2002-04-14 17:27:55 +00:00
|
|
|
|
|
2005-11-03 21:41:20 +00:00
|
|
|
|
(defcustom set-mark-command-repeat-pop nil
|
|
|
|
|
"*Non-nil means that repeating \\[set-mark-command] after popping will pop.
|
|
|
|
|
This means that if you type C-u \\[set-mark-command] \\[set-mark-command]
|
|
|
|
|
will pop twice."
|
|
|
|
|
:type 'boolean
|
|
|
|
|
:group 'editing)
|
|
|
|
|
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(defun set-mark-command (arg)
|
|
|
|
|
"Set mark at where point is, or jump to mark.
|
2003-03-21 23:49:23 +00:00
|
|
|
|
With no prefix argument, set mark, and push old mark position on local
|
|
|
|
|
mark ring; also push mark on global mark ring if last mark was set in
|
|
|
|
|
another buffer. Immediately repeating the command activates
|
|
|
|
|
`transient-mark-mode' temporarily.
|
|
|
|
|
|
|
|
|
|
With argument, e.g. \\[universal-argument] \\[set-mark-command], \
|
|
|
|
|
jump to mark, and pop a new position
|
|
|
|
|
for mark off the local mark ring \(this does not affect the global
|
|
|
|
|
mark ring\). Use \\[pop-global-mark] to jump to a mark off the global
|
|
|
|
|
mark ring \(see `pop-global-mark'\).
|
2003-03-24 11:00:39 +00:00
|
|
|
|
|
2006-01-20 01:22:07 +00:00
|
|
|
|
If `set-mark-command-repeat-pop' is non-nil, repeating
|
|
|
|
|
the \\[set-mark-command] command with no prefix pops the next position
|
|
|
|
|
off the local (or global) mark ring and jumps there.
|
2003-03-21 23:49:23 +00:00
|
|
|
|
|
|
|
|
|
With a double \\[universal-argument] prefix argument, e.g. \\[universal-argument] \
|
|
|
|
|
\\[universal-argument] \\[set-mark-command], unconditionally
|
|
|
|
|
set mark where point is.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
2006-03-20 15:08:28 +00:00
|
|
|
|
Setting the mark also sets the \"region\", which is the closest
|
|
|
|
|
equivalent in Emacs to what some editors call the \"selection\".
|
|
|
|
|
|
1992-08-21 07:18:16 +00:00
|
|
|
|
Novice Emacs Lisp programmers often try to use the mark for the wrong
|
1991-12-21 09:29:41 +00:00
|
|
|
|
purposes. See the documentation of `set-mark' for more information."
|
|
|
|
|
(interactive "P")
|
2002-04-14 17:27:55 +00:00
|
|
|
|
(if (eq transient-mark-mode 'lambda)
|
|
|
|
|
(setq transient-mark-mode nil))
|
|
|
|
|
(cond
|
2003-03-24 11:00:39 +00:00
|
|
|
|
((and (consp arg) (> (prefix-numeric-value arg) 4))
|
|
|
|
|
(push-mark-command nil))
|
2002-04-14 17:27:55 +00:00
|
|
|
|
((not (eq this-command 'set-mark-command))
|
2002-04-18 22:16:50 +00:00
|
|
|
|
(if arg
|
|
|
|
|
(pop-to-mark-command)
|
|
|
|
|
(push-mark-command t)))
|
2005-11-03 21:41:20 +00:00
|
|
|
|
((and set-mark-command-repeat-pop
|
|
|
|
|
(eq last-command 'pop-to-mark-command))
|
2003-03-21 23:49:23 +00:00
|
|
|
|
(setq this-command 'pop-to-mark-command)
|
|
|
|
|
(pop-to-mark-command))
|
2005-11-03 21:41:20 +00:00
|
|
|
|
((and set-mark-command-repeat-pop
|
|
|
|
|
(eq last-command 'pop-global-mark)
|
|
|
|
|
(not arg))
|
2003-03-21 23:49:23 +00:00
|
|
|
|
(setq this-command 'pop-global-mark)
|
|
|
|
|
(pop-global-mark))
|
2002-04-14 17:27:55 +00:00
|
|
|
|
(arg
|
2002-04-18 22:16:50 +00:00
|
|
|
|
(setq this-command 'pop-to-mark-command)
|
2002-04-14 17:27:55 +00:00
|
|
|
|
(pop-to-mark-command))
|
|
|
|
|
((and (eq last-command 'set-mark-command)
|
|
|
|
|
mark-active (null transient-mark-mode))
|
|
|
|
|
(setq transient-mark-mode 'lambda)
|
|
|
|
|
(message "Transient-mark-mode temporarily enabled"))
|
|
|
|
|
(t
|
|
|
|
|
(push-mark-command nil))))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
1993-05-16 15:39:39 +00:00
|
|
|
|
(defun push-mark (&optional location nomsg activate)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
"Set mark at LOCATION (point, by default) and push old mark on mark ring.
|
1994-02-07 04:48:18 +00:00
|
|
|
|
If the last global mark pushed was not in the current buffer,
|
|
|
|
|
also push LOCATION on the global mark ring.
|
1993-05-16 15:39:39 +00:00
|
|
|
|
Display `Mark set' unless the optional second arg NOMSG is non-nil.
|
1993-05-16 23:09:57 +00:00
|
|
|
|
In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
1992-08-21 07:18:16 +00:00
|
|
|
|
Novice Emacs Lisp programmers often try to use the mark for the wrong
|
1993-05-15 20:55:02 +00:00
|
|
|
|
purposes. See the documentation of `set-mark' for more information.
|
|
|
|
|
|
|
|
|
|
In Transient Mark mode, this does not activate the mark."
|
2003-07-25 12:18:04 +00:00
|
|
|
|
(unless (null (mark t))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
|
2003-07-25 12:18:04 +00:00
|
|
|
|
(when (> (length mark-ring) mark-ring-max)
|
|
|
|
|
(move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
|
|
|
|
|
(setcdr (nthcdr (1- mark-ring-max) mark-ring) nil)))
|
1993-05-15 20:55:02 +00:00
|
|
|
|
(set-marker (mark-marker) (or location (point)) (current-buffer))
|
1994-02-07 02:24:01 +00:00
|
|
|
|
;; Now push the mark on the global mark ring.
|
1994-02-07 04:48:18 +00:00
|
|
|
|
(if (and global-mark-ring
|
1994-02-07 18:40:13 +00:00
|
|
|
|
(eq (marker-buffer (car global-mark-ring)) (current-buffer)))
|
1994-02-07 04:48:18 +00:00
|
|
|
|
;; The last global mark pushed was in this same buffer.
|
|
|
|
|
;; Don't push another one.
|
|
|
|
|
nil
|
|
|
|
|
(setq global-mark-ring (cons (copy-marker (mark-marker)) global-mark-ring))
|
2003-07-25 12:18:04 +00:00
|
|
|
|
(when (> (length global-mark-ring) global-mark-ring-max)
|
|
|
|
|
(move-marker (car (nthcdr global-mark-ring-max global-mark-ring)) nil)
|
|
|
|
|
(setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil)))
|
1996-05-29 17:17:34 +00:00
|
|
|
|
(or nomsg executing-kbd-macro (> (minibuffer-depth) 0)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(message "Mark set"))
|
1993-05-16 23:09:57 +00:00
|
|
|
|
(if (or activate (not transient-mark-mode))
|
|
|
|
|
(set-mark (mark t)))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
nil)
|
|
|
|
|
|
|
|
|
|
(defun pop-mark ()
|
|
|
|
|
"Pop off mark ring into the buffer's actual mark.
|
|
|
|
|
Does not set point. Does nothing if mark ring is empty."
|
2003-07-25 12:18:04 +00:00
|
|
|
|
(when mark-ring
|
|
|
|
|
(setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
|
|
|
|
|
(set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
|
|
|
|
|
(move-marker (car mark-ring) nil)
|
|
|
|
|
(if (null (mark t)) (ding))
|
2005-01-12 00:42:57 +00:00
|
|
|
|
(setq mark-ring (cdr mark-ring)))
|
|
|
|
|
(deactivate-mark))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
1996-10-12 23:54:33 +00:00
|
|
|
|
(defalias 'exchange-dot-and-mark 'exchange-point-and-mark)
|
2002-04-14 17:27:55 +00:00
|
|
|
|
(defun exchange-point-and-mark (&optional arg)
|
1993-03-09 05:40:33 +00:00
|
|
|
|
"Put the mark where point is now, and point where the mark is now.
|
|
|
|
|
This command works even when the mark is not active,
|
2002-04-14 17:27:55 +00:00
|
|
|
|
and it reactivates the mark.
|
|
|
|
|
With prefix arg, `transient-mark-mode' is enabled temporarily."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(if arg
|
2003-02-04 12:29:42 +00:00
|
|
|
|
(if mark-active
|
2002-04-14 17:27:55 +00:00
|
|
|
|
(if (null transient-mark-mode)
|
|
|
|
|
(setq transient-mark-mode 'lambda))
|
|
|
|
|
(setq arg nil)))
|
|
|
|
|
(unless arg
|
|
|
|
|
(let ((omark (mark t)))
|
|
|
|
|
(if (null omark)
|
|
|
|
|
(error "No mark set in this buffer"))
|
|
|
|
|
(set-mark (point))
|
|
|
|
|
(goto-char omark)
|
|
|
|
|
nil)))
|
1993-05-15 18:47:18 +00:00
|
|
|
|
|
2002-09-11 20:46:33 +00:00
|
|
|
|
(define-minor-mode transient-mark-mode
|
1993-05-15 18:47:18 +00:00
|
|
|
|
"Toggle Transient Mark mode.
|
1993-05-21 17:26:48 +00:00
|
|
|
|
With arg, turn Transient Mark mode on if arg is positive, off otherwise.
|
1993-05-15 18:47:18 +00:00
|
|
|
|
|
1993-12-30 10:06:31 +00:00
|
|
|
|
In Transient Mark mode, when the mark is active, the region is highlighted.
|
|
|
|
|
Changing the buffer \"deactivates\" the mark.
|
|
|
|
|
So do certain other operations that set the mark
|
|
|
|
|
but whose main purpose is something else--for example,
|
2001-01-27 11:45:54 +00:00
|
|
|
|
incremental search, \\[beginning-of-buffer], and \\[end-of-buffer].
|
|
|
|
|
|
2001-03-30 11:37:52 +00:00
|
|
|
|
You can also deactivate the mark by typing \\[keyboard-quit] or
|
|
|
|
|
\\[keyboard-escape-quit].
|
2001-03-30 08:35:49 +00:00
|
|
|
|
|
2001-01-27 11:45:54 +00:00
|
|
|
|
Many commands change their behavior when Transient Mark mode is in effect
|
|
|
|
|
and the mark is active, by acting on the region instead of their usual
|
2001-01-27 17:15:58 +00:00
|
|
|
|
default part of the buffer's text. Examples of such commands include
|
2004-12-13 03:08:52 +00:00
|
|
|
|
\\[comment-dwim], \\[flush-lines], \\[keep-lines], \
|
|
|
|
|
\\[query-replace], \\[query-replace-regexp], \\[ispell], and \\[undo].
|
|
|
|
|
Invoke \\[apropos-documentation] and type \"transient\" or
|
|
|
|
|
\"mark.*active\" at the prompt, to see the documentation of
|
|
|
|
|
commands which are sensitive to the Transient Mark mode."
|
2005-12-02 03:31:21 +00:00
|
|
|
|
:global t :group 'editing-basics)
|
1994-02-07 02:24:01 +00:00
|
|
|
|
|
2005-05-01 18:54:00 +00:00
|
|
|
|
(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.")
|
|
|
|
|
|
1994-02-07 02:24:01 +00:00
|
|
|
|
(defun pop-global-mark ()
|
|
|
|
|
"Pop off global mark ring and jump to the top location."
|
|
|
|
|
(interactive)
|
1994-06-14 00:34:43 +00:00
|
|
|
|
;; Pop entries which refer to non-existent buffers.
|
|
|
|
|
(while (and global-mark-ring (not (marker-buffer (car global-mark-ring))))
|
|
|
|
|
(setq global-mark-ring (cdr global-mark-ring)))
|
1994-02-07 02:24:01 +00:00
|
|
|
|
(or global-mark-ring
|
|
|
|
|
(error "No global mark set"))
|
|
|
|
|
(let* ((marker (car global-mark-ring))
|
|
|
|
|
(buffer (marker-buffer marker))
|
|
|
|
|
(position (marker-position marker)))
|
1995-01-05 23:53:01 +00:00
|
|
|
|
(setq global-mark-ring (nconc (cdr global-mark-ring)
|
|
|
|
|
(list (car global-mark-ring))))
|
1994-02-07 02:24:01 +00:00
|
|
|
|
(set-buffer buffer)
|
|
|
|
|
(or (and (>= position (point-min))
|
|
|
|
|
(<= position (point-max)))
|
2005-05-01 18:54:00 +00:00
|
|
|
|
(if widen-automatically
|
2005-08-11 13:58:59 +00:00
|
|
|
|
(widen)
|
|
|
|
|
(error "Global mark position is outside accessible part of buffer")))
|
1994-02-07 02:24:01 +00:00
|
|
|
|
(goto-char position)
|
|
|
|
|
(switch-to-buffer buffer)))
|
2002-03-29 23:16:11 +00:00
|
|
|
|
|
2000-12-02 10:14:48 +00:00
|
|
|
|
(defcustom next-line-add-newlines nil
|
1997-05-05 11:57:31 +00:00
|
|
|
|
"*If non-nil, `next-line' inserts newline to avoid `end of buffer' error."
|
|
|
|
|
:type 'boolean
|
2001-01-16 12:13:43 +00:00
|
|
|
|
:version "21.1"
|
1997-05-05 11:57:31 +00:00
|
|
|
|
:group 'editing-basics)
|
1993-04-23 06:50:37 +00:00
|
|
|
|
|
2005-03-13 23:20:49 +00:00
|
|
|
|
(defun next-line (&optional arg try-vscroll)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
"Move cursor vertically down ARG lines.
|
2005-03-13 23:20:49 +00:00
|
|
|
|
Interactively, vscroll tall lines if `auto-window-vscroll' is enabled.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
If there is no character in the target line exactly under the current column,
|
|
|
|
|
the cursor is positioned after the character in that line which spans this
|
|
|
|
|
column, or at the end of the line if it is not long enough.
|
1993-04-23 06:50:37 +00:00
|
|
|
|
If there is no line in the buffer after this one, behavior depends on the
|
1994-12-23 17:25:50 +00:00
|
|
|
|
value of `next-line-add-newlines'. If non-nil, it inserts a newline character
|
|
|
|
|
to create a line, and moves the cursor to that line. Otherwise it moves the
|
1995-07-30 00:46:23 +00:00
|
|
|
|
cursor to the end of the buffer.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
|
|
|
|
The command \\[set-goal-column] can be used to create
|
1997-07-04 04:47:05 +00:00
|
|
|
|
a semipermanent goal column for this command.
|
|
|
|
|
Then instead of trying to move exactly vertically (or as close as possible),
|
|
|
|
|
this command moves to the specified goal column (or as close as possible).
|
|
|
|
|
The goal column is stored in the variable `goal-column', which is nil
|
|
|
|
|
when there is no goal column.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
|
|
|
|
If you are thinking of using this in a Lisp program, consider
|
|
|
|
|
using `forward-line' instead. It is usually easier to use
|
|
|
|
|
and more reliable (no dependence on goal column, etc.)."
|
2005-03-13 23:20:49 +00:00
|
|
|
|
(interactive "p\np")
|
2003-08-17 00:15:53 +00:00
|
|
|
|
(or arg (setq arg 1))
|
1994-01-26 17:19:32 +00:00
|
|
|
|
(if (and next-line-add-newlines (= arg 1))
|
2001-01-26 09:23:17 +00:00
|
|
|
|
(if (save-excursion (end-of-line) (eobp))
|
|
|
|
|
;; When adding a newline, don't expand an abbrev.
|
|
|
|
|
(let ((abbrev-mode nil))
|
2001-02-05 10:16:47 +00:00
|
|
|
|
(end-of-line)
|
2005-11-29 23:54:47 +00:00
|
|
|
|
(insert (if use-hard-newlines hard-newline "\n")))
|
2005-03-13 23:20:49 +00:00
|
|
|
|
(line-move arg nil nil try-vscroll))
|
1994-12-23 17:25:50 +00:00
|
|
|
|
(if (interactive-p)
|
|
|
|
|
(condition-case nil
|
2005-03-13 23:20:49 +00:00
|
|
|
|
(line-move arg nil nil try-vscroll)
|
1994-12-23 17:25:50 +00:00
|
|
|
|
((beginning-of-buffer end-of-buffer) (ding)))
|
2005-03-13 23:20:49 +00:00
|
|
|
|
(line-move arg nil nil try-vscroll)))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
nil)
|
|
|
|
|
|
2005-03-13 23:20:49 +00:00
|
|
|
|
(defun previous-line (&optional arg try-vscroll)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
"Move cursor vertically up ARG lines.
|
2005-03-13 23:20:49 +00:00
|
|
|
|
Interactively, vscroll tall lines if `auto-window-vscroll' is enabled.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
If there is no character in the target line exactly over the current column,
|
|
|
|
|
the cursor is positioned after the character in that line which spans this
|
|
|
|
|
column, or at the end of the line if it is not long enough.
|
|
|
|
|
|
|
|
|
|
The command \\[set-goal-column] can be used to create
|
1997-07-04 04:47:05 +00:00
|
|
|
|
a semipermanent goal column for this command.
|
|
|
|
|
Then instead of trying to move exactly vertically (or as close as possible),
|
|
|
|
|
this command moves to the specified goal column (or as close as possible).
|
|
|
|
|
The goal column is stored in the variable `goal-column', which is nil
|
|
|
|
|
when there is no goal column.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
|
|
|
|
If you are thinking of using this in a Lisp program, consider using
|
1992-11-07 06:13:23 +00:00
|
|
|
|
`forward-line' with a negative argument instead. It is usually easier
|
1991-12-21 09:29:41 +00:00
|
|
|
|
to use and more reliable (no dependence on goal column, etc.)."
|
2005-03-13 23:20:49 +00:00
|
|
|
|
(interactive "p\np")
|
2003-08-17 00:15:53 +00:00
|
|
|
|
(or arg (setq arg 1))
|
1994-12-23 17:25:50 +00:00
|
|
|
|
(if (interactive-p)
|
|
|
|
|
(condition-case nil
|
2005-03-13 23:20:49 +00:00
|
|
|
|
(line-move (- arg) nil nil try-vscroll)
|
1994-12-23 17:25:50 +00:00
|
|
|
|
((beginning-of-buffer end-of-buffer) (ding)))
|
2005-03-13 23:20:49 +00:00
|
|
|
|
(line-move (- arg) nil nil try-vscroll))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
nil)
|
2000-11-22 20:59:39 +00:00
|
|
|
|
|
1997-05-05 11:57:31 +00:00
|
|
|
|
(defcustom track-eol nil
|
1991-12-21 09:29:41 +00:00
|
|
|
|
"*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.
|
1997-05-05 11:57:31 +00:00
|
|
|
|
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)
|
1992-10-23 08:54:08 +00:00
|
|
|
|
(make-variable-buffer-local 'goal-column)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
|
|
|
|
(defvar temporary-goal-column 0
|
|
|
|
|
"Current goal column for vertical motion.
|
|
|
|
|
It is the column where point was
|
|
|
|
|
at the start of current run of vertical motion commands.
|
1992-01-27 22:52:05 +00:00
|
|
|
|
When the `track-eol' feature is doing its job, the value is 9999.")
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
2004-11-08 16:59:43 +00:00
|
|
|
|
(defcustom line-move-ignore-invisible t
|
1995-03-10 03:27:46 +00:00
|
|
|
|
"*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines.
|
1997-05-05 11:57:31 +00:00
|
|
|
|
Outline mode sets this."
|
|
|
|
|
:type 'boolean
|
|
|
|
|
:group 'editing-basics)
|
1995-03-10 03:27:46 +00:00
|
|
|
|
|
2004-11-08 16:59:43 +00:00
|
|
|
|
(defun line-move-invisible-p (pos)
|
2001-12-28 05:15:59 +00:00
|
|
|
|
"Return non-nil if the character after POS is currently invisible."
|
|
|
|
|
(let ((prop
|
|
|
|
|
(get-char-property pos 'invisible)))
|
|
|
|
|
(if (eq buffer-invisibility-spec t)
|
|
|
|
|
prop
|
|
|
|
|
(or (memq prop buffer-invisibility-spec)
|
|
|
|
|
(assq prop buffer-invisibility-spec)))))
|
|
|
|
|
|
2006-09-05 22:52:29 +00:00
|
|
|
|
;; Returns non-nil if partial move was done.
|
|
|
|
|
(defun line-move-partial (arg noerror to-end)
|
|
|
|
|
(if (< arg 0)
|
|
|
|
|
;; Move backward (up).
|
|
|
|
|
;; If already vscrolled, reduce vscroll
|
|
|
|
|
(let ((vs (window-vscroll nil t)))
|
|
|
|
|
(when (> vs (frame-char-height))
|
|
|
|
|
(set-window-vscroll nil (- vs (frame-char-height)) t)))
|
|
|
|
|
|
|
|
|
|
;; Move forward (down).
|
2006-09-18 11:13:04 +00:00
|
|
|
|
(let* ((lh (window-line-height -1))
|
|
|
|
|
(vpos (nth 1 lh))
|
|
|
|
|
(ypos (nth 2 lh))
|
|
|
|
|
(rbot (nth 3 lh))
|
|
|
|
|
ppos py vs)
|
|
|
|
|
(when (or (null lh)
|
|
|
|
|
(>= rbot (frame-char-height))
|
|
|
|
|
(<= ypos (- (frame-char-height))))
|
|
|
|
|
(unless lh
|
2006-09-20 09:45:19 +00:00
|
|
|
|
(let ((wend (pos-visible-in-window-p t nil t)))
|
|
|
|
|
(setq rbot (nth 3 wend)
|
|
|
|
|
vpos (nth 5 wend))))
|
2006-09-18 11:13:04 +00:00
|
|
|
|
(cond
|
|
|
|
|
;; If last line of window is fully visible, move forward.
|
|
|
|
|
((or (null rbot) (= rbot 0))
|
|
|
|
|
nil)
|
|
|
|
|
;; If cursor is not in the bottom scroll margin, move forward.
|
|
|
|
|
((and (> vpos 0)
|
2006-09-19 13:13:49 +00:00
|
|
|
|
(< (setq py
|
|
|
|
|
(or (nth 1 (window-line-height))
|
|
|
|
|
(let ((ppos (posn-at-point)))
|
|
|
|
|
(cdr (or (posn-actual-col-row ppos)
|
|
|
|
|
(posn-col-row ppos))))))
|
2006-09-18 11:13:04 +00:00
|
|
|
|
(min (- (window-text-height) scroll-margin 1) (1- vpos))))
|
|
|
|
|
nil)
|
|
|
|
|
;; When already vscrolled, we vscroll some more if we can,
|
|
|
|
|
;; or clear vscroll and move forward at end of tall image.
|
|
|
|
|
((> (setq vs (window-vscroll nil t)) 0)
|
|
|
|
|
(when (> rbot 0)
|
|
|
|
|
(set-window-vscroll nil (+ vs (min rbot (frame-char-height))) t)))
|
|
|
|
|
;; If cursor just entered the bottom scroll margin, move forward,
|
|
|
|
|
;; but also vscroll one line so redisplay wont recenter.
|
|
|
|
|
((and (> vpos 0)
|
|
|
|
|
(= py (min (- (window-text-height) scroll-margin 1)
|
|
|
|
|
(1- vpos))))
|
|
|
|
|
(set-window-vscroll nil (frame-char-height) t)
|
|
|
|
|
(line-move-1 arg noerror to-end)
|
|
|
|
|
t)
|
|
|
|
|
;; If there are lines above the last line, scroll-up one line.
|
|
|
|
|
((> vpos 0)
|
|
|
|
|
(scroll-up 1)
|
|
|
|
|
t)
|
|
|
|
|
;; Finally, start vscroll.
|
|
|
|
|
(t
|
|
|
|
|
(set-window-vscroll nil (frame-char-height) t)))))))
|
2006-09-05 22:52:29 +00:00
|
|
|
|
|
|
|
|
|
|
2005-06-08 15:35:05 +00:00
|
|
|
|
;; 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.
|
2005-02-19 23:30:29 +00:00
|
|
|
|
(defun line-move (arg &optional noerror to-end try-vscroll)
|
2006-09-05 22:52:29 +00:00
|
|
|
|
(unless (and auto-window-vscroll try-vscroll
|
|
|
|
|
;; Only vscroll for single line moves
|
|
|
|
|
(= (abs arg) 1)
|
|
|
|
|
;; But don't vscroll in a keyboard macro.
|
|
|
|
|
(not defining-kbd-macro)
|
|
|
|
|
(not executing-kbd-macro)
|
|
|
|
|
(line-move-partial arg noerror to-end))
|
|
|
|
|
(set-window-vscroll nil 0 t)
|
2005-01-22 01:44:56 +00:00
|
|
|
|
(line-move-1 arg noerror to-end)))
|
|
|
|
|
|
1995-04-09 09:34:05 +00:00
|
|
|
|
;; This is the guts of next-line and previous-line.
|
|
|
|
|
;; Arg says how many lines to move.
|
2004-11-08 16:59:43 +00:00
|
|
|
|
;; The value is t if we can move the specified number of lines.
|
2005-01-22 01:44:56 +00:00
|
|
|
|
(defun line-move-1 (arg &optional noerror to-end)
|
1995-04-18 07:01:34 +00:00
|
|
|
|
;; Don't run any point-motion hooks, and disregard intangibility,
|
|
|
|
|
;; for intermediate positions.
|
|
|
|
|
(let ((inhibit-point-motion-hooks t)
|
|
|
|
|
(opoint (point))
|
2006-09-19 21:34:01 +00:00
|
|
|
|
(orig-arg arg))
|
1995-04-18 07:01:34 +00:00
|
|
|
|
(unwind-protect
|
|
|
|
|
(progn
|
2002-04-11 23:44:06 +00:00
|
|
|
|
(if (not (memq last-command '(next-line previous-line)))
|
1995-04-18 07:01:34 +00:00
|
|
|
|
(setq temporary-goal-column
|
|
|
|
|
(if (and track-eol (eolp)
|
|
|
|
|
;; Don't count beg of empty line as end of line
|
|
|
|
|
;; unless we just did explicit end-of-line.
|
2006-06-21 12:01:57 +00:00
|
|
|
|
(or (not (bolp)) (eq last-command 'move-end-of-line)))
|
1995-04-18 07:01:34 +00:00
|
|
|
|
9999
|
|
|
|
|
(current-column))))
|
2004-11-08 16:59:43 +00:00
|
|
|
|
|
1995-04-18 07:01:34 +00:00
|
|
|
|
(if (and (not (integerp selective-display))
|
|
|
|
|
(not line-move-ignore-invisible))
|
|
|
|
|
;; Use just newline characters.
|
2002-01-13 04:02:49 +00:00
|
|
|
|
;; Set ARG to 0 if we move as many lines as requested.
|
1995-04-18 07:01:34 +00:00
|
|
|
|
(or (if (> arg 0)
|
|
|
|
|
(progn (if (> arg 1) (forward-line (1- arg)))
|
|
|
|
|
;; This way of moving forward ARG lines
|
|
|
|
|
;; verifies that we have a newline after the last one.
|
|
|
|
|
;; It doesn't get confused by intangible text.
|
|
|
|
|
(end-of-line)
|
2002-01-13 04:02:49 +00:00
|
|
|
|
(if (zerop (forward-line 1))
|
|
|
|
|
(setq arg 0)))
|
1995-04-18 07:01:34 +00:00
|
|
|
|
(and (zerop (forward-line arg))
|
2002-01-13 04:02:49 +00:00
|
|
|
|
(bolp)
|
|
|
|
|
(setq arg 0)))
|
2004-11-08 16:59:43 +00:00
|
|
|
|
(unless noerror
|
|
|
|
|
(signal (if (< arg 0)
|
|
|
|
|
'beginning-of-buffer
|
|
|
|
|
'end-of-buffer)
|
|
|
|
|
nil)))
|
1995-04-18 07:01:34 +00:00
|
|
|
|
;; Move by arg lines, but ignore invisible ones.
|
2006-09-19 21:34:01 +00:00
|
|
|
|
(let (done line-end)
|
2004-11-08 16:59:43 +00:00
|
|
|
|
(while (and (> arg 0) (not done))
|
|
|
|
|
;; If the following character is currently invisible,
|
|
|
|
|
;; skip all characters with that same `invisible' property value.
|
|
|
|
|
(while (and (not (eobp)) (line-move-invisible-p (point)))
|
|
|
|
|
(goto-char (next-char-property-change (point))))
|
2006-09-19 21:34:01 +00:00
|
|
|
|
;; Move a line.
|
|
|
|
|
;; We don't use `end-of-line', since we want to escape
|
|
|
|
|
;; from field boundaries ocurring exactly at point.
|
|
|
|
|
(let ((inhibit-field-text-motion t))
|
|
|
|
|
(setq line-end (line-end-position)))
|
|
|
|
|
(goto-char (constrain-to-field line-end (point) t t))
|
2005-04-26 18:31:19 +00:00
|
|
|
|
;; If there's no invisibility here, move over the newline.
|
2005-07-13 13:45:30 +00:00
|
|
|
|
(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))))
|
2004-11-08 16:59:43 +00:00
|
|
|
|
(unless done
|
|
|
|
|
(setq arg (1- arg))))
|
2005-05-05 22:43:06 +00:00
|
|
|
|
;; The logic of this is the same as the loop above,
|
2005-04-26 18:31:19 +00:00
|
|
|
|
;; it just goes in the other direction.
|
2004-11-08 16:59:43 +00:00
|
|
|
|
(while (and (< arg 0) (not done))
|
2006-10-18 04:58:29 +00:00
|
|
|
|
;; For completely consistency with the forward-motion
|
|
|
|
|
;; case, we should call beginning-of-line here.
|
|
|
|
|
;; However, if point is inside a field and on a
|
|
|
|
|
;; continued line, the call to (vertical-motion -1)
|
|
|
|
|
;; below won't move us back far enough; then we return
|
|
|
|
|
;; to the same column in line-move-finish, and point
|
|
|
|
|
;; gets stuck -- cyd
|
|
|
|
|
(forward-line 0)
|
2005-07-13 13:45:30 +00:00
|
|
|
|
(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))))
|
2004-11-08 16:59:43 +00:00
|
|
|
|
(unless done
|
|
|
|
|
(setq arg (1+ arg))
|
|
|
|
|
(while (and ;; Don't move over previous invis lines
|
|
|
|
|
;; if our target is the middle of this line.
|
|
|
|
|
(or (zerop (or goal-column temporary-goal-column))
|
|
|
|
|
(< arg 0))
|
|
|
|
|
(not (bobp)) (line-move-invisible-p (1- (point))))
|
|
|
|
|
(goto-char (previous-char-property-change (point))))))))
|
|
|
|
|
;; This is the value the function returns.
|
|
|
|
|
(= arg 0))
|
2001-12-28 05:15:59 +00:00
|
|
|
|
|
2002-01-13 04:02:49 +00:00
|
|
|
|
(cond ((> arg 0)
|
|
|
|
|
;; If we did not move down as far as desired,
|
|
|
|
|
;; at least go to end of line.
|
|
|
|
|
(end-of-line))
|
|
|
|
|
((< arg 0)
|
2005-07-22 18:43:24 +00:00
|
|
|
|
;; If we did not move up as far as desired,
|
|
|
|
|
;; at least go to beginning of line.
|
2002-01-13 04:02:49 +00:00
|
|
|
|
(beginning-of-line))
|
|
|
|
|
(t
|
2004-11-20 19:08:45 +00:00
|
|
|
|
(line-move-finish (or goal-column temporary-goal-column)
|
2006-09-19 21:34:01 +00:00
|
|
|
|
opoint (> orig-arg 0)))))))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
2004-11-20 19:08:45 +00:00
|
|
|
|
(defun line-move-finish (column opoint forward)
|
2001-12-28 05:15:59 +00:00
|
|
|
|
(let ((repeat t))
|
|
|
|
|
(while repeat
|
|
|
|
|
;; Set REPEAT to t to repeat the whole thing.
|
|
|
|
|
(setq repeat nil)
|
|
|
|
|
|
2002-04-22 22:35:46 +00:00
|
|
|
|
(let (new
|
2006-09-24 21:58:12 +00:00
|
|
|
|
(old (point))
|
2001-12-28 05:15:59 +00:00
|
|
|
|
(line-beg (save-excursion (beginning-of-line) (point)))
|
2002-04-22 22:35:46 +00:00
|
|
|
|
(line-end
|
|
|
|
|
;; Compute the end of the line
|
2004-11-20 19:08:45 +00:00
|
|
|
|
;; ignoring effectively invisible newlines.
|
2004-11-08 16:59:43 +00:00
|
|
|
|
(save-excursion
|
2005-10-23 18:26:38 +00:00
|
|
|
|
;; Like end-of-line but ignores fields.
|
|
|
|
|
(skip-chars-forward "^\n")
|
2004-11-20 19:08:45 +00:00
|
|
|
|
(while (and (not (eobp)) (line-move-invisible-p (point)))
|
|
|
|
|
(goto-char (next-char-property-change (point)))
|
2005-10-23 18:26:38 +00:00
|
|
|
|
(skip-chars-forward "^\n"))
|
2004-11-08 16:59:43 +00:00
|
|
|
|
(point))))
|
2002-04-22 22:35:46 +00:00
|
|
|
|
|
|
|
|
|
;; Move to the desired column.
|
|
|
|
|
(line-move-to-column column)
|
2006-09-24 21:58:12 +00:00
|
|
|
|
|
|
|
|
|
;; Corner case: suppose we start out in a field boundary in
|
|
|
|
|
;; the middle of a continued line. When we get to
|
|
|
|
|
;; line-move-finish, point is at the start of a new *screen*
|
|
|
|
|
;; line but the same text line; then line-move-to-column would
|
|
|
|
|
;; move us backwards. Test using C-n with point on the "x" in
|
|
|
|
|
;; (insert "a" (propertize "x" 'field t) (make-string 89 ?y))
|
|
|
|
|
(and forward
|
|
|
|
|
(< (point) old)
|
|
|
|
|
(goto-char old))
|
|
|
|
|
|
2002-04-22 22:35:46 +00:00
|
|
|
|
(setq new (point))
|
2001-12-28 05:15:59 +00:00
|
|
|
|
|
|
|
|
|
;; Process intangibility within a line.
|
2006-05-23 00:49:55 +00:00
|
|
|
|
;; With inhibit-point-motion-hooks bound to nil, a call to
|
|
|
|
|
;; goto-char moves point past intangible text.
|
|
|
|
|
|
|
|
|
|
;; However, inhibit-point-motion-hooks controls both the
|
|
|
|
|
;; intangibility and the point-entered/point-left hooks. The
|
|
|
|
|
;; following hack avoids calling the point-* hooks
|
|
|
|
|
;; unnecessarily. Note that we move *forward* past intangible
|
|
|
|
|
;; text when the initial and final points are the same.
|
2006-05-12 17:39:59 +00:00
|
|
|
|
(goto-char new)
|
2006-05-12 17:48:40 +00:00
|
|
|
|
(let ((inhibit-point-motion-hooks nil))
|
|
|
|
|
(goto-char new)
|
|
|
|
|
|
|
|
|
|
;; If intangibility moves us to a different (later) place
|
|
|
|
|
;; in the same line, use that as the destination.
|
|
|
|
|
(if (<= (point) line-end)
|
2002-04-22 22:35:46 +00:00
|
|
|
|
(setq new (point))
|
2006-05-12 17:48:40 +00:00
|
|
|
|
;; If that position is "too late",
|
|
|
|
|
;; try the previous allowable position.
|
|
|
|
|
;; See if it is ok.
|
|
|
|
|
(backward-char)
|
|
|
|
|
(if (if forward
|
|
|
|
|
;; If going forward, don't accept the previous
|
|
|
|
|
;; allowable position if it is before the target line.
|
|
|
|
|
(< line-beg (point))
|
|
|
|
|
;; If going backward, don't accept the previous
|
|
|
|
|
;; allowable position if it is still after the target line.
|
|
|
|
|
(<= (point) line-end))
|
|
|
|
|
(setq new (point))
|
|
|
|
|
;; As a last resort, use the end of the line.
|
|
|
|
|
(setq new line-end))))
|
2001-12-28 05:15:59 +00:00
|
|
|
|
|
|
|
|
|
;; Now move to the updated destination, processing fields
|
|
|
|
|
;; as well as intangibility.
|
|
|
|
|
(goto-char opoint)
|
|
|
|
|
(let ((inhibit-point-motion-hooks nil))
|
|
|
|
|
(goto-char
|
2006-09-29 18:18:42 +00:00
|
|
|
|
;; Ignore field boundaries if the initial and final
|
|
|
|
|
;; positions have the same `field' property, even if the
|
|
|
|
|
;; fields are non-contiguous. This seems to be "nicer"
|
|
|
|
|
;; behavior in many situations.
|
|
|
|
|
(if (eq (get-char-property new 'field)
|
|
|
|
|
(get-char-property opoint 'field))
|
|
|
|
|
new
|
|
|
|
|
(constrain-to-field new opoint t t
|
|
|
|
|
'inhibit-line-move-field-capture))))
|
2001-12-28 05:15:59 +00:00
|
|
|
|
|
2002-04-22 22:35:46 +00:00
|
|
|
|
;; If all this moved us to a different line,
|
2001-12-28 05:15:59 +00:00
|
|
|
|
;; retry everything within that new line.
|
|
|
|
|
(when (or (< (point) line-beg) (> (point) line-end))
|
|
|
|
|
;; Repeat the intangibility and field processing.
|
|
|
|
|
(setq repeat t))))))
|
|
|
|
|
|
|
|
|
|
(defun line-move-to-column (col)
|
|
|
|
|
"Try to find column COL, considering invisibility.
|
|
|
|
|
This function works only in certain cases,
|
|
|
|
|
because what we really need is for `move-to-column'
|
|
|
|
|
and `current-column' to be able to ignore invisible text."
|
2002-03-28 18:27:23 +00:00
|
|
|
|
(if (zerop col)
|
|
|
|
|
(beginning-of-line)
|
2006-09-16 14:14:53 +00:00
|
|
|
|
(move-to-column col))
|
2001-12-28 05:15:59 +00:00
|
|
|
|
|
|
|
|
|
(when (and line-move-ignore-invisible
|
2004-11-08 16:59:43 +00:00
|
|
|
|
(not (bolp)) (line-move-invisible-p (1- (point))))
|
2001-12-28 05:15:59 +00:00
|
|
|
|
(let ((normal-location (point))
|
|
|
|
|
(normal-column (current-column)))
|
|
|
|
|
;; If the following character is currently invisible,
|
|
|
|
|
;; skip all characters with that same `invisible' property value.
|
|
|
|
|
(while (and (not (eobp))
|
2004-11-08 16:59:43 +00:00
|
|
|
|
(line-move-invisible-p (point)))
|
2001-12-28 05:15:59 +00:00
|
|
|
|
(goto-char (next-char-property-change (point))))
|
|
|
|
|
;; Have we advanced to a larger column position?
|
|
|
|
|
(if (> (current-column) normal-column)
|
|
|
|
|
;; We have made some progress towards the desired column.
|
|
|
|
|
;; See if we can make any further progress.
|
|
|
|
|
(line-move-to-column (+ (current-column) (- col normal-column)))
|
|
|
|
|
;; Otherwise, go to the place we originally found
|
|
|
|
|
;; and move back over invisible text.
|
|
|
|
|
;; that will get us to the same place on the screen
|
|
|
|
|
;; but with a more reasonable buffer position.
|
|
|
|
|
(goto-char normal-location)
|
|
|
|
|
(let ((line-beg (save-excursion (beginning-of-line) (point))))
|
2004-11-08 16:59:43 +00:00
|
|
|
|
(while (and (not (bolp)) (line-move-invisible-p (1- (point))))
|
2001-12-28 05:15:59 +00:00
|
|
|
|
(goto-char (previous-char-property-change (point) line-beg))))))))
|
|
|
|
|
|
2004-11-08 16:59:43 +00:00
|
|
|
|
(defun move-end-of-line (arg)
|
2006-01-05 15:59:50 +00:00
|
|
|
|
"Move point to end of current line as displayed.
|
|
|
|
|
\(If there's an image in the line, this disregards newlines
|
|
|
|
|
which are part of the text that the image rests on.)
|
|
|
|
|
|
2004-11-08 16:59:43 +00:00
|
|
|
|
With argument ARG not nil or 1, move forward ARG - 1 lines first.
|
|
|
|
|
If point reaches the beginning or end of buffer, it stops there.
|
2006-01-05 15:59:50 +00:00
|
|
|
|
To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
|
2004-11-08 16:59:43 +00:00
|
|
|
|
(interactive "p")
|
|
|
|
|
(or arg (setq arg 1))
|
|
|
|
|
(let (done)
|
|
|
|
|
(while (not done)
|
|
|
|
|
(let ((newpos
|
|
|
|
|
(save-excursion
|
|
|
|
|
(let ((goal-column 0))
|
|
|
|
|
(and (line-move arg t)
|
|
|
|
|
(not (bobp))
|
|
|
|
|
(progn
|
|
|
|
|
(while (and (not (bobp)) (line-move-invisible-p (1- (point))))
|
|
|
|
|
(goto-char (previous-char-property-change (point))))
|
|
|
|
|
(backward-char 1)))
|
|
|
|
|
(point)))))
|
|
|
|
|
(goto-char newpos)
|
|
|
|
|
(if (and (> (point) newpos)
|
|
|
|
|
(eq (preceding-char) ?\n))
|
|
|
|
|
(backward-char 1)
|
|
|
|
|
(if (and (> (point) newpos) (not (eobp))
|
|
|
|
|
(not (eq (following-char) ?\n)))
|
|
|
|
|
;; If we skipped something intangible
|
|
|
|
|
;; and now we're not really at eol,
|
|
|
|
|
;; keep going.
|
|
|
|
|
(setq arg 1)
|
|
|
|
|
(setq done t)))))))
|
|
|
|
|
|
2005-03-07 11:12:31 +00:00
|
|
|
|
(defun move-beginning-of-line (arg)
|
2006-01-05 15:59:50 +00:00
|
|
|
|
"Move point to beginning of current line as displayed.
|
|
|
|
|
\(If there's an image in the line, this disregards newlines
|
|
|
|
|
which are part of the text that the image rests on.)
|
|
|
|
|
|
2005-03-07 11:12:31 +00:00
|
|
|
|
With argument ARG not nil or 1, move forward ARG - 1 lines first.
|
|
|
|
|
If point reaches the beginning or end of buffer, it stops there.
|
2006-01-05 15:59:50 +00:00
|
|
|
|
To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
|
2005-03-07 11:12:31 +00:00
|
|
|
|
(interactive "p")
|
|
|
|
|
(or arg (setq arg 1))
|
2006-04-09 23:03:48 +00:00
|
|
|
|
|
2006-08-16 05:07:22 +00:00
|
|
|
|
(let ((orig (point))
|
|
|
|
|
start first-vis first-vis-field-value)
|
2006-01-26 17:56:54 +00:00
|
|
|
|
|
|
|
|
|
;; Move by lines, if ARG is not 1 (the default).
|
|
|
|
|
(if (/= arg 1)
|
|
|
|
|
(line-move (1- arg) t))
|
|
|
|
|
|
|
|
|
|
;; Move to beginning-of-line, ignoring fields and invisibles.
|
|
|
|
|
(skip-chars-backward "^\n")
|
|
|
|
|
(while (and (not (bobp)) (line-move-invisible-p (1- (point))))
|
2006-02-02 04:21:10 +00:00
|
|
|
|
(goto-char (previous-char-property-change (point)))
|
2006-01-26 17:56:54 +00:00
|
|
|
|
(skip-chars-backward "^\n"))
|
2006-08-16 05:07:22 +00:00
|
|
|
|
(setq start (point))
|
|
|
|
|
|
|
|
|
|
;; Now find first visible char in the line
|
|
|
|
|
(while (and (not (eobp)) (line-move-invisible-p (point)))
|
|
|
|
|
(goto-char (next-char-property-change (point))))
|
|
|
|
|
(setq first-vis (point))
|
|
|
|
|
|
|
|
|
|
;; See if fields would stop us from reaching FIRST-VIS.
|
|
|
|
|
(setq first-vis-field-value
|
|
|
|
|
(constrain-to-field first-vis orig (/= arg 1) t nil))
|
|
|
|
|
|
|
|
|
|
(goto-char (if (/= first-vis-field-value first-vis)
|
|
|
|
|
;; If yes, obey them.
|
|
|
|
|
first-vis-field-value
|
|
|
|
|
;; Otherwise, move to START with attention to fields.
|
|
|
|
|
;; (It is possible that fields never matter in this case.)
|
|
|
|
|
(constrain-to-field (point) orig
|
|
|
|
|
(/= arg 1) t nil)))))
|
2005-03-07 11:12:31 +00:00
|
|
|
|
|
|
|
|
|
|
1993-01-14 14:50:16 +00:00
|
|
|
|
;;; Many people have said they rarely use this feature, and often type
|
|
|
|
|
;;; it by accident. Maybe it shouldn't even be on a key.
|
|
|
|
|
(put 'set-goal-column 'disabled t)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
|
|
|
|
(defun set-goal-column (arg)
|
|
|
|
|
"Set the current horizontal position as a goal for \\[next-line] and \\[previous-line].
|
|
|
|
|
Those commands will move to this position in the line moved to
|
|
|
|
|
rather than trying to keep the same horizontal position.
|
|
|
|
|
With a non-nil argument, clears out the goal column
|
1992-10-23 08:54:08 +00:00
|
|
|
|
so that \\[next-line] and \\[previous-line] resume vertical motion.
|
|
|
|
|
The goal column is stored in the variable `goal-column'."
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(interactive "P")
|
|
|
|
|
(if arg
|
|
|
|
|
(progn
|
|
|
|
|
(setq goal-column nil)
|
|
|
|
|
(message "No goal column"))
|
|
|
|
|
(setq goal-column (current-column))
|
2005-09-18 12:25:02 +00:00
|
|
|
|
;; 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"
|
2005-11-12 00:10:56 +00:00
|
|
|
|
(concat
|
2005-09-18 12:25:02 +00:00
|
|
|
|
(format "Goal column %d " goal-column)
|
|
|
|
|
(substitute-command-keys
|
|
|
|
|
"(use \\[set-goal-column] with an arg to unset it)")))
|
2005-11-12 00:10:56 +00:00
|
|
|
|
|
2005-09-18 12:25:02 +00:00
|
|
|
|
)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
nil)
|
2002-03-29 23:16:11 +00:00
|
|
|
|
|
1994-06-22 05:16:22 +00:00
|
|
|
|
|
|
|
|
|
(defun scroll-other-window-down (lines)
|
1995-07-30 00:46:23 +00:00
|
|
|
|
"Scroll the \"other window\" down.
|
|
|
|
|
For more details, see the documentation for `scroll-other-window'."
|
1994-06-22 05:16:22 +00:00
|
|
|
|
(interactive "P")
|
|
|
|
|
(scroll-other-window
|
|
|
|
|
;; Just invert the argument's meaning.
|
|
|
|
|
;; We can do that without knowing which window it will be.
|
|
|
|
|
(if (eq lines '-) nil
|
|
|
|
|
(if (null lines) '-
|
|
|
|
|
(- (prefix-numeric-value lines))))))
|
1994-06-25 18:58:42 +00:00
|
|
|
|
|
|
|
|
|
(defun beginning-of-buffer-other-window (arg)
|
|
|
|
|
"Move point to the beginning of the buffer in the other window.
|
|
|
|
|
Leave mark at previous position.
|
|
|
|
|
With arg N, put point N/10 of the way from the true beginning."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(let ((orig-window (selected-window))
|
|
|
|
|
(window (other-window-for-scrolling)))
|
|
|
|
|
;; We use unwind-protect rather than save-window-excursion
|
|
|
|
|
;; because the latter would preserve the things we want to change.
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(progn
|
|
|
|
|
(select-window window)
|
|
|
|
|
;; Set point and mark in that window's buffer.
|
2004-11-08 16:59:43 +00:00
|
|
|
|
(with-no-warnings
|
|
|
|
|
(beginning-of-buffer arg))
|
1994-06-25 18:58:42 +00:00
|
|
|
|
;; Set point accordingly.
|
|
|
|
|
(recenter '(t)))
|
|
|
|
|
(select-window orig-window))))
|
|
|
|
|
|
|
|
|
|
(defun end-of-buffer-other-window (arg)
|
|
|
|
|
"Move point to the end of the buffer in the other window.
|
|
|
|
|
Leave mark at previous position.
|
|
|
|
|
With arg N, put point N/10 of the way from the true end."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
;; See beginning-of-buffer-other-window for comments.
|
|
|
|
|
(let ((orig-window (selected-window))
|
|
|
|
|
(window (other-window-for-scrolling)))
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(progn
|
|
|
|
|
(select-window window)
|
2004-11-08 16:59:43 +00:00
|
|
|
|
(with-no-warnings
|
|
|
|
|
(end-of-buffer arg))
|
1994-06-25 18:58:42 +00:00
|
|
|
|
(recenter '(t)))
|
|
|
|
|
(select-window orig-window))))
|
2002-03-29 23:16:11 +00:00
|
|
|
|
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(defun transpose-chars (arg)
|
|
|
|
|
"Interchange characters around point, moving forward one character.
|
|
|
|
|
With prefix arg ARG, effect is to take character before point
|
|
|
|
|
and drag it forward past ARG other characters (backward if ARG negative).
|
|
|
|
|
If no argument and at end of line, the previous two chars are exchanged."
|
|
|
|
|
(interactive "*P")
|
|
|
|
|
(and (null arg) (eolp) (forward-char -1))
|
|
|
|
|
(transpose-subr 'forward-char (prefix-numeric-value arg)))
|
|
|
|
|
|
|
|
|
|
(defun transpose-words (arg)
|
|
|
|
|
"Interchange words around point, leaving point at end of them.
|
|
|
|
|
With prefix arg ARG, effect is to take word before or around point
|
|
|
|
|
and drag it forward past ARG other words (backward if ARG negative).
|
|
|
|
|
If ARG is zero, the words around or after point and around or after mark
|
|
|
|
|
are interchanged."
|
2002-04-11 23:44:06 +00:00
|
|
|
|
;; FIXME: `foo a!nd bar' should transpose into `bar and foo'.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(interactive "*p")
|
|
|
|
|
(transpose-subr 'forward-word arg))
|
|
|
|
|
|
|
|
|
|
(defun transpose-sexps (arg)
|
|
|
|
|
"Like \\[transpose-words] but applies to sexps.
|
|
|
|
|
Does not work on a sexp that point is in the middle of
|
|
|
|
|
if it is a list or string."
|
|
|
|
|
(interactive "*p")
|
2002-04-11 23:44:06 +00:00
|
|
|
|
(transpose-subr
|
|
|
|
|
(lambda (arg)
|
|
|
|
|
;; Here we should try to simulate the behavior of
|
|
|
|
|
;; (cons (progn (forward-sexp x) (point))
|
|
|
|
|
;; (progn (forward-sexp (- x)) (point)))
|
|
|
|
|
;; Except that we don't want to rely on the second forward-sexp
|
|
|
|
|
;; putting us back to where we want to be, since forward-sexp-function
|
|
|
|
|
;; might do funny things like infix-precedence.
|
|
|
|
|
(if (if (> arg 0)
|
|
|
|
|
(looking-at "\\sw\\|\\s_")
|
|
|
|
|
(and (not (bobp))
|
|
|
|
|
(save-excursion (forward-char -1) (looking-at "\\sw\\|\\s_"))))
|
|
|
|
|
;; Jumping over a symbol. We might be inside it, mind you.
|
|
|
|
|
(progn (funcall (if (> arg 0)
|
|
|
|
|
'skip-syntax-backward 'skip-syntax-forward)
|
|
|
|
|
"w_")
|
|
|
|
|
(cons (save-excursion (forward-sexp arg) (point)) (point)))
|
|
|
|
|
;; Otherwise, we're between sexps. Take a step back before jumping
|
|
|
|
|
;; to make sure we'll obey the same precedence no matter which direction
|
|
|
|
|
;; we're going.
|
|
|
|
|
(funcall (if (> arg 0) 'skip-syntax-backward 'skip-syntax-forward) " .")
|
|
|
|
|
(cons (save-excursion (forward-sexp arg) (point))
|
|
|
|
|
(progn (while (or (forward-comment (if (> arg 0) 1 -1))
|
|
|
|
|
(not (zerop (funcall (if (> arg 0)
|
|
|
|
|
'skip-syntax-forward
|
|
|
|
|
'skip-syntax-backward)
|
|
|
|
|
".")))))
|
|
|
|
|
(point)))))
|
|
|
|
|
arg 'special))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
|
|
|
|
(defun transpose-lines (arg)
|
|
|
|
|
"Exchange current line and previous line, leaving point after both.
|
|
|
|
|
With argument ARG, takes previous line and moves it past ARG lines.
|
|
|
|
|
With argument 0, interchanges line point is in with line mark is in."
|
|
|
|
|
(interactive "*p")
|
|
|
|
|
(transpose-subr (function
|
|
|
|
|
(lambda (arg)
|
1997-12-17 13:54:03 +00:00
|
|
|
|
(if (> arg 0)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(progn
|
1997-12-17 13:54:03 +00:00
|
|
|
|
;; Move forward over ARG lines,
|
|
|
|
|
;; but create newlines if necessary.
|
|
|
|
|
(setq arg (forward-line arg))
|
|
|
|
|
(if (/= (preceding-char) ?\n)
|
|
|
|
|
(setq arg (1+ arg)))
|
|
|
|
|
(if (> arg 0)
|
|
|
|
|
(newline arg)))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(forward-line arg))))
|
|
|
|
|
arg))
|
|
|
|
|
|
2001-10-31 00:57:04 +00:00
|
|
|
|
(defun transpose-subr (mover arg &optional special)
|
|
|
|
|
(let ((aux (if special mover
|
|
|
|
|
(lambda (x)
|
|
|
|
|
(cons (progn (funcall mover x) (point))
|
|
|
|
|
(progn (funcall mover (- x)) (point))))))
|
|
|
|
|
pos1 pos2)
|
|
|
|
|
(cond
|
|
|
|
|
((= arg 0)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(setq pos1 (funcall aux 1))
|
|
|
|
|
(goto-char (mark))
|
|
|
|
|
(setq pos2 (funcall aux 1))
|
|
|
|
|
(transpose-subr-1 pos1 pos2))
|
|
|
|
|
(exchange-point-and-mark))
|
|
|
|
|
((> arg 0)
|
|
|
|
|
(setq pos1 (funcall aux -1))
|
|
|
|
|
(setq pos2 (funcall aux arg))
|
|
|
|
|
(transpose-subr-1 pos1 pos2)
|
|
|
|
|
(goto-char (car pos2)))
|
|
|
|
|
(t
|
|
|
|
|
(setq pos1 (funcall aux -1))
|
|
|
|
|
(goto-char (car pos1))
|
|
|
|
|
(setq pos2 (funcall aux arg))
|
|
|
|
|
(transpose-subr-1 pos1 pos2)))))
|
|
|
|
|
|
|
|
|
|
(defun transpose-subr-1 (pos1 pos2)
|
|
|
|
|
(when (> (car pos1) (cdr pos1)) (setq pos1 (cons (cdr pos1) (car pos1))))
|
|
|
|
|
(when (> (car pos2) (cdr pos2)) (setq pos2 (cons (cdr pos2) (car pos2))))
|
|
|
|
|
(when (> (car pos1) (car pos2))
|
|
|
|
|
(let ((swap pos1))
|
|
|
|
|
(setq pos1 pos2 pos2 swap)))
|
|
|
|
|
(if (> (cdr pos1) (car pos2)) (error "Don't have two things to transpose"))
|
2002-02-06 15:08:45 +00:00
|
|
|
|
(atomic-change-group
|
|
|
|
|
(let (word2)
|
2003-05-13 19:45:01 +00:00
|
|
|
|
;; FIXME: We first delete the two pieces of text, so markers that
|
|
|
|
|
;; used to point to after the text end up pointing to before it :-(
|
2002-02-06 15:08:45 +00:00
|
|
|
|
(setq word2 (delete-and-extract-region (car pos2) (cdr pos2)))
|
|
|
|
|
(goto-char (car pos2))
|
|
|
|
|
(insert (delete-and-extract-region (car pos1) (cdr pos1)))
|
|
|
|
|
(goto-char (car pos1))
|
|
|
|
|
(insert word2))))
|
2002-03-29 23:16:11 +00:00
|
|
|
|
|
2003-08-17 00:15:53 +00:00
|
|
|
|
(defun backward-word (&optional arg)
|
2001-09-04 08:37:35 +00:00
|
|
|
|
"Move backward until encountering the beginning of a word.
|
2000-10-06 18:13:28 +00:00
|
|
|
|
With argument, do this that many times."
|
1994-02-03 23:48:59 +00:00
|
|
|
|
(interactive "p")
|
2003-08-17 00:15:53 +00:00
|
|
|
|
(forward-word (- (or arg 1))))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
2004-12-29 01:33:04 +00:00
|
|
|
|
(defun mark-word (&optional arg allow-extend)
|
2004-12-13 03:08:52 +00:00
|
|
|
|
"Set mark ARG words away from point.
|
|
|
|
|
The place mark goes is the same place \\[forward-word] would
|
|
|
|
|
move to with the same argument.
|
2004-12-29 01:33:04 +00:00
|
|
|
|
Interactively, if this command is repeated
|
2005-01-06 22:00:36 +00:00
|
|
|
|
or (in Transient Mark mode) if the mark is active,
|
2004-12-13 03:08:52 +00:00
|
|
|
|
it marks the next ARG words after the ones already marked."
|
2004-12-29 01:33:04 +00:00
|
|
|
|
(interactive "P\np")
|
|
|
|
|
(cond ((and allow-extend
|
|
|
|
|
(or (and (eq last-command this-command) (mark t))
|
|
|
|
|
(and transient-mark-mode mark-active)))
|
2004-12-13 03:08:52 +00:00
|
|
|
|
(setq arg (if arg (prefix-numeric-value arg)
|
|
|
|
|
(if (< (mark) (point)) -1 1)))
|
2002-02-15 08:53:15 +00:00
|
|
|
|
(set-mark
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char (mark))
|
|
|
|
|
(forward-word arg)
|
|
|
|
|
(point))))
|
|
|
|
|
(t
|
|
|
|
|
(push-mark
|
|
|
|
|
(save-excursion
|
2004-12-13 03:08:52 +00:00
|
|
|
|
(forward-word (prefix-numeric-value arg))
|
2002-02-15 08:53:15 +00:00
|
|
|
|
(point))
|
|
|
|
|
nil t))))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
|
|
|
|
(defun kill-word (arg)
|
|
|
|
|
"Kill characters forward until encountering the end of a word.
|
|
|
|
|
With argument, do this that many times."
|
2000-02-23 23:08:02 +00:00
|
|
|
|
(interactive "p")
|
1999-08-25 21:12:15 +00:00
|
|
|
|
(kill-region (point) (progn (forward-word arg) (point))))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
|
|
|
|
(defun backward-kill-word (arg)
|
|
|
|
|
"Kill characters backward until encountering the end of a word.
|
|
|
|
|
With argument, do this that many times."
|
2000-02-23 23:08:02 +00:00
|
|
|
|
(interactive "p")
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(kill-word (- arg)))
|
1993-03-29 04:58:31 +00:00
|
|
|
|
|
2003-07-07 21:00:26 +00:00
|
|
|
|
(defun current-word (&optional strict really-word)
|
|
|
|
|
"Return the symbol or word that point is on (or a nearby one) as a string.
|
|
|
|
|
The return value includes no text properties.
|
1994-03-03 18:27:51 +00:00
|
|
|
|
If optional arg STRICT is non-nil, return nil unless point is within
|
2004-07-09 16:08:17 +00:00
|
|
|
|
or adjacent to a symbol or word. In all cases the value can be nil
|
|
|
|
|
if there is no word nearby.
|
2003-07-07 21:00:26 +00:00
|
|
|
|
The function, belying its name, normally finds a symbol.
|
|
|
|
|
If optional arg REALLY-WORD is non-nil, it finds just a word."
|
1993-03-29 04:58:31 +00:00
|
|
|
|
(save-excursion
|
2003-07-07 21:00:26 +00:00
|
|
|
|
(let* ((oldpoint (point)) (start (point)) (end (point))
|
2003-07-18 22:46:08 +00:00
|
|
|
|
(syntaxes (if really-word "w" "w_"))
|
2003-07-07 21:00:26 +00:00
|
|
|
|
(not-syntaxes (concat "^" syntaxes)))
|
|
|
|
|
(skip-syntax-backward syntaxes) (setq start (point))
|
1993-03-29 04:58:31 +00:00
|
|
|
|
(goto-char oldpoint)
|
2003-07-07 21:00:26 +00:00
|
|
|
|
(skip-syntax-forward syntaxes) (setq end (point))
|
|
|
|
|
(when (and (eq start oldpoint) (eq end oldpoint)
|
|
|
|
|
;; Point is neither within nor adjacent to a word.
|
|
|
|
|
(not strict))
|
|
|
|
|
;; Look for preceding word in same line.
|
|
|
|
|
(skip-syntax-backward not-syntaxes
|
|
|
|
|
(save-excursion (beginning-of-line)
|
|
|
|
|
(point)))
|
|
|
|
|
(if (bolp)
|
|
|
|
|
;; No preceding word in same line.
|
|
|
|
|
;; Look for following word in same line.
|
|
|
|
|
(progn
|
|
|
|
|
(skip-syntax-forward not-syntaxes
|
|
|
|
|
(save-excursion (end-of-line)
|
|
|
|
|
(point)))
|
|
|
|
|
(setq start (point))
|
|
|
|
|
(skip-syntax-forward syntaxes)
|
|
|
|
|
(setq end (point)))
|
|
|
|
|
(setq end (point))
|
|
|
|
|
(skip-syntax-backward syntaxes)
|
|
|
|
|
(setq start (point))))
|
|
|
|
|
;; If we found something nonempty, return it as a string.
|
|
|
|
|
(unless (= start end)
|
1997-06-22 09:16:07 +00:00
|
|
|
|
(buffer-substring-no-properties start end)))))
|
2002-03-29 23:16:11 +00:00
|
|
|
|
|
1997-05-05 11:57:31 +00:00
|
|
|
|
(defcustom fill-prefix nil
|
2001-10-31 00:57:04 +00:00
|
|
|
|
"*String for filling to insert at front of new line, or nil for none."
|
1997-05-05 11:57:31 +00:00
|
|
|
|
:type '(choice (const :tag "None" nil)
|
|
|
|
|
string)
|
|
|
|
|
:group 'fill)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(make-variable-buffer-local 'fill-prefix)
|
2006-05-11 15:01:41 +00:00
|
|
|
|
;;;###autoload(put 'fill-prefix 'safe-local-variable 'string-or-null-p)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
1997-05-05 11:57:31 +00:00
|
|
|
|
(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)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
2000-11-22 19:47:30 +00:00
|
|
|
|
(defvar comment-line-break-function 'comment-indent-new-line
|
1997-08-05 06:07:24 +00:00
|
|
|
|
"*Mode-specific function which line breaks and continues a comment.
|
|
|
|
|
|
|
|
|
|
This function is only called during auto-filling of a comment section.
|
|
|
|
|
The function should take a single optional argument, which is a flag
|
2005-06-20 13:53:49 +00:00
|
|
|
|
indicating whether it should use soft newlines.")
|
1997-08-05 06:07:24 +00:00
|
|
|
|
|
1998-03-09 06:36:42 +00:00
|
|
|
|
;; This function is used as the auto-fill-function of a buffer
|
1996-05-21 14:31:40 +00:00
|
|
|
|
;; when Auto-Fill mode is enabled.
|
|
|
|
|
;; It returns t if it really did any work.
|
1998-03-09 06:36:42 +00:00
|
|
|
|
;; (Actually some major modes use a different auto-fill function,
|
|
|
|
|
;; but this one is the default one.)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(defun do-auto-fill ()
|
2004-05-19 19:10:19 +00:00
|
|
|
|
(let (fc justify give-up
|
1995-07-28 02:38:16 +00:00
|
|
|
|
(fill-prefix fill-prefix))
|
1995-01-19 04:26:55 +00:00
|
|
|
|
(if (or (not (setq justify (current-justification)))
|
1995-06-29 03:18:29 +00:00
|
|
|
|
(null (setq fc (current-fill-column)))
|
|
|
|
|
(and (eq justify 'left)
|
|
|
|
|
(<= (current-column) fc))
|
2004-05-19 19:10:19 +00:00
|
|
|
|
(and auto-fill-inhibit-regexp
|
|
|
|
|
(save-excursion (beginning-of-line)
|
1995-01-19 04:21:56 +00:00
|
|
|
|
(looking-at auto-fill-inhibit-regexp))))
|
|
|
|
|
nil ;; Auto-filling not required
|
1995-02-23 18:38:42 +00:00
|
|
|
|
(if (memq justify '(full center right))
|
|
|
|
|
(save-excursion (unjustify-current-line)))
|
1995-07-28 02:38:16 +00:00
|
|
|
|
|
|
|
|
|
;; Choose a fill-prefix automatically.
|
2001-10-31 00:57:04 +00:00
|
|
|
|
(when (and adaptive-fill-mode
|
|
|
|
|
(or (null fill-prefix) (string= fill-prefix "")))
|
|
|
|
|
(let ((prefix
|
|
|
|
|
(fill-context-prefix
|
|
|
|
|
(save-excursion (backward-paragraph 1) (point))
|
|
|
|
|
(save-excursion (forward-paragraph 1) (point)))))
|
|
|
|
|
(and prefix (not (equal prefix ""))
|
|
|
|
|
;; Use auto-indentation rather than a guessed empty prefix.
|
2002-09-10 01:24:12 +00:00
|
|
|
|
(not (and fill-indent-according-to-mode
|
2002-09-09 22:09:14 +00:00
|
|
|
|
(string-match "\\`[ \t]*\\'" prefix)))
|
2001-10-31 00:57:04 +00:00
|
|
|
|
(setq fill-prefix prefix))))
|
2003-02-04 12:29:42 +00:00
|
|
|
|
|
1995-01-19 04:21:56 +00:00
|
|
|
|
(while (and (not give-up) (> (current-column) fc))
|
1995-07-30 00:46:23 +00:00
|
|
|
|
;; Determine where to split the line.
|
1997-08-14 03:55:49 +00:00
|
|
|
|
(let* (after-prefix
|
|
|
|
|
(fill-point
|
2004-05-19 19:10:19 +00:00
|
|
|
|
(save-excursion
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(setq after-prefix (point))
|
|
|
|
|
(and fill-prefix
|
|
|
|
|
(looking-at (regexp-quote fill-prefix))
|
|
|
|
|
(setq after-prefix (match-end 0)))
|
|
|
|
|
(move-to-column (1+ fc))
|
|
|
|
|
(fill-move-to-break-point after-prefix)
|
|
|
|
|
(point))))
|
1997-08-14 03:55:49 +00:00
|
|
|
|
|
|
|
|
|
;; See whether the place we found is any good.
|
1995-07-30 00:46:23 +00:00
|
|
|
|
(if (save-excursion
|
|
|
|
|
(goto-char fill-point)
|
2002-04-11 23:44:06 +00:00
|
|
|
|
(or (bolp)
|
|
|
|
|
;; There is no use breaking at end of line.
|
|
|
|
|
(save-excursion (skip-chars-forward " ") (eolp))
|
|
|
|
|
;; It is futile to split at the end of the prefix
|
|
|
|
|
;; since we would just insert the prefix again.
|
|
|
|
|
(and after-prefix (<= (point) after-prefix))
|
|
|
|
|
;; Don't split right after a comment starter
|
|
|
|
|
;; since we would just make another comment starter.
|
|
|
|
|
(and comment-start-skip
|
|
|
|
|
(let ((limit (point)))
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(and (re-search-forward comment-start-skip
|
|
|
|
|
limit t)
|
|
|
|
|
(eq (point) limit))))))
|
|
|
|
|
;; No good place to break => stop trying.
|
|
|
|
|
(setq give-up t)
|
|
|
|
|
;; Ok, we have a useful place to break the line. Do it.
|
|
|
|
|
(let ((prev-column (current-column)))
|
|
|
|
|
;; If point is at the fill-point, do not `save-excursion'.
|
|
|
|
|
;; Otherwise, if a comment prefix or fill-prefix is inserted,
|
|
|
|
|
;; point will end up before it rather than after it.
|
|
|
|
|
(if (save-excursion
|
|
|
|
|
(skip-chars-backward " \t")
|
|
|
|
|
(= (point) fill-point))
|
|
|
|
|
(funcall comment-line-break-function t)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char fill-point)
|
|
|
|
|
(funcall comment-line-break-function t)))
|
|
|
|
|
;; Now do justification, if required
|
|
|
|
|
(if (not (eq justify 'left))
|
1995-07-30 00:46:23 +00:00
|
|
|
|
(save-excursion
|
2001-10-31 00:57:04 +00:00
|
|
|
|
(end-of-line 0)
|
|
|
|
|
(justify-current-line justify nil t)))
|
2002-04-11 23:44:06 +00:00
|
|
|
|
;; If making the new line didn't reduce the hpos of
|
|
|
|
|
;; the end of the line, then give up now;
|
|
|
|
|
;; trying again will not help.
|
|
|
|
|
(if (>= (current-column) prev-column)
|
|
|
|
|
(setq give-up t))))))
|
1996-08-07 19:45:46 +00:00
|
|
|
|
;; Justify last line.
|
1996-05-21 14:31:40 +00:00
|
|
|
|
(justify-current-line justify t t)
|
1999-11-15 16:11:14 +00:00
|
|
|
|
t)))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
1996-08-07 19:45:46 +00:00
|
|
|
|
(defvar normal-auto-fill-function 'do-auto-fill
|
|
|
|
|
"The function to use for `auto-fill-function' if Auto Fill mode is turned on.
|
|
|
|
|
Some major modes set this.")
|
|
|
|
|
|
2005-03-16 13:11:34 +00:00
|
|
|
|
(put 'auto-fill-function :minor-mode-function 'auto-fill-mode)
|
2002-09-09 22:09:14 +00:00
|
|
|
|
;; FIXME: turn into a proper minor mode.
|
|
|
|
|
;; Add a global minor mode version of it.
|
1994-04-16 02:06:17 +00:00
|
|
|
|
(defun auto-fill-mode (&optional arg)
|
1996-08-07 19:45:46 +00:00
|
|
|
|
"Toggle Auto Fill mode.
|
|
|
|
|
With arg, turn Auto Fill mode on if and only if arg is positive.
|
|
|
|
|
In Auto Fill mode, inserting a space at a column beyond `current-fill-column'
|
|
|
|
|
automatically breaks the line at a previous space.
|
|
|
|
|
|
|
|
|
|
The value of `normal-auto-fill-function' specifies the function to use
|
|
|
|
|
for `auto-fill-function' when turning Auto Fill mode on."
|
1994-04-16 02:06:17 +00:00
|
|
|
|
(interactive "P")
|
|
|
|
|
(prog1 (setq auto-fill-function
|
|
|
|
|
(if (if (null arg)
|
|
|
|
|
(not auto-fill-function)
|
|
|
|
|
(> (prefix-numeric-value arg) 0))
|
1996-08-07 19:45:46 +00:00
|
|
|
|
normal-auto-fill-function
|
1994-04-16 02:06:17 +00:00
|
|
|
|
nil))
|
1995-04-25 22:26:16 +00:00
|
|
|
|
(force-mode-line-update)))
|
1994-04-16 02:06:17 +00:00
|
|
|
|
|
|
|
|
|
;; This holds a document string used to document auto-fill-mode.
|
|
|
|
|
(defun auto-fill-function ()
|
|
|
|
|
"Automatically break line at a previous space, in insertion of text."
|
|
|
|
|
nil)
|
|
|
|
|
|
|
|
|
|
(defun turn-on-auto-fill ()
|
|
|
|
|
"Unconditionally turn on Auto Fill mode."
|
|
|
|
|
(auto-fill-mode 1))
|
2000-06-20 18:24:59 +00:00
|
|
|
|
|
|
|
|
|
(defun turn-off-auto-fill ()
|
|
|
|
|
"Unconditionally turn off Auto Fill mode."
|
|
|
|
|
(auto-fill-mode -1))
|
|
|
|
|
|
1999-02-18 07:24:11 +00:00
|
|
|
|
(custom-add-option 'text-mode-hook 'turn-on-auto-fill)
|
1994-04-16 02:06:17 +00:00
|
|
|
|
|
|
|
|
|
(defun set-fill-column (arg)
|
1996-06-14 02:11:11 +00:00
|
|
|
|
"Set `fill-column' to specified argument.
|
1998-10-13 15:47:40 +00:00
|
|
|
|
Use \\[universal-argument] followed by a number to specify a column.
|
1996-06-14 02:11:11 +00:00
|
|
|
|
Just \\[universal-argument] as argument means to use the current column."
|
1994-04-16 02:06:17 +00:00
|
|
|
|
(interactive "P")
|
1997-05-19 02:52:50 +00:00
|
|
|
|
(if (consp arg)
|
|
|
|
|
(setq arg (current-column)))
|
|
|
|
|
(if (not (integerp arg))
|
|
|
|
|
;; Disallow missing argument; it's probably a typo for C-x C-f.
|
(clone-indirect-buffer): Doc fix.
(fixup-whitespace, just-one-space, backward-delete-char-untabify, lambda):
"?\ " -> "?\s".
(next-error, next-error-highlight, next-error-highlight-no-select,
next-error-last-buffer, next-error-buffer-p, next-error-find-buffer, next-error,
previous-error, next-error-no-select, previous-error-no-select, open-line,
split-line, minibuffer-prompt-width, kill-new, binary-overwrite-mode):
Fix typos in docstrings.
(set-fill-column): Fix typo in message.
2005-07-20 22:29:53 +00:00
|
|
|
|
(error "set-fill-column requires an explicit argument")
|
1997-05-19 02:52:50 +00:00
|
|
|
|
(message "Fill column set to %d (was %d)" arg fill-column)
|
|
|
|
|
(setq fill-column arg)))
|
2002-03-29 23:16:11 +00:00
|
|
|
|
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(defun set-selective-display (arg)
|
1992-08-21 07:18:16 +00:00
|
|
|
|
"Set `selective-display' to ARG; clear it if no arg.
|
|
|
|
|
When the value of `selective-display' is a number > 0,
|
|
|
|
|
lines whose indentation is >= that value are not displayed.
|
|
|
|
|
The variable `selective-display' has a separate value for each buffer."
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(interactive "P")
|
|
|
|
|
(if (eq selective-display t)
|
|
|
|
|
(error "selective-display already in use for marked lines"))
|
1992-05-30 21:11:25 +00:00
|
|
|
|
(let ((current-vpos
|
|
|
|
|
(save-restriction
|
|
|
|
|
(narrow-to-region (point-min) (point))
|
|
|
|
|
(goto-char (window-start))
|
|
|
|
|
(vertical-motion (window-height)))))
|
|
|
|
|
(setq selective-display
|
|
|
|
|
(and arg (prefix-numeric-value arg)))
|
|
|
|
|
(recenter current-vpos))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(set-window-start (selected-window) (window-start (selected-window)))
|
|
|
|
|
(princ "selective-display set to " t)
|
|
|
|
|
(prin1 selective-display t)
|
|
|
|
|
(princ "." t))
|
|
|
|
|
|
2002-11-18 04:55:28 +00:00
|
|
|
|
(defvaralias 'indicate-unused-lines 'indicate-empty-lines)
|
|
|
|
|
(defvaralias 'default-indicate-unused-lines 'default-indicate-empty-lines)
|
|
|
|
|
|
2006-05-26 12:40:59 +00:00
|
|
|
|
(defun toggle-truncate-lines (&optional arg)
|
2006-12-04 05:51:48 +00:00
|
|
|
|
"Toggle whether to fold or truncate long lines for the current buffer.
|
2002-08-13 01:48:42 +00:00
|
|
|
|
With arg, truncate long lines iff arg is positive.
|
|
|
|
|
Note that in side-by-side windows, truncation is always enabled."
|
2002-07-04 13:36:12 +00:00
|
|
|
|
(interactive "P")
|
|
|
|
|
(setq truncate-lines
|
|
|
|
|
(if (null arg)
|
|
|
|
|
(not truncate-lines)
|
2002-08-13 01:48:42 +00:00
|
|
|
|
(> (prefix-numeric-value arg) 0)))
|
|
|
|
|
(force-mode-line-update)
|
2002-10-26 22:40:31 +00:00
|
|
|
|
(unless truncate-lines
|
|
|
|
|
(let ((buffer (current-buffer)))
|
|
|
|
|
(walk-windows (lambda (window)
|
|
|
|
|
(if (eq buffer (window-buffer window))
|
|
|
|
|
(set-window-hscroll window 0)))
|
|
|
|
|
nil t)))
|
2002-08-13 01:48:42 +00:00
|
|
|
|
(message "Truncate long lines %s"
|
|
|
|
|
(if truncate-lines "enabled" "disabled")))
|
2002-07-04 13:36:12 +00:00
|
|
|
|
|
1997-04-15 07:48:25 +00:00
|
|
|
|
(defvar overwrite-mode-textual " Ovwrt"
|
1993-03-16 18:18:47 +00:00
|
|
|
|
"The string displayed in the mode line when in overwrite mode.")
|
1997-04-15 07:48:25 +00:00
|
|
|
|
(defvar overwrite-mode-binary " Bin Ovwrt"
|
1993-03-16 18:18:47 +00:00
|
|
|
|
"The string displayed in the mode line when in binary overwrite mode.")
|
|
|
|
|
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(defun overwrite-mode (arg)
|
|
|
|
|
"Toggle overwrite mode.
|
|
|
|
|
With arg, turn overwrite mode on iff arg is positive.
|
|
|
|
|
In overwrite mode, printing characters typed in replace existing text
|
1993-03-16 18:18:47 +00:00
|
|
|
|
on a one-for-one basis, rather than pushing it to the right. At the
|
|
|
|
|
end of a line, such characters extend the line. Before a tab,
|
|
|
|
|
such characters insert until the tab is filled in.
|
|
|
|
|
\\[quoted-insert] still inserts characters in overwrite mode; this
|
|
|
|
|
is supposed to make it easier to insert characters when necessary."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(setq overwrite-mode
|
|
|
|
|
(if (if (null arg) (not overwrite-mode)
|
|
|
|
|
(> (prefix-numeric-value arg) 0))
|
|
|
|
|
'overwrite-mode-textual))
|
|
|
|
|
(force-mode-line-update))
|
|
|
|
|
|
|
|
|
|
(defun binary-overwrite-mode (arg)
|
|
|
|
|
"Toggle binary overwrite mode.
|
|
|
|
|
With arg, turn binary overwrite mode on iff arg is positive.
|
|
|
|
|
In binary overwrite mode, printing characters typed in replace
|
|
|
|
|
existing text. Newlines are not treated specially, so typing at the
|
|
|
|
|
end of a line joins the line to the next, with the typed character
|
|
|
|
|
between them. Typing before a tab character simply replaces the tab
|
|
|
|
|
with the character typed.
|
|
|
|
|
\\[quoted-insert] replaces the text at the cursor, just as ordinary
|
|
|
|
|
typing characters do.
|
|
|
|
|
|
|
|
|
|
Note that binary overwrite mode is not its own minor mode; it is a
|
(clone-indirect-buffer): Doc fix.
(fixup-whitespace, just-one-space, backward-delete-char-untabify, lambda):
"?\ " -> "?\s".
(next-error, next-error-highlight, next-error-highlight-no-select,
next-error-last-buffer, next-error-buffer-p, next-error-find-buffer, next-error,
previous-error, next-error-no-select, previous-error-no-select, open-line,
split-line, minibuffer-prompt-width, kill-new, binary-overwrite-mode):
Fix typos in docstrings.
(set-fill-column): Fix typo in message.
2005-07-20 22:29:53 +00:00
|
|
|
|
specialization of overwrite mode, entered by setting the
|
1993-03-16 18:18:47 +00:00
|
|
|
|
`overwrite-mode' variable to `overwrite-mode-binary'."
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(interactive "P")
|
|
|
|
|
(setq overwrite-mode
|
1993-03-16 18:18:47 +00:00
|
|
|
|
(if (if (null arg)
|
1993-03-21 08:22:37 +00:00
|
|
|
|
(not (eq overwrite-mode 'overwrite-mode-binary))
|
1993-03-16 18:18:47 +00:00
|
|
|
|
(> (prefix-numeric-value arg) 0))
|
|
|
|
|
'overwrite-mode-binary))
|
|
|
|
|
(force-mode-line-update))
|
2000-11-22 20:59:39 +00:00
|
|
|
|
|
2002-09-11 20:46:33 +00:00
|
|
|
|
(define-minor-mode line-number-mode
|
1993-03-21 08:22:37 +00:00
|
|
|
|
"Toggle Line Number mode.
|
|
|
|
|
With arg, turn Line Number mode on iff arg is positive.
|
|
|
|
|
When Line Number mode is enabled, the line number appears
|
1998-11-07 02:08:40 +00:00
|
|
|
|
in the mode line.
|
|
|
|
|
|
2001-08-22 18:30:36 +00:00
|
|
|
|
Line numbers do not appear for very large buffers and buffers
|
|
|
|
|
with very long lines; see variables `line-number-display-limit'
|
|
|
|
|
and `line-number-display-limit-width'."
|
2006-09-14 23:55:31 +00:00
|
|
|
|
:init-value t :global t :group 'mode-line)
|
1995-07-17 23:03:53 +00:00
|
|
|
|
|
2002-09-11 20:46:33 +00:00
|
|
|
|
(define-minor-mode column-number-mode
|
1995-07-17 23:03:53 +00:00
|
|
|
|
"Toggle Column Number mode.
|
|
|
|
|
With arg, turn Column Number mode on iff arg is positive.
|
|
|
|
|
When Column Number mode is enabled, the column number appears
|
|
|
|
|
in the mode line."
|
2006-09-14 23:55:31 +00:00
|
|
|
|
:global t :group 'mode-line)
|
2003-09-08 08:01:41 +00:00
|
|
|
|
|
|
|
|
|
(define-minor-mode size-indication-mode
|
|
|
|
|
"Toggle Size Indication mode.
|
|
|
|
|
With arg, turn Size Indication mode on iff arg is positive. When
|
|
|
|
|
Size Indication mode is enabled, the size of the accessible part
|
|
|
|
|
of the buffer appears in the mode line."
|
2006-09-14 23:55:31 +00:00
|
|
|
|
:global t :group 'mode-line)
|
2002-03-29 23:16:11 +00:00
|
|
|
|
|
1997-06-19 09:04:09 +00:00
|
|
|
|
(defgroup paren-blinking nil
|
1997-06-22 09:16:07 +00:00
|
|
|
|
"Blinking matching of parens and expressions."
|
1997-06-19 09:04:09 +00:00
|
|
|
|
:prefix "blink-matching-"
|
|
|
|
|
:group 'paren-matching)
|
|
|
|
|
|
1997-05-05 11:57:31 +00:00
|
|
|
|
(defcustom blink-matching-paren t
|
|
|
|
|
"*Non-nil means show matching open-paren when close-paren is inserted."
|
|
|
|
|
:type 'boolean
|
1997-06-19 09:04:09 +00:00
|
|
|
|
:group 'paren-blinking)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
1997-05-05 11:57:31 +00:00
|
|
|
|
(defcustom blink-matching-paren-on-screen t
|
1995-12-21 18:08:12 +00:00
|
|
|
|
"*Non-nil means show matching open-paren when it is on screen.
|
1997-06-19 09:04:09 +00:00
|
|
|
|
If nil, means don't show it (but the open-paren can still be shown
|
2005-11-27 15:53:16 +00:00
|
|
|
|
when it is off screen).
|
|
|
|
|
|
2005-11-27 16:59:57 +00:00
|
|
|
|
This variable has no effect if `blink-matching-paren' is nil.
|
2005-11-27 17:02:13 +00:00
|
|
|
|
\(In that case, the open-paren is never shown.)
|
2005-11-27 16:59:57 +00:00
|
|
|
|
It is also ignored if `show-paren-mode' is enabled."
|
1997-05-05 11:57:31 +00:00
|
|
|
|
:type 'boolean
|
1997-06-19 09:04:09 +00:00
|
|
|
|
:group 'paren-blinking)
|
1995-12-21 18:08:12 +00:00
|
|
|
|
|
1997-06-19 09:04:09 +00:00
|
|
|
|
(defcustom blink-matching-paren-distance (* 25 1024)
|
2005-08-27 12:30:36 +00:00
|
|
|
|
"*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)
|
1997-06-19 09:04:09 +00:00
|
|
|
|
:group 'paren-blinking)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
1997-05-05 11:57:31 +00:00
|
|
|
|
(defcustom blink-matching-delay 1
|
1997-06-19 09:04:09 +00:00
|
|
|
|
"*Time in seconds to delay after showing a matching paren."
|
|
|
|
|
:type 'number
|
|
|
|
|
:group 'paren-blinking)
|
1994-11-01 04:22:00 +00:00
|
|
|
|
|
1997-05-05 11:57:31 +00:00
|
|
|
|
(defcustom blink-matching-paren-dont-ignore-comments nil
|
2006-02-12 20:31:12 +00:00
|
|
|
|
"*nil means `blink-matching-paren' ignores comments.
|
|
|
|
|
More precisely, when looking for the matching parenthesis,
|
|
|
|
|
it skips the contents of comments that end before point."
|
1997-05-05 11:57:31 +00:00
|
|
|
|
:type 'boolean
|
1997-06-19 09:04:09 +00:00
|
|
|
|
:group 'paren-blinking)
|
1995-08-19 16:59:43 +00:00
|
|
|
|
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(defun blink-matching-open ()
|
|
|
|
|
"Move cursor momentarily to the beginning of the sexp before point."
|
|
|
|
|
(interactive)
|
2005-09-26 00:03:43 +00:00
|
|
|
|
(when (and (> (point) (point-min))
|
2005-09-09 01:11:34 +00:00
|
|
|
|
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
|
2005-11-20 18:08:55 +00:00
|
|
|
|
((not (or (eq matching-paren (char-before oldpos))
|
|
|
|
|
;; The cdr might hold a new paren-class info rather than
|
|
|
|
|
;; a matching-char info, in which case the two CDRs
|
|
|
|
|
;; should match.
|
2005-11-23 15:05:27 +00:00
|
|
|
|
(eq matching-paren (cdr (syntax-after (1- oldpos))))))
|
2005-09-09 01:11:34 +00:00
|
|
|
|
(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.
|
2005-11-27 15:53:16 +00:00
|
|
|
|
(and blink-matching-paren-on-screen
|
|
|
|
|
(not show-paren-mode)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char blinkpos)
|
|
|
|
|
(sit-for blink-matching-delay))))
|
2005-09-09 01:11:34 +00:00
|
|
|
|
(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
|
1994-10-11 07:29:05 +00:00
|
|
|
|
(skip-chars-backward "\n \t")
|
2005-09-09 01:11:34 +00:00
|
|
|
|
(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))))))))
|
1991-12-21 09:29:41 +00:00
|
|
|
|
|
|
|
|
|
;Turned off because it makes dbx bomb out.
|
|
|
|
|
(setq blink-paren-function 'blink-matching-open)
|
2002-03-29 23:16:11 +00:00
|
|
|
|
|
1993-05-15 20:55:02 +00:00
|
|
|
|
;; This executes C-g typed while Emacs is waiting for a command.
|
|
|
|
|
;; Quitting out of a program does not go through here;
|
|
|
|
|
;; that happens in the QUIT macro at the C code level.
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(defun keyboard-quit ()
|
1998-06-01 03:04:39 +00:00
|
|
|
|
"Signal a `quit' condition.
|
1993-03-09 05:40:33 +00:00
|
|
|
|
During execution of Lisp code, this character causes a quit directly.
|
|
|
|
|
At top-level, as an editor command, this simply beeps."
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(interactive)
|
1993-07-08 22:37:42 +00:00
|
|
|
|
(deactivate-mark)
|
2004-11-01 23:03:12 +00:00
|
|
|
|
(if (fboundp 'kmacro-keyboard-quit)
|
|
|
|
|
(kmacro-keyboard-quit))
|
2002-09-09 22:45:03 +00:00
|
|
|
|
(setq defining-kbd-macro nil)
|
1991-12-21 09:29:41 +00:00
|
|
|
|
(signal 'quit nil))
|
|
|
|
|
|
1994-12-15 02:02:04 +00:00
|
|
|
|
(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
|
|
|
|
|
\(such as cancelling a prefix argument, minibuffer or region) do not apply.")
|
|
|
|
|
|
1994-11-28 19:44:16 +00:00
|
|
|
|
(defun keyboard-escape-quit ()
|
|
|
|
|
"Exit the current \"mode\" (in a generalized sense of the word).
|
|
|
|
|
This command can exit an interactive command such as `query-replace',
|
|
|
|
|
can clear out a prefix argument or a region,
|
|
|
|
|
can get out of the minibuffer or other recursive edit,
|
1994-12-15 02:02:04 +00:00
|
|
|
|
cancel the use of the current buffer (for special-purpose buffers),
|
|
|
|
|
or go back to just one window (by deleting all but the selected window)."
|
1994-11-28 19:44:16 +00:00
|
|
|
|
(interactive)
|
|
|
|
|
(cond ((eq last-command 'mode-exited) nil)
|
|
|
|
|
((> (minibuffer-depth) 0)
|
|
|
|
|
(abort-recursive-edit))
|
|
|
|
|
(current-prefix-arg
|
|
|
|
|
nil)
|
2004-12-13 03:08:52 +00:00
|
|
|
|
((and transient-mark-mode mark-active)
|
1994-11-28 19:44:16 +00:00
|
|
|
|
(deactivate-mark))
|
1997-04-10 06:29:59 +00:00
|
|
|
|
((> (recursion-depth) 0)
|
|
|
|
|
(exit-recursive-edit))
|
1994-12-15 02:02:04 +00:00
|
|
|
|
(buffer-quit-function
|
|
|
|
|
(funcall buffer-quit-function))
|
1994-11-28 19:44:16 +00:00
|
|
|
|
((not (one-window-p t))
|
1997-04-10 06:29:59 +00:00
|
|
|
|
(delete-other-windows))
|
|
|
|
|
((string-match "^ \\*" (buffer-name (current-buffer)))
|
|
|
|
|
(bury-buffer))))
|
1994-11-28 19:44:16 +00:00
|
|
|
|
|
2002-03-29 23:16:11 +00:00
|
|
|
|
(defun play-sound-file (file &optional volume device)
|
|
|
|
|
"Play sound stored in FILE.
|
|
|
|
|
VOLUME and DEVICE correspond to the keywords of the sound
|
|
|
|
|
specification for `play-sound'."
|
|
|
|
|
(interactive "fPlay sound file: ")
|
|
|
|
|
(let ((sound (list :file file)))
|
|
|
|
|
(if volume
|
|
|
|
|
(plist-put sound :volume volume))
|
|
|
|
|
(if device
|
|
|
|
|
(plist-put sound :device device))
|
|
|
|
|
(push 'sound sound)
|
|
|
|
|
(play-sound sound)))
|
|
|
|
|
|
2005-01-15 18:08:46 +00:00
|
|
|
|
|
2000-01-07 12:53:36 +00:00
|
|
|
|
(defcustom read-mail-command 'rmail
|
|
|
|
|
"*Your preference for a mail reading package.
|
2000-09-12 17:59:26 +00:00
|
|
|
|
This is used by some keybindings which support reading mail.
|
|
|
|
|
See also `mail-user-agent' concerning sending mail."
|
2000-01-07 12:53:36 +00:00
|
|
|
|
:type '(choice (function-item rmail)
|
|
|
|
|
(function-item gnus)
|
|
|
|
|
(function-item mh-rmail)
|
|
|
|
|
(function :tag "Other"))
|
|
|
|
|
:version "21.1"
|
|
|
|
|
:group 'mail)
|
|
|
|
|
|
1997-05-05 11:57:31 +00:00
|
|
|
|
(defcustom mail-user-agent 'sendmail-user-agent
|
1996-08-30 16:59:20 +00:00
|
|
|
|
"*Your preference for a mail composition package.
|
2000-09-12 17:59:26 +00:00
|
|
|
|
Various Emacs Lisp packages (e.g. Reporter) require you to compose an
|
1996-08-30 16:59:20 +00:00
|
|
|
|
outgoing email message. This variable lets you specify which
|
|
|
|
|
mail-sending package you prefer.
|
|
|
|
|
|
|
|
|
|
Valid values include:
|
|
|
|
|
|
2000-09-12 17:59:26 +00:00
|
|
|
|
`sendmail-user-agent' -- use the default Emacs Mail package.
|
|
|
|
|
See Info node `(emacs)Sending Mail'.
|
|
|
|
|
`mh-e-user-agent' -- use the Emacs interface to the MH mail system.
|
|
|
|
|
See Info node `(mh-e)'.
|
|
|
|
|
`message-user-agent' -- use the Gnus Message package.
|
|
|
|
|
See Info node `(message)'.
|
|
|
|
|
`gnus-user-agent' -- like `message-user-agent', but with Gnus
|
|
|
|
|
paraphernalia, particularly the Gcc: header for
|
|
|
|
|
archiving.
|
1996-08-30 16:59:20 +00:00
|
|
|
|
|
|
|
|
|
Additional valid symbols may be available; check with the author of
|
2000-12-18 17:09:42 +00:00
|
|
|
|
your package for details. The function should return non-nil if it
|
|
|
|
|
succeeds.
|
2000-09-12 17:59:26 +00:00
|
|
|
|
|
|
|
|
|
See also `read-mail-command' concerning reading mail."
|
1997-05-05 11:57:31 +00:00
|
|
|
|
: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)
|
2000-09-12 17:59:26 +00:00
|
|
|
|
(function-item :tag "Gnus Message package"
|
1997-05-05 11:57:31 +00:00
|
|
|
|
:format "%t\n"
|
|
|
|
|
message-user-agent)
|
2000-09-12 17:59:26 +00:00
|
|
|
|
(function-item :tag "Gnus Message with full Gnus features"
|
|
|
|
|
:format "%t\n"
|
|
|
|
|
gnus-user-agent)
|
1997-05-05 11:57:31 +00:00
|
|
|
|
(function :tag "Other"))
|
|
|
|
|
:group 'mail)
|
1996-08-30 16:59:20 +00:00
|
|
|
|
|
|
|
|
|
(define-mail-user-agent 'sendmail-user-agent
|
1997-07-05 03:44:54 +00:00
|
|
|
|
'sendmail-user-agent-compose
|
1996-08-30 16:59:20 +00:00
|
|
|
|
'mail-send-and-exit)
|
|
|
|
|
|
1998-05-02 06:50:44 +00:00
|
|
|
|
(defun rfc822-goto-eoh ()
|
|
|
|
|
;; Go to header delimiter line in a mail message, following RFC822 rules
|
|
|
|
|
(goto-char (point-min))
|
2001-10-31 00:57:04 +00:00
|
|
|
|
(when (re-search-forward
|
|
|
|
|
"^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move)
|
|
|
|
|
(goto-char (match-beginning 0))))
|
1998-05-02 06:50:44 +00:00
|
|
|
|
|
1997-07-05 03:44:54 +00:00
|
|
|
|
(defun sendmail-user-agent-compose (&optional to subject other-headers continue
|
|
|
|
|
switch-function yank-action
|
|
|
|
|
send-actions)
|
|
|
|
|
(if switch-function
|
|
|
|
|
(let ((special-display-buffer-names nil)
|
|
|
|
|
(special-display-regexps nil)
|
|
|
|
|
(same-window-buffer-names nil)
|
|
|
|
|
(same-window-regexps nil))
|
|
|
|
|
(funcall switch-function "*mail*")))
|
2003-12-29 19:52:25 +00:00
|
|
|
|
(let ((cc (cdr (assoc-string "cc" other-headers t)))
|
|
|
|
|
(in-reply-to (cdr (assoc-string "in-reply-to" other-headers t)))
|
|
|
|
|
(body (cdr (assoc-string "body" other-headers t))))
|
2005-09-15 03:47:22 +00:00
|
|
|
|
(or (mail continue to subject in-reply-to cc yank-action send-actions)
|
|
|
|
|
continue
|
|
|
|
|
(error "Message aborted"))
|
1997-07-05 03:44:54 +00:00
|
|
|
|
(save-excursion
|
1998-05-02 06:50:44 +00:00
|
|
|
|
(rfc822-goto-eoh)
|
1997-07-05 03:44:54 +00:00
|
|
|
|
(while other-headers
|
2000-04-03 19:31:33 +00:00
|
|
|
|
(unless (member-ignore-case (car (car other-headers))
|
|
|
|
|
'("in-reply-to" "cc" "body"))
|
1997-07-05 03:44:54 +00:00
|
|
|
|
(insert (car (car other-headers)) ": "
|
2005-11-29 23:54:47 +00:00
|
|
|
|
(cdr (car other-headers))
|
|
|
|
|
(if use-hard-newlines hard-newline "\n")))
|
1997-07-05 03:44:54 +00:00
|
|
|
|
(setq other-headers (cdr other-headers)))
|
2000-04-03 19:31:33 +00:00
|
|
|
|
(when body
|
|
|
|
|
(forward-line 1)
|
|
|
|
|
(insert body))
|
1997-07-05 03:44:54 +00:00
|
|
|
|
t)))
|
|
|
|
|
|
1996-12-07 21:30:17 +00:00
|
|
|
|
(defun compose-mail (&optional to subject other-headers continue
|
|
|
|
|
switch-function yank-action send-actions)
|
|
|
|
|
"Start composing a mail message to send.
|
|
|
|
|
This uses the user's chosen mail composition package
|
|
|
|
|
as selected with the variable `mail-user-agent'.
|
|
|
|
|
The optional arguments TO and SUBJECT specify recipients
|
|
|
|
|
and the initial Subject field, respectively.
|
|
|
|
|
|
|
|
|
|
OTHER-HEADERS is an alist specifying additional
|
|
|
|
|
header fields. Elements look like (HEADER . VALUE) where both
|
|
|
|
|
HEADER and VALUE are strings.
|
|
|
|
|
|
|
|
|
|
CONTINUE, if non-nil, says to continue editing a message already
|
|
|
|
|
being composed.
|
|
|
|
|
|
|
|
|
|
SWITCH-FUNCTION, if non-nil, is a function to use to
|
|
|
|
|
switch to and display the buffer used for mail composition.
|
|
|
|
|
|
|
|
|
|
YANK-ACTION, if non-nil, is an action to perform, if and when necessary,
|
1996-12-18 16:32:43 +00:00
|
|
|
|
to insert the raw text of the message being replied to.
|
|
|
|
|
It has the form (FUNCTION . ARGS). The user agent will apply
|
|
|
|
|
FUNCTION to ARGS, to insert the raw text of the original message.
|
|
|
|
|
\(The user agent will also run `mail-citation-hook', *after* the
|
|
|
|
|
original text has been inserted in this way.)
|
1996-12-07 21:30:17 +00:00
|
|
|
|
|
|
|
|
|
SEND-ACTIONS is a list of actions to call when the message is sent.
|
|
|
|
|
Each action has the form (FUNCTION . ARGS)."
|
1997-04-29 02:07:02 +00:00
|
|
|
|
(interactive
|
|
|
|
|
(list nil nil nil current-prefix-arg))
|
1996-12-07 21:30:17 +00:00
|
|
|
|
(let ((function (get mail-user-agent 'composefunc)))
|
|
|
|
|
(funcall function to subject other-headers continue
|
|
|
|
|
switch-function yank-action send-actions)))
|
1997-04-29 02:07:02 +00:00
|
|
|
|
|
|
|
|
|
(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))
|
2005-01-15 18:08:46 +00:00
|
|
|
|
|
1997-04-30 18:57:35 +00:00
|
|
|
|
(defvar set-variable-value-history nil
|
|
|
|
|
"History of values entered with `set-variable'.")
|
|
|
|
|
|
2005-06-23 21:26:31 +00:00
|
|
|
|
(defun set-variable (variable value &optional make-local)
|
1997-04-30 18:57:35 +00:00
|
|
|
|
"Set VARIABLE to VALUE. VALUE is a Lisp object.
|
2005-06-23 21:26:31 +00:00
|
|
|
|
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.
|
1997-04-30 18:57:35 +00:00
|
|
|
|
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 VALUE.
|
|
|
|
|
|
|
|
|
|
If VARIABLE has been defined with `defcustom', then the type information
|
2002-08-09 14:14:32 +00:00
|
|
|
|
in the definition is used to check that VALUE is valid.
|
|
|
|
|
|
|
|
|
|
With a prefix argument, set VARIABLE to VALUE buffer-locally."
|
1998-05-20 03:54:58 +00:00
|
|
|
|
(interactive
|
|
|
|
|
(let* ((default-var (variable-at-point))
|
2005-10-21 08:55:12 +00:00
|
|
|
|
(var (if (user-variable-p default-var)
|
|
|
|
|
(read-variable (format "Set variable (default %s): " default-var)
|
|
|
|
|
default-var)
|
|
|
|
|
(read-variable "Set variable: ")))
|
2003-11-19 13:23:30 +00:00
|
|
|
|
(minibuffer-help-form '(describe-variable var))
|
|
|
|
|
(prop (get var 'variable-interactive))
|
2005-06-29 23:50:29 +00:00
|
|
|
|
(obsolete (car (get var 'byte-obsolete-variable)))
|
|
|
|
|
(prompt (format "Set %s %s to value: " var
|
2003-11-19 13:23:30 +00:00
|
|
|
|
(cond ((local-variable-p var)
|
2005-06-29 23:50:29 +00:00
|
|
|
|
"(buffer-local)")
|
2003-11-19 13:23:30 +00:00
|
|
|
|
((or current-prefix-arg
|
|
|
|
|
(local-variable-if-set-p var))
|
2005-06-29 23:50:29 +00:00
|
|
|
|
"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
|
2005-10-21 08:55:12 +00:00
|
|
|
|
'set-variable-value-history
|
|
|
|
|
(format "%S" (symbol-value var))))))))
|
2003-11-19 13:23:30 +00:00
|
|
|
|
(list var val current-prefix-arg)))
|
1997-04-30 18:57:35 +00:00
|
|
|
|
|
2005-06-23 21:26:31 +00:00
|
|
|
|
(and (custom-variable-p variable)
|
|
|
|
|
(not (get variable 'custom-type))
|
|
|
|
|
(custom-load-symbol variable))
|
|
|
|
|
(let ((type (get variable 'custom-type)))
|
1997-04-30 18:57:35 +00:00
|
|
|
|
(when type
|
|
|
|
|
;; Match with custom type.
|
2001-07-16 11:52:56 +00:00
|
|
|
|
(require 'cus-edit)
|
1997-04-30 18:57:35 +00:00
|
|
|
|
(setq type (widget-convert type))
|
2005-06-23 21:26:31 +00:00
|
|
|
|
(unless (widget-apply type :match value)
|
1999-11-15 16:11:14 +00:00
|
|
|
|
(error "Value `%S' does not match type %S of %S"
|
2005-06-23 21:26:31 +00:00
|
|
|
|
value (car type) variable))))
|
2002-08-09 14:14:32 +00:00
|
|
|
|
|
|
|
|
|
(if make-local
|
2005-06-23 21:26:31 +00:00
|
|
|
|
(make-local-variable variable))
|
2003-02-04 12:29:42 +00:00
|
|
|
|
|
2005-06-23 21:26:31 +00:00
|
|
|
|
(set variable value)
|
2001-01-10 15:10:01 +00:00
|
|
|
|
|
|
|
|
|
;; Force a thorough redisplay for the case that the variable
|
|
|
|
|
;; has an effect on the display, like `tab-width' has.
|
|
|
|
|
(force-mode-line-update))
|
2005-01-15 18:08:46 +00:00
|
|
|
|
|
1993-07-13 21:34:05 +00:00
|
|
|
|
;; Define the major mode for lists of completions.
|
|
|
|
|
|
1995-04-08 22:42:47 +00:00
|
|
|
|
(defvar completion-list-mode-map nil
|
|
|
|
|
"Local map for completion list buffers.")
|
1993-07-22 05:47:10 +00:00
|
|
|
|
(or completion-list-mode-map
|
1993-07-13 21:34:05 +00:00
|
|
|
|
(let ((map (make-sparse-keymap)))
|
|
|
|
|
(define-key map [mouse-2] 'mouse-choose-completion)
|
2005-01-06 22:00:36 +00:00
|
|
|
|
(define-key map [follow-link] 'mouse-face)
|
1994-06-01 18:28:06 +00:00
|
|
|
|
(define-key map [down-mouse-2] nil)
|
1994-03-27 22:21:04 +00:00
|
|
|
|
(define-key map "\C-m" 'choose-completion)
|
1994-12-15 02:02:04 +00:00
|
|
|
|
(define-key map "\e\e\e" 'delete-completion-window)
|
1994-12-29 18:53:25 +00:00
|
|
|
|
(define-key map [left] 'previous-completion)
|
|
|
|
|
(define-key map [right] 'next-completion)
|
1993-07-22 05:47:10 +00:00
|
|
|
|
(setq completion-list-mode-map map)))
|
1993-07-13 21:34:05 +00:00
|
|
|
|
|
|
|
|
|
;; Completion mode is suitable only for specially formatted data.
|
1993-07-22 05:47:10 +00:00
|
|
|
|
(put 'completion-list-mode 'mode-class 'special)
|
1993-07-13 21:34:05 +00:00
|
|
|
|
|
1995-04-08 22:42:47 +00:00
|
|
|
|
(defvar completion-reference-buffer nil
|
|
|
|
|
"Record the buffer that was current when the completion list was requested.
|
|
|
|
|
This is a local variable in the completion list buffer.
|
1995-04-09 03:33:01 +00:00
|
|
|
|
Initial value is nil to avoid some compiler warnings.")
|
1994-03-02 23:09:40 +00:00
|
|
|
|
|
1997-01-24 03:51:57 +00:00
|
|
|
|
(defvar completion-no-auto-exit nil
|
|
|
|
|
"Non-nil means `choose-completion-string' should never exit the minibuffer.
|
|
|
|
|
This also applies to other functions such as `choose-completion'
|
|
|
|
|
and `mouse-choose-completion'.")
|
|
|
|
|
|
1995-04-08 22:42:47 +00:00
|
|
|
|
(defvar completion-base-size nil
|
|
|
|
|
"Number of chars at beginning of minibuffer not involved in completion.
|
|
|
|
|
This is a local variable in the completion list buffer
|
|
|
|
|
but it talks about the buffer in `completion-reference-buffer'.
|
|
|
|
|
If this is nil, it means to compare text to determine which part
|
|
|
|
|
of the tail end of the buffer's text is involved in completion.")
|
1994-08-07 18:11:58 +00:00
|
|
|
|
|
1994-12-15 02:02:04 +00:00
|
|
|
|
(defun delete-completion-window ()
|
|
|
|
|
"Delete the completion list window.
|
|
|
|
|
Go to the window from which completion was requested."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let ((buf completion-reference-buffer))
|
1997-01-09 07:59:03 +00:00
|
|
|
|
(if (one-window-p t)
|
|
|
|
|
(if (window-dedicated-p (selected-window))
|
|
|
|
|
(delete-frame (selected-frame)))
|
|
|
|
|
(delete-window (selected-window))
|
|
|
|
|
(if (get-buffer-window buf)
|
|
|
|
|
(select-window (get-buffer-window buf))))))
|
1994-12-15 02:02:04 +00:00
|
|
|
|
|
1994-12-29 18:53:25 +00:00
|
|
|
|
(defun previous-completion (n)
|
|
|
|
|
"Move to the previous item in the completion list."
|
|
|
|
|
(interactive "p")
|
|
|
|
|
(next-completion (- n)))
|
|
|
|
|
|
|
|
|
|
(defun next-completion (n)
|
|
|
|
|
"Move to the next item in the completion list.
|
1996-01-04 23:20:13 +00:00
|
|
|
|
With prefix argument N, move N items (negative N means move backward)."
|
1994-12-29 18:53:25 +00:00
|
|
|
|
(interactive "p")
|
2000-11-22 19:47:30 +00:00
|
|
|
|
(let ((beg (point-min)) (end (point-max)))
|
|
|
|
|
(while (and (> n 0) (not (eobp)))
|
1994-12-29 18:53:25 +00:00
|
|
|
|
;; If in a completion, move to the end of it.
|
2000-11-22 19:47:30 +00:00
|
|
|
|
(when (get-text-property (point) 'mouse-face)
|
|
|
|
|
(goto-char (next-single-property-change (point) 'mouse-face nil end)))
|
1994-12-29 18:53:25 +00:00
|
|
|
|
;; Move to start of next one.
|
2000-11-22 19:47:30 +00:00
|
|
|
|
(unless (get-text-property (point) 'mouse-face)
|
|
|
|
|
(goto-char (next-single-property-change (point) 'mouse-face nil end)))
|
|
|
|
|
(setq n (1- n)))
|
|
|
|
|
(while (and (< n 0) (not (bobp)))
|
|
|
|
|
(let ((prop (get-text-property (1- (point)) 'mouse-face)))
|
|
|
|
|
;; If in a completion, move to the start of it.
|
|
|
|
|
(when (and prop (eq prop (get-text-property (point) 'mouse-face)))
|
1995-10-11 03:11:11 +00:00
|
|
|
|
(goto-char (previous-single-property-change
|
2000-11-22 19:47:30 +00:00
|
|
|
|
(point) 'mouse-face nil beg)))
|
|
|
|
|
;; Move to end of the previous completion.
|
|
|
|
|
(unless (or (bobp) (get-text-property (1- (point)) 'mouse-face))
|
|
|
|
|
(goto-char (previous-single-property-change
|
|
|
|
|
(point) 'mouse-face nil beg)))
|
|
|
|
|
;; Move to the start of that one.
|
|
|
|
|
(goto-char (previous-single-property-change
|
|
|
|
|
(point) 'mouse-face nil beg))
|
|
|
|
|
(setq n (1+ n))))))
|
1994-12-29 18:53:25 +00:00
|
|
|
|
|
1994-03-27 22:21:04 +00:00
|
|
|
|
(defun choose-completion ()
|
|
|
|
|
"Choose the completion that point is in or next to."
|
|
|
|
|
(interactive)
|
1994-08-07 18:11:58 +00:00
|
|
|
|
(let (beg end completion (buffer completion-reference-buffer)
|
|
|
|
|
(base-size completion-base-size))
|
1994-07-11 21:25:19 +00:00
|
|
|
|
(if (and (not (eobp)) (get-text-property (point) 'mouse-face))
|
|
|
|
|
(setq end (point) beg (1+ (point))))
|
|
|
|
|
(if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
|
1995-03-11 19:13:52 +00:00
|
|
|
|
(setq end (1- (point)) beg (point)))
|
1994-07-11 21:25:19 +00:00
|
|
|
|
(if (null beg)
|
|
|
|
|
(error "No completion here"))
|
|
|
|
|
(setq beg (previous-single-property-change beg 'mouse-face))
|
1994-07-29 21:35:56 +00:00
|
|
|
|
(setq end (or (next-single-property-change end 'mouse-face) (point-max)))
|
2005-12-16 19:08:21 +00:00
|
|
|
|
(setq completion (buffer-substring-no-properties beg end))
|
1994-08-06 21:51:31 +00:00
|
|
|
|
(let ((owindow (selected-window)))
|
|
|
|
|
(if (and (one-window-p t 'selected-frame)
|
|
|
|
|
(window-dedicated-p (selected-window)))
|
|
|
|
|
;; This is a special buffer's frame
|
|
|
|
|
(iconify-frame (selected-frame))
|
|
|
|
|
(or (window-dedicated-p (selected-window))
|
|
|
|
|
(bury-buffer)))
|
|
|
|
|
(select-window owindow))
|
1994-08-07 18:11:58 +00:00
|
|
|
|
(choose-completion-string completion buffer base-size)))
|
1994-03-27 22:21:04 +00:00
|
|
|
|
|
|
|
|
|
;; Delete the longest partial match for STRING
|
|
|
|
|
;; that can be found before POINT.
|
|
|
|
|
(defun choose-completion-delete-max-match (string)
|
|
|
|
|
(let ((opoint (point))
|
2002-07-18 14:57:46 +00:00
|
|
|
|
len)
|
|
|
|
|
;; Try moving back by the length of the string.
|
|
|
|
|
(goto-char (max (- (point) (length string))
|
|
|
|
|
(minibuffer-prompt-end)))
|
|
|
|
|
;; See how far back we were actually able to move. That is the
|
|
|
|
|
;; upper bound on how much we can match and delete.
|
|
|
|
|
(setq len (- opoint (point)))
|
1994-05-19 23:06:47 +00:00
|
|
|
|
(if completion-ignore-case
|
|
|
|
|
(setq string (downcase string)))
|
1994-03-27 22:21:04 +00:00
|
|
|
|
(while (and (> len 0)
|
2002-07-18 14:57:46 +00:00
|
|
|
|
(let ((tail (buffer-substring (point) opoint)))
|
1994-05-19 23:06:47 +00:00
|
|
|
|
(if completion-ignore-case
|
|
|
|
|
(setq tail (downcase tail)))
|
1994-03-27 22:21:04 +00:00
|
|
|
|
(not (string= tail (substring string 0 len)))))
|
|
|
|
|
(setq len (1- len))
|
|
|
|
|
(forward-char 1))
|
|
|
|
|
(delete-char len)))
|
|
|
|
|
|
2002-06-01 00:00:29 +00:00
|
|
|
|
(defvar choose-completion-string-functions nil
|
2002-06-01 21:56:40 +00:00
|
|
|
|
"Functions that may override the normal insertion of a completion choice.
|
|
|
|
|
These functions are called in order with four arguments:
|
|
|
|
|
CHOICE - the string to insert in the buffer,
|
|
|
|
|
BUFFER - the buffer in which the choice should be inserted,
|
2002-09-06 07:17:49 +00:00
|
|
|
|
MINI-P - non-nil iff BUFFER is a minibuffer, and
|
2002-06-02 00:01:59 +00:00
|
|
|
|
BASE-SIZE - the number of characters in BUFFER before
|
|
|
|
|
the string being completed.
|
|
|
|
|
|
2002-06-01 21:56:40 +00:00
|
|
|
|
If a function in the list returns non-nil, that function is supposed
|
|
|
|
|
to have inserted the CHOICE in the BUFFER, and possibly exited
|
2002-06-02 00:01:59 +00:00
|
|
|
|
the minibuffer; no further functions will be called.
|
2002-06-01 00:00:29 +00:00
|
|
|
|
|
2002-06-02 00:01:59 +00:00
|
|
|
|
If all functions in the list return nil, that means to use
|
|
|
|
|
the default method of inserting the completion in BUFFER.")
|
1996-06-22 04:50:32 +00:00
|
|
|
|
|
1994-08-07 18:11:58 +00:00
|
|
|
|
(defun choose-completion-string (choice &optional buffer base-size)
|
2002-06-02 00:01:59 +00:00
|
|
|
|
"Switch to BUFFER and insert the completion choice CHOICE.
|
|
|
|
|
BASE-SIZE, if non-nil, says how many characters of BUFFER's text
|
2002-07-16 13:38:19 +00:00
|
|
|
|
to keep. If it is nil, we call `choose-completion-delete-max-match'
|
|
|
|
|
to decide what to delete."
|
2002-06-02 00:01:59 +00:00
|
|
|
|
|
|
|
|
|
;; If BUFFER is the minibuffer, exit the minibuffer
|
|
|
|
|
;; unless it is reading a file name and CHOICE is a directory,
|
|
|
|
|
;; or completion-no-auto-exit is non-nil.
|
|
|
|
|
|
2003-07-25 12:18:04 +00:00
|
|
|
|
(let* ((buffer (or buffer completion-reference-buffer))
|
|
|
|
|
(mini-p (minibufferp buffer)))
|
1994-05-05 05:27:59 +00:00
|
|
|
|
;; If BUFFER is a minibuffer, barf unless it's the currently
|
|
|
|
|
;; active minibuffer.
|
1999-12-31 04:02:38 +00:00
|
|
|
|
(if (and mini-p
|
1995-03-31 01:48:40 +00:00
|
|
|
|
(or (not (active-minibuffer-window))
|
|
|
|
|
(not (equal buffer
|
|
|
|
|
(window-buffer (active-minibuffer-window))))))
|
1994-05-05 05:27:59 +00:00
|
|
|
|
(error "Minibuffer is not active for completion")
|
2004-09-12 18:52:03 +00:00
|
|
|
|
;; Set buffer so buffer-local choose-completion-string-functions works.
|
|
|
|
|
(set-buffer buffer)
|
2003-02-04 12:29:42 +00:00
|
|
|
|
(unless (run-hook-with-args-until-success
|
2002-09-09 22:09:14 +00:00
|
|
|
|
'choose-completion-string-functions
|
|
|
|
|
choice buffer mini-p base-size)
|
|
|
|
|
;; Insert the completion into the buffer where it was requested.
|
2002-06-01 21:56:40 +00:00
|
|
|
|
(if base-size
|
|
|
|
|
(delete-region (+ base-size (if mini-p
|
|
|
|
|
(minibuffer-prompt-end)
|
|
|
|
|
(point-min)))
|
|
|
|
|
(point))
|
|
|
|
|
(choose-completion-delete-max-match choice))
|
|
|
|
|
(insert choice)
|
|
|
|
|
(remove-text-properties (- (point) (length choice)) (point)
|
|
|
|
|
'(mouse-face nil))
|
|
|
|
|
;; Update point in the window that BUFFER is showing in.
|
|
|
|
|
(let ((window (get-buffer-window buffer t)))
|
|
|
|
|
(set-window-point window (point)))
|
|
|
|
|
;; If completing for the minibuffer, exit it with this choice.
|
|
|
|
|
(and (not completion-no-auto-exit)
|
|
|
|
|
(equal buffer (window-buffer (minibuffer-window)))
|
|
|
|
|
minibuffer-completion-table
|
|
|
|
|
;; If this is reading a file name, and the file name chosen
|
|
|
|
|
;; is a directory, don't exit the minibuffer.
|
|
|
|
|
(if (and (eq minibuffer-completion-table 'read-file-name-internal)
|
|
|
|
|
(file-directory-p (field-string (point-max))))
|
|
|
|
|
(let ((mini (active-minibuffer-window)))
|
|
|
|
|
(select-window mini)
|
|
|
|
|
(when minibuffer-auto-raise
|
|
|
|
|
(raise-frame (window-frame mini))))
|
|
|
|
|
(exit-minibuffer)))))))
|
1994-03-27 22:21:04 +00:00
|
|
|
|
|
1993-07-22 05:47:10 +00:00
|
|
|
|
(defun completion-list-mode ()
|
1993-07-13 21:34:05 +00:00
|
|
|
|
"Major mode for buffers showing lists of possible completions.
|
1994-03-27 22:21:04 +00:00
|
|
|
|
Type \\<completion-list-mode-map>\\[choose-completion] in the completion list\
|
|
|
|
|
to select the completion near point.
|
|
|
|
|
Use \\<completion-list-mode-map>\\[mouse-choose-completion] to select one\
|
|
|
|
|
with the mouse."
|
1993-07-13 21:34:05 +00:00
|
|
|
|
(interactive)
|
|
|
|
|
(kill-all-local-variables)
|
1993-07-22 05:47:10 +00:00
|
|
|
|
(use-local-map completion-list-mode-map)
|
|
|
|
|
(setq mode-name "Completion List")
|
|
|
|
|
(setq major-mode 'completion-list-mode)
|
1994-08-07 18:11:58 +00:00
|
|
|
|
(make-local-variable 'completion-base-size)
|
|
|
|
|
(setq completion-base-size nil)
|
2005-05-26 13:12:00 +00:00
|
|
|
|
(run-mode-hooks 'completion-list-mode-hook))
|
1993-07-13 21:34:05 +00:00
|
|
|
|
|
2001-04-10 14:48:42 +00:00
|
|
|
|
(defun completion-list-mode-finish ()
|
|
|
|
|
"Finish setup of the completions buffer.
|
|
|
|
|
Called from `temp-buffer-show-hook'."
|
|
|
|
|
(when (eq major-mode 'completion-list-mode)
|
|
|
|
|
(toggle-read-only 1)))
|
|
|
|
|
|
|
|
|
|
(add-hook 'temp-buffer-show-hook 'completion-list-mode-finish)
|
|
|
|
|
|
1997-12-21 01:47:48 +00:00
|
|
|
|
(defvar completion-setup-hook nil
|
|
|
|
|
"Normal hook run at the end of setting up a completion list buffer.
|
|
|
|
|
When this hook is run, the current buffer is the one in which the
|
|
|
|
|
command to display the completion list buffer was run.
|
2005-10-16 09:31:48 +00:00
|
|
|
|
The completion list buffer is available as the value of `standard-output'.
|
2005-11-12 00:10:56 +00:00
|
|
|
|
The common prefix substring for completion may be available as the
|
2005-10-16 09:31:48 +00:00
|
|
|
|
value of `completion-common-substring'. See also `display-completion-list'.")
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; Variables and faces used in `completion-setup-function'.
|
1997-12-21 01:47:48 +00:00
|
|
|
|
|
2006-09-04 18:26:03 +00:00
|
|
|
|
(defcustom completion-show-help t
|
|
|
|
|
"Non-nil means show help message in *Completions* buffer."
|
|
|
|
|
:type 'boolean
|
|
|
|
|
:version "22.1"
|
|
|
|
|
:group 'completion)
|
|
|
|
|
|
2004-04-16 08:57:51 +00:00
|
|
|
|
(defface completions-first-difference
|
2004-03-25 16:01:38 +00:00
|
|
|
|
'((t (:inherit bold)))
|
|
|
|
|
"Face put on the first uncommon character in completions in *Completions* buffer."
|
|
|
|
|
:group 'completion)
|
|
|
|
|
|
2004-04-16 08:57:51 +00:00
|
|
|
|
(defface completions-common-part
|
2004-03-25 16:01:38 +00:00
|
|
|
|
'((t (:inherit default)))
|
2004-04-27 06:45:49 +00:00
|
|
|
|
"Face put on the common prefix substring in completions in *Completions* buffer.
|
|
|
|
|
The idea of `completions-common-part' is that you can use it to
|
|
|
|
|
make the common parts less visible than normal, so that the rest
|
|
|
|
|
of the differing parts is, by contrast, slightly highlighted."
|
2004-03-25 16:01:38 +00:00
|
|
|
|
:group 'completion)
|
1994-07-11 21:25:19 +00:00
|
|
|
|
|
2004-08-07 16:47:41 +00:00
|
|
|
|
;; This is for packages that need to bind it to a non-default regexp
|
|
|
|
|
;; in order to make the first-differing character highlight work
|
|
|
|
|
;; to their liking
|
|
|
|
|
(defvar completion-root-regexp "^/"
|
|
|
|
|
"Regexp to use in `completion-setup-function' to find the root directory.")
|
|
|
|
|
|
2005-10-16 09:31:48 +00:00
|
|
|
|
(defvar completion-common-substring nil
|
|
|
|
|
"Common prefix substring to use in `completion-setup-function' to put faces.
|
|
|
|
|
The value is set by `display-completion-list' during running `completion-setup-hook'.
|
|
|
|
|
|
2005-12-16 19:08:21 +00:00
|
|
|
|
To put faces `completions-first-difference' and `completions-common-part'
|
|
|
|
|
in the `*Completions*' buffer, the common prefix substring in completions
|
|
|
|
|
is needed as a hint. (The minibuffer is a special case. The content
|
|
|
|
|
of the minibuffer before point is always the common substring.)")
|
2005-10-16 09:31:48 +00:00
|
|
|
|
|
|
|
|
|
;; This function goes in completion-setup-hook, so that it is called
|
|
|
|
|
;; after the text of the completion list buffer is written.
|
1993-07-13 21:34:05 +00:00
|
|
|
|
(defun completion-setup-function ()
|
2005-11-01 07:18:10 +00:00
|
|
|
|
(let* ((mainbuf (current-buffer))
|
2005-12-16 19:08:21 +00:00
|
|
|
|
(mbuf-contents (minibuffer-completion-contents))
|
|
|
|
|
common-string-length)
|
2004-05-19 19:10:19 +00:00
|
|
|
|
;; When reading a file name in the minibuffer,
|
|
|
|
|
;; set default-directory in the minibuffer
|
|
|
|
|
;; so it will get copied into the completion list buffer.
|
|
|
|
|
(if minibuffer-completing-file-name
|
|
|
|
|
(with-current-buffer mainbuf
|
|
|
|
|
(setq default-directory (file-name-directory mbuf-contents))))
|
|
|
|
|
(with-current-buffer standard-output
|
1994-03-02 23:09:40 +00:00
|
|
|
|
(completion-list-mode)
|
2005-11-01 07:18:10 +00:00
|
|
|
|
(set (make-local-variable 'completion-reference-buffer) mainbuf)
|
2005-11-16 22:43:16 +00:00
|
|
|
|
(setq completion-base-size
|
2005-12-16 19:08:21 +00:00
|
|
|
|
(cond
|
|
|
|
|
((and (symbolp minibuffer-completion-table)
|
|
|
|
|
(get minibuffer-completion-table 'completion-base-size-function))
|
|
|
|
|
;; To compute base size, a function can use the global value of
|
|
|
|
|
;; completion-common-substring or minibuffer-completion-contents.
|
|
|
|
|
(with-current-buffer mainbuf
|
|
|
|
|
(funcall (get minibuffer-completion-table
|
|
|
|
|
'completion-base-size-function))))
|
|
|
|
|
(minibuffer-completing-file-name
|
|
|
|
|
;; For file name completion, use the number of chars before
|
|
|
|
|
;; the start of the file name component at point.
|
|
|
|
|
(with-current-buffer mainbuf
|
|
|
|
|
(save-excursion
|
|
|
|
|
(skip-chars-backward completion-root-regexp)
|
|
|
|
|
(- (point) (minibuffer-prompt-end)))))
|
|
|
|
|
;; Otherwise, in minibuffer, the base size is 0.
|
|
|
|
|
((minibufferp mainbuf) 0)))
|
|
|
|
|
(setq common-string-length
|
|
|
|
|
(cond
|
|
|
|
|
(completion-common-substring
|
|
|
|
|
(length completion-common-substring))
|
|
|
|
|
(completion-base-size
|
|
|
|
|
(- (length mbuf-contents) completion-base-size))))
|
2004-05-19 19:10:19 +00:00
|
|
|
|
;; Put faces on first uncommon characters and common parts.
|
2005-12-16 19:08:21 +00:00
|
|
|
|
(when (and (integerp common-string-length) (>= common-string-length 0))
|
2005-11-01 07:18:10 +00:00
|
|
|
|
(let ((element-start (point-min))
|
|
|
|
|
(maxp (point-max))
|
|
|
|
|
element-common-end)
|
|
|
|
|
(while (and (setq element-start
|
|
|
|
|
(next-single-property-change
|
|
|
|
|
element-start 'mouse-face))
|
|
|
|
|
(< (setq element-common-end
|
|
|
|
|
(+ element-start common-string-length))
|
|
|
|
|
maxp))
|
2005-12-04 02:42:29 +00:00
|
|
|
|
(when (get-char-property element-start 'mouse-face)
|
2005-12-16 19:08:21 +00:00
|
|
|
|
(if (and (> common-string-length 0)
|
|
|
|
|
(get-char-property (1- element-common-end) 'mouse-face))
|
2005-12-04 02:42:29 +00:00
|
|
|
|
(put-text-property element-start element-common-end
|
|
|
|
|
'font-lock-face 'completions-common-part))
|
|
|
|
|
(if (get-char-property element-common-end 'mouse-face)
|
|
|
|
|
(put-text-property element-common-end (1+ element-common-end)
|
|
|
|
|
'font-lock-face 'completions-first-difference))))))
|
2006-09-04 18:26:03 +00:00
|
|
|
|
;; Maybe insert help string.
|
|
|
|
|
(when completion-show-help
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(if (display-mouse-p)
|
|
|
|
|
(insert (substitute-command-keys
|
|
|
|
|
"Click \\[mouse-choose-completion] on a completion to select it.\n")))
|
|
|
|
|
(insert (substitute-command-keys
|
|
|
|
|
"In this buffer, type \\[choose-completion] to \
|
|
|
|
|
select the completion near point.\n\n"))))))
|
1992-05-30 21:11:25 +00:00
|
|
|
|
|
1993-07-13 21:34:05 +00:00
|
|
|
|
(add-hook 'completion-setup-hook 'completion-setup-function)
|
1994-12-29 18:53:25 +00:00
|
|
|
|
|
2005-11-01 07:18:10 +00:00
|
|
|
|
(define-key minibuffer-local-completion-map [prior] 'switch-to-completions)
|
|
|
|
|
(define-key minibuffer-local-completion-map "\M-v" 'switch-to-completions)
|
1994-12-29 18:53:25 +00:00
|
|
|
|
|
|
|
|
|
(defun switch-to-completions ()
|
|
|
|
|
"Select the completion list window."
|
|
|
|
|
(interactive)
|
1995-07-07 13:26:23 +00:00
|
|
|
|
;; Make sure we have a completions window.
|
|
|
|
|
(or (get-buffer-window "*Completions*")
|
|
|
|
|
(minibuffer-completion-help))
|
1998-01-18 03:32:20 +00:00
|
|
|
|
(let ((window (get-buffer-window "*Completions*")))
|
|
|
|
|
(when window
|
|
|
|
|
(select-window window)
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(search-forward "\n\n")
|
|
|
|
|
(forward-line 1))))
|
2006-01-23 01:24:26 +00:00
|
|
|
|
|
|
|
|
|
;;; Support keyboard commands to turn on various modifiers.
|
1995-03-28 03:49:39 +00:00
|
|
|
|
|
|
|
|
|
;; These functions -- which are not commands -- each add one modifier
|
|
|
|
|
;; to the following event.
|
|
|
|
|
|
|
|
|
|
(defun event-apply-alt-modifier (ignore-prompt)
|
2003-05-13 19:45:01 +00:00
|
|
|
|
"\\<function-key-map>Add the Alt modifier to the following event.
|
1998-06-01 21:10:43 +00:00
|
|
|
|
For example, type \\[event-apply-alt-modifier] & to enter Alt-&."
|
1995-03-28 03:49:39 +00:00
|
|
|
|
(vector (event-apply-modifier (read-event) 'alt 22 "A-")))
|
|
|
|
|
(defun event-apply-super-modifier (ignore-prompt)
|
2003-05-13 19:45:01 +00:00
|
|
|
|
"\\<function-key-map>Add the Super modifier to the following event.
|
1998-06-01 21:10:43 +00:00
|
|
|
|
For example, type \\[event-apply-super-modifier] & to enter Super-&."
|
1995-03-28 03:49:39 +00:00
|
|
|
|
(vector (event-apply-modifier (read-event) 'super 23 "s-")))
|
|
|
|
|
(defun event-apply-hyper-modifier (ignore-prompt)
|
2003-05-13 19:45:01 +00:00
|
|
|
|
"\\<function-key-map>Add the Hyper modifier to the following event.
|
1998-06-01 21:10:43 +00:00
|
|
|
|
For example, type \\[event-apply-hyper-modifier] & to enter Hyper-&."
|
1995-03-28 03:49:39 +00:00
|
|
|
|
(vector (event-apply-modifier (read-event) 'hyper 24 "H-")))
|
|
|
|
|
(defun event-apply-shift-modifier (ignore-prompt)
|
2003-05-13 19:45:01 +00:00
|
|
|
|
"\\<function-key-map>Add the Shift modifier to the following event.
|
1998-06-01 21:10:43 +00:00
|
|
|
|
For example, type \\[event-apply-shift-modifier] & to enter Shift-&."
|
1995-03-28 03:49:39 +00:00
|
|
|
|
(vector (event-apply-modifier (read-event) 'shift 25 "S-")))
|
|
|
|
|
(defun event-apply-control-modifier (ignore-prompt)
|
2003-05-13 19:45:01 +00:00
|
|
|
|
"\\<function-key-map>Add the Ctrl modifier to the following event.
|
1998-06-01 21:10:43 +00:00
|
|
|
|
For example, type \\[event-apply-control-modifier] & to enter Ctrl-&."
|
1995-03-28 03:49:39 +00:00
|
|
|
|
(vector (event-apply-modifier (read-event) 'control 26 "C-")))
|
|
|
|
|
(defun event-apply-meta-modifier (ignore-prompt)
|
2003-05-13 19:45:01 +00:00
|
|
|
|
"\\<function-key-map>Add the Meta modifier to the following event.
|
1998-06-01 21:10:43 +00:00
|
|
|
|
For example, type \\[event-apply-meta-modifier] & to enter Meta-&."
|
1995-03-28 03:49:39 +00:00
|
|
|
|
(vector (event-apply-modifier (read-event) 'meta 27 "M-")))
|
|
|
|
|
|
|
|
|
|
(defun event-apply-modifier (event symbol lshiftby prefix)
|
|
|
|
|
"Apply a modifier flag to event EVENT.
|
|
|
|
|
SYMBOL is the name of this modifier, as a symbol.
|
|
|
|
|
LSHIFTBY is the numeric value of this modifier, in keyboard events.
|
|
|
|
|
PREFIX is the string that represents this modifier in an event type symbol."
|
|
|
|
|
(if (numberp event)
|
|
|
|
|
(cond ((eq symbol 'control)
|
1995-04-04 22:48:16 +00:00
|
|
|
|
(if (and (<= (downcase event) ?z)
|
|
|
|
|
(>= (downcase event) ?a))
|
1995-03-28 03:49:39 +00:00
|
|
|
|
(- (downcase event) ?a -1)
|
1995-04-04 22:48:16 +00:00
|
|
|
|
(if (and (<= (downcase event) ?Z)
|
|
|
|
|
(>= (downcase event) ?A))
|
1995-03-28 03:49:39 +00:00
|
|
|
|
(- (downcase event) ?A -1)
|
|
|
|
|
(logior (lsh 1 lshiftby) event))))
|
|
|
|
|
((eq symbol 'shift)
|
|
|
|
|
(if (and (<= (downcase event) ?z)
|
|
|
|
|
(>= (downcase event) ?a))
|
|
|
|
|
(upcase event)
|
|
|
|
|
(logior (lsh 1 lshiftby) event)))
|
|
|
|
|
(t
|
|
|
|
|
(logior (lsh 1 lshiftby) event)))
|
|
|
|
|
(if (memq symbol (event-modifiers event))
|
|
|
|
|
event
|
|
|
|
|
(let ((event-type (if (symbolp event) event (car event))))
|
|
|
|
|
(setq event-type (intern (concat prefix (symbol-name event-type))))
|
|
|
|
|
(if (symbolp event)
|
|
|
|
|
event-type
|
|
|
|
|
(cons event-type (cdr event)))))))
|
|
|
|
|
|
1995-04-05 03:34:40 +00:00
|
|
|
|
(define-key function-key-map [?\C-x ?@ ?h] 'event-apply-hyper-modifier)
|
|
|
|
|
(define-key function-key-map [?\C-x ?@ ?s] 'event-apply-super-modifier)
|
|
|
|
|
(define-key function-key-map [?\C-x ?@ ?m] 'event-apply-meta-modifier)
|
|
|
|
|
(define-key function-key-map [?\C-x ?@ ?a] 'event-apply-alt-modifier)
|
|
|
|
|
(define-key function-key-map [?\C-x ?@ ?S] 'event-apply-shift-modifier)
|
|
|
|
|
(define-key function-key-map [?\C-x ?@ ?c] 'event-apply-control-modifier)
|
2006-01-23 01:24:26 +00:00
|
|
|
|
|
1993-07-01 20:34:13 +00:00
|
|
|
|
;;;; Keypad support.
|
|
|
|
|
|
|
|
|
|
;;; Make the keypad keys act like ordinary typing keys. If people add
|
|
|
|
|
;;; bindings for the function key symbols, then those bindings will
|
|
|
|
|
;;; override these, so this shouldn't interfere with any existing
|
|
|
|
|
;;; bindings.
|
|
|
|
|
|
1993-12-25 00:45:07 +00:00
|
|
|
|
;; Also tell read-char how to handle these keys.
|
2001-10-31 00:57:04 +00:00
|
|
|
|
(mapc
|
1993-07-01 20:34:13 +00:00
|
|
|
|
(lambda (keypad-normal)
|
|
|
|
|
(let ((keypad (nth 0 keypad-normal))
|
|
|
|
|
(normal (nth 1 keypad-normal)))
|
1993-12-25 00:45:07 +00:00
|
|
|
|
(put keypad 'ascii-character normal)
|
1993-07-01 20:34:13 +00:00
|
|
|
|
(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)
|
(clone-indirect-buffer): Doc fix.
(fixup-whitespace, just-one-space, backward-delete-char-untabify, lambda):
"?\ " -> "?\s".
(next-error, next-error-highlight, next-error-highlight-no-select,
next-error-last-buffer, next-error-buffer-p, next-error-find-buffer, next-error,
previous-error, next-error-no-select, previous-error-no-select, open-line,
split-line, minibuffer-prompt-width, kill-new, binary-overwrite-mode):
Fix typos in docstrings.
(set-fill-column): Fix typo in message.
2005-07-20 22:29:53 +00:00
|
|
|
|
(kp-space ?\s)
|
1993-07-01 20:34:13 +00:00
|
|
|
|
(kp-tab ?\t)
|
|
|
|
|
(kp-enter ?\r)
|
|
|
|
|
(kp-multiply ?*)
|
|
|
|
|
(kp-add ?+)
|
|
|
|
|
(kp-separator ?,)
|
|
|
|
|
(kp-subtract ?-)
|
|
|
|
|
(kp-decimal ?.)
|
|
|
|
|
(kp-divide ?/)
|
|
|
|
|
(kp-equal ?=)))
|
2002-04-27 23:16:18 +00:00
|
|
|
|
|
1999-11-15 16:11:14 +00:00
|
|
|
|
;;;;
|
1999-10-13 00:48:17 +00:00
|
|
|
|
;;;; forking a twin copy of a buffer.
|
1999-11-15 16:11:14 +00:00
|
|
|
|
;;;;
|
1999-10-13 00:48:17 +00:00
|
|
|
|
|
|
|
|
|
(defvar clone-buffer-hook nil
|
|
|
|
|
"Normal hook to run in the new buffer at the end of `clone-buffer'.")
|
|
|
|
|
|
|
|
|
|
(defun clone-process (process &optional newname)
|
|
|
|
|
"Create a twin copy of PROCESS.
|
|
|
|
|
If NEWNAME is nil, it defaults to PROCESS' name;
|
|
|
|
|
NEWNAME is modified by adding or incrementing <N> at the end as necessary.
|
|
|
|
|
If PROCESS is associated with a buffer, the new process will be associated
|
|
|
|
|
with the current buffer instead.
|
|
|
|
|
Returns nil if PROCESS has already terminated."
|
|
|
|
|
(setq newname (or newname (process-name process)))
|
|
|
|
|
(if (string-match "<[0-9]+>\\'" newname)
|
|
|
|
|
(setq newname (substring newname 0 (match-beginning 0))))
|
|
|
|
|
(when (memq (process-status process) '(run stop open))
|
|
|
|
|
(let* ((process-connection-type (process-tty-name process))
|
|
|
|
|
(new-process
|
|
|
|
|
(if (memq (process-status process) '(open))
|
2002-03-17 20:28:53 +00:00
|
|
|
|
(let ((args (process-contact process t)))
|
|
|
|
|
(setq args (plist-put args :name newname))
|
|
|
|
|
(setq args (plist-put args :buffer
|
2003-01-14 10:16:00 +00:00
|
|
|
|
(if (process-buffer process)
|
|
|
|
|
(current-buffer))))
|
2002-03-17 20:28:53 +00:00
|
|
|
|
(apply 'make-network-process args))
|
1999-10-13 00:48:17 +00:00
|
|
|
|
(apply 'start-process newname
|
|
|
|
|
(if (process-buffer process) (current-buffer))
|
|
|
|
|
(process-command process)))))
|
2002-03-17 20:28:53 +00:00
|
|
|
|
(set-process-query-on-exit-flag
|
|
|
|
|
new-process (process-query-on-exit-flag process))
|
1999-10-13 00:48:17 +00:00
|
|
|
|
(set-process-inherit-coding-system-flag
|
|
|
|
|
new-process (process-inherit-coding-system-flag process))
|
|
|
|
|
(set-process-filter new-process (process-filter process))
|
|
|
|
|
(set-process-sentinel new-process (process-sentinel process))
|
2003-01-14 10:16:00 +00:00
|
|
|
|
(set-process-plist new-process (copy-sequence (process-plist process)))
|
1999-10-13 00:48:17 +00:00
|
|
|
|
new-process)))
|
|
|
|
|
|
2002-03-26 06:29:01 +00:00
|
|
|
|
;; things to maybe add (currently partly covered by `funcall mode'):
|
1999-10-13 00:48:17 +00:00
|
|
|
|
;; - syntax-table
|
|
|
|
|
;; - overlays
|
|
|
|
|
(defun clone-buffer (&optional newname display-flag)
|
2004-03-18 02:57:32 +00:00
|
|
|
|
"Create and return a twin copy of the current buffer.
|
|
|
|
|
Unlike an indirect buffer, the new buffer can be edited
|
|
|
|
|
independently of the old one (if it is not read-only).
|
|
|
|
|
NEWNAME is the name of the new buffer. It may be modified by
|
|
|
|
|
adding or incrementing <N> at the end as necessary to create a
|
|
|
|
|
unique buffer name. If nil, it defaults to the name of the
|
|
|
|
|
current buffer, with the proper suffix. If DISPLAY-FLAG is
|
|
|
|
|
non-nil, the new buffer is shown with `pop-to-buffer'. Trying to
|
|
|
|
|
clone a file-visiting buffer, or a buffer whose major mode symbol
|
|
|
|
|
has a non-nil `no-clone' property, results in an error.
|
|
|
|
|
|
|
|
|
|
Interactively, DISPLAY-FLAG is t and NEWNAME is the name of the
|
|
|
|
|
current buffer with appropriate suffix. However, if a prefix
|
|
|
|
|
argument is given, then the command prompts for NEWNAME in the
|
|
|
|
|
minibuffer.
|
1999-10-13 00:48:17 +00:00
|
|
|
|
|
|
|
|
|
This runs the normal hook `clone-buffer-hook' in the new buffer
|
|
|
|
|
after it has been set up properly in other respects."
|
2001-11-13 02:09:59 +00:00
|
|
|
|
(interactive
|
|
|
|
|
(progn
|
|
|
|
|
(if buffer-file-name
|
|
|
|
|
(error "Cannot clone a file-visiting buffer"))
|
|
|
|
|
(if (get major-mode 'no-clone)
|
|
|
|
|
(error "Cannot clone a buffer in %s mode" mode-name))
|
2006-01-23 01:24:26 +00:00
|
|
|
|
(list (if current-prefix-arg
|
|
|
|
|
(read-buffer "Name of new cloned buffer: " (current-buffer)))
|
2001-11-13 02:09:59 +00:00
|
|
|
|
t)))
|
1999-10-13 00:48:17 +00:00
|
|
|
|
(if buffer-file-name
|
|
|
|
|
(error "Cannot clone a file-visiting buffer"))
|
|
|
|
|
(if (get major-mode 'no-clone)
|
|
|
|
|
(error "Cannot clone a buffer in %s mode" mode-name))
|
|
|
|
|
(setq newname (or newname (buffer-name)))
|
|
|
|
|
(if (string-match "<[0-9]+>\\'" newname)
|
|
|
|
|
(setq newname (substring newname 0 (match-beginning 0))))
|
|
|
|
|
(let ((buf (current-buffer))
|
|
|
|
|
(ptmin (point-min))
|
|
|
|
|
(ptmax (point-max))
|
|
|
|
|
(pt (point))
|
|
|
|
|
(mk (if mark-active (mark t)))
|
|
|
|
|
(modified (buffer-modified-p))
|
|
|
|
|
(mode major-mode)
|
|
|
|
|
(lvars (buffer-local-variables))
|
|
|
|
|
(process (get-buffer-process (current-buffer)))
|
|
|
|
|
(new (generate-new-buffer (or newname (buffer-name)))))
|
|
|
|
|
(save-restriction
|
|
|
|
|
(widen)
|
|
|
|
|
(with-current-buffer new
|
|
|
|
|
(insert-buffer-substring buf)))
|
|
|
|
|
(with-current-buffer new
|
|
|
|
|
(narrow-to-region ptmin ptmax)
|
|
|
|
|
(goto-char pt)
|
|
|
|
|
(if mk (set-mark mk))
|
|
|
|
|
(set-buffer-modified-p modified)
|
|
|
|
|
|
|
|
|
|
;; Clone the old buffer's process, if any.
|
|
|
|
|
(when process (clone-process process))
|
|
|
|
|
|
|
|
|
|
;; Now set up the major mode.
|
|
|
|
|
(funcall mode)
|
|
|
|
|
|
|
|
|
|
;; Set up other local variables.
|
|
|
|
|
(mapcar (lambda (v)
|
|
|
|
|
(condition-case () ;in case var is read-only
|
|
|
|
|
(if (symbolp v)
|
|
|
|
|
(makunbound v)
|
|
|
|
|
(set (make-local-variable (car v)) (cdr v)))
|
|
|
|
|
(error nil)))
|
|
|
|
|
lvars)
|
|
|
|
|
|
|
|
|
|
;; Run any hooks (typically set up by the major mode
|
|
|
|
|
;; for cloning to work properly).
|
|
|
|
|
(run-hooks 'clone-buffer-hook))
|
2006-01-23 04:05:59 +00:00
|
|
|
|
(if display-flag
|
|
|
|
|
;; Presumably the current buffer is shown in the selected frame, so
|
|
|
|
|
;; we want to display the clone elsewhere.
|
|
|
|
|
(let ((same-window-regexps nil)
|
|
|
|
|
(same-window-buffer-names))
|
|
|
|
|
(pop-to-buffer new)))
|
1999-10-13 00:48:17 +00:00
|
|
|
|
new))
|
|
|
|
|
|
2000-04-17 15:24:58 +00:00
|
|
|
|
|
2000-04-19 20:40:46 +00:00
|
|
|
|
(defun clone-indirect-buffer (newname display-flag &optional norecord)
|
2000-04-17 15:24:58 +00:00
|
|
|
|
"Create an indirect buffer that is a twin copy of the current buffer.
|
|
|
|
|
|
2005-06-20 10:29:02 +00:00
|
|
|
|
Give the indirect buffer name NEWNAME. Interactively, read NEWNAME
|
2000-04-17 15:24:58 +00:00
|
|
|
|
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 `<N>' suffix to it
|
|
|
|
|
or by incrementing the N in an existing suffix.
|
|
|
|
|
|
|
|
|
|
DISPLAY-FLAG non-nil means show the new buffer with `pop-to-buffer'.
|
2000-04-19 20:40:46 +00:00
|
|
|
|
This is always done when called interactively.
|
|
|
|
|
|
(clone-indirect-buffer): Doc fix.
(fixup-whitespace, just-one-space, backward-delete-char-untabify, lambda):
"?\ " -> "?\s".
(next-error, next-error-highlight, next-error-highlight-no-select,
next-error-last-buffer, next-error-buffer-p, next-error-find-buffer, next-error,
previous-error, next-error-no-select, previous-error-no-select, open-line,
split-line, minibuffer-prompt-width, kill-new, binary-overwrite-mode):
Fix typos in docstrings.
(set-fill-column): Fix typo in message.
2005-07-20 22:29:53 +00:00
|
|
|
|
Optional third arg NORECORD non-nil means do not put this buffer at the
|
2000-04-19 20:40:46 +00:00
|
|
|
|
front of the list of recently selected ones."
|
2001-11-13 02:09:59 +00:00
|
|
|
|
(interactive
|
|
|
|
|
(progn
|
|
|
|
|
(if (get major-mode 'no-clone-indirect)
|
|
|
|
|
(error "Cannot indirectly clone a buffer in %s mode" mode-name))
|
|
|
|
|
(list (if current-prefix-arg
|
2006-01-23 01:24:26 +00:00
|
|
|
|
(read-buffer "Name of indirect buffer: " (current-buffer)))
|
2001-11-13 02:09:59 +00:00
|
|
|
|
t)))
|
|
|
|
|
(if (get major-mode 'no-clone-indirect)
|
|
|
|
|
(error "Cannot indirectly clone a buffer in %s mode" mode-name))
|
2000-04-17 15:24:58 +00:00
|
|
|
|
(setq newname (or newname (buffer-name)))
|
|
|
|
|
(if (string-match "<[0-9]+>\\'" newname)
|
|
|
|
|
(setq newname (substring newname 0 (match-beginning 0))))
|
|
|
|
|
(let* ((name (generate-new-buffer-name newname))
|
|
|
|
|
(buffer (make-indirect-buffer (current-buffer) name t)))
|
|
|
|
|
(when display-flag
|
2000-11-22 19:47:30 +00:00
|
|
|
|
(pop-to-buffer buffer norecord))
|
2000-04-17 15:24:58 +00:00
|
|
|
|
buffer))
|
|
|
|
|
|
|
|
|
|
|
2006-01-26 17:56:54 +00:00
|
|
|
|
(defun clone-indirect-buffer-other-window (newname display-flag &optional norecord)
|
|
|
|
|
"Like `clone-indirect-buffer' but display in another window."
|
2006-01-20 01:22:07 +00:00
|
|
|
|
(interactive
|
|
|
|
|
(progn
|
|
|
|
|
(if (get major-mode 'no-clone-indirect)
|
|
|
|
|
(error "Cannot indirectly clone a buffer in %s mode" mode-name))
|
|
|
|
|
(list (if current-prefix-arg
|
2006-01-23 01:24:26 +00:00
|
|
|
|
(read-buffer "Name of indirect buffer: " (current-buffer)))
|
2006-01-20 01:22:07 +00:00
|
|
|
|
t)))
|
2002-05-01 15:08:25 +00:00
|
|
|
|
(let ((pop-up-windows t))
|
2006-01-26 17:56:54 +00:00
|
|
|
|
(clone-indirect-buffer newname display-flag norecord)))
|
2000-04-19 20:40:46 +00:00
|
|
|
|
|
2002-04-27 23:16:18 +00:00
|
|
|
|
|
2000-12-14 13:36:59 +00:00
|
|
|
|
;;; Handling of Backspace and Delete keys.
|
|
|
|
|
|
2005-03-06 00:32:12 +00:00
|
|
|
|
(defcustom normal-erase-is-backspace
|
|
|
|
|
(and (not noninteractive)
|
|
|
|
|
(or (memq system-type '(ms-dos windows-nt))
|
2005-03-15 07:45:21 +00:00
|
|
|
|
(eq window-system 'mac)
|
2005-03-06 00:32:12 +00:00
|
|
|
|
(and (memq window-system '(x))
|
|
|
|
|
(fboundp 'x-backspace-delete-keys-p)
|
|
|
|
|
(x-backspace-delete-keys-p))
|
|
|
|
|
;; If the terminal Emacs is running on has erase char
|
|
|
|
|
;; set to ^H, use the Backspace key for deleting
|
|
|
|
|
;; backward and, and the Delete key for deleting forward.
|
|
|
|
|
(and (null window-system)
|
|
|
|
|
(eq tty-erase-char ?\^H))))
|
2001-04-04 14:07:13 +00:00
|
|
|
|
"If non-nil, Delete key deletes forward and Backspace key deletes backward.
|
2000-12-14 13:36:59 +00:00
|
|
|
|
|
|
|
|
|
On window systems, the default value of this option is chosen
|
|
|
|
|
according to the keyboard used. If the keyboard has both a Backspace
|
|
|
|
|
key and a Delete key, and both are mapped to their usual meanings, the
|
|
|
|
|
option's default value is set to t, so that Backspace can be used to
|
2001-04-04 14:07:13 +00:00
|
|
|
|
delete backward, and Delete can be used to delete forward.
|
2000-12-14 13:36:59 +00:00
|
|
|
|
|
2001-04-04 14:07:13 +00:00
|
|
|
|
If not running under a window system, customizing this option accomplishes
|
2000-12-14 13:36:59 +00:00
|
|
|
|
a similar effect by mapping C-h, which is usually generated by the
|
|
|
|
|
Backspace key, to DEL, and by mapping DEL to C-d via
|
|
|
|
|
`keyboard-translate'. The former functionality of C-h is available on
|
|
|
|
|
the F1 key. You should probably not use this setting if you don't
|
2000-12-22 12:50:39 +00:00
|
|
|
|
have both Backspace, Delete and F1 keys.
|
|
|
|
|
|
|
|
|
|
Setting this variable with setq doesn't take effect. Programmatically,
|
2001-04-04 14:07:13 +00:00
|
|
|
|
call `normal-erase-is-backspace-mode' (which see) instead."
|
2000-12-14 13:36:59 +00:00
|
|
|
|
:type 'boolean
|
|
|
|
|
:group 'editing-basics
|
|
|
|
|
:version "21.1"
|
|
|
|
|
:set (lambda (symbol value)
|
|
|
|
|
;; The fboundp is because of a problem with :set when
|
|
|
|
|
;; dumping Emacs. It doesn't really matter.
|
2001-04-04 14:07:13 +00:00
|
|
|
|
(if (fboundp 'normal-erase-is-backspace-mode)
|
|
|
|
|
(normal-erase-is-backspace-mode (or value 0))
|
2000-12-14 13:36:59 +00:00
|
|
|
|
(set-default symbol value))))
|
|
|
|
|
|
|
|
|
|
|
2001-04-04 14:07:13 +00:00
|
|
|
|
(defun normal-erase-is-backspace-mode (&optional arg)
|
|
|
|
|
"Toggle the Erase and Delete mode of the Backspace and Delete keys.
|
|
|
|
|
|
2001-04-06 13:36:54 +00:00
|
|
|
|
With numeric arg, turn the mode on if and only if ARG is positive.
|
2001-04-04 14:07:13 +00:00
|
|
|
|
|
|
|
|
|
On window systems, when this mode is on, Delete is mapped to C-d and
|
|
|
|
|
Backspace is mapped to DEL; when this mode is off, both Delete and
|
|
|
|
|
Backspace are mapped to DEL. (The remapping goes via
|
|
|
|
|
`function-key-map', so binding Delete or Backspace in the global or
|
|
|
|
|
local keymap will override that.)
|
|
|
|
|
|
|
|
|
|
In addition, on window systems, the bindings of C-Delete, M-Delete,
|
|
|
|
|
C-M-Delete, C-Backspace, M-Backspace, and C-M-Backspace are changed in
|
|
|
|
|
the global keymap in accordance with the functionality of Delete and
|
|
|
|
|
Backspace. For example, if Delete is remapped to C-d, which deletes
|
|
|
|
|
forward, C-Delete is bound to `kill-word', but if Delete is remapped
|
|
|
|
|
to DEL, which deletes backward, C-Delete is bound to
|
|
|
|
|
`backward-kill-word'.
|
|
|
|
|
|
|
|
|
|
If not running on a window system, a similar effect is accomplished by
|
|
|
|
|
remapping C-h (normally produced by the Backspace key) and DEL via
|
|
|
|
|
`keyboard-translate': if this mode is on, C-h is mapped to DEL and DEL
|
|
|
|
|
to C-d; if it's off, the keys are not remapped.
|
|
|
|
|
|
|
|
|
|
When not running on a window system, and this mode is turned on, the
|
|
|
|
|
former functionality of C-h is available on the F1 key. You should
|
|
|
|
|
probably not turn on this mode on a text-only terminal if you don't
|
|
|
|
|
have both Backspace, Delete and F1 keys.
|
|
|
|
|
|
|
|
|
|
See also `normal-erase-is-backspace'."
|
2000-12-14 13:36:59 +00:00
|
|
|
|
(interactive "P")
|
2001-04-04 14:07:13 +00:00
|
|
|
|
(setq normal-erase-is-backspace
|
2000-12-14 13:36:59 +00:00
|
|
|
|
(if arg
|
|
|
|
|
(> (prefix-numeric-value arg) 0)
|
2001-04-04 14:07:13 +00:00
|
|
|
|
(not normal-erase-is-backspace)))
|
2000-12-14 13:36:59 +00:00
|
|
|
|
|
2000-12-14 16:51:52 +00:00
|
|
|
|
(cond ((or (memq window-system '(x w32 mac pc))
|
|
|
|
|
(memq system-type '(ms-dos windows-nt)))
|
2001-04-04 14:07:13 +00:00
|
|
|
|
(let ((bindings
|
2001-02-10 16:34:42 +00:00
|
|
|
|
`(([C-delete] [C-backspace])
|
|
|
|
|
([M-delete] [M-backspace])
|
|
|
|
|
([C-M-delete] [C-M-backspace])
|
2001-01-16 20:25:23 +00:00
|
|
|
|
(,esc-map
|
2001-02-10 16:34:42 +00:00
|
|
|
|
[C-delete] [C-backspace])))
|
|
|
|
|
(old-state (lookup-key function-key-map [delete])))
|
2001-01-16 20:25:23 +00:00
|
|
|
|
|
2001-04-04 14:07:13 +00:00
|
|
|
|
(if normal-erase-is-backspace
|
2001-01-16 20:25:23 +00:00
|
|
|
|
(progn
|
|
|
|
|
(define-key function-key-map [delete] [?\C-d])
|
2001-01-31 15:05:25 +00:00
|
|
|
|
(define-key function-key-map [kp-delete] [?\C-d])
|
2001-01-16 20:25:23 +00:00
|
|
|
|
(define-key function-key-map [backspace] [?\C-?]))
|
|
|
|
|
(define-key function-key-map [delete] [?\C-?])
|
2001-01-31 15:05:25 +00:00
|
|
|
|
(define-key function-key-map [kp-delete] [?\C-?])
|
2001-01-16 20:25:23 +00:00
|
|
|
|
(define-key function-key-map [backspace] [?\C-?]))
|
|
|
|
|
|
2001-02-10 16:34:42 +00:00
|
|
|
|
;; Maybe swap bindings of C-delete and C-backspace, etc.
|
|
|
|
|
(unless (equal old-state (lookup-key function-key-map [delete]))
|
|
|
|
|
(dolist (binding bindings)
|
|
|
|
|
(let ((map global-map))
|
|
|
|
|
(when (keymapp (car binding))
|
|
|
|
|
(setq map (car binding) binding (cdr binding)))
|
|
|
|
|
(let* ((key1 (nth 0 binding))
|
|
|
|
|
(key2 (nth 1 binding))
|
|
|
|
|
(binding1 (lookup-key map key1))
|
|
|
|
|
(binding2 (lookup-key map key2)))
|
|
|
|
|
(define-key map key1 binding2)
|
|
|
|
|
(define-key map key2 binding1)))))))
|
2000-12-14 13:36:59 +00:00
|
|
|
|
(t
|
2001-04-04 14:07:13 +00:00
|
|
|
|
(if normal-erase-is-backspace
|
2000-12-14 13:36:59 +00:00
|
|
|
|
(progn
|
|
|
|
|
(keyboard-translate ?\C-h ?\C-?)
|
|
|
|
|
(keyboard-translate ?\C-? ?\C-d))
|
|
|
|
|
(keyboard-translate ?\C-h ?\C-h)
|
|
|
|
|
(keyboard-translate ?\C-? ?\C-?))))
|
|
|
|
|
|
2001-04-04 14:07:13 +00:00
|
|
|
|
(run-hooks 'normal-erase-is-backspace-hook)
|
2000-12-14 13:36:59 +00:00
|
|
|
|
(if (interactive-p)
|
2001-04-04 14:07:13 +00:00
|
|
|
|
(message "Delete key deletes %s"
|
|
|
|
|
(if normal-erase-is-backspace "forward" "backward"))))
|
2003-05-25 01:45:14 +00:00
|
|
|
|
|
2003-06-17 18:40:06 +00:00
|
|
|
|
(defvar vis-mode-saved-buffer-invisibility-spec nil
|
2003-07-07 21:00:26 +00:00
|
|
|
|
"Saved value of `buffer-invisibility-spec' when Visible mode is on.")
|
2001-04-04 14:07:13 +00:00
|
|
|
|
|
2003-07-07 21:00:26 +00:00
|
|
|
|
(define-minor-mode visible-mode
|
|
|
|
|
"Toggle Visible mode.
|
|
|
|
|
With argument ARG turn Visible mode on iff ARG is positive.
|
2000-12-14 13:36:59 +00:00
|
|
|
|
|
2003-07-07 21:00:26 +00:00
|
|
|
|
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."
|
2003-06-17 02:35:46 +00:00
|
|
|
|
:lighter " Vis"
|
2005-04-02 19:24:26 +00:00
|
|
|
|
:group 'editing-basics
|
2003-06-17 18:40:06 +00:00
|
|
|
|
(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))
|
2003-07-07 21:00:26 +00:00
|
|
|
|
(when visible-mode
|
2003-06-17 18:40:06 +00:00
|
|
|
|
(set (make-local-variable 'vis-mode-saved-buffer-invisibility-spec)
|
|
|
|
|
buffer-invisibility-spec)
|
|
|
|
|
(setq buffer-invisibility-spec nil)))
|
2003-06-17 02:35:46 +00:00
|
|
|
|
|
2001-10-31 00:57:04 +00:00
|
|
|
|
;; Minibuffer prompt stuff.
|
2001-09-13 10:02:35 +00:00
|
|
|
|
|
2001-09-14 11:08:20 +00:00
|
|
|
|
;(defun minibuffer-prompt-modification (start end)
|
|
|
|
|
; (error "You cannot modify the prompt"))
|
|
|
|
|
;
|
|
|
|
|
;
|
|
|
|
|
;(defun minibuffer-prompt-insertion (start end)
|
|
|
|
|
; (let ((inhibit-modification-hooks t))
|
|
|
|
|
; (delete-region start end)
|
|
|
|
|
; ;; Discard undo information for the text insertion itself
|
|
|
|
|
; ;; and for the text deletion.above.
|
|
|
|
|
; (when (consp buffer-undo-list)
|
|
|
|
|
; (setq buffer-undo-list (cddr buffer-undo-list)))
|
|
|
|
|
; (message "You cannot modify the prompt")))
|
|
|
|
|
;
|
|
|
|
|
;
|
2003-02-04 12:29:42 +00:00
|
|
|
|
;(setq minibuffer-prompt-properties
|
2001-09-14 11:08:20 +00:00
|
|
|
|
; (list 'modification-hooks '(minibuffer-prompt-modification)
|
|
|
|
|
; 'insert-in-front-hooks '(minibuffer-prompt-insertion)))
|
2003-02-04 12:29:42 +00:00
|
|
|
|
;
|
2001-09-13 10:02:35 +00:00
|
|
|
|
|
2002-09-13 13:56:41 +00:00
|
|
|
|
(provide 'simple)
|
2003-09-01 15:45:59 +00:00
|
|
|
|
|
2004-05-19 19:10:19 +00:00
|
|
|
|
;; arch-tag: 24af67c0-2a49-44f6-b3b1-312d8b570dfd
|
1992-05-30 21:11:25 +00:00
|
|
|
|
;;; simple.el ends here
|