annotate lisp/simple.el @ 844:047d37eb70d7

[xemacs-hg @ 2002-05-16 13:30:23 by ben] ui fixes for things that were bothering me bytecode.c, editfns.c, lisp.h, lread.c: Fix save-restriction to use markers rather than pseudo-markers (integers representing the amount of text on either side of the region). That way, all inserts are handled correctly, not just those inside old restriction. Add buffer argument to save_restriction_save(). process.c: Clean up very dirty and kludgy code that outputs into a buffer -- use proper unwind protects, etc. font-lock.c: Do save-restriction/widen around the function -- otherwise, incorrect results will ensue when a buffer has been narrowed before a call to e.g. `buffer-syntactic-context' -- something that happens quite often. fileio.c: Look for a handler for make-temp-name. window.c, winslots.h: Try to solve this annoying problem: have two frames displaying the buffer, in different places; in one, temporarily switch away to another buffer and then back -- and you've lost your position; it's reset to the other one in the other frame. My current solution involves window-level caches of buffers and points (also a cache for window-start); when set-window-buffer is called, it looks to see if the buffer was previously visited in the window, and if so, uses the most recent point at that time. (It's a marker, so it handles changes.) #### Note: It could be argued that doing it on the frame level would be better -- e.g. if you visit a buffer temporarily through a grep, and then go back to that buffer, you presumably want the grep's position rather than some previous position provided everything was in the same frame, even though the grep was in another window in the frame. However, doing it on the frame level fails when you have two windows on the same frame. Perhaps we keep both a window and a frame cache, and use the frame cache if there are no other windows on the frame showing the buffer, else the window's cache? This is probably something to be configurable using a specifier. Suggestions please please please? window.c: Clean up a bit code that deals with the annoyance of window-point vs. point. dialog.el: Function to ask a multiple-choice question, automatically choosing a dialog box or minibuffer representation as necessary. Generalized version of yes-or-no-p, y-or-n-p. files.el: Use get-user-response to ask "yes/no/diff" question when recovering. "diff" means that a diff is displayed between the current file and the autosave. (Converts/deconverts escape-quoted as necessary. No more complaints from you, Mr. Turnbull!) One known problem: when a dialog is used, it's modal, so you can't scroll the diff. Will fix soon. lisp-mode.el: If we're filling a string, don't treat semicolon as a comment, which would give very unfriendly results. Uses `buffer-syntactic-context'. simple.el: all changes back to the beginning. (Useful if you've saved the file in the middle of the changes.) simple.el: Add option kill-word-into-kill-ring, which controls whether words deleted with kill-word, backward-kill-word, etc. are "cut" into the kill ring, or "cleared" into nothingness. (My preference is the latter, by far. I'd almost go so far as suggesting we make it the default, as you can always select a word and then cut it if you want it cut.) menubar-items.el: Add option corresponding to kill-word-into-kill-ring.
author ben
date Thu, 16 May 2002 13:30:58 +0000
parents f46864126a0d
children 4cbfb36b35e0
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;;; simple.el --- basic editing commands for XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1985-7, 1993-5, 1997 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 613
diff changeset
5 ;; Copyright (C) 2000, 2001, 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Maintainer: XEmacs Development Team
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;; Keywords: lisp, extensions, internal, dumped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 ;;; Synched up with: FSF 19.34 [But not very closely].
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 ;; This file is dumped with XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 ;; A grab-bag of basic XEmacs commands not specifically related to some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;; major mode or to file-handling.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 ;; Changes for zmacs-style active-regions:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;; beginning-of-buffer, end-of-buffer, count-lines-region,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 ;; count-lines-buffer, what-line, what-cursor-position, set-goal-column,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 ;; set-fill-column, prefix-arg-internal, and line-move (which is used by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 ;; next-line and previous-line) set zmacs-region-stays to t, so that they
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 ;; don't affect the current region-hilighting state.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 ;; mark-whole-buffer, mark-word, exchange-point-and-mark, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 ;; set-mark-command (without an argument) call zmacs-activate-region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 ;; mark takes an optional arg like the new Fmark_marker() does. When
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 ;; the region is not active, mark returns nil unless the optional arg is true.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 ;; push-mark, pop-mark, exchange-point-and-mark, and set-marker, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 ;; set-mark-command use (mark t) so that they can access the mark whether
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 ;; the region is active or not.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 ;; shell-command, shell-command-on-region, yank, and yank-pop (which all
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 ;; push a mark) have been altered to call exchange-point-and-mark with an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 ;; argument, meaning "don't activate the region". These commands only use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 ;; exchange-point-and-mark to position the newly-pushed mark correctly, so
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 ;; this isn't a user-visible change. These functions have also been altered
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 ;; to use (mark t) for the same reason.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
61 ;; 97/3/14 Jareth Hein (jhod@po.iijnet.or.jp) added kinsoku processing
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
62 ;; (support for filling of Asian text) into the fill code. This was
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
63 ;; ripped bleeding from Mule-2.3, and could probably use some feature
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
64 ;; additions (like additional wrap styles, etc)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 ;; 97/06/11 Steve Baur (steve@xemacs.org) Convert use of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 ;; (preceding|following)-char to char-(after|before).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 (defgroup editing-basics nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 "Most basic editing variables."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 :group 'editing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 (defgroup killing nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 "Killing and yanking commands."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 :group 'editing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 (defgroup fill-comments nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 "Indenting and filling of comments."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 :prefix "comment-"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 :group 'fill)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 (defgroup paren-matching nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 "Highlight (un)matching of parens and expressions."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 :prefix "paren-"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 :group 'matching)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 (defgroup log-message nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 "Messages logging and display customizations."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 :group 'minibuffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 (defgroup warnings nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 "Warnings customizations."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 :group 'minibuffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 (defcustom search-caps-disable-folding t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 "*If non-nil, upper case chars disable case fold searching.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 This does not apply to \"yanked\" strings."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 ;; This is stolen (and slightly modified) from FSF emacs's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 ;; `isearch-no-upper-case-p'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 (defun no-upper-case-p (string &optional regexp-flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 "Return t if there are no upper case chars in STRING.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 If REGEXP-FLAG is non-nil, disregard letters preceded by `\\' (but not `\\\\')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 since they have special meaning in a regexp."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 (let ((case-fold-search nil))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
111 (not (string-match (if regexp-flag
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 "\\(^\\|\\\\\\\\\\|[^\\]\\)[A-Z]"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 "[A-Z]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 (defmacro with-search-caps-disable-folding (string regexp-flag &rest body) "\
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
118 Eval BODY with `case-fold-search' let to nil if `search-caps-disable-folding'
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 is non-nil, and if STRING (either a string or a regular expression according
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 to REGEXP-FLAG) contains uppercase letters."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 `(let ((case-fold-search
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 (if (and case-fold-search search-caps-disable-folding)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 (no-upper-case-p ,string ,regexp-flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 case-fold-search)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 ,@body))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 (put 'with-search-caps-disable-folding 'lisp-indent-function 2)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
127 (put 'with-search-caps-disable-folding 'edebug-form-spec
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 '(sexp sexp &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
130 (defmacro with-interactive-search-caps-disable-folding (string regexp-flag
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 &rest body)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 "Same as `with-search-caps-disable-folding', but only in the case of a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 function called interactively."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 `(let ((case-fold-search
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
135 (if (and (interactive-p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 case-fold-search search-caps-disable-folding)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 (no-upper-case-p ,string ,regexp-flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 case-fold-search)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 ,@body))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 (put 'with-interactive-search-caps-disable-folding 'lisp-indent-function 2)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
141 (put 'with-interactive-search-caps-disable-folding 'edebug-form-spec
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 '(sexp sexp &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
144 (defun newline (&optional n)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 "Insert a newline, and move to left margin of the new line if it's blank.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 The newline is marked with the text-property `hard'.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
147 With optional arg N, insert that many newlines.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 In Auto Fill mode, if no numeric arg, break the preceding line if it's long."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 (interactive "*P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 (barf-if-buffer-read-only nil (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 ;; Inserting a newline at the end of a line produces better redisplay in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 ;; try_window_id than inserting at the beginning of a line, and the textual
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 ;; result is the same. So, if we're at beginning of line, pretend to be at
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 ;; the end of the previous line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 ;; #### Does this have any relevance in XEmacs?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 (let ((flag (and (not (bobp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 (bolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 ;; Make sure the newline before point isn't intangible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 (not (get-char-property (1- (point)) 'intangible))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 ;; Make sure the newline before point isn't read-only.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 (not (get-char-property (1- (point)) 'read-only))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 ;; Make sure the newline before point isn't invisible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 (not (get-char-property (1- (point)) 'invisible))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 ;; This should probably also test for the previous char
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 ;; being the *last* character too.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 (not (get-char-property (1- (point)) 'end-open))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 ;; Make sure the newline before point has the same
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 ;; properties as the char before it (if any).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 (< (or (previous-extent-change (point)) -2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 (- (point) 2))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 (was-page-start (and (bolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 (looking-at page-delimiter)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 (beforepos (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 (if flag (backward-char 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 ;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 ;; Set last-command-char to tell self-insert what to insert.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 (let ((last-command-char ?\n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 ;; Don't auto-fill if we have a numeric argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 ;; Also not if flag is true (it would fill wrong line);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 ;; there is no need to since we're at BOL.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
181 (auto-fill-function (if (or n flag) nil auto-fill-function)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 (unwind-protect
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
183 (self-insert-command (prefix-numeric-value n))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 ;; If we get an error in self-insert-command, put point at right place.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 (if flag (forward-char 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 ;; If we did *not* get an error, cancel that forward-char.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 (if flag (backward-char 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 ;; Mark the newline(s) `hard'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 (if use-hard-newlines
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
190 (let* ((from (- (point) (if n (prefix-numeric-value n) 1)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 (sticky (get-text-property from 'end-open))) ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 (put-text-property from (point) 'hard 't)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 ;; If end-open is not "t", add 'hard to end-open list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 (if (and (listp sticky) (not (memq 'hard sticky)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 (put-text-property from (point) 'end-open ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 (cons 'hard sticky)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 ;; If the newline leaves the previous line blank,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 ;; and we have a left margin, delete that from the blank line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 (or flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 (goto-char beforepos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 (and (looking-at "[ \t]$")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 (> (current-left-margin) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 (delete-region (point) (progn (end-of-line) (point))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 (if flag (forward-char 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 ;; Indent the line after the newline, except in one case:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 ;; when we added the newline at the beginning of a line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 ;; which starts a page.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 (or was-page-start
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 (move-to-left-margin nil t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 (defun set-hard-newline-properties (from to)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 (let ((sticky (get-text-property from 'rear-nonsticky)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 (put-text-property from to 'hard 't)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 ;; If rear-nonsticky is not "t", add 'hard to rear-nonsticky list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 (if (and (listp sticky) (not (memq 'hard sticky)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 (put-text-property from (point) 'rear-nonsticky
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 (cons 'hard sticky)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
222 (defun open-line (n)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 "Insert a newline and leave point before it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 If there is a fill prefix and/or a left-margin, insert them on the new line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 if the line would have been blank.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 With arg N, insert N newlines."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 (interactive "*p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 (let* ((do-fill-prefix (and fill-prefix (bolp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 (do-left-margin (and (bolp) (> (current-left-margin) 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 (loc (point)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
231 (newline n)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 (goto-char loc)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
233 (while (> n 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 (cond ((bolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 (if do-left-margin (indent-to (current-left-margin)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 (if do-fill-prefix (insert fill-prefix))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 (forward-line 1)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
238 (setq n (1- n)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 (goto-char loc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 (end-of-line)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 (defun split-line ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 "Split current line, moving portion beyond point vertically down."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 (interactive "*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 (skip-chars-forward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 (let ((col (current-column))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 (pos (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 (newline 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 (indent-to col 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 (goto-char pos)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 (defun quoted-insert (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 "Read next input character and insert it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 This is useful for inserting control characters.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 You may also type up to 3 octal digits, to insert a character with that code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 In overwrite mode, this function inserts the character anyway, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 does not handle octal digits specially. This means that if you use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 overwrite as your normal editing mode, you can use this function to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 insert characters when necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 In binary overwrite mode, this function does overwrite, and octal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 digits are interpreted as a character code. This is supposed to make
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 this function useful in editing binary files."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 (interactive "*p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 (let ((char (if (or (not overwrite-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 (eq overwrite-mode 'overwrite-mode-binary))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 (read-quoted-char)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 ;; read-char obeys C-g, so we should protect. FSF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 ;; doesn't have the protection here, but it's a bug in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 ;; FSF.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 (let ((inhibit-quit t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 (read-char)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 (if (> arg 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 (if (eq overwrite-mode 'overwrite-mode-binary)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 (delete-char arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 (while (> arg 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 (insert char)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 (setq arg (1- arg)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 (defun delete-indentation (&optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 "Join this line to previous and fix up whitespace at join.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 If there is a fill prefix, delete it from the beginning of this line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 With argument, join this line to following line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 (interactive "*P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 (if arg (forward-line 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 (if (eq (char-before (point)) ?\n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 (delete-region (point) (1- (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 ;; If the second line started with the fill prefix,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 ;; delete the prefix.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 (if (and fill-prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 (<= (+ (point) (length fill-prefix)) (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 (string= fill-prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 (buffer-substring (point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 (+ (point) (length fill-prefix)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 (delete-region (point) (+ (point) (length fill-prefix))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 (fixup-whitespace))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 (defun fixup-whitespace ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 "Fixup white space between objects around point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 Leave one space or none, according to the context."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 (interactive "*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 (delete-horizontal-space)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 (if (or (looking-at "^\\|\\s)")
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
308 (save-excursion (backward-char 1)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 (looking-at "$\\|\\s(\\|\\s'")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 (insert ?\ ))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 (defun delete-horizontal-space ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 "Delete all spaces and tabs around point."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 (interactive "*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 (skip-chars-backward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 (delete-region (point) (progn (skip-chars-forward " \t") (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 (defun just-one-space ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 "Delete all spaces and tabs around point, leaving one space."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 (interactive "*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 (if abbrev-mode ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 (expand-abbrev))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 (skip-chars-backward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 (if (eq (char-after (point)) ? ) ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 (forward-char 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 (insert ? ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 (delete-region (point) (progn (skip-chars-forward " \t") (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 (defun delete-blank-lines ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 "On blank line, delete all surrounding blank lines, leaving just one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 On isolated blank line, delete that one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 On nonblank line, delete any immediately following blank lines."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 (interactive "*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 (let (thisblank singleblank)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 (setq thisblank (looking-at "[ \t]*$"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 ;; Set singleblank if there is just one blank line here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 (setq singleblank
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 (and thisblank
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 (not (looking-at "[ \t]*\n[ \t]*$"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 (or (bobp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 (progn (forward-line -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 (not (looking-at "[ \t]*$")))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 ;; Delete preceding blank lines, and this one too if it's the only one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 (if thisblank
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 (if singleblank (forward-line 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 (delete-region (point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 (if (re-search-backward "[^ \t\n]" nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 (progn (forward-line 1) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 (point-min)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 ;; Delete following blank lines, unless the current line is blank
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 ;; and there are no following blank lines.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 (if (not (and thisblank singleblank))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 (forward-line 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 (delete-region (point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 (if (re-search-forward "[^ \t\n]" nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 (progn (beginning-of-line) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 (point-max)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 ;; Handle the special case where point is followed by newline and eob.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 ;; Delete the line, leaving point at eob.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 (if (looking-at "^[ \t]*\n\\'")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 (delete-region (point) (point-max)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 (defun back-to-indentation ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 "Move point to the first non-whitespace character on this line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 (interactive "_")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 (beginning-of-line 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 (skip-chars-forward " \t"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 (defun newline-and-indent ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 "Insert a newline, then indent according to major mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 Indentation is done using the value of `indent-line-function'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 In programming language modes, this is the same as TAB.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 In some text modes, where TAB inserts a tab, this command indents to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 column specified by the function `current-left-margin'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 (interactive "*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 (delete-region (point) (progn (skip-chars-backward " \t") (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 (newline)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 (indent-according-to-mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 (defun reindent-then-newline-and-indent ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 "Reindent current line, insert newline, then indent the new line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 Indentation of both lines is done according to the current major mode,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 which means calling the current value of `indent-line-function'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 In programming language modes, this is the same as TAB.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 In some text modes, where TAB inserts a tab, this indents to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 column specified by the function `current-left-margin'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 (interactive "*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 (delete-region (point) (progn (skip-chars-backward " \t") (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 (indent-according-to-mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 (newline)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 (indent-according-to-mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 ;; Internal subroutine of delete-char
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 (defun kill-forward-chars (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 (if (listp arg) (setq arg (car arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 (if (eq arg '-) (setq arg -1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 (kill-region (point) (+ (point) arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 ;; Internal subroutine of backward-delete-char
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 (defun kill-backward-chars (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 (if (listp arg) (setq arg (car arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 (if (eq arg '-) (setq arg -1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 (kill-region (point) (- (point) arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 (defun backward-delete-char-untabify (arg &optional killp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 "Delete characters backward, changing tabs into spaces.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 Interactively, ARG is the prefix arg (default 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 and KILLP is t if a prefix arg was specified."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 (interactive "*p\nP")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 (let ((count arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 (while (and (> count 0) (not (bobp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 (if (eq (char-before (point)) ?\t) ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 (let ((col (current-column)))
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
425 (backward-char 1)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 (setq col (- col (current-column)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 (insert-char ?\ col)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 (delete-char 1)))
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
429 (backward-char 1)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 (setq count (1- count)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 (delete-backward-char arg killp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 ;; XEmacs: In overwrite mode, back over columns while clearing them out,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 ;; unless at end of line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 (and overwrite-mode (not (eolp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 (save-excursion (insert-char ?\ arg))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 (defcustom delete-key-deletes-forward t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 "*If non-nil, the DEL key will erase one character forwards.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 If nil, the DEL key will erase one character backwards."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
443 (defcustom backward-delete-function 'delete-backward-char
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 "*Function called to delete backwards on a delete keypress.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 If `delete-key-deletes-forward' is nil, `backward-or-forward-delete-char'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 calls this function to erase one character backwards. Default value
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
447 is `delete-backward-char', with `backward-delete-char-untabify' being a
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 popular alternate setting."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 :type 'function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 ;; Trash me, baby.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 (defsubst delete-forward-p ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 (and delete-key-deletes-forward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 (or (not (eq (device-type) 'x))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
456 (declare-fboundp
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
457 (x-keysym-on-keyboard-sans-modifiers-p 'backspace)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 (defun backward-or-forward-delete-char (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 "Delete either one character backwards or one character forwards.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 Controlled by the state of `delete-key-deletes-forward' and whether the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 BackSpace keysym even exists on your keyboard. If you don't have a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 BackSpace keysym, the delete key should always delete one character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 backwards."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 (interactive "*p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 (if (delete-forward-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 (delete-char arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 (funcall backward-delete-function arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 (defun backward-or-forward-kill-word (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 "Delete either one word backwards or one word forwards.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 Controlled by the state of `delete-key-deletes-forward' and whether the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 BackSpace keysym even exists on your keyboard. If you don't have a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 BackSpace keysym, the delete key should always delete one character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 backwards."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 (interactive "*p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 (if (delete-forward-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 (kill-word arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 (backward-kill-word arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 (defun backward-or-forward-kill-sentence (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 "Delete either one sentence backwards or one sentence forwards.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 Controlled by the state of `delete-key-deletes-forward' and whether the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 BackSpace keysym even exists on your keyboard. If you don't have a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 BackSpace keysym, the delete key should always delete one character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 backwards."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 (interactive "*P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 (if (delete-forward-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 (kill-sentence arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 (backward-kill-sentence (prefix-numeric-value arg))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 (defun backward-or-forward-kill-sexp (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 "Delete either one sexpr backwards or one sexpr forwards.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 Controlled by the state of `delete-key-deletes-forward' and whether the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 BackSpace keysym even exists on your keyboard. If you don't have a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 BackSpace keysym, the delete key should always delete one character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 backwards."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 (interactive "*p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 (if (delete-forward-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 (kill-sexp arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 (backward-kill-sexp arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 (defun zap-to-char (arg char)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 "Kill up to and including ARG'th occurrence of CHAR.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 Goes backward if ARG is negative; error if CHAR not found."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 (interactive "*p\ncZap to char: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 (kill-region (point) (with-interactive-search-caps-disable-folding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 (char-to-string char) nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 (search-forward (char-to-string char) nil nil arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 (defun zap-up-to-char (arg char)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 "Kill up to ARG'th occurrence of CHAR.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 Goes backward if ARG is negative; error if CHAR not found."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 (interactive "*p\ncZap up to char: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 (kill-region (point) (with-interactive-search-caps-disable-folding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 (char-to-string char) nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 (search-forward (char-to-string char) nil nil arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 (defun beginning-of-buffer (&optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 "Move point to the beginning of the buffer; leave mark at previous position.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 With arg N, put point N/10 of the way from the beginning.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 If the buffer is narrowed, this command uses the beginning and size
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 of the accessible part of the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
529 The characters that are moved over may be added to the current selection
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
530 \(i.e. active region) if the Shift key is held down, a motion key is used
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
531 to invoke this command, and `shifted-motion-keys-select-region' is t; see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
532 the documentation for this variable for more details.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
533
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 Don't use this command in Lisp programs!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 \(goto-char (point-min)) is faster and avoids clobbering the mark."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 (interactive "_P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 (push-mark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 (let ((size (- (point-max) (point-min))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 (goto-char (if arg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 (+ (point-min)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 (if (> size 10000)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 ;; Avoid overflow for large buffer sizes!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 (* (prefix-numeric-value arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 (/ size 10))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 (/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 (point-min))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 (if arg (forward-line 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 (defun end-of-buffer (&optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 "Move point to the end of the buffer; leave mark at previous position.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 With arg N, put point N/10 of the way from the end.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 If the buffer is narrowed, this command uses the beginning and size
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 of the accessible part of the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
557 The characters that are moved over may be added to the current selection
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
558 \(i.e. active region) if the Shift key is held down, a motion key is used
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
559 to invoke this command, and `shifted-motion-keys-select-region' is t; see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
560 the documentation for this variable for more details.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
561
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 Don't use this command in Lisp programs!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 \(goto-char (point-max)) is faster and avoids clobbering the mark."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 (interactive "_P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 (push-mark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 ;; XEmacs changes here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 (let ((scroll-to-end (not (pos-visible-in-window-p (point-max))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 (size (- (point-max) (point-min))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 (goto-char (if arg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 (- (point-max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 (if (> size 10000)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 ;; Avoid overflow for large buffer sizes!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 (* (prefix-numeric-value arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 (/ size 10))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 (/ (* size (prefix-numeric-value arg)) 10)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 (point-max)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 (cond (arg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 ;; If we went to a place in the middle of the buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 ;; adjust it to the beginning of a line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 (forward-line 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 (scroll-to-end
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 ;; If the end of the buffer is not already on the screen,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 ;; then scroll specially to put it near, but not at, the bottom.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 (recenter -3)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 ;; XEmacs (not in FSF)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 (defun mark-beginning-of-buffer (&optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 "Push a mark at the beginning of the buffer; leave point where it is.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 With arg N, push mark N/10 of the way from the true beginning."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 (push-mark (if arg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 (if (> (buffer-size) 10000)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 ;; Avoid overflow for large buffer sizes!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 (* (prefix-numeric-value arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 (/ (buffer-size) 10))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 (/ (+ 10 (* (buffer-size) (prefix-numeric-value arg))) 10))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 (define-function 'mark-bob 'mark-beginning-of-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 ;; XEmacs (not in FSF)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 (defun mark-end-of-buffer (&optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 "Push a mark at the end of the buffer; leave point where it is.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 With arg N, push mark N/10 of the way from the true end."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 (push-mark (if arg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 (- (1+ (buffer-size))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 (if (> (buffer-size) 10000)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 ;; Avoid overflow for large buffer sizes!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 (* (prefix-numeric-value arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 (/ (buffer-size) 10))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 (/ (* (buffer-size) (prefix-numeric-value arg)) 10)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 (define-function 'mark-eob 'mark-end-of-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 (defun mark-whole-buffer ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 "Put point at beginning and mark at end of buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 You probably should not use this function in Lisp programs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 it is usually a mistake for a Lisp function to use any subroutine
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 that uses or sets the mark."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 (push-mark (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 (push-mark (point-max) nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 (goto-char (point-min)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 (defun eval-current-buffer (&optional printflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 "Evaluate the current buffer as Lisp code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 Programs can pass argument PRINTFLAG which controls printing of output:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 nil means discard it; anything else is stream for print."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 (eval-buffer (current-buffer) printflag))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 (defun count-words-buffer (&optional buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 "Print the number of words in BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 If called noninteractively, the value is returned rather than printed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 BUFFER defaults to the current buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 (let ((words (count-words-region (point-min) (point-max) buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 (when (interactive-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 (message "Buffer has %d words" words))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 words))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 (defun count-words-region (start end &optional buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 "Print the number of words in region between START and END in BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 If called noninteractively, the value is returned rather than printed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 BUFFER defaults to the current buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 (interactive "_r")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 (set-buffer (or buffer (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 (let ((words 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 (goto-char start)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 (while (< (point) end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 (when (forward-word 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 (incf words)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 (when (interactive-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 (message "Region has %d words" words))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 words)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 (defun count-lines-region (start end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 "Print number of lines and characters in the region."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 (interactive "_r")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 (message "Region has %d lines, %d characters"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 (count-lines start end) (- end start)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 (defun count-lines-buffer (&optional buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 "Print number of lines and characters in BUFFER."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 (with-current-buffer (or buffer (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 (let ((cnt (count-lines (point-min) (point-max))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 (message "Buffer has %d lines, %d characters"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 cnt (- (point-max) (point-min)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 cnt)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 ;;; Modified by Bob Weiner, 8/24/95, to print narrowed line number also.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 ;;; Expanded by Bob Weiner, BeOpen, on 02/12/1997
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 (defun what-line ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 "Print the following variants of the line number of point:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 Region line - displayed line within the active region
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 Collapsed line - includes only selectively displayed lines;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 Buffer line - physical line in the buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 Narrowed line - line number from the start of the buffer narrowing."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 (interactive "_")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 (let ((opoint (point)) start)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 (save-restriction
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 (if (region-active-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 (goto-char (region-beginning))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 (goto-char (point-min)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 (widen)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 (setq start (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 (goto-char opoint)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 (let* ((buffer-line (1+ (count-lines 1 (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 (narrowed-p (or (/= start 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 (/= (point-max) (1+ (buffer-size)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 (narrowed-line (if narrowed-p (1+ (count-lines start (point)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 (selective-line (if selective-display
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 (1+ (count-lines start (point) t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 (region-line (if (region-active-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 (1+ (count-lines start (point) selective-display)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 (cond (region-line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 (message "Region line %d; Buffer line %d"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 region-line buffer-line))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 ((and narrowed-p selective-line (/= selective-line narrowed-line))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 ;; buffer narrowed and some lines selectively displayed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 (message "Collapsed line %d; Buffer line %d; Narrowed line %d"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 selective-line buffer-line narrowed-line))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 (narrowed-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 ;; buffer narrowed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 (message "Buffer line %d; Narrowed line %d"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 buffer-line narrowed-line))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 ((and selective-line (/= selective-line buffer-line))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 ;; some lines selectively displayed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 (message "Collapsed line %d; Buffer line %d"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 selective-line buffer-line))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 ;; give a basic line count
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 (message "Line %d" buffer-line)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 (setq zmacs-region-stays t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
733 ;; new in XEmacs 21.2 (not in FSF).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
734 (defun line-number (&optional pos respect-narrowing)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
735 "Return the line number of POS (defaults to point).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
736 If RESPECT-NARROWING is non-nil, then the narrowed line number is returned;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
737 otherwise, the absolute line number is returned. The returned line can always
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
738 be given to `goto-line' to get back to the current line."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
739 (if (and pos (/= pos (point)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
740 (save-excursion
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
741 (goto-char pos)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
742 (line-number nil respect-narrowing))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
743 (1+ (count-lines (if respect-narrowing (point-min) 1) (point-at-bol)))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
744
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 (defun count-lines (start end &optional ignore-invisible-lines-flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 "Return number of lines between START and END.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 This is usually the number of newlines between them,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 but can be one more if START is not equal to END
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 and the greater of them is not at the start of a line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 With optional IGNORE-INVISIBLE-LINES-FLAG non-nil, lines collapsed with
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
752 selective-display are excluded from the line count.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
753
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
754 NOTE: The expression to return the current line number is not obvious:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
755
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
756 (1+ (count-lines 1 (point-at-bol)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
757
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
758 See also `line-number'."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 (save-restriction
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 (narrow-to-region start end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 (if (and (not ignore-invisible-lines-flag) (eq selective-display t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 (save-match-data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 (let ((done 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 (while (re-search-forward "[\n\C-m]" nil t 40)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 (setq done (+ 40 done)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 (while (re-search-forward "[\n\C-m]" nil t 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 (setq done (+ 1 done)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 (goto-char (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 (if (and (/= start end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 (not (bolp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 (1+ done)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 done)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 (- (buffer-size) (forward-line (buffer-size)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 (defun what-cursor-position ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 "Print info on cursor position (on screen and within buffer)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 (interactive "_")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 (let* ((char (char-after (point))) ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 (beg (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 (end (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 (pos (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 (total (buffer-size))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 (percent (if (> total 50000)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 ;; Avoid overflow from multiplying by 100!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 (hscroll (if (= (window-hscroll) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 ""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 (format " Hscroll=%d" (window-hscroll))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 (col (+ (current-column) (if column-number-start-at-one 1 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 (if (= pos end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 (if (or (/= beg 1) (/= end (1+ total)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 (message "point=%d of %d(%d%%) <%d - %d> column %d %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 pos total percent beg end col hscroll)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 (message "point=%d of %d(%d%%) column %d %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 pos total percent col hscroll))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 ;; XEmacs: don't use single-key-description
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 (if (or (/= beg 1) (/= end (1+ total)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 (message "Char: %s (0%o, %d, 0x%x) point=%d of %d(%d%%) <%d - %d> column %d %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 (text-char-description char) char char char pos total
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 percent beg end col hscroll)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 (message "Char: %s (0%o, %d, 0x%x) point=%d of %d(%d%%) column %d %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 (text-char-description char) char char char pos total
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 percent col hscroll)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 (defun fundamental-mode ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 "Major mode not specialized for anything in particular.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 Other major modes are defined by comparison with this one."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 (kill-all-local-variables))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 ;; XEmacs the following are declared elsewhere
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 ;(defvar read-expression-map (cons 'keymap minibuffer-local-map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 ; "Minibuffer keymap used for reading Lisp expressions.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 ;(define-key read-expression-map "\M-\t" 'lisp-complete-symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 ;(put 'eval-expression 'disabled t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 ;(defvar read-expression-history nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 ;; We define this, rather than making `eval' interactive,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 ;; for the sake of completion of names like eval-region, eval-current-buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 (defun eval-expression (expression &optional eval-expression-insert-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 "Evaluate EXPRESSION and print value in minibuffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 Value is also consed on to front of the variable `values'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 With prefix argument, insert the result to the current buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 ;(interactive "xEval: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 (list (read-from-minibuffer "Eval: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 nil read-expression-map t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 'read-expression-history)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 (setq values (cons (eval expression) values))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 (prin1 (car values)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 (if eval-expression-insert-value (current-buffer) t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 ;; XEmacs -- extra parameter (variant, but equivalent logic)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
841 (defun edit-and-eval-command (prompt form &optional history)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
842 "Prompting with PROMPT, let user edit FORM and eval result.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
843 FORM is a Lisp expression. Let user edit that expression in
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 the minibuffer, then read and evaluate the result."
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
845 (let ((form (read-expression prompt
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
846 ;; first try to format the thing readably;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
847 ;; and if that fails, print it normally.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
848 (condition-case ()
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
849 (let ((print-readably t))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
850 (prin1-to-string form))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
851 (error (prin1-to-string form)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
852 (or history '(command-history . 1)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 (or history (setq history 'command-history))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 (if (consp history)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 (setq history (car history)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 (if (eq history t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 nil
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
858 ;; If form was added to the history as a string,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 ;; get rid of that. We want only evallable expressions there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 (if (stringp (car (symbol-value history)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 (set history (cdr (symbol-value history))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
863 ;; If form to be redone does not match front of history,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 ;; add it to the history.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
865 (or (equal form (car (symbol-value history)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
866 (set history (cons form (symbol-value history)))))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
867 (eval form)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 (defun repeat-complex-command (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 "Edit and re-evaluate last complex command, or ARGth from last.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 A complex command is one which used the minibuffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 The command is placed in the minibuffer as a Lisp form for editing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 The result is executed, repeating the command as changed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 If the command has been changed or is not the most recent previous command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 it is added to the front of the command history.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 You can use the minibuffer history commands \\<minibuffer-local-map>\\[next-history-element] and \\[previous-history-element]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 to get different commands to edit and resubmit."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 (interactive "p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 ;; XEmacs: It looks like our version is better -sb
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 (let ((print-level nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 (edit-and-eval-command "Redo: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 (or (nth (1- arg) command-history)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 (error ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 (cons 'command-history arg))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 ;; XEmacs: Functions moved to minibuf.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 ;; previous-matching-history-element
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 ;; next-matching-history-element
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 ;; next-history-element
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 ;; previous-history-element
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 ;; next-complete-history-element
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 ;; previous-complete-history-element
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
894 (defun goto-line (line)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
895 "Goto line LINE, counting from line 1 at beginning of buffer."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 (interactive "NGoto line: ")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
897 (setq line (prefix-numeric-value line))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 (save-restriction
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 (widen)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 (goto-char 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 (if (eq selective-display t)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
902 (re-search-forward "[\n\C-m]" nil 'end (1- line))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
903 (forward-line (1- line)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 613
diff changeset
905 ;[Put this on C-x u, so we can force that rather than C-_ into startup msg]
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 613
diff changeset
906 ;No more, stop pandering to TTY users.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 (define-function 'advertised-undo 'undo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
909 (defun undo (&optional count)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 "Undo some previous changes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 Repeat this command to undo more changes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 A numeric argument serves as a repeat count."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 (interactive "*p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 ;; If we don't get all the way through, make last-command indicate that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 ;; for the following command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 (setq this-command t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 (let ((modified (buffer-modified-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 (recent-save (recent-auto-save-p)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 (or (eq (selected-window) (minibuffer-window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 (display-message 'command "Undo!"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 (or (and (eq last-command 'undo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 (eq (current-buffer) last-undo-buffer)) ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 (progn (undo-start)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 (undo-more 1)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
925 (undo-more (or count 1))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 ;; Don't specify a position in the undo record for the undo command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 ;; Instead, undoing this should move point to where the change is.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 (let ((tail buffer-undo-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 done)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 (while (and tail (not done) (not (null (car tail))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 (if (integerp (car tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 (setq done t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 (setq buffer-undo-list (delq (car tail) buffer-undo-list))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 (setq tail (cdr tail))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 (and modified (not (buffer-modified-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 (delete-auto-save-file-if-necessary recent-save)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 ;; If we do get all the way through, make this-command indicate that.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 (setq this-command 'undo))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 (defvar pending-undo-list nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 "Within a run of consecutive undo commands, list remaining to be undone.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 (defvar last-undo-buffer nil) ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 (defun undo-start ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 "Set `pending-undo-list' to the front of the undo list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 The next call to `undo-more' will undo the most recently made change."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 (if (eq buffer-undo-list t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 (error "No undo information in this buffer"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 (setq pending-undo-list buffer-undo-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 (defun undo-more (count)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 "Undo back N undo-boundaries beyond what was already undone recently.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 Call `undo-start' to get ready to undo recent changes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 then call `undo-more' one or more times to undo them."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 (or pending-undo-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 (error "No further undo information"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 (setq pending-undo-list (primitive-undo count pending-undo-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 last-undo-buffer (current-buffer))) ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 843
diff changeset
962 (defun undo-all-changes ()
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 843
diff changeset
963 "Keep undoing till the start of the undo list is reached.
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 843
diff changeset
964 Undoes all changes, even past a file save. Especially useful when you've
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 843
diff changeset
965 saved the file at some point."
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 843
diff changeset
966 (interactive)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 843
diff changeset
967 (undo-start)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 843
diff changeset
968 (while pending-undo-list (undo-more 1)))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 843
diff changeset
969
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 (defun call-with-transparent-undo (fn &rest args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 "Apply FN to ARGS, and then undo all changes made by FN to the current
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 buffer. The undo records are processed even if FN returns non-locally.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 There is no trace of the changes made by FN in the buffer's undo history.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 You can use this in a write-file-hooks function with continue-save-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 to make the contents of a disk file differ from its in-memory buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 (let ((buffer-undo-list nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 ;; Kludge to prevent undo list truncation:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 (undo-high-threshold -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 (undo-threshold -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 (obuffer (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 (apply fn args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 ;; Go to the buffer we will restore and make it writable:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 (set-buffer obuffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 (let ((buffer-read-only nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 (save-restriction
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 (widen)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 ;; Perform all undos, with further undo logging disabled:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 (let ((tail buffer-undo-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 (setq buffer-undo-list t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 (while tail
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 (setq tail (primitive-undo (length tail) tail))))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 ;; XEmacs: The following are in other files
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 ;; shell-command-history
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 ;; shell-command-switch
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 ;; shell-command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 ;; shell-command-sentinel
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 (defconst universal-argument-map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 (let ((map (make-sparse-keymap)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 (set-keymap-default-binding map 'universal-argument-other-key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 ;FSFmacs (define-key map [switch-frame] nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 (define-key map [(t)] 'universal-argument-other-key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 (define-key map [(meta t)] 'universal-argument-other-key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 (define-key map [(control u)] 'universal-argument-more)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 (define-key map [?-] 'universal-argument-minus)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 (define-key map [?0] 'digit-argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 (define-key map [?1] 'digit-argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 (define-key map [?2] 'digit-argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 (define-key map [?3] 'digit-argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 (define-key map [?4] 'digit-argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 (define-key map [?5] 'digit-argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 (define-key map [?6] 'digit-argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 (define-key map [?7] 'digit-argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 (define-key map [?8] 'digit-argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 (define-key map [?9] 'digit-argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 "Keymap used while processing \\[universal-argument].")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 (defvar universal-argument-num-events nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 "Number of argument-specifying events read by `universal-argument'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 `universal-argument-other-key' uses this to discard those events
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 from (this-command-keys), and reread only the final command.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 (defun universal-argument ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 "Begin a numeric argument for the following command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 Digits or minus sign following \\[universal-argument] make up the numeric argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 \\[universal-argument] following the digits or minus sign ends the argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 \\[universal-argument] without digits or minus sign provides 4 as argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 Repeating \\[universal-argument] without digits or minus sign
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 multiplies the argument by 4 each time."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 (setq prefix-arg (list 4))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 (setq zmacs-region-stays t) ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 (setq universal-argument-num-events (length (this-command-keys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 (setq overriding-terminal-local-map universal-argument-map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 ;; A subsequent C-u means to multiply the factor by 4 if we've typed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 ;; nothing but C-u's; otherwise it means to terminate the prefix arg.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 (defun universal-argument-more (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 (interactive "_P") ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 (if (consp arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 (setq prefix-arg (list (* 4 (car arg))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 (setq prefix-arg arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 (setq overriding-terminal-local-map nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 (setq universal-argument-num-events (length (this-command-keys))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 (defun negative-argument (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 "Begin a negative numeric argument for the next command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 \\[universal-argument] following digits or minus sign ends the argument."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 (interactive "_P") ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 (cond ((integerp arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 (setq prefix-arg (- arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 ((eq arg '-)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 (setq prefix-arg nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 (setq prefix-arg '-)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 (setq universal-argument-num-events (length (this-command-keys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 (setq overriding-terminal-local-map universal-argument-map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 ;; XEmacs: This function not synched with FSF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 (defun digit-argument (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 "Part of the numeric argument for the next command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 \\[universal-argument] following digits or minus sign ends the argument."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 (interactive "_P") ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 (let* ((event last-command-event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 (key (and (key-press-event-p event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 (event-key event)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 (digit (and key (characterp key) (>= key ?0) (<= key ?9)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 (- key ?0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 (if (null digit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 (universal-argument-other-key arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 (cond ((integerp arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 (setq prefix-arg (+ (* arg 10)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 (if (< arg 0) (- digit) digit))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 ((eq arg '-)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 ;; Treat -0 as just -, so that -01 will work.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 (setq prefix-arg (if (zerop digit) '- (- digit))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 (setq prefix-arg digit)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 (setq universal-argument-num-events (length (this-command-keys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 (setq overriding-terminal-local-map universal-argument-map))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 ;; For backward compatibility, minus with no modifiers is an ordinary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 ;; command if digits have already been entered.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 (defun universal-argument-minus (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 (interactive "_P") ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 (if (integerp arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 (universal-argument-other-key arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 (negative-argument arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 ;; Anything else terminates the argument and is left in the queue to be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 ;; executed as a command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 (defun universal-argument-other-key (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 (interactive "_P") ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 (setq prefix-arg arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 (let* ((key (this-command-keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 ;; FSF calls silly function `listify-key-sequence' here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 (keylist (append key nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 (setq unread-command-events
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 (append (nthcdr universal-argument-num-events keylist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 unread-command-events)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 (reset-this-command-lengths)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 (setq overriding-terminal-local-map nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 ;; XEmacs -- keep zmacs-region active.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1113 (defun forward-to-indentation (count)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1114 "Move forward COUNT lines and position at first nonblank character."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 (interactive "_p")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1116 (forward-line count)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 (skip-chars-forward " \t"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1119 (defun backward-to-indentation (count)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1120 "Move backward COUNT lines and position at first nonblank character."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 (interactive "_p")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1122 (forward-line (- count))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 (skip-chars-forward " \t"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 (defcustom kill-whole-line nil
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1126 "*If non-nil, kill the whole line if point is at the beginning.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1127 Otherwise, `kill-line' kills only up to the end of the line, but not
503
98fb34b6fbe9 [xemacs-hg @ 2001-05-04 23:31:31 by ben]
ben
parents: 502
diff changeset
1128 the terminating newline.
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1129
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1130 WARNING: This is a misnamed variable! It should be called something
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1131 like `kill-whole-line-when-at-beginning'. If you simply want
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1132 \\[kill-line] to kill the entire current line, bind it to the function
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1133 `kill-entire-line'. "
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1134 :type 'boolean
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 :group 'killing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136
503
98fb34b6fbe9 [xemacs-hg @ 2001-05-04 23:31:31 by ben]
ben
parents: 502
diff changeset
1137 (defun kill-line-1 (arg entire-line)
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1138 (kill-region (if entire-line
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1139 (save-excursion
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1140 (beginning-of-line)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1141 (point))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1142 (point))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 ;; Don't shift point before doing the delete; that way,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 ;; undo will record the right position of point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 ;; FSF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 ; ;; It is better to move point to the other end of the kill
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 ; ;; before killing. That way, in a read-only buffer, point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 ; ;; moves across the text that is copied to the kill ring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 ; ;; The choice has no effect on undo now that undo records
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 ; ;; the value of point from before the command was run.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 ; (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 (if arg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 (forward-line (prefix-numeric-value arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 (if (eobp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 (signal 'end-of-buffer nil))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1157 (if (or (looking-at "[ \t]*$")
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1158 (or entire-line
503
98fb34b6fbe9 [xemacs-hg @ 2001-05-04 23:31:31 by ben]
ben
parents: 502
diff changeset
1159 (and kill-whole-line (bolp))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 (forward-line 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 (end-of-line)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1164 (defun kill-entire-line (&optional arg)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1165 "Kill the entire line.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1166 With prefix argument, kill that many lines from point. Negative
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1167 arguments kill lines backward.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1168
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1169 When calling from a program, nil means \"no arg\",
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1170 a number counts as a prefix arg."
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1171 (interactive "*P")
503
98fb34b6fbe9 [xemacs-hg @ 2001-05-04 23:31:31 by ben]
ben
parents: 502
diff changeset
1172 (kill-line-1 arg t))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1173
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1174 (defun kill-line (&optional arg)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1175 "Kill the rest of the current line, or the entire line.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1176 If no nonblanks there, kill thru newline. If called interactively,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1177 may kill the entire line when given no argument at the beginning of a
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1178 line; see `kill-whole-line'. With prefix argument, kill that many
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1179 lines from point. Negative arguments kill lines backward.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1180
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1181 WARNING: This is a misnamed function! It should be called something
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1182 like `kill-to-end-of-line'. If you simply want to kill the entire
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1183 current line, use `kill-entire-line'.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1184
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1185 When calling from a program, nil means \"no arg\",
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1186 a number counts as a prefix arg."
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1187 (interactive "*P")
503
98fb34b6fbe9 [xemacs-hg @ 2001-05-04 23:31:31 by ben]
ben
parents: 502
diff changeset
1188 (kill-line-1 arg nil))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1189
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 (defun backward-kill-line nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 "Kill back to the beginning of the line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 (let ((point (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 (beginning-of-line nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 (kill-region (point) point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 ;;;; Window system cut and paste hooks.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 ;;; I think that kill-hooks is a better name and more general mechanism
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 ;;; than interprogram-cut-function (from FSFmacs). I don't like the behavior
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 ;;; of interprogram-paste-function: ^Y should always come from the kill ring,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 ;;; not the X selection. But if that were provided, it should be called (and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 ;;; behave as) yank-hooks instead. -- jwz
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 ;; [... code snipped ...]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 (defcustom kill-hooks nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 "*Functions run when something is added to the XEmacs kill ring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 These functions are called with one argument, the string most recently
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 cut or copied. You can use this to, for example, make the most recent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 kill become the X Clipboard selection."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 :type 'hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 :group 'killing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 ;;; `kill-hooks' seems not sufficient because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 ;;; `interprogram-cut-function' requires more variable about to rotate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 ;;; the cut buffers. I'm afraid to change interface of `kill-hooks',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 ;;; so I add it. (1997-11-03 by MORIOKA Tomohiko)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1222 (defcustom interprogram-cut-function 'own-clipboard
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 "Function to call to make a killed region available to other programs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 Most window systems provide some sort of facility for cutting and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 pasting text between the windows of different programs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 This variable holds a function that Emacs calls whenever text
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 is put in the kill ring, to make the new kill available to other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 programs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 The function takes one or two arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 The first argument, TEXT, is a string containing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 the text which should be made available.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 The second, PUSH, if non-nil means this is a \"new\" kill;
843
f46864126a0d [xemacs-hg @ 2002-05-15 15:27:40 by stephent]
stephent
parents: 829
diff changeset
1235 nil means appending to an \"old\" kill.
f46864126a0d [xemacs-hg @ 2002-05-15 15:27:40 by stephent]
stephent
parents: 829
diff changeset
1236
f46864126a0d [xemacs-hg @ 2002-05-15 15:27:40 by stephent]
stephent
parents: 829
diff changeset
1237 One reasonable choice is `own-clipboard' (the default)."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1238 :type '(radio (function-item :tag "Send to Clipboard"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1239 :format "%t\n"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1240 own-clipboard)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1241 (const :tag "None" nil)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1242 (function :tag "Other"))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1243 :group 'killing)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1244
843
f46864126a0d [xemacs-hg @ 2002-05-15 15:27:40 by stephent]
stephent
parents: 829
diff changeset
1245 (defcustom interprogram-paste-function 'get-clipboard-foreign
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 "Function to call to get text cut from other programs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 Most window systems provide some sort of facility for cutting and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 pasting text between the windows of different programs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 This variable holds a function that Emacs calls to obtain
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 text that other programs have provided for pasting.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 The function should be called with no arguments. If the function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 returns nil, then no other program has provided such text, and the top
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 of the Emacs kill ring should be used. If the function returns a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 string, that string should be put in the kill ring as the latest kill.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 Note that the function should return a string only if a program other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 than Emacs has provided a string for pasting; if Emacs provided the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 most recent string, the function should return nil. If it is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 difficult to tell whether Emacs or some other program provided the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 current string, it is probably good enough to return nil if the string
843
f46864126a0d [xemacs-hg @ 2002-05-15 15:27:40 by stephent]
stephent
parents: 829
diff changeset
1263 is equal (according to `string=') to the last text Emacs provided.
f46864126a0d [xemacs-hg @ 2002-05-15 15:27:40 by stephent]
stephent
parents: 829
diff changeset
1264
f46864126a0d [xemacs-hg @ 2002-05-15 15:27:40 by stephent]
stephent
parents: 829
diff changeset
1265 Reasonable choices include `get-clipboard-foreign' (the default), and
f46864126a0d [xemacs-hg @ 2002-05-15 15:27:40 by stephent]
stephent
parents: 829
diff changeset
1266 functions calling `get-selection-foreign' (q.v.)."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1267 :type '(radio (function-item :tag "Get from Clipboard"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1268 :format "%t\n"
843
f46864126a0d [xemacs-hg @ 2002-05-15 15:27:40 by stephent]
stephent
parents: 829
diff changeset
1269 get-clipboard-foreign)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1270 (const :tag "None" nil)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1271 (function :tag "Other"))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1272 :group 'killing)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 ;;;; The kill ring data structure.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 (defvar kill-ring nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 "List of killed text sequences.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 Since the kill ring is supposed to interact nicely with cut-and-paste
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 facilities offered by window systems, use of this variable should
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 interact nicely with `interprogram-cut-function' and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 `interprogram-paste-function'. The functions `kill-new',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 `kill-append', and `current-kill' are supposed to implement this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 interaction; you may want to use them instead of manipulating the kill
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 ring directly.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286
829
42a86787d173 [xemacs-hg @ 2002-05-07 15:58:46 by stephent]
stephent
parents: 801
diff changeset
1287 (defcustom kill-ring-max 60
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 "*Maximum length of kill ring before oldest elements are thrown away."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 :type 'integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 :group 'killing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 (defvar kill-ring-yank-pointer nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 "The tail of the kill ring whose car is the last thing yanked.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 (defun kill-new (string &optional replace)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 "Make STRING the latest kill in the kill ring.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1297 Set `kill-ring-yank-pointer' to point to it.
829
42a86787d173 [xemacs-hg @ 2002-05-07 15:58:46 by stephent]
stephent
parents: 801
diff changeset
1298 If `interprogram-cut-function' is non-nil, apply it to STRING.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 Run `kill-hooks'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 Optional second argument REPLACE non-nil means that STRING will replace
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 the front of the kill ring, rather than being added to the list."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 ; (and (fboundp 'menu-bar-update-yank-menu)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 ; (menu-bar-update-yank-menu string (and replace (car kill-ring))))
829
42a86787d173 [xemacs-hg @ 2002-05-07 15:58:46 by stephent]
stephent
parents: 801
diff changeset
1304 (if (and replace kill-ring)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 (setcar kill-ring string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 (setq kill-ring (cons string kill-ring))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 (if (> (length kill-ring) kill-ring-max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 (setq kill-ring-yank-pointer kill-ring)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 (if interprogram-cut-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 (funcall interprogram-cut-function string (not replace)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 (run-hook-with-args 'kill-hooks string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 (defun kill-append (string before-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 "Append STRING to the end of the latest kill in the kill ring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 If BEFORE-P is non-nil, prepend STRING to the kill.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 Run `kill-hooks'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 (kill-new (if before-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 (concat string (car kill-ring))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 (concat (car kill-ring) string)) t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 (defun current-kill (n &optional do-not-move)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 "Rotate the yanking point by N places, and then return that kill.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 If N is zero, `interprogram-paste-function' is set, and calling it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 returns a string, then that string is added to the front of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 kill ring and returned as the latest kill.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 If optional arg DO-NOT-MOVE is non-nil, then don't actually move the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 yanking point\; just return the Nth kill forward."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 (let ((interprogram-paste (and (= n 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 interprogram-paste-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 (funcall interprogram-paste-function))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 (if interprogram-paste
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 ;; Disable the interprogram cut function when we add the new
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 ;; text to the kill ring, so Emacs doesn't try to own the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 ;; selection, with identical text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 (let ((interprogram-cut-function nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 (kill-new interprogram-paste))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 interprogram-paste)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 (or kill-ring (error "Kill ring is empty"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 (let* ((tem (nthcdr (mod (- n (length kill-ring-yank-pointer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 (length kill-ring))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 kill-ring)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 (or do-not-move
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 (setq kill-ring-yank-pointer tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 (car tem)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 ;;;; Commands for manipulating the kill ring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352 ;; In FSF killing read-only text just pastes it into kill-ring. Which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 ;; is a very bad idea -- see Jamie's comment below.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 ;(defvar kill-read-only-ok nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 ; "*Non-nil means don't signal an error for killing read-only text.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1358 (defun kill-region (start end &optional verbose) ; verbose is XEmacs addition
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 "Kill between point and mark.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 The text is deleted but saved in the kill ring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 The command \\[yank] can retrieve it from there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 \(If you want to kill and then yank immediately, use \\[copy-region-as-kill].)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 This is the primitive for programs to kill text (as opposed to deleting it).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 Supply two arguments, character numbers indicating the stretch of text
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 to be killed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 Any command that calls this function is a \"kill command\".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 If the previous command was also a kill command,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 the text killed this time appends to the text killed last time
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 to make one entry in the kill ring."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 (interactive "*r\np")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 ; (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 ; (let ((region-hack (and zmacs-regions (eq last-command 'yank))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 ; ;; This lets "^Y^W" work. I think this is dumb, but zwei did it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 ; (if region-hack (zmacs-activate-region))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 ; (prog1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 ; (list (point) (mark) current-prefix-arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 ; (if region-hack (zmacs-deactivate-region)))))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1379 ;; start and end can be markers but the rest of this function is
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 ;; written as if they are only integers
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1381 (if (markerp start) (setq start (marker-position start)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 (if (markerp end) (setq end (marker-position end)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1383 (or (and start end) (if zmacs-regions ;; rewritten for I18N3 snarfing
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 (error "The region is not active now")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 (error "The mark is not set now")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 (if verbose (if buffer-read-only
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 (lmessage 'command "Copying %d characters"
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1388 (- (max start end) (min start end)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 (lmessage 'command "Killing %d characters"
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1390 (- (max start end) (min start end)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 (cond
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 ;; I don't like this large change in behavior -- jwz
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 ;; Read-Only text means it shouldn't be deleted, so I'm restoring
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 ;; this code, but only for text-properties and not full extents. -sb
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 ;; If the buffer is read-only, we should beep, in case the person
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 ;; just isn't aware of this. However, there's no harm in putting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 ;; the region's text in the kill ring, anyway.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 ((or (and buffer-read-only (not inhibit-read-only))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1400 (text-property-not-all (min start end) (max start end) 'read-only nil))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 ;; This is redundant.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 ;; (if verbose (message "Copying %d characters"
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1403 ;; (- (max start end) (min start end))))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1404 (copy-region-as-kill start end)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 ;; ;; This should always barf, and give us the correct error.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 ;; (if kill-read-only-ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 ;; (message "Read only text copied to kill ring")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408 (setq this-command 'kill-region)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 (barf-if-buffer-read-only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 (signal 'buffer-read-only (list (current-buffer))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 ;; In certain cases, we can arrange for the undo list and the kill
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413 ;; ring to share the same string object. This code does that.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 ((not (or (eq buffer-undo-list t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 (eq last-command 'kill-region)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 ;; Use = since positions may be numbers or markers.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1417 (= start end)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 ;; Don't let the undo list be truncated before we can even access it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 ;; FSF calls this `undo-strong-limit'
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1420 (let ((undo-high-threshold (+ (- end start) 100))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 ;(old-list buffer-undo-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 tail)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1423 (delete-region start end)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 ;; Search back in buffer-undo-list for this string,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 ;; in case a change hook made property changes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 (setq tail buffer-undo-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 (while (and tail
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 (not (stringp (car-safe (car-safe tail))))) ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 (pop tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 ;; Take the same string recorded for undo
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 ;; and put it in the kill-ring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 (and tail
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 (kill-new (car (car tail))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 ;; if undo is not kept, grab the string then delete it (which won't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 ;; add another string to the undo list).
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1438 (copy-region-as-kill start end)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1439 (delete-region start end)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 (setq this-command 'kill-region))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442 ;; copy-region-as-kill no longer sets this-command, because it's confusing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 ;; to get two copies of the text when the user accidentally types M-w and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 ;; then corrects it with the intended C-w.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1445 (defun copy-region-as-kill (start end)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 "Save the region as if killed, but don't kill it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 Run `kill-hooks'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 (interactive "r")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 (if (eq last-command 'kill-region)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1450 (kill-append (buffer-substring start end) (< end start))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1451 (kill-new (buffer-substring start end)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1454 (defun kill-ring-save (start end)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 "Save the region as if killed, but don't kill it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 This command is similar to `copy-region-as-kill', except that it gives
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 visual feedback indicating the extent of the region being copied."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 (interactive "r")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1459 (copy-region-as-kill start end)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 ;; copy before delay, for xclipboard's benefit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 (if (interactive-p)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1462 (let ((other-end (if (= (point) start) end start))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 (opoint (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 ;; Inhibit quitting so we can make a quit here
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 ;; look like a C-g typed as a command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 (inhibit-quit t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 (if (pos-visible-in-window-p other-end (selected-window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 ;; FSF (I'm not sure what this does -sb)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 ; ;; Swap point and mark.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 ; (set-marker (mark-marker) (point) (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 (goto-char other-end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 (sit-for 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 ; ;; Swap back.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 ; (set-marker (mark-marker) other-end (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 (goto-char opoint)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 ;; If user quit, deactivate the mark
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 ;; as C-g would as a command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 (and quit-flag (mark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 (zmacs-deactivate-region)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 ;; too noisy. -- jwz
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 ; (let* ((killed-text (current-kill 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483 ; (message-len (min (length killed-text) 40)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1484 ; (if (= (point) start)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485 ; ;; Don't say "killed"; that is misleading.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 ; (message "Saved text until \"%s\""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 ; (substring killed-text (- message-len)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488 ; (message "Saved text from \"%s\""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 ; (substring killed-text 0 message-len))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 ))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492 (defun append-next-kill ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 "Cause following command, if it kills, to append to previous kill."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 (interactive "_")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 (if (interactive-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 (setq this-command 'kill-region)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 (display-message 'command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 "If the next command is a kill, it will append"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 (setq last-command 'kill-region)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 (defun yank-pop (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 "Replace just-yanked stretch of killed text with a different stretch.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 This command is allowed only immediately after a `yank' or a `yank-pop'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 At such a time, the region contains a stretch of reinserted
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 previously-killed text. `yank-pop' deletes that text and inserts in its
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 place a different stretch of killed text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 With no argument, the previous kill is inserted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 With argument N, insert the Nth previous kill.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 If N is negative, this is a more recent kill.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 The sequence of kills wraps around, so that after the oldest one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 comes the newest one."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 (interactive "*p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 (if (not (eq last-command 'yank))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 (error "Previous command was not a yank"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 (setq this-command 'yank)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 (let ((inhibit-read-only t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 (before (< (point) (mark t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 (delete-region (point) (mark t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 ;;(set-marker (mark-marker) (point) (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 (set-mark (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 (insert (current-kill arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 (if before
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 ;; It is cleaner to avoid activation, even though the command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 ;; loop would deactivate the mark because we inserted text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 (goto-char (prog1 (mark t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531 (set-marker (mark-marker t) (point) (current-buffer))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 (defun yank (&optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 "Reinsert the last stretch of killed text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 More precisely, reinsert the stretch of killed text most recently
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 killed OR yanked. Put point at end, and set mark at beginning.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 With just C-u as argument, same but put point at beginning (and mark at end).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 With argument N, reinsert the Nth most recently killed stretch of killed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542 See also the command \\[yank-pop]."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543 (interactive "*P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 ;; If we don't get all the way through, make last-command indicate that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545 ;; for the following command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546 (setq this-command t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 (push-mark (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548 (insert (current-kill (cond
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 ((listp arg) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550 ((eq arg '-) -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 (t (1- arg)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552 (if (consp arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 ;; It is cleaner to avoid activation, even though the command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 ;; loop would deactivate the mark because we inserted text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 ;; (But it's an unnecessary kludge in XEmacs.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557 ;(goto-char (prog1 (mark t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 ;(set-marker (mark-marker) (point) (current-buffer)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559 (exchange-point-and-mark t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 ;; If we do get all the way thru, make this-command indicate that.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 (setq this-command 'yank)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564 (defun rotate-yank-pointer (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 "Rotate the yanking point in the kill ring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566 With argument, rotate that many kills forward (or backward, if negative)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567 (interactive "p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 (current-kill arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 (defun insert-buffer (buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 "Insert after point the contents of BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 Puts mark after the inserted text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 BUFFER may be a buffer or a buffer name."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 (list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 (barf-if-buffer-read-only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579 (read-buffer "Insert buffer: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580 ;; XEmacs: we have different args
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 (other-buffer (current-buffer) nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582 t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 (or (bufferp buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 (setq buffer (get-buffer buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 (let (start end newmark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 (set-buffer buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 (setq start (point-min) end (point-max)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 (insert-buffer-substring buffer start end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 (setq newmark (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 (push-mark newmark))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 (defun append-to-buffer (buffer start end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 "Append to specified buffer the text of the region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 It is inserted into that buffer before its point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 When calling from a program, give three arguments:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 BUFFER (or buffer name), START and END.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601 START and END specify the portion of the current buffer to be copied."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603 ;; XEmacs: we have different args to other-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 (list (read-buffer "Append to buffer: " (other-buffer (current-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 nil t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 (region-beginning) (region-end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 (let ((oldbuf (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 (set-buffer (get-buffer-create buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610 (insert-buffer-substring oldbuf start end))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1612 (defun prepend-to-buffer (buffer start end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613 "Prepend to specified buffer the text of the region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 It is inserted into that buffer after its point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 When calling from a program, give three arguments:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617 BUFFER (or buffer name), START and END.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 START and END specify the portion of the current buffer to be copied."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 (interactive "BPrepend to buffer: \nr")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 (let ((oldbuf (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 (set-buffer (get-buffer-create buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 (insert-buffer-substring oldbuf start end)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626 (defun copy-to-buffer (buffer start end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627 "Copy to specified buffer the text of the region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 It is inserted into that buffer, replacing existing text there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 When calling from a program, give three arguments:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 BUFFER (or buffer name), START and END.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 START and END specify the portion of the current buffer to be copied."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 (interactive "BCopy to buffer: \nr")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 (let ((oldbuf (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 (set-buffer (get-buffer-create buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 (erase-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 (insert-buffer-substring oldbuf start end)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641 ;FSFmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 ;(put 'mark-inactive 'error-conditions '(mark-inactive error))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 ;(put 'mark-inactive 'error-message "The mark is not active now")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 (defun mark (&optional force buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646 "Return this buffer's mark value as integer, or nil if no mark.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 If `zmacs-regions' is true, then this returns nil unless the region is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 currently in the active (highlighted) state. With an argument of t, this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 returns the mark (if there is one) regardless of the active-region state.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 You should *generally* not use the mark unless the region is active, if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 the user has expressed a preference for the active-region model.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 If you are using this in an editing command, you are most likely making
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 a mistake; see the documentation of `set-mark'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 (setq buffer (decode-buffer buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 ;FSFmacs version:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658 ; (if (or force (not transient-mark-mode) mark-active mark-even-if-inactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 ; (marker-position (mark-marker))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 ; (signal 'mark-inactive nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 (let ((m (mark-marker force buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662 (and m (marker-position m))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664 ;;;#### FSFmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 ;;; Many places set mark-active directly, and several of them failed to also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 ;;; run deactivate-mark-hook. This shorthand should simplify.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 ;(defsubst deactivate-mark ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 ; "Deactivate the mark by setting `mark-active' to nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 ;\(That makes a difference only in Transient Mark mode.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 ;Also runs the hook `deactivate-mark-hook'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 ; (if transient-mark-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 ; (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 ; (setq mark-active nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 ; (run-hooks 'deactivate-mark-hook))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 (defun set-mark (pos &optional buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 "Set this buffer's mark to POS. Don't use this function!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678 That is to say, don't use this function unless you want
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 the user to see that the mark has moved, and you want the previous
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 mark position to be lost.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 Normally, when a new mark is set, the old one should go on the stack.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1683 This is why most applications should use `push-mark', not `set-mark'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 Novice Emacs Lisp programmers often try to use the mark for the wrong
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 purposes. The mark saves a location for the user's convenience.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 Most editing commands should not alter the mark.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688 To remember a location for internal use in the Lisp program,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 store it in a Lisp variable. Example:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1691 (let ((start (point))) (forward-line 1) (delete-region start (point)))."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 (setq buffer (decode-buffer buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 (set-marker (mark-marker t buffer) pos buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 ;; FSF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696 ; (if pos
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 ; (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 ; (setq mark-active t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 ; (run-hooks 'activate-mark-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 ; (set-marker (mark-marker) pos (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701 ; ;; Normally we never clear mark-active except in Transient Mark mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 ; ;; But when we actually clear out the mark value too,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 ; ;; we must clear mark-active in any mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704 ; (setq mark-active nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705 ; (run-hooks 'deactivate-mark-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 ; (set-marker (mark-marker) nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708 (defvar mark-ring nil
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1709 "The list of former marks of the current buffer, most recent first.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1710 This variable is automatically buffer-local.")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 (make-variable-buffer-local 'mark-ring)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712 (put 'mark-ring 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1714 (defvar dont-record-current-mark nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1715 "If set to t, the current mark value should not be recorded on the mark ring.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1716 This is set by commands that manipulate the mark incidentally, to avoid
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1717 cluttering the mark ring unnecessarily. Under most circumstances, you do
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1718 not need to set this directly; it is automatically reset each time
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1719 `push-mark' is called, according to `mark-ring-unrecorded-commands'. This
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1720 variable is automatically buffer-local.")
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1721 (make-variable-buffer-local 'dont-record-current-mark)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1722 (put 'dont-record-current-mark 'permanent-local t)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1723
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1724 ;; a conspiracy between push-mark and handle-pre-motion-command
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1725 (defvar in-shifted-motion-command nil)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1726
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1727 (defcustom mark-ring-unrecorded-commands '(shifted-motion-commands
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1728 yank
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1729 mark-beginning-of-buffer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1730 mark-bob
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1731 mark-defun
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1732 mark-end-of-buffer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1733 mark-end-of-line
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1734 mark-end-of-sentence
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1735 mark-eob
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1736 mark-marker
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1737 mark-page
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1738 mark-paragraph
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1739 mark-sexp
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1740 mark-whole-buffer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1741 mark-word)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1742 "*List of commands whose marks should not be recorded on the mark stack.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1743 Many commands set the mark as part of their action. Normally, all such
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1744 marks get recorded onto the mark stack. However, this tends to clutter up
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1745 the mark stack unnecessarily. You can control this by putting a command
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1746 onto this list. Then, any marks set by the function will not be recorded.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1747
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1748 The special value `shifted-motion-commands' causes marks set as a result
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1749 of selection using any shifted motion commands to not be recorded.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1750
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1751 The value `yank' affects all yank-like commands, as well as just `yank'."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1752 :type '(repeat (choice (const :tag "shifted motion commands"
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1753 shifted-motion-commands)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1754 (const :tag "functions that select text"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1755 :inline t
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1756 (mark-beginning-of-buffer
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1757 mark-bob
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1758 mark-defun
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1759 mark-end-of-buffer
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1760 mark-end-of-line
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1761 mark-end-of-sentence
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1762 mark-eob
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1763 mark-marker
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1764 mark-page
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1765 mark-paragraph
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1766 mark-sexp
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1767 mark-whole-buffer
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1768 mark-word))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1769 (const :tag "functions that paste text"
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1770 yank)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1771 function))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1772 :group 'killing)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1773
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 (defcustom mark-ring-max 16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 "*Maximum size of mark ring. Start discarding off end if gets this big."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 :type 'integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 :group 'killing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 (defvar global-mark-ring nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 "The list of saved global marks, most recent first.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 (defcustom global-mark-ring-max 16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 "*Maximum size of global mark ring. \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 Start discarding off end if gets this big."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785 :type 'integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786 :group 'killing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 (defun set-mark-command (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 "Set mark at where point is, or jump to mark.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790 With no prefix argument, set mark, push old mark position on local mark
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 ring, and push mark on global mark ring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 With argument, jump to mark, and pop a new position for mark off the ring
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 \(does not affect global mark ring\).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1795 The mark ring is a per-buffer stack of marks, most recent first. Its
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1796 maximum length is controlled by `mark-ring-max'. Generally, when new
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1797 marks are set, the current mark is pushed onto the stack. You can pop
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1798 marks off the stack using \\[universal-argument] \\[set-mark-command]. The term \"ring\" is used because when
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1799 you pop a mark off the stack, the current mark value is pushed onto the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1800 far end of the stack. If this is confusing, just think of the mark ring
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1801 as a stack.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1802
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803 Novice Emacs Lisp programmers often try to use the mark for the wrong
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 purposes. See the documentation of `set-mark' for more information."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 (if (null arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 (push-mark nil nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 (if (null (mark t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 (error "No mark set in this buffer")
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1810 (if dont-record-current-mark (pop-mark))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 (goto-char (mark t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 (pop-mark))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 ;; XEmacs: Extra parameter
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 (defun push-mark (&optional location nomsg activate-region buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 "Set mark at LOCATION (point, by default) and push old mark on mark ring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 If the last global mark pushed was not in the current buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 also push LOCATION on the global mark ring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 Display `Mark set' unless the optional second arg NOMSG is non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 Activate mark if optional third arg ACTIVATE-REGION non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 Novice Emacs Lisp programmers often try to use the mark for the wrong
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 purposes. See the documentation of `set-mark' for more information."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 (setq buffer (decode-buffer buffer)) ; XEmacs
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1825 (if (or dont-record-current-mark (null (mark t buffer))) ; XEmacs
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 ;; The save-excursion / set-buffer is necessary because mark-ring
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 ;; is a buffer local variable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 (set-buffer buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 (setq mark-ring (cons (copy-marker (mark-marker t buffer)) mark-ring))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 (if (> (length mark-ring) mark-ring-max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 (move-marker (car (nthcdr mark-ring-max mark-ring)) nil buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835 (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 (set-mark (or location (point buffer)) buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 ; (set-marker (mark-marker) (or location (point)) (current-buffer)) ; FSF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 ;; Now push the mark on the global mark ring.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1839 (if (and (not dont-record-current-mark)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1840 (or (null global-mark-ring)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1841 (not (eq (marker-buffer (car global-mark-ring)) buffer))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842 ;; The last global mark pushed wasn't in this same buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 (setq global-mark-ring (cons (copy-marker (mark-marker t buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 global-mark-ring))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 (if (> (length global-mark-ring) global-mark-ring-max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 (move-marker (car (nthcdr global-mark-ring-max global-mark-ring))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849 nil buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil)))))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1851 (setq dont-record-current-mark
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1852 (not (not (or (and in-shifted-motion-command
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1853 (memq 'shifted-motion-commands
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1854 mark-ring-unrecorded-commands))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1855 (memq this-command mark-ring-unrecorded-commands)))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1856 (or dont-record-current-mark nomsg executing-kbd-macro
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1857 (> (minibuffer-depth) 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 (display-message 'command "Mark set"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859 (if activate-region
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 (setq zmacs-region-stays t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 (zmacs-activate-region)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 ; (if (or activate (not transient-mark-mode)) ; FSF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864 ; (set-mark (mark t))) ; FSF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 (defun pop-mark ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 "Pop off mark ring into the buffer's actual mark.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 Does not set point. Does nothing if mark ring is empty."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 (if mark-ring
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker t)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 (set-mark (car mark-ring))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874 (move-marker (car mark-ring) nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875 (if (null (mark t)) (ding))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 (setq mark-ring (cdr mark-ring)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 (define-function 'exchange-dot-and-mark 'exchange-point-and-mark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 (defun exchange-point-and-mark (&optional dont-activate-region)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 "Put the mark where point is now, and point where the mark is now.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881 The mark is activated unless DONT-ACTIVATE-REGION is non-nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 (interactive nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 (let ((omark (mark t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1884 (if (null omark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885 (error "No mark set in this buffer"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886 (set-mark (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887 (goto-char omark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 (or dont-activate-region (zmacs-activate-region)) ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 (defun mark-something (mark-fn movement-fn arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 "internal function used by mark-sexp, mark-word, etc."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894 (let (newmark (pushp t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 (if (and (eq last-command mark-fn) (mark))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 ;; Extend the previous state in the same direction:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 (if (< (mark) (point)) (setq arg (- arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 (goto-char (mark))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 (setq pushp nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 (funcall movement-fn arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 (setq newmark (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904 (if pushp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 (push-mark newmark nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 ;; Do not mess with the mark stack, but merely adjust the previous state:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 (set-mark newmark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 (activate-region))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 ;(defun transient-mark-mode (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 ; "Toggle Transient Mark mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 ;With arg, turn Transient Mark mode on if arg is positive, off otherwise.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 ;In Transient Mark mode, when the mark is active, the region is highlighted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 ;Changing the buffer \"deactivates\" the mark.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 ;So do certain other operations that set the mark
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 ;but whose main purpose is something else--for example,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 ;incremental search, \\[beginning-of-buffer], and \\[end-of-buffer]."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919 ; (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 ; (setq transient-mark-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 ; (if (null arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 ; (not transient-mark-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 ; (> (prefix-numeric-value arg) 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 (defun pop-global-mark ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926 "Pop off global mark ring and jump to the top location."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 ;; Pop entries which refer to non-existent buffers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 (while (and global-mark-ring (not (marker-buffer (car global-mark-ring))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930 (setq global-mark-ring (cdr global-mark-ring)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 (or global-mark-ring
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 (error "No global mark set"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 (let* ((marker (car global-mark-ring))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 (buffer (marker-buffer marker))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935 (position (marker-position marker)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936 (setq global-mark-ring (nconc (cdr global-mark-ring)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 (list (car global-mark-ring))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938 (set-buffer buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 (or (and (>= position (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940 (<= position (point-max)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 (widen))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 (goto-char position)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 (switch-to-buffer buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 (defcustom signal-error-on-buffer-boundary t
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1947 "*If Non-nil, beep or signal an error when moving past buffer boundary.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948 The commands that honor this variable are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 forward-char-command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 backward-char-command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 next-line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953 previous-line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954 scroll-up-command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955 scroll-down-command"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959 ;;; After 8 years of waiting ... -sb
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960 (defcustom next-line-add-newlines nil ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961 "*If non-nil, `next-line' inserts newline when the point is at end of buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 This behavior used to be the default, and is still default in FSF Emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963 We think it is an unnecessary and unwanted side-effect."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1967 (defcustom shifted-motion-keys-select-region t
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1968 "*If non-nil, shifted motion keys select text, like in MS Windows.
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1969
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1970 More specifically, if a keystroke that matches one of the key
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1971 specifications in `motion-keys-for-shifted-motion' is pressed along
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1972 with the Shift key, and the command invoked moves the cursor and
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1973 preserves the active region (see `zmacs-region-stays'), the
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1974 intervening text will be added to the active region.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1975
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1976 When the region has been enabled or augmented as a result of a shifted
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1977 motion key, an unshifted motion key will normally deselect the region.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1978 However, if `unshifted-motion-keys-deselect-region' is t, the region
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1979 will remain active, augmented by the characters moved over by this
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1980 motion key.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1981
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1982 This functionality is specifically interpreted in terms of keys, and
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1983 *NOT* in terms of particular commands, because that produces the most
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1984 intuitive behavior: `forward-char' will work with shifted motion
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1985 when invoked by `right' but not `C-f', and user-written motion commands
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1986 bound to motion keys will automatically work with shifted motion."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1987 :type 'boolean
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1988 :group 'editing-basics)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1989
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1990 (defcustom unshifted-motion-keys-deselect-region t
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1991 "*If non-nil, unshifted motion keys deselect a shifted-motion region.
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1992 This only occurs after a region has been selected or augmented using
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1993 shifted motion keys (not when using the traditional set-mark-then-move
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1994 method), and has no effect if `shifted-motion-keys-select-region' is
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1995 nil."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1996 :type 'boolean
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1997 :group 'editing-basics)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1998
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1999 (defcustom motion-keys-for-shifted-motion
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2000 '(left right up down home end prior next
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2001 kp-left kp-right kp-up kp-down kp-home kp-end kp-prior kp-next)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2002 "*List of keys considered motion keys for the purpose of shifted selection.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2003 When one of these keys is pressed along with the Shift key, and the
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2004 command invoked moves the cursor and preserves the active region (see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2005 `zmacs-region-stays'), the intervening text will be added to the active
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2006 region. See `shifted-motion-keys-select-region' for more details.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2007
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2008 Each entry should be a keysym or a list (MODIFIERS ... KEYSYM),
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2009 i.e. zero or more modifiers followed by a keysym. When a keysym alone
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2010 is given, a keystroke consisting of that keysym, with or without any
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2011 modifiers, is considered a motion key. When the list form is given,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2012 only a keystroke with exactly those modifiers and no others (with the
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2013 exception of the Shift key) is considered a motion key.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2014
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2015 NOTE: Currently, the keysym cannot be a non-alphabetic character key
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2016 such as the `=/+' key. In any case, the shifted-motion paradigm does
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2017 not make much sense with those keys. The keysym can, however, be an
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2018 alphabetic key without problem, and you can specify the key using
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2019 either a character or a symbol, uppercase or lowercase."
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2020 :type '(repeat (choice (const :tag "normal cursor-pad (\"gray\") keys"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2021 :inline t
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2022 (left right up down home end prior next))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2023 (const :tag "keypad motion keys"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2024 :inline t
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2025 (kp-left kp-right kp-up kp-down
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2026 kp-home kp-end kp-prior kp-next))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2027 (const :tag "alphabetic motion keys"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2028 :inline t
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2029 ((control b) (control f)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2030 (control p) (control n)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2031 (control a) (control e)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2032 (control v) (meta v)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2033 (meta b) (meta f)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2034 (meta a) (meta e)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2035 (meta m) ; back-to-indentation
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2036 (meta r) ; move-to-window-line
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2037 (meta control b) (meta control f)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2038 (meta control p) (meta control n)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2039 (meta control a) (meta control e)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2040 (meta control d) ;; down-list
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2041 (meta control u) ;; backward-up-list
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2042 ))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2043 symbol))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2044 :group 'editing-basics)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2045
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2046 (defun handle-pre-motion-command-current-command-is-motion ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2047 (and (key-press-event-p last-input-event)
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2048 (let ((key (event-key last-input-event))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2049 (mods (delq 'shift (event-modifiers last-input-event))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2050 ;(princ (format "key: %s mods: %s\n" key mods) 'external-debugging-output)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2051 (catch 'handle-pre-motion-command-current-command-is-motion
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2052 (flet ((keysyms-equal (a b)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2053 (if (characterp a)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2054 (setq a (intern (char-to-string (downcase a)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2055 (if (characterp b)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2056 (setq b (intern (char-to-string (downcase b)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2057 (eq a b)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2058 (mapc #'(lambda (keysym)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2059 (when (if (listp keysym)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2060 (and (equal mods (butlast keysym))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2061 (keysyms-equal key (car (last keysym))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2062 (keysyms-equal key keysym))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2063 (throw
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2064 'handle-pre-motion-command-current-command-is-motion
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2065 t)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2066 motion-keys-for-shifted-motion)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2067 nil)))))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2068
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2069 (defun handle-pre-motion-command ()
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2070 (if (and
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2071 (handle-pre-motion-command-current-command-is-motion)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2072 zmacs-regions
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2073 shifted-motion-keys-select-region
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2074 (not (region-active-p))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2075 ;; Special-case alphabetic keysyms, because the `shift'
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2076 ;; modifier does not appear on them. (Unfortunately, we have no
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2077 ;; way of determining Shift-key status on non-alphabetic ASCII
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2078 ;; keysyms. However, in this case, using Shift will invoke a
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2079 ;; separate command from the non-shifted version, so the
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2080 ;; "shifted motion" paradigm makes no sense.)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2081 (or (memq 'shift (event-modifiers last-input-event))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2082 (let ((key (event-key last-input-event)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2083 (and (characterp key)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2084 (not (eq key (downcase key)))))))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2085 (let ((in-shifted-motion-command t))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2086 (push-mark nil nil t))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2087
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2088 (defun handle-post-motion-command ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2089 (if
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2090 (and
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2091 (handle-pre-motion-command-current-command-is-motion)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2092 zmacs-regions
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2093 (region-active-p))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2094 ;; Special-case alphabetic keysyms, because the `shift'
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2095 ;; modifier does not appear on them. See above.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2096 (cond ((or (memq 'shift (event-modifiers last-input-event))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2097 (let ((key (event-key last-input-event)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2098 (and (characterp key)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2099 (not (eq key (downcase key))))))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2100 (if shifted-motion-keys-select-region
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2101 (putf this-command-properties 'shifted-motion-command t))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2102 (setq zmacs-region-stays t))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2103 ((and (getf last-command-properties 'shifted-motion-command)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2104 unshifted-motion-keys-deselect-region)
487
54fa1a5c2d12 [xemacs-hg @ 2001-04-28 07:48:36 by ben]
ben
parents: 462
diff changeset
2105 (setq zmacs-region-stays nil)))))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2106
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 (defun forward-char-command (&optional arg buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108 "Move point right ARG characters (left if ARG negative) in BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 On attempt to pass end of buffer, stop and signal `end-of-buffer'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2110 On attempt to pass beginning of buffer, stop and signal `beginning-of-buffer'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111 Error signaling is suppressed if `signal-error-on-buffer-boundary'
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2112 is nil. If BUFFER is nil, the current buffer is assumed.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2113
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2114 The characters that are moved over may be added to the current selection
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2115 \(i.e. active region) if the Shift key is held down, a motion key is used
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2116 to invoke this command, and `shifted-motion-keys-select-region' is t; see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2117 the documentation for this variable for more details."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 (interactive "_p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2119 (if signal-error-on-buffer-boundary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2120 (forward-char arg buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122 (forward-char arg buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123 (beginning-of-buffer nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 (end-of-buffer nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126 (defun backward-char-command (&optional arg buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2127 "Move point left ARG characters (right if ARG negative) in BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2128 On attempt to pass end of buffer, stop and signal `end-of-buffer'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129 On attempt to pass beginning of buffer, stop and signal `beginning-of-buffer'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2130 Error signaling is suppressed if `signal-error-on-buffer-boundary'
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2131 is nil. If BUFFER is nil, the current buffer is assumed.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2132
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2133 The characters that are moved over may be added to the current selection
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2134 \(i.e. active region) if the Shift key is held down, a motion key is used
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2135 to invoke this command, and `shifted-motion-keys-select-region' is t; see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2136 the documentation for this variable for more details."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2137 (interactive "_p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2138 (if signal-error-on-buffer-boundary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2139 (backward-char arg buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141 (backward-char arg buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2142 (beginning-of-buffer nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 (end-of-buffer nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2145 (defun scroll-up-one ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2146 "Scroll text of current window upward one line.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2147 On attempt to scroll past end of buffer, `end-of-buffer' is signaled.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2148 On attempt to scroll past beginning of buffer, `beginning-of-buffer' is
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2149 signaled.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2150
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2151 If `signal-error-on-buffer-boundary' is nil, attempts to scroll past buffer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2152 boundaries do not cause an error to be signaled."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2153 (interactive "_")
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2154 (scroll-up-command 1))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2155
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2156 (defun scroll-up-command (&optional n)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2157 "Scroll current window upward N lines; or near full screen if N is nil.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2158 A near full screen is `next-screen-context-lines' less than a full screen.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2159 Negative N means scroll downward.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160 When calling from a program, supply a number as argument or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161 On attempt to scroll past end of buffer, `end-of-buffer' is signaled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162 On attempt to scroll past beginning of buffer, `beginning-of-buffer' is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2163 signaled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2164
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2165 The characters that are moved over may be added to the current selection
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2166 \(i.e. active region) if the Shift key is held down, a motion key is used
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2167 to invoke this command, and `shifted-motion-keys-select-region' is t; see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2168 the documentation for this variable for more details.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2169
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2170 If `signal-error-on-buffer-boundary' is nil, attempts to scroll past buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2171 boundaries do not cause an error to be signaled."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2172 (interactive "_P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2173 (if signal-error-on-buffer-boundary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2174 (scroll-up n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2175 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176 (scroll-up n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2177 (beginning-of-buffer nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2178 (end-of-buffer nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2179
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2180 (defun scroll-down-one ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2181 "Scroll text of current window downward one line.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2182 On attempt to scroll past end of buffer, `end-of-buffer' is signaled.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2183 On attempt to scroll past beginning of buffer, `beginning-of-buffer' is
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2184 signaled.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2185
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2186 If `signal-error-on-buffer-boundary' is nil, attempts to scroll past buffer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2187 boundaries do not cause an error to be signaled."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2188 (interactive "_")
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2189 (scroll-down-command 1))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2190
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2191 (defun scroll-down-command (&optional n)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2192 "Scroll current window downward N lines; or near full screen if N is nil.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2193 A near full screen is `next-screen-context-lines' less than a full screen.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2194 Negative N means scroll upward.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2195 When calling from a program, supply a number as argument or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2196 On attempt to scroll past end of buffer, `end-of-buffer' is signaled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197 On attempt to scroll past beginning of buffer, `beginning-of-buffer' is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 signaled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200 If `signal-error-on-buffer-boundary' is nil, attempts to scroll past buffer
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2201 boundaries do not cause an error to be signaled.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2202
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2203 The characters that are moved over may be added to the current selection
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2204 \(i.e. active region) if the Shift key is held down, a motion key is used
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2205 to invoke this command, and `shifted-motion-keys-select-region' is t; see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2206 the documentation for this variable for more details."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2207 (interactive "_P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 (if signal-error-on-buffer-boundary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209 (scroll-down n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 (scroll-down n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212 (beginning-of-buffer nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213 (end-of-buffer nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2215 (defun next-line (count)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2216 "Move cursor vertically down COUNT lines.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217 If there is no character in the target line exactly under the current column,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2218 the cursor is positioned after the character in that line which spans this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219 column, or at the end of the line if it is not long enough.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221 If there is no line in the buffer after this one, behavior depends on the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 value of `next-line-add-newlines'. If non-nil, it inserts a newline character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2223 to create a line, and moves the cursor to that line. Otherwise it moves the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2224 cursor to the end of the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2226 The command \\[set-goal-column] can be used to create
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 a semipermanent goal column to which this command always moves.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228 Then it does not try to move vertically. This goal column is stored
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229 in `goal-column', which is nil when there is none.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2231 The characters that are moved over may be added to the current selection
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2232 \(i.e. active region) if the Shift key is held down, a motion key is used
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2233 to invoke this command, and `shifted-motion-keys-select-region' is t; see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2234 the documentation for this variable for more details.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2235
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 If you are thinking of using this in a Lisp program, consider
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2237 using `forward-line' instead. It is usually easier to use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2238 and more reliable (no dependence on goal column, etc.)."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2239 (interactive "_p")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2240 (if (and next-line-add-newlines (= count 1))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241 (let ((opoint (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2242 (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2243 (if (eobp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2244 (newline 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2245 (goto-char opoint)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2246 (line-move count)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247 (if (interactive-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2248 ;; XEmacs: Not sure what to do about this. It's inconsistent. -sb
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249 (condition-case nil
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2250 (line-move count)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2251 ((beginning-of-buffer end-of-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2252 (when signal-error-on-buffer-boundary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2253 (ding nil 'buffer-bound))))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2254 (line-move count)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2255 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2256
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2257 (defun previous-line (count)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2258 "Move cursor vertically up COUNT lines.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2259 If there is no character in the target line exactly over the current column,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2260 the cursor is positioned after the character in that line which spans this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2261 column, or at the end of the line if it is not long enough.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2263 The command \\[set-goal-column] can be used to create
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2264 a semipermanent goal column to which this command always moves.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2265 Then it does not try to move vertically.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2267 The characters that are moved over may be added to the current selection
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2268 \(i.e. active region) if the Shift key is held down, a motion key is used
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2269 to invoke this command, and `shifted-motion-keys-select-region' is t; see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2270 the documentation for this variable for more details.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2271
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2272 If you are thinking of using this in a Lisp program, consider using
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2273 `forward-line' with a negative argument instead. It is usually easier
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2274 to use and more reliable (no dependence on goal column, etc.)."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2275 (interactive "_p")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2276 (if (interactive-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2277 (condition-case nil
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2278 (line-move (- count))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2279 ((beginning-of-buffer end-of-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2280 (when signal-error-on-buffer-boundary ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2281 (ding nil 'buffer-bound))))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2282 (line-move (- count)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2283 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2284
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2285 (defcustom block-movement-size 6
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2286 "*Number of lines that \"block movement\" commands (\\[forward-block-of-lines], \\[backward-block-of-lines]) move by."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2287 :type 'integer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2288 :group 'editing-basics)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2289
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2290 (defun backward-block-of-lines ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2291 "Move backward by one \"block\" of lines.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2292 The number of lines that make up a block is controlled by
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2293 `block-movement-size', which defaults to 6.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2294
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2295 The characters that are moved over may be added to the current selection
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2296 \(i.e. active region) if the Shift key is held down, a motion key is used
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2297 to invoke this command, and `shifted-motion-keys-select-region' is t; see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2298 the documentation for this variable for more details."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2299 (interactive "_")
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2300 (forward-line (- block-movement-size)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2301
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2302 (defun forward-block-of-lines ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2303 "Move forward by one \"block\" of lines.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2304 The number of lines that make up a block is controlled by
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2305 `block-movement-size', which defaults to 6.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2306
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2307 The characters that are moved over may be added to the current selection
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2308 \(i.e. active region) if the Shift key is held down, a motion key is used
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2309 to invoke this command, and `shifted-motion-keys-select-region' is t; see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2310 the documentation for this variable for more details."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2311 (interactive "_")
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2312 (forward-line block-movement-size))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2313
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314 (defcustom track-eol nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315 "*Non-nil means vertical motion starting at end of line keeps to ends of lines.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2316 This means moving to the end of each line moved onto.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2317 The beginning of a blank line does not count as the end of a line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2318 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2320
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2321 (defcustom goal-column nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2322 "*Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323 :type '(choice integer (const :tag "None" nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2324 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2325 (make-variable-buffer-local 'goal-column)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2326
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2327 (defvar temporary-goal-column 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2328 "Current goal column for vertical motion.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2329 It is the column where point was
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2330 at the start of current run of vertical motion commands.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2331 When the `track-eol' feature is doing its job, the value is 9999.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2332 (make-variable-buffer-local 'temporary-goal-column)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2333
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2334 ;XEmacs: not yet ported, so avoid compiler warnings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2335 (eval-when-compile
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2336 (defvar inhibit-point-motion-hooks))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2338 (defcustom line-move-ignore-invisible nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2339 "*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2340 Use with care, as it slows down movement significantly. Outline mode sets this."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2341 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2342 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2343
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2344 ;; This is the guts of next-line and previous-line.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2345 ;; Count says how many lines to move.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2346 (defun line-move (count)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2347 ;; Don't run any point-motion hooks, and disregard intangibility,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2348 ;; for intermediate positions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2349 (let ((inhibit-point-motion-hooks t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2350 (opoint (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2351 new)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2352 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2353 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2354 (if (not (or (eq last-command 'next-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2355 (eq last-command 'previous-line)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2356 (setq temporary-goal-column
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2357 (if (and track-eol (eolp)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2358 ;; Don't count start of empty line as end of line
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2359 ;; unless we just did explicit end-of-line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2360 (or (not (bolp)) (eq last-command 'end-of-line)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2361 9999
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2362 (current-column))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2363 (if (and (not (integerp selective-display))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2364 (not line-move-ignore-invisible))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2365 ;; Use just newline characters.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2366 (or (if (> count 0)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2367 (progn (if (> count 1) (forward-line (1- count)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2368 ;; This way of moving forward COUNT lines
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2369 ;; verifies that we have a newline after the last one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2370 ;; It doesn't get confused by intangible text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2371 (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2372 (zerop (forward-line 1)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2373 (and (zerop (forward-line count))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2374 (bolp)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2375 (signal (if (< count 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2376 'beginning-of-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2377 'end-of-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2378 nil))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2379 ;; Move by count lines, but ignore invisible ones.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2380 (while (> count 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2381 (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2382 (and (zerop (vertical-motion 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2383 (signal 'end-of-buffer nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2384 ;; If the following character is currently invisible,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2385 ;; skip all characters with that same `invisible' property value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2386 (while (and (not (eobp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2387 (let ((prop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2388 (get-char-property (point) 'invisible)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2389 (if (eq buffer-invisibility-spec t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2390 prop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2391 (or (memq prop buffer-invisibility-spec)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2392 (assq prop buffer-invisibility-spec)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2393 (if (get-text-property (point) 'invisible)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2394 (goto-char (next-single-property-change (point) 'invisible))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2395 (goto-char (next-extent-change (point))))) ; XEmacs
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2396 (setq count (1- count)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2397 (while (< count 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2398 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2399 (and (zerop (vertical-motion -1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2400 (signal 'beginning-of-buffer nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2401 (while (and (not (bobp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2402 (let ((prop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2403 (get-char-property (1- (point)) 'invisible)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2404 (if (eq buffer-invisibility-spec t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2405 prop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2406 (or (memq prop buffer-invisibility-spec)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2407 (assq prop buffer-invisibility-spec)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2408 (if (get-text-property (1- (point)) 'invisible)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2409 (goto-char (previous-single-property-change (point) 'invisible))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2410 (goto-char (previous-extent-change (point))))) ; XEmacs
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2411 (setq count (1+ count))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2412 (move-to-column (or goal-column temporary-goal-column)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2413 ;; Remember where we moved to, go back home,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2414 ;; then do the motion over again
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2415 ;; in just one step, with intangibility and point-motion hooks
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2416 ;; enabled this time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2417 (setq new (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2418 (goto-char opoint)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2419 (setq inhibit-point-motion-hooks nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2420 (goto-char new)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2421 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2422
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2423 ;;; Many people have said they rarely use this feature, and often type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2424 ;;; it by accident. Maybe it shouldn't even be on a key.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2425 ;; It's not on a key, as of 20.2. So no need for this.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2426 ;(put 'set-goal-column 'disabled t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2427
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2428 (defun set-goal-column (column)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2429 "Set the current horizontal position as a goal for \\[next-line] and \\[previous-line].
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2430 Those commands will move to this position in the line moved to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2431 rather than trying to keep the same horizontal position.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2432 With a non-nil argument, clears out the goal column
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2433 so that \\[next-line] and \\[previous-line] resume vertical motion.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2434 The goal column is stored in the variable `goal-column'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2435 (interactive "_P") ; XEmacs
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2436 (if column
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2437 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2438 (setq goal-column nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2439 (display-message 'command "No goal column"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2440 (setq goal-column (current-column))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2441 (lmessage 'command
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2442 "Goal column %d (use %s with a prefix arg to unset it)"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2443 goal-column
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2444 (substitute-command-keys "\\[set-goal-column]")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2445 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2446
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2447 ;; deleted FSFmacs terminal randomness hscroll-point-visible stuff.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2448 ;; hscroll-step
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2449 ;; hscroll-point-visible
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2450 ;; hscroll-window-column
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2451 ;; right-arrow
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2452 ;; left-arrow
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2453
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2454 (defun scroll-other-window-down (lines)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2455 "Scroll the \"other window\" down.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2456 For more details, see the documentation for `scroll-other-window'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2457 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2458 (scroll-other-window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2459 ;; Just invert the argument's meaning.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2460 ;; We can do that without knowing which window it will be.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2461 (if (eq lines '-) nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2462 (if (null lines) '-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2463 (- (prefix-numeric-value lines))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2464 ;(define-key esc-map [?\C-\S-v] 'scroll-other-window-down)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2465
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2466 (defun beginning-of-buffer-other-window (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2467 "Move point to the beginning of the buffer in the other window.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2468 Leave mark at previous position.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2469 With arg N, put point N/10 of the way from the true beginning."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2470 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2471 (let ((orig-window (selected-window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472 (window (other-window-for-scrolling)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2473 ;; We use unwind-protect rather than save-window-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2474 ;; because the latter would preserve the things we want to change.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2475 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2476 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2477 (select-window window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478 ;; Set point and mark in that window's buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2479 (beginning-of-buffer arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2480 ;; Set point accordingly.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2481 (recenter '(t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2482 (select-window orig-window))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2484 (defun end-of-buffer-other-window (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2485 "Move point to the end of the buffer in the other window.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2486 Leave mark at previous position.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2487 With arg N, put point N/10 of the way from the true end."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2488 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2489 ;; See beginning-of-buffer-other-window for comments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2490 (let ((orig-window (selected-window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2491 (window (other-window-for-scrolling)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2492 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2493 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2494 (select-window window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2495 (end-of-buffer arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2496 (recenter '(t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2497 (select-window orig-window))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2498
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2499 (defun transpose-chars (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2500 "Interchange characters around point, moving forward one character.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2501 With prefix arg ARG, effect is to take character before point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2502 and drag it forward past ARG other characters (backward if ARG negative).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2503 If no argument and at end of line, the previous two chars are exchanged."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2504 (interactive "*P")
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2505 (and (null arg) (eolp) (backward-char 1))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2506 (transpose-subr 'forward-char (prefix-numeric-value arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2507
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2508 ;;; A very old implementation of transpose-chars from the old days ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2509 (defun transpose-preceding-chars (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2510 "Interchange characters before point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2511 With prefix arg ARG, effect is to take character before point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2512 and drag it forward past ARG other characters (backward if ARG negative).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2513 If no argument and not at start of line, the previous two chars are exchanged."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2514 (interactive "*P")
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2515 (and (null arg) (not (bolp)) (backward-char 1))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2516 (transpose-subr 'forward-char (prefix-numeric-value arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2517
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2518
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2519 (defun transpose-words (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2520 "Interchange words around point, leaving point at end of them.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2521 With prefix arg ARG, effect is to take word before or around point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2522 and drag it forward past ARG other words (backward if ARG negative).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2523 If ARG is zero, the words around or after point and around or after mark
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2524 are interchanged."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2525 (interactive "*p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2526 (transpose-subr 'forward-word arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2527
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2528 (defun transpose-sexps (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2529 "Like \\[transpose-words] but applies to sexps.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2530 Does not work on a sexp that point is in the middle of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2531 if it is a list or string."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2532 (interactive "*p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2533 (transpose-subr 'forward-sexp arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2534
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2535 (defun Simple-forward-line-creating-newline ()
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2536 ;; Move forward over a line,
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2537 ;; but create a newline if none exists yet.
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2538 (end-of-line)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2539 (if (eobp)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2540 (newline)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2541 (forward-char 1)))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2542
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2543 (defun Simple-transpose-lines-mover (arg)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2544 (if (= arg 1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2545 (Simple-forward-line-creating-newline)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2546 (forward-line arg)))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2547
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2548 (defun transpose-lines (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2549 "Exchange current line and previous line, leaving point after both.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2550 With argument ARG, takes previous line and moves it past ARG lines.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2551 With argument 0, interchanges line point is in with line mark is in."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2552 (interactive "*p")
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2553 (transpose-subr 'Simple-transpose-lines-mover arg))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2554
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2555 (defun transpose-line-up (arg)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2556 "Move current line one line up, leaving point at beginning of that line.
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2557 With argument ARG, move it ARG lines up. This can be run repeatedly
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2558 to move the current line up a number of lines.
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2559
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2560 If the region is active, move the region up one line (or ARG lines,
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2561 if specified). The region will not be selected afterwards, but this
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2562 command can still be run repeatedly to move the region up a number
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2563 of lines."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2564 (interactive "*p")
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2565 (transpose-line-down (- arg)))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2566
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2567 (defun transpose-line-down (arg)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2568 "Move current line one line down, leaving point at beginning of that line.
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2569 With argument ARG, move it ARG lines down. This can be run repeatedly
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2570 to move the current line down a number of lines.
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2571
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2572 If the region is active, move the region down one line (or ARG lines,
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2573 if specified). The region will not be selected afterwards, but this
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2574 command can still be run repeatedly to move the region down a number
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2575 of lines."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2576 (interactive "*p")
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2577 (if (or (region-active-p)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2578 (getf last-command-properties 'transpose-region-by-line-command))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2579 (progn
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2580 (transpose-subr 'Simple-transpose-lines-mover arg t)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2581 (putf this-command-properties 'transpose-region-by-line-command t))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2582 (Simple-forward-line-creating-newline)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2583 (transpose-subr 'Simple-transpose-lines-mover arg)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2584 (forward-line -1)))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2585
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2586 (defun transpose-subr (mover arg &optional move-region)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2587 (let (start1 end1 start2 end2)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2588 ;; XEmacs -- use flet instead of defining a separate function and
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2589 ;; relying on dynamic scope; use (mark t) etc; add code to support
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2590 ;; the new MOVE-REGION arg.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2591 (flet ((transpose-subr-1 ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2592 (if (> (min end1 end2) (max start1 start2))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2593 (error "Don't have two things to transpose"))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2594 (let ((word1 (buffer-substring start1 end1))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2595 (word2 (buffer-substring start2 end2)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2596 (delete-region start2 end2)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2597 (goto-char start2)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2598 (insert word1)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2599 (goto-char (if (< start1 start2) start1
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2600 (+ start1 (- (length word1) (length word2)))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2601 (delete-char (length word1))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2602 (insert word2))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2603 (if (= arg 0)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2604 (progn
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2605 (save-excursion
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2606 (funcall mover 1)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2607 (setq end2 (point))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2608 (funcall mover -1)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2609 (setq start2 (point))
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2610 (goto-char (mark t))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2611 (funcall mover 1)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2612 (setq end1 (point))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2613 (funcall mover -1)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2614 (setq start1 (point))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2615 (transpose-subr-1))
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2616 (exchange-point-and-mark t)))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2617 (if move-region
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2618 (let ((rbeg (region-beginning))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2619 (rend (region-end)))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2620 (while (> arg 0)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2621 (goto-char rend)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2622 (funcall mover 1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2623 (setq end2 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2624 (funcall mover -1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2625 (setq start2 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2626 (setq start1 rbeg end1 rend)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2627 (transpose-subr-1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2628 (incf rbeg (- end2 start2))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2629 (incf rend (- end2 start2))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2630 (setq arg (1- arg)))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2631 (while (< arg 0)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2632 (goto-char rbeg)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2633 (funcall mover -1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2634 (setq start1 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2635 (funcall mover 1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2636 (setq end1 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2637 (setq start2 rbeg end2 rend)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2638 (transpose-subr-1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2639 (decf rbeg (- end1 start1))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2640 (decf rend (- end1 start1))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2641 (setq arg (1+ arg)))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2642 (set-mark rbeg)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2643 (goto-char rend))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2644 (while (> arg 0)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2645 (funcall mover -1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2646 (setq start1 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2647 (funcall mover 1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2648 (setq end1 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2649 (funcall mover 1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2650 (setq end2 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2651 (funcall mover -1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2652 (setq start2 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2653 (transpose-subr-1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2654 (goto-char end2)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2655 (setq arg (1- arg)))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2656 (while (< arg 0)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2657 (funcall mover -1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2658 (setq start2 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2659 (funcall mover -1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2660 (setq start1 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2661 (funcall mover 1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2662 (setq end1 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2663 (funcall mover 1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2664 (setq end2 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2665 (transpose-subr-1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2666 (setq arg (1+ arg)))))))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2667
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2668
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2669 (defcustom comment-column 32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2670 "*Column to indent right-margin comments to.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2671 Setting this variable automatically makes it local to the current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2672 Each mode establishes a different default value for this variable; you
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2673 can set the value for a particular mode using that mode's hook."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2674 :type 'integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2675 :group 'fill-comments)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2676 (make-variable-buffer-local 'comment-column)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2677
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2678 (defcustom comment-start nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2679 "*String to insert to start a new comment, or nil if no comment syntax."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2680 :type '(choice (const :tag "None" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2681 string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2682 :group 'fill-comments)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2683
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2684 (defcustom comment-start-skip nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2685 "*Regexp to match the start of a comment plus everything up to its body.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2686 If there are any \\(...\\) pairs, the comment delimiter text is held to begin
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2687 at the place matched by the close of the first pair."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2688 :type '(choice (const :tag "None" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2689 regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2690 :group 'fill-comments)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2691
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2692 (defcustom comment-end ""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2693 "*String to insert to end a new comment.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2694 Should be an empty string if comments are terminated by end-of-line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2695 :type 'string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2696 :group 'fill-comments)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2697
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2698 (defconst comment-indent-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2699 "Obsolete variable for function to compute desired indentation for a comment.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2700 Use `comment-indent-function' instead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2701 This function is called with no args with point at the beginning of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2702 the comment's starting delimiter.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2703
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2704 (defconst comment-indent-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2705 ;; XEmacs - add at least one space after the end of the text on the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2706 ;; current line...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2707 (lambda ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2708 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2709 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2710 (let ((eol (save-excursion (end-of-line) (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2711 (and comment-start-skip
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2712 (re-search-forward comment-start-skip eol t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2713 (setq eol (match-beginning 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2714 (goto-char eol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2715 (skip-chars-backward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2716 (max comment-column (1+ (current-column))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2717 "Function to compute desired indentation for a comment.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2718 This function is called with no args with point at the beginning of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2719 the comment's starting delimiter.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2720
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2721 (defcustom block-comment-start nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2722 "*String to insert to start a new comment on a line by itself.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2723 If nil, use `comment-start' instead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2724 Note that the regular expression `comment-start-skip' should skip this string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2725 as well as the `comment-start' string."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2726 :type '(choice (const :tag "Use `comment-start'" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2727 string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2728 :group 'fill-comments)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2729
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2730 (defcustom block-comment-end nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2731 "*String to insert to end a new comment on a line by itself.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2732 Should be an empty string if comments are terminated by end-of-line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2733 If nil, use `comment-end' instead."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2734 :type '(choice (const :tag "Use `comment-end'" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2735 string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2736 :group 'fill-comments)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2737
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2738 (defun indent-for-comment ()
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2739 "Indent this line's comment to comment column, or insert an empty
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2740 comment. Comments starting in column 0 are not moved."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2741 (interactive "*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2742 (let* ((empty (save-excursion (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2743 (looking-at "[ \t]*$")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2744 (starter (or (and empty block-comment-start) comment-start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2745 (ender (or (and empty block-comment-end) comment-end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2746 (if (null starter)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2747 (error "No comment syntax defined")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2748 (let* ((eolpos (save-excursion (end-of-line) (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2749 cpos indent begpos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2750 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2751 (if (re-search-forward comment-start-skip eolpos 'move)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2752 (progn (setq cpos (point-marker))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2753 ;; Find the start of the comment delimiter.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2754 ;; If there were paren-pairs in comment-start-skip,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2755 ;; position at the end of the first pair.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2756 (if (match-end 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2757 (goto-char (match-end 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2758 ;; If comment-start-skip matched a string with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2759 ;; internal whitespace (not final whitespace) then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2760 ;; the delimiter start at the end of that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2761 ;; whitespace. Otherwise, it starts at the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2762 ;; beginning of what was matched.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2763 (skip-syntax-backward " " (match-beginning 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2764 (skip-syntax-backward "^ " (match-beginning 0)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2765 (setq begpos (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2766 ;; Compute desired indent.
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2767 ;; XEmacs change: Preserve indentation of comments starting in
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2768 ;; column 0, as documented.
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2769 (cond
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2770 ((= (current-column) 0)
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2771 (goto-char begpos))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2772 ((= (current-column)
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2773 (setq indent (funcall comment-indent-function)))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2774 (goto-char begpos))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2775 (t
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2776 ;; If that's different from current, change it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2777 (skip-chars-backward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2778 (delete-region (point) begpos)
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2779 (indent-to indent)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2780 ;; An existing comment?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2781 (if cpos
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2782 (progn (goto-char cpos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2783 (set-marker cpos nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2784 ;; No, insert one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2785 (insert starter)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2786 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2787 (insert ender)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2788
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2789 (defun set-comment-column (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2790 "Set the comment column based on point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2791 With no arg, set the comment column to the current column.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2792 With just minus as arg, kill any comment on this line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2793 With any other arg, set comment column to indentation of the previous comment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2794 and then align or create a comment on this line at that column."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2795 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2796 (if (eq arg '-)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2797 (kill-comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2798 (if arg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2799 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2800 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2801 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2802 (re-search-backward comment-start-skip)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2803 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2804 (re-search-forward comment-start-skip)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2805 (goto-char (match-beginning 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2806 (setq comment-column (current-column))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2807 (lmessage 'command "Comment column set to %d" comment-column))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2808 (indent-for-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2809 (setq comment-column (current-column))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2810 (lmessage 'command "Comment column set to %d" comment-column))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2811
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2812 (defun kill-comment (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2813 "Kill the comment on this line, if any.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2814 With argument, kill comments on that many lines starting with this one."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2815 ;; this function loses in a lot of situations. it incorrectly recognizes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2816 ;; comment delimiters sometimes (ergo, inside a string), doesn't work
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2817 ;; with multi-line comments, can kill extra whitespace if comment wasn't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2818 ;; through end-of-line, et cetera.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2819 (interactive "*P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2820 (or comment-start-skip (error "No comment syntax defined"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2821 (let ((count (prefix-numeric-value arg)) endc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2822 (while (> count 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2823 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2824 (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2825 (setq endc (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2826 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2827 (and (string< "" comment-end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2828 (setq endc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2829 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2830 (re-search-forward (regexp-quote comment-end) endc 'move)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2831 (skip-chars-forward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2832 (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2833 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2834 (if (re-search-forward comment-start-skip endc t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2835 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2836 (goto-char (match-beginning 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2837 (skip-chars-backward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2838 (kill-region (point) endc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2839 ;; to catch comments a line beginnings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2840 (indent-according-to-mode))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2841 (if arg (forward-line 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2842 (setq count (1- count)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2843
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2844 ;; This variable: Synched up with 20.7.
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2845 (defvar comment-padding 1
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2846 "Number of spaces `comment-region' puts between comment chars and text.
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2847
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2848 Extra spacing between the comment characters and the comment text
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2849 makes the comment easier to read. Default is 1. Nil means 0 and is
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2850 more efficient.")
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2851
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2852 ;; This function: Synched up with 20.7.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2853 (defun comment-region (start end &optional arg)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2854 "Comment or uncomment each line in the region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2855 With just C-u prefix arg, uncomment each line in region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2856 Numeric prefix arg ARG means use ARG comment characters.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2857 If ARG is negative, delete that many comment characters instead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2858 Comments are terminated on each line, even for syntax in which newline does
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2859 not end the comment. Blank lines do not get comments."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2860 ;; if someone wants it to only put a comment-start at the beginning and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2861 ;; comment-end at the end then typing it, C-x C-x, closing it, C-x C-x
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2862 ;; is easy enough. No option is made here for other than commenting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2863 ;; every line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2864 (interactive "r\nP")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2865 (or comment-start (error "No comment syntax is defined"))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2866 (if (> start end) (let (mid) (setq mid start start end end mid)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2867 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2868 (save-restriction
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2869 (let ((cs comment-start) (ce comment-end)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2870 (cp (when comment-padding
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2871 (make-string comment-padding ? )))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2872 numarg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2873 (if (consp arg) (setq numarg t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2874 (setq numarg (prefix-numeric-value arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2875 ;; For positive arg > 1, replicate the comment delims now,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2876 ;; then insert the replicated strings just once.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2877 (while (> numarg 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2878 (setq cs (concat cs comment-start)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2879 ce (concat ce comment-end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2880 (setq numarg (1- numarg))))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2881 ;; Loop over all lines from START to END.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2882 (narrow-to-region start end)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2883 (goto-char start)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2884 ;; if user didn't specify how many comments to remove, be smart
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2885 ;; and remove the minimal number that all lines have. that way,
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2886 ;; comments in a region of Elisp code that gets commented out will
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2887 ;; get put back correctly.
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2888 (if (eq numarg t)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2889 (let ((min-comments 999999))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2890 (while (not (eobp))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2891 (let ((this-comments 0))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2892 (while (looking-at (regexp-quote cs))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2893 (incf this-comments)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2894 (forward-char (length cs)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2895 (if (and (> this-comments 0) (< this-comments min-comments))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2896 (setq min-comments this-comments))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2897 (forward-line 1)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2898 (if (< min-comments 999999)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2899 (setq numarg (- min-comments)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2900 (goto-char start)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2901 (if (or (eq numarg t) (< numarg 0))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2902 (while (not (eobp))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2903 (let (found-comment)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2904 ;; Delete comment start from beginning of line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2905 (if (eq numarg t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2906 (while (looking-at (regexp-quote cs))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2907 (setq found-comment t)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2908 (delete-char (length cs)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2909 (let ((count numarg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2910 (while (and (> 1 (setq count (1+ count)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2911 (looking-at (regexp-quote cs)))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2912 (setq found-comment t)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2913 (delete-char (length cs)))))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2914 ;; Delete comment padding from beginning of line
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2915 (when (and found-comment comment-padding
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2916 (looking-at (regexp-quote cp)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2917 (delete-char comment-padding))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2918 ;; Delete comment end from end of line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2919 (if (string= "" ce)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2920 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2921 (if (eq numarg t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2922 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2923 (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2924 ;; This is questionable if comment-end ends in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2925 ;; whitespace. That is pretty brain-damaged,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2926 ;; though.
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2927 (while (progn (skip-chars-backward " \t")
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2928 (and (>= (- (point) (point-min))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2929 (length ce))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2930 (save-excursion
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2931 (backward-char (length ce))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2932 (looking-at (regexp-quote ce)))))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2933 (delete-char (- (length ce)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2934 (let ((count numarg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2935 (while (> 1 (setq count (1+ count)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2936 (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2937 ;; This is questionable if comment-end ends in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2938 ;; whitespace. That is pretty brain-damaged though
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2939 (skip-chars-backward " \t")
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2940 (if (>= (- (point) (point-min)) (length ce))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2941 (save-excursion
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2942 (backward-char (length ce))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2943 (if (looking-at (regexp-quote ce))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2944 (delete-char (length ce)))))))))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2945 (forward-line 1)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2946
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2947 (when comment-padding
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2948 (setq cs (concat cs cp)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2949 (while (not (eobp))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2950 ;; Insert at beginning and at end.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2951 (if (looking-at "[ \t]*$") ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2952 (insert cs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2953 (if (string= "" ce) ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2954 (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2955 (insert ce)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2956 (search-forward "\n" nil 'move)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2957
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2958 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2959 (defun prefix-region (prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2960 "Add a prefix string to each line between mark and point."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2961 (interactive "sPrefix string: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2962 (if prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2963 (let ((count (count-lines (mark) (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2964 (goto-char (min (mark) (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2965 (while (> count 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2966 (setq count (1- count))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2967 (beginning-of-line 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2968 (insert prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2969 (end-of-line 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2970 (forward-char 1)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2971
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2972
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2973 (defun backward-word (&optional count buffer)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2974 "Move point backward COUNT words (forward if COUNT is negative).
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2975 Normally t is returned, but if an edge of the buffer is reached,
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2976 point is left there and nil is returned.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2977
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2978 COUNT defaults to 1, and BUFFER defaults to the current buffer.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2979
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2980 The characters that are moved over may be added to the current selection
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2981 \(i.e. active region) if the Shift key is held down, a motion key is used
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2982 to invoke this command, and `shifted-motion-keys-select-region' is t; see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2983 the documentation for this variable for more details."
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2984 (interactive "_p")
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2985 (forward-word (- (or count 1)) buffer))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2986
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2987 (defun mark-word (&optional count)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2988 "Mark the text from point until encountering the end of a word.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2989 With optional argument COUNT, mark COUNT words."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2990 (interactive "p")
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2991 (mark-something 'mark-word 'forward-word count))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2992
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 843
diff changeset
2993 (defcustom kill-word-into-kill-ring t
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 843
diff changeset
2994 "*Non-nil means `kill-word' saves word killed into kill ring.
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 843
diff changeset
2995 \(Normally, this also affects the clipboard.)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 843
diff changeset
2996 Nil means word is just deleted, without being remembered.
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 843
diff changeset
2997 This also applies to `backward-kill-word' and `backward-or-forward-kill-word'."
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 843
diff changeset
2998 :type 'boolean
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 843
diff changeset
2999 :group 'editing-basics)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 843
diff changeset
3000
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3001 (defun kill-word (&optional count)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3002 "Kill characters forward until encountering the end of a word.
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3003 With optional argument COUNT, do this that many times."
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3004 (interactive "*p")
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 843
diff changeset
3005 (if kill-word-into-kill-ring
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 843
diff changeset
3006 (kill-region (point) (save-excursion (forward-word count) (point)))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 843
diff changeset
3007 (delete-region (point) (save-excursion (forward-word count) (point)))))
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3008
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3009 (defun backward-kill-word (&optional count)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3010 "Kill characters backward until encountering the end of a word.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3011 With argument, do this that many times."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3012 (interactive "*p")
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3013 (kill-word (- (or count 1))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3014
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3015 (defun current-word (&optional strict)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3016 "Return the word point is on (or a nearby word) as a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3017 If optional arg STRICT is non-nil, return nil unless point is within
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3018 or adjacent to a word.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3019 If point is not between two word-constituent characters, but immediately
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3020 follows one, move back first.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3021 Otherwise, if point precedes a word constituent, move forward first.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3022 Otherwise, move backwards until a word constituent is found and get that word;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3023 if you a newlines is reached first, move forward instead."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3024 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3025 (let ((oldpoint (point)) (start (point)) (end (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3026 (skip-syntax-backward "w_") (setq start (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3027 (goto-char oldpoint)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3028 (skip-syntax-forward "w_") (setq end (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3029 (if (and (eq start oldpoint) (eq end oldpoint))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3030 ;; Point is neither within nor adjacent to a word.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3031 (and (not strict)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3032 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3033 ;; Look for preceding word in same line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3034 (skip-syntax-backward "^w_"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3035 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3036 (beginning-of-line) (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3037 (if (bolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3038 ;; No preceding word in same line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3039 ;; Look for following word in same line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3040 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3041 (skip-syntax-forward "^w_"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3042 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3043 (end-of-line) (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3044 (setq start (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3045 (skip-syntax-forward "w_")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3046 (setq end (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3047 (setq end (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3048 (skip-syntax-backward "w_")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3049 (setq start (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3050 (buffer-substring start end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3051 (buffer-substring start end)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3052
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3053 (defcustom fill-prefix nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3054 "*String for filling to insert at front of new line, or nil for none.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3055 Setting this variable automatically makes it local to the current buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3056 :type '(choice (const :tag "None" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3057 string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3058 :group 'fill)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3059 (make-variable-buffer-local 'fill-prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3060
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3061 (defcustom auto-fill-inhibit-regexp nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3062 "*Regexp to match lines which should not be auto-filled."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3063 :type '(choice (const :tag "None" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3064 regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3065 :group 'fill)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3066
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3067 (defvar comment-line-break-function 'indent-new-comment-line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3068 "*Mode-specific function which line breaks and continues a comment.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3069
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3070 This function is only called during auto-filling of a comment section.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3071 The function should take a single optional argument which is a flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3072 indicating whether soft newlines should be inserted.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3073
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3074 ;; This function is the auto-fill-function of a buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3075 ;; when Auto-Fill mode is enabled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3076 ;; It returns t if it really did any work.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3077 ;; XEmacs: This function is totally different.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3078 (defun do-auto-fill ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3079 (let (give-up)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3080 (or (and auto-fill-inhibit-regexp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3081 (save-excursion (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3082 (looking-at auto-fill-inhibit-regexp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3083 (while (and (not give-up) (> (current-column) fill-column))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3084 ;; Determine where to split the line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3085 (let ((fill-prefix fill-prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3086 (fill-point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3087 (let ((opoint (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3088 bounce
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3089 (re-break-point ;; Kinsoku processing
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3090 (if (featurep 'mule)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 613
diff changeset
3091 (with-boundp 'word-across-newline
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 613
diff changeset
3092 (concat "[ \t\n]\\|" word-across-newline
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 613
diff changeset
3093 ".\\|." word-across-newline))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3094 "[ \t\n]"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3095 (first t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3096 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3097 (move-to-column (1+ fill-column))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3098 ;; Move back to a word boundary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3099 (while (or first
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3100 ;; If this is after period and a single space,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3101 ;; move back once more--we don't want to break
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3102 ;; the line there and make it look like a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3103 ;; sentence end.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3104 (and (not (bobp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3105 (not bounce)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3106 sentence-end-double-space
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3107 (save-excursion (backward-char 1)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3108 (and (looking-at "\\. ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3109 (not (looking-at "\\. "))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3110 (setq first nil)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3111 ;; XEmacs: change for Kinsoku processing
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3112 (fill-move-backward-to-break-point re-break-point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3113 ;; If we find nowhere on the line to break it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3114 ;; break after one word. Set bounce to t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3115 ;; so we will not keep going in this while loop.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3116 (if (bolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3117 (progn
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3118 ;; XEmacs: change for Kinsoku processing
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3119 (fill-move-forward-to-break-point re-break-point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3120 opoint)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3121 (setq bounce t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3122 (skip-chars-backward " \t"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3123 (if (and (featurep 'mule)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3124 (or bounce (bolp)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3125 (declare-fboundp (kinsoku-process)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3126 ;; Let fill-point be set to the place where we end up.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3127 (point)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3128
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3129 ;; I'm not sure why Stig made this change but it breaks
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3130 ;; auto filling in at least C mode so I'm taking it back
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3131 ;; out. --cet
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3132 ;; XEmacs - adaptive fill.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3133 ;;(maybe-adapt-fill-prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3134 ;; (or from (setq from (save-excursion (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3135 ;; (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3136 ;; (or to (setq to (save-excursion (beginning-of-line 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3137 ;; (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3138 ;; t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3140 ;; If that place is not the beginning of the line,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3141 ;; break the line there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3142 (if (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3143 (goto-char fill-point)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3144 ;; during kinsoku processing it is possible to move beyond
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3145 (not (or (bolp) (eolp))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3146 (let ((prev-column (current-column)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3147 ;; If point is at the fill-point, do not `save-excursion'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3148 ;; Otherwise, if a comment prefix or fill-prefix is inserted,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3149 ;; point will end up before it rather than after it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3150 (if (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3151 (skip-chars-backward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3152 (= (point) fill-point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3153 ;; 1999-09-17 hniksic: turn off Kinsoku until
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3154 ;; it's debugged.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3155 (funcall comment-line-break-function)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3156 ;; XEmacs: Kinsoku processing
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3157 ; ;(indent-new-comment-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3158 ; (let ((spacep (memq (char-before (point)) '(?\ ?\t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3159 ; (funcall comment-line-break-function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3160 ; ;; if user type space explicitly, leave SPC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3161 ; ;; even if there is no WAN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3162 ; (if spacep
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3163 ; (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3164 ; (goto-char fill-point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3165 ; ;; put SPC except that there is SPC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3166 ; ;; already or there is sentence end.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3167 ; (or (memq (char-after (point)) '(?\ ?\t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3168 ; (fill-end-of-sentence-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3169 ; (insert ?\ )))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3170 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3171 (goto-char fill-point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3172 (funcall comment-line-break-function)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3173 ;; If making the new line didn't reduce the hpos of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3174 ;; the end of the line, then give up now;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3175 ;; trying again will not help.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3176 (if (>= (current-column) prev-column)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3177 (setq give-up t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3178 ;; No place to break => stop trying.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3179 (setq give-up t)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3180
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3181 ;; Put FSF one in until I can one or the other working properly, then the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3182 ;; other one is history.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3183 ;(defun fsf:do-auto-fill ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3184 ; (let (fc justify
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3185 ; ;; bol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3186 ; give-up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3187 ; (fill-prefix fill-prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3188 ; (if (or (not (setq justify (current-justification)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3189 ; (null (setq fc (current-fill-column)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3190 ; (and (eq justify 'left)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3191 ; (<= (current-column) fc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3192 ; (save-excursion (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3193 ; ;; (setq bol (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3194 ; (and auto-fill-inhibit-regexp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3195 ; (looking-at auto-fill-inhibit-regexp))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3196 ; nil ;; Auto-filling not required
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3197 ; (if (memq justify '(full center right))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3198 ; (save-excursion (unjustify-current-line)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3199
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3200 ; ;; Choose a fill-prefix automatically.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3201 ; (if (and adaptive-fill-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3202 ; (or (null fill-prefix) (string= fill-prefix "")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3203 ; (let ((prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3204 ; (fill-context-prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3205 ; (save-excursion (backward-paragraph 1) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3206 ; (save-excursion (forward-paragraph 1) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3207 ; ;; Don't accept a non-whitespace fill prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3208 ; ;; from the first line of a paragraph.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3209 ; "^[ \t]*$")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3210 ; (and prefix (not (equal prefix ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3211 ; (setq fill-prefix prefix))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3212
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3213 ; (while (and (not give-up) (> (current-column) fc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3214 ; ;; Determine where to split the line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3215 ; (let ((fill-point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3216 ; (let ((opoint (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3217 ; bounce
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3218 ; (first t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3219 ; (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3220 ; (move-to-column (1+ fc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3221 ; ;; Move back to a word boundary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3222 ; (while (or first
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3223 ; ;; If this is after period and a single space,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3224 ; ;; move back once more--we don't want to break
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3225 ; ;; the line there and make it look like a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3226 ; ;; sentence end.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3227 ; (and (not (bobp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3228 ; (not bounce)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3229 ; sentence-end-double-space
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3230 ; (save-excursion (backward-char 1)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3231 ; (and (looking-at "\\. ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3232 ; (not (looking-at "\\. "))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3233 ; (setq first nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3234 ; (skip-chars-backward "^ \t\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3235 ; ;; If we find nowhere on the line to break it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3236 ; ;; break after one word. Set bounce to t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3237 ; ;; so we will not keep going in this while loop.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3238 ; (if (bolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3239 ; (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3240 ; (re-search-forward "[ \t]" opoint t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3241 ; (setq bounce t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3242 ; (skip-chars-backward " \t"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3243 ; ;; Let fill-point be set to the place where we end up.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3244 ; (point)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3245 ; ;; If that place is not the beginning of the line,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3246 ; ;; break the line there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3247 ; (if (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3248 ; (goto-char fill-point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3249 ; (not (bolp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3250 ; (let ((prev-column (current-column)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3251 ; ;; If point is at the fill-point, do not `save-excursion'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3252 ; ;; Otherwise, if a comment prefix or fill-prefix is inserted,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3253 ; ;; point will end up before it rather than after it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3254 ; (if (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3255 ; (skip-chars-backward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3256 ; (= (point) fill-point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3257 ; (funcall comment-line-break-function t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3258 ; (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3259 ; (goto-char fill-point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3260 ; (funcall comment-line-break-function t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3261 ; ;; Now do justification, if required
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3262 ; (if (not (eq justify 'left))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3263 ; (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3264 ; (end-of-line 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3265 ; (justify-current-line justify nil t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3266 ; ;; If making the new line didn't reduce the hpos of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3267 ; ;; the end of the line, then give up now;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3268 ; ;; trying again will not help.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3269 ; (if (>= (current-column) prev-column)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3270 ; (setq give-up t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3271 ; ;; No place to break => stop trying.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3272 ; (setq give-up t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3273 ; ;; Justify last line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3274 ; (justify-current-line justify t t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3275 ; t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3276
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3277 (defvar normal-auto-fill-function 'do-auto-fill
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3278 "The function to use for `auto-fill-function' if Auto Fill mode is turned on.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3279 Some major modes set this.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3280
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3281 (defun auto-fill-mode (&optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3282 "Toggle auto-fill mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3283 With arg, turn auto-fill mode on if and only if arg is positive.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3284 In Auto-Fill mode, inserting a space at a column beyond `current-fill-column'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3285 automatically breaks the line at a previous space.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3286
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3287 The value of `normal-auto-fill-function' specifies the function to use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3288 for `auto-fill-function' when turning Auto Fill mode on."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3289 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3290 (prog1 (setq auto-fill-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3291 (if (if (null arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3292 (not auto-fill-function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3293 (> (prefix-numeric-value arg) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3294 normal-auto-fill-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3295 nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3296 (redraw-modeline)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3297
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3298 ;; This holds a document string used to document auto-fill-mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3299 (defun auto-fill-function ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3300 "Automatically break line at a previous space, in insertion of text."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3301 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3302
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3303 (defun turn-on-auto-fill ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3304 "Unconditionally turn on Auto Fill mode."
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3305 (interactive)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3306 (auto-fill-mode 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3307
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3308 (defun set-fill-column (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3309 "Set `fill-column' to specified argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3310 Just \\[universal-argument] as argument means to use the current column
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3311 The variable `fill-column' has a separate value for each buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3312 (interactive "_P") ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3313 (cond ((integerp arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3314 (setq fill-column arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3315 ((consp arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3316 (setq fill-column (current-column)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3317 ;; Disallow missing argument; it's probably a typo for C-x C-f.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3318 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3319 (error "set-fill-column requires an explicit argument")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3320 (lmessage 'command "fill-column set to %d" fill-column))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3322 (defcustom comment-multi-line t ; XEmacs - this works well with adaptive fill
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3323 "*Non-nil means \\[indent-new-comment-line] should continue same comment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3324 on new line, with no new terminator or starter.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3325 This is obsolete because you might as well use \\[newline-and-indent]."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3326 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3327 :group 'fill-comments)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3328
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3329 (defun indent-new-comment-line (&optional soft)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3330 "Break line at point and indent, continuing comment if within one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3331 This indents the body of the continued comment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3332 under the previous comment line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3333
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3334 This command is intended for styles where you write a comment per line,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3335 starting a new comment (and terminating it if necessary) on each line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3336 If you want to continue one comment across several lines, use \\[newline-and-indent].
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3338 If a fill column is specified, it overrides the use of the comment column
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3339 or comment indentation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3340
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3341 The inserted newline is marked hard if `use-hard-newlines' is true,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3342 unless optional argument SOFT is non-nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3343 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3344 (let (comcol comstart)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3345 (skip-chars-backward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3346 (if (featurep 'mule)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3347 (declare-fboundp (kinsoku-process)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3348 (delete-region (point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3349 (progn (skip-chars-forward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3350 (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3351 (if soft (insert ?\n) (newline 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3352 (if fill-prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3353 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3354 (indent-to-left-margin)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3355 (insert fill-prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3356 ;; #### - Eric Eide reverts to v18 semantics for this function in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3357 ;; fa-extras, which I'm not gonna do. His changes are to (1) execute
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3358 ;; the save-excursion below unconditionally, and (2) uncomment the check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3359 ;; for (not comment-multi-line) further below. --Stig
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3360 ;;#### jhod: probably need to fix this for kinsoku processing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3361 (if (not comment-multi-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3362 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3363 (if (and comment-start-skip
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3364 (let ((opoint (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3365 (forward-line -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3366 (re-search-forward comment-start-skip opoint t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3367 ;; The old line is a comment.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3368 ;; Set WIN to the pos of the comment-start.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3369 ;; But if the comment is empty, look at preceding lines
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3370 ;; to find one that has a nonempty comment.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3371
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3372 ;; If comment-start-skip contains a \(...\) pair,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3373 ;; the real comment delimiter starts at the end of that pair.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3374 (let ((win (or (match-end 1) (match-beginning 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3375 (while (and (eolp) (not (bobp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3376 (let (opoint)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3377 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3378 (setq opoint (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3379 (forward-line -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3380 (re-search-forward comment-start-skip opoint t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3381 (setq win (or (match-end 1) (match-beginning 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3382 ;; Indent this line like what we found.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3383 (goto-char win)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3384 (setq comcol (current-column))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3385 (setq comstart
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3386 (buffer-substring (point) (match-end 0)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3387 (if (and comcol (not fill-prefix)) ; XEmacs - (ENE) from fa-extras.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3388 (let ((comment-column comcol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3389 (comment-start comstart)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3390 (block-comment-start comstart)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3391 (comment-end comment-end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3392 (and comment-end (not (equal comment-end ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3393 ; (if (not comment-multi-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3394 (progn
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3395 (backward-char 1)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3396 (insert comment-end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3397 (forward-char 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3398 ; (setq comment-column (+ comment-column (length comment-start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3399 ; comment-start "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3400 ; )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3401 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3402 (if (not (eolp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3403 (setq comment-end ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3404 (insert ?\n)
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3405 (backward-char 1)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3406 (indent-for-comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3407 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3408 ;; Make sure we delete the newline inserted above.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3409 (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3410 (delete-char 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3411 (indent-according-to-mode)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3412
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3413
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3414 (defun set-selective-display (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3415 "Set `selective-display' to ARG; clear it if no arg.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3416 When the value of `selective-display' is a number > 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3417 lines whose indentation is >= that value are not displayed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3418 The variable `selective-display' has a separate value for each buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3419 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3420 (if (eq selective-display t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3421 (error "selective-display already in use for marked lines"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3422 (let ((current-vpos
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3423 (save-restriction
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3424 (narrow-to-region (point-min) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3425 (goto-char (window-start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3426 (vertical-motion (window-height)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3427 (setq selective-display
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3428 (and arg (prefix-numeric-value arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3429 (recenter current-vpos))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3430 (set-window-start (selected-window) (window-start (selected-window)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3431 ;; #### doesn't localize properly:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3432 (princ "selective-display set to " t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3433 (prin1 selective-display t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3434 (princ "." t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3435
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3436 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3437 (defun nuke-selective-display ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3438 "Ensure that the buffer is not in selective-display mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3439 If `selective-display' is t, then restore the buffer text to its original
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3440 state before disabling selective display."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3441 ;; by Stig@hackvan.com
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3442 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3443 (and (eq t selective-display)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3444 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3445 (save-restriction
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3446 (widen)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3447 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3448 (let ((mod-p (buffer-modified-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3449 (buffer-read-only nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3450 (while (search-forward "\r" nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3451 (delete-char -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3452 (insert "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3453 (set-buffer-modified-p mod-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3454 ))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3455 (setq selective-display nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3456
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3457 (add-hook 'change-major-mode-hook 'nuke-selective-display)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3458
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3459 (defconst overwrite-mode-textual " Ovwrt"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3460 "The string displayed in the mode line when in overwrite mode.")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3461 (defconst overwrite-mode-binary " Bin Ovwrt"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3462 "The string displayed in the mode line when in binary overwrite mode.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3463
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3464 (defun overwrite-mode (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3465 "Toggle overwrite mode.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3466 With arg, enable overwrite mode if arg is positive, else disable.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3467 In overwrite mode, printing characters typed in replace existing text
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3468 on a one-for-one basis, rather than pushing it to the right. At the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3469 end of a line, such characters extend the line. Before a tab,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3470 such characters insert until the tab is filled in.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3471 \\[quoted-insert] still inserts characters in overwrite mode; this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3472 is supposed to make it easier to insert characters when necessary."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3473 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3474 (setq overwrite-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3475 (if (if (null arg) (not overwrite-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3476 (> (prefix-numeric-value arg) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3477 'overwrite-mode-textual))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3478 (redraw-modeline))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3479
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3480 (defun binary-overwrite-mode (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3481 "Toggle binary overwrite mode.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3482 With arg, enable binary overwrite mode if arg is positive, else disable.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3483 In binary overwrite mode, printing characters typed in replace
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3484 existing text. Newlines are not treated specially, so typing at the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3485 end of a line joins the line to the next, with the typed character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3486 between them. Typing before a tab character simply replaces the tab
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3487 with the character typed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3488 \\[quoted-insert] replaces the text at the cursor, just as ordinary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3489 typing characters do.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3490
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3491 Note that binary overwrite mode is not its own minor mode; it is a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3492 specialization of overwrite-mode, entered by setting the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3493 `overwrite-mode' variable to `overwrite-mode-binary'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3494 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3495 (setq overwrite-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3496 (if (if (null arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3497 (not (eq overwrite-mode 'overwrite-mode-binary))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3498 (> (prefix-numeric-value arg) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3499 'overwrite-mode-binary))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3500 (redraw-modeline))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3501
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 613
diff changeset
3502 (defcustom line-number-mode t
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3503 "*Non-nil means display line number in modeline."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3504 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3505 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3506
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3507 (defun line-number-mode (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3508 "Toggle Line Number mode.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3509 With arg, enable Line Number mode if arg is positive, else disable.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3510 When Line Number mode is enabled, the line number appears
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3511 in the mode line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3512 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3513 (setq line-number-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3514 (if (null arg) (not line-number-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3515 (> (prefix-numeric-value arg) 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3516 (redraw-modeline))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3517
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 613
diff changeset
3518 (defcustom column-number-mode t
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3519 "*Non-nil means display column number in mode line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3520 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3521 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3522
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3523 (defun column-number-mode (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3524 "Toggle Column Number mode.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3525 With arg, enable Column Number mode if arg is positive, else disable.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3526 When Column Number mode is enabled, the column number appears
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3527 in the mode line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3528 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3529 (setq column-number-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3530 (if (null arg) (not column-number-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3531 (> (prefix-numeric-value arg) 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3532 (redraw-modeline))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3533
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3534
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3535 (defcustom blink-matching-paren t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3536 "*Non-nil means show matching open-paren when close-paren is inserted."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3537 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3538 :group 'paren-blinking)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3539
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3540 (defcustom blink-matching-paren-on-screen t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3541 "*Non-nil means show matching open-paren when it is on screen.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3542 nil means don't show it (but the open-paren can still be shown
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3543 when it is off screen."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3544 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3545 :group 'paren-blinking)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3546
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3547 (defcustom blink-matching-paren-distance 12000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3548 "*If non-nil, is maximum distance to search for matching open-paren."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3549 :type '(choice integer (const nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3550 :group 'paren-blinking)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3551
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3552 (defcustom blink-matching-delay 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3553 "*The number of seconds that `blink-matching-open' will delay at a match."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3554 :type 'number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3555 :group 'paren-blinking)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3556
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3557 (defcustom blink-matching-paren-dont-ignore-comments nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3558 "*Non-nil means `blink-matching-paren' should not ignore comments."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3559 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3560 :group 'paren-blinking)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3561
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3562 (defun blink-matching-open ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3563 "Move cursor momentarily to the beginning of the sexp before point."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3564 (interactive "_") ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3565 (and (> (point) (1+ (point-min)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3566 blink-matching-paren
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3567 ;; Verify an even number of quoting characters precede the close.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3568 (= 1 (logand 1 (- (point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3569 (save-excursion
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3570 (backward-char 1)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3571 (skip-syntax-backward "/\\")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3572 (point)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3573 (let* ((oldpos (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3574 (blinkpos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3575 (mismatch))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3576 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3577 (save-restriction
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3578 (if blink-matching-paren-distance
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3579 (narrow-to-region (max (point-min)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3580 (- (point) blink-matching-paren-distance))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3581 oldpos))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3582 (condition-case ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3583 (let ((parse-sexp-ignore-comments
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3584 (and parse-sexp-ignore-comments
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3585 (not blink-matching-paren-dont-ignore-comments))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3586 (setq blinkpos (scan-sexps oldpos -1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3587 (error nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3588 (and blinkpos
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3589 (/= (char-syntax (char-after blinkpos))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3590 ?\$)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3591 (setq mismatch
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3592 (or (null (matching-paren (char-after blinkpos)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3593 (/= (char-after (1- oldpos))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3594 (matching-paren (char-after blinkpos))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3595 (if mismatch (setq blinkpos nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3596 (if blinkpos
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3597 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3598 (goto-char blinkpos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3599 (if (pos-visible-in-window-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3600 (and blink-matching-paren-on-screen
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3601 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3602 (auto-show-make-point-visible)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3603 (sit-for blink-matching-delay)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3604 (goto-char blinkpos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3605 (lmessage 'command "Matches %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3606 ;; Show what precedes the open in its line, if anything.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3607 (if (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3608 (skip-chars-backward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3609 (not (bolp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3610 (buffer-substring (progn (beginning-of-line) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3611 (1+ blinkpos))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3612 ;; Show what follows the open in its line, if anything.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3613 (if (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3614 (forward-char 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3615 (skip-chars-forward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3616 (not (eolp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3617 (buffer-substring blinkpos
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3618 (progn (end-of-line) (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3619 ;; Otherwise show the previous nonblank line,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3620 ;; if there is one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3621 (if (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3622 (skip-chars-backward "\n \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3623 (not (bobp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3624 (concat
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3625 (buffer-substring (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3626 (skip-chars-backward "\n \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3627 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3628 (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3629 (progn (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3630 (skip-chars-backward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3631 (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3632 ;; Replace the newline and other whitespace with `...'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3633 "..."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3634 (buffer-substring blinkpos (1+ blinkpos)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3635 ;; There is nothing to show except the char itself.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3636 (buffer-substring blinkpos (1+ blinkpos))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3637 (cond (mismatch
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3638 (display-message 'no-log "Mismatched parentheses"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3639 ((not blink-matching-paren-distance)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3640 (display-message 'no-log "Unmatched parenthesis"))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3641
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3642 ;Turned off because it makes dbx bomb out.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3643 (setq blink-paren-function 'blink-matching-open)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3644
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3645
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3646 ;; XEmacs: Some functions moved to cmdloop.el:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3647 ;; keyboard-quit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3648 ;; buffer-quit-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3649 ;; keyboard-escape-quit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3650
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3651 (defun assoc-ignore-case (key alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3652 "Like `assoc', but assumes KEY is a string and ignores case when comparing."
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
3653 (assoc* key alist :test #'equalp))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3654
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3655
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3656 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3657 ;; mail composition code ;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3658 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3659
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3660 (defcustom mail-user-agent 'sendmail-user-agent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3661 "*Your preference for a mail composition package.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3662 Various Emacs Lisp packages (e.g. reporter) require you to compose an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3663 outgoing email message. This variable lets you specify which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3664 mail-sending package you prefer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3665
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3666 Valid values include:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3667
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3668 sendmail-user-agent -- use the default Emacs Mail package
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3669 mh-e-user-agent -- use the Emacs interface to the MH mail system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3670 message-user-agent -- use the GNUS mail sending package
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3671
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3672 Additional valid symbols may be available; check with the author of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3673 your package for details."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3674 :type '(radio (function-item :tag "Default Emacs mail"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3675 :format "%t\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3676 sendmail-user-agent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3677 (function-item :tag "Gnus mail sending package"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3678 :format "%t\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3679 message-user-agent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3680 (function :tag "Other"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3681 :group 'mail)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3682
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3683 (defun define-mail-user-agent (symbol composefunc sendfunc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3684 &optional abortfunc hookvar)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3685 "Define a symbol to identify a mail-sending package for `mail-user-agent'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3686
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3687 SYMBOL can be any Lisp symbol. Its function definition and/or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3688 value as a variable do not matter for this usage; we use only certain
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3689 properties on its property list, to encode the rest of the arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3690
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3691 COMPOSEFUNC is program callable function that composes an outgoing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3692 mail message buffer. This function should set up the basics of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3693 buffer without requiring user interaction. It should populate the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3694 standard mail headers, leaving the `to:' and `subject:' headers blank
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3695 by default.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3696
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3697 COMPOSEFUNC should accept several optional arguments--the same
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3698 arguments that `compose-mail' takes. See that function's documentation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3699
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3700 SENDFUNC is the command a user would run to send the message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3701
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3702 Optional ABORTFUNC is the command a user would run to abort the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3703 message. For mail packages that don't have a separate abort function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3704 this can be `kill-buffer' (the equivalent of omitting this argument).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3705
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3706 Optional HOOKVAR is a hook variable that gets run before the message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3707 is actually sent. Callers that use the `mail-user-agent' may
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3708 install a hook function temporarily on this hook variable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3709 If HOOKVAR is nil, `mail-send-hook' is used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3710
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3711 The properties used on SYMBOL are `composefunc', `sendfunc',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3712 `abortfunc', and `hookvar'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3713 (put symbol 'composefunc composefunc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3714 (put symbol 'sendfunc sendfunc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3715 (put symbol 'abortfunc (or abortfunc 'kill-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3716 (put symbol 'hookvar (or hookvar 'mail-send-hook)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3717
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3718 (define-mail-user-agent 'sendmail-user-agent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3719 'sendmail-user-agent-compose 'mail-send-and-exit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3720
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3721 (define-mail-user-agent 'message-user-agent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3722 'message-mail 'message-send-and-exit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3723 'message-kill-buffer 'message-send-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3724
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3725 (defun sendmail-user-agent-compose (&optional to subject other-headers continue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3726 switch-function yank-action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3727 send-actions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3728 (if switch-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3729 (let ((special-display-buffer-names nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3730 (special-display-regexps nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3731 (same-window-buffer-names nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3732 (same-window-regexps nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3733 (funcall switch-function "*mail*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3734 (let ((cc (cdr (assoc-ignore-case "cc" other-headers)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3735 (in-reply-to (cdr (assoc-ignore-case "in-reply-to" other-headers))))
776
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 771
diff changeset
3736 (or (declare-fboundp
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 771
diff changeset
3737 (mail continue to subject in-reply-to cc yank-action send-actions))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3738 continue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3739 (error "Message aborted"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3740 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3741 (goto-char (point-min))
776
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 771
diff changeset
3742 (search-forward (declare-boundp mail-header-separator))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3743 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3744 (while other-headers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3745 (if (not (member (car (car other-headers)) '("in-reply-to" "cc")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3746 (insert (car (car other-headers)) ": "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3747 (cdr (car other-headers)) "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3748 (setq other-headers (cdr other-headers)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3749 t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3750
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3751 (define-mail-user-agent 'mh-e-user-agent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3752 'mh-user-agent-compose 'mh-send-letter 'mh-fully-kill-draft
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3753 'mh-before-send-letter-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3754
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3755 (defun compose-mail (&optional to subject other-headers continue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3756 switch-function yank-action send-actions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3757 "Start composing a mail message to send.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3758 This uses the user's chosen mail composition package
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3759 as selected with the variable `mail-user-agent'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3760 The optional arguments TO and SUBJECT specify recipients
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3761 and the initial Subject field, respectively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3762
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3763 OTHER-HEADERS is an alist specifying additional
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3764 header fields. Elements look like (HEADER . VALUE) where both
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3765 HEADER and VALUE are strings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3766
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3767 CONTINUE, if non-nil, says to continue editing a message already
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3768 being composed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3769
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3770 SWITCH-FUNCTION, if non-nil, is a function to use to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3771 switch to and display the buffer used for mail composition.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3772
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3773 YANK-ACTION, if non-nil, is an action to perform, if and when necessary,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3774 to insert the raw text of the message being replied to.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3775 It has the form (FUNCTION . ARGS). The user agent will apply
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3776 FUNCTION to ARGS, to insert the raw text of the original message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3777 \(The user agent will also run `mail-citation-hook', *after* the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3778 original text has been inserted in this way.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3779
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3780 SEND-ACTIONS is a list of actions to call when the message is sent.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3781 Each action has the form (FUNCTION . ARGS)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3782 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3783 (list nil nil nil current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3784 (let ((function (get mail-user-agent 'composefunc)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3785 (funcall function to subject other-headers continue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3786 switch-function yank-action send-actions)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3787
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3788 (defun compose-mail-other-window (&optional to subject other-headers continue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3789 yank-action send-actions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3790 "Like \\[compose-mail], but edit the outgoing message in another window."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3791 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3792 (list nil nil nil current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3793 (compose-mail to subject other-headers continue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3794 'switch-to-buffer-other-window yank-action send-actions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3795
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3796
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3797 (defun compose-mail-other-frame (&optional to subject other-headers continue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3798 yank-action send-actions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3799 "Like \\[compose-mail], but edit the outgoing message in another frame."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3800 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3801 (list nil nil nil current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3802 (compose-mail to subject other-headers continue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3803 'switch-to-buffer-other-frame yank-action send-actions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3804
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3805
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3806 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3807 ;; set variable ;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3808 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3809
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3810 (defun set-variable (var val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3811 "Set VARIABLE to VALUE. VALUE is a Lisp object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3812 When using this interactively, supply a Lisp expression for VALUE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3813 If you want VALUE to be a string, you must surround it with doublequotes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3814 If VARIABLE is a specifier, VALUE is added to it as an instantiator in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3815 the 'global locale with nil tag set (see `set-specifier').
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3816
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3817 If VARIABLE has a `variable-interactive' property, that is used as if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3818 it were the arg to `interactive' (which see) to interactively read the value."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3819 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3820 (let* ((var (read-variable "Set variable: "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3821 ;; #### - yucky code replication here. This should use something
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3822 ;; from help.el or hyper-apropos.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3823 (myhelp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3824 #'(lambda ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3825 (with-output-to-temp-buffer "*Help*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3826 (prin1 var)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3827 (princ "\nDocumentation:\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3828 (princ (substring (documentation-property var 'variable-documentation)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3829 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3830 (if (boundp var)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3831 (let ((print-length 20))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3832 (princ "\n\nCurrent value: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3833 (prin1 (symbol-value var))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3834 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3835 (set-buffer standard-output)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3836 (help-mode))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3837 nil)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3838 (minibuffer-help-form
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3839 '(funcall myhelp)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3840 (list var
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3841 (let ((prop (get var 'variable-interactive)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3842 (if prop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3843 ;; Use VAR's `variable-interactive' property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3844 ;; as an interactive spec for prompting.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3845 (call-interactively (list 'lambda '(arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3846 (list 'interactive prop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3847 'arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3848 (eval-minibuffer (format "Set %s to value: " var)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3849 (if (and (boundp var) (specifierp (symbol-value var)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3850 (set-specifier (symbol-value var) val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3851 (set var val)))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3852
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3853
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3854 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3855 ;; case changing code ;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3856 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3857
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3858 ;; A bunch of stuff was moved elsewhere:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3859 ;; completion-list-mode-map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3860 ;; completion-reference-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3861 ;; completion-base-size
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3862 ;; delete-completion-window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3863 ;; previous-completion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3864 ;; next-completion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3865 ;; choose-completion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3866 ;; choose-completion-delete-max-match
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3867 ;; choose-completion-string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3868 ;; completion-list-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3869 ;; completion-fixup-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3870 ;; completion-setup-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3871 ;; switch-to-completions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3872 ;; event stuffs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3873 ;; keypad stuffs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3874
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3875 ;; The rest of this file is not in Lisp in FSF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3876 (defun capitalize-region-or-word (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3877 "Capitalize the selected region or the following word (or ARG words)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3878 (interactive "p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3879 (if (region-active-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3880 (capitalize-region (region-beginning) (region-end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3881 (capitalize-word arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3882
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3883 (defun upcase-region-or-word (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3884 "Upcase the selected region or the following word (or ARG words)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3885 (interactive "p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3886 (if (region-active-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3887 (upcase-region (region-beginning) (region-end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3888 (upcase-word arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3889
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3890 (defun downcase-region-or-word (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3891 "Downcase the selected region or the following word (or ARG words)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3892 (interactive "p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3893 (if (region-active-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3894 (downcase-region (region-beginning) (region-end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3895 (downcase-word arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3896
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3897 ;; #### not localized
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3898 (defvar uncapitalized-title-words
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3899 '("the" "a" "an" "in" "of" "for" "to" "and" "but" "at" "on" "as" "by"))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3900
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3901 (defvar uncapitalized-title-word-regexp
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3902 (concat "[ \t]*\\(" (mapconcat #'identity uncapitalized-title-words "\\|")
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3903 "\\)\\>"))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3904
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3905 (defun capitalize-string-as-title (string)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3906 "Capitalize the words in the string, except for small words (as in titles).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3907 The words not capitalized are specified in `uncapitalized-title-words'."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3908 (let ((buffer (get-buffer-create " *capitalize-string-as-title*")))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3909 (unwind-protect
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3910 (progn
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3911 (insert-string string buffer)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3912 (capitalize-region-as-title 1 (point-max buffer) buffer)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3913 (buffer-string buffer))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3914 (kill-buffer buffer))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3915
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3916 (defun capitalize-region-as-title (b e &optional buffer)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3917 "Capitalize the words in the region, except for small words (as in titles).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3918 The words not capitalized are specified in `uncapitalized-title-words'."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3919 (interactive "r")
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3920 (save-excursion
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3921 (and buffer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3922 (set-buffer buffer))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3923 (save-restriction
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3924 (narrow-to-region b e)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3925 (goto-char (point-min))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3926 (let ((first t))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3927 (while (< (point) (point-max))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3928 (if (or first
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3929 (not (looking-at uncapitalized-title-word-regexp)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3930 (capitalize-word 1)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3931 (forward-word 1))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3932 (setq first nil))))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3933
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3934
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3935 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3936 ;; zmacs active region code ;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3937 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3938
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3939 ;; Most of the zmacs code is now in elisp. The only thing left in C
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3940 ;; are the variables zmacs-regions, zmacs-region-active-p and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3941 ;; zmacs-region-stays plus the function zmacs_update_region which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3942 ;; simply calls the lisp level zmacs-update-region. It must remain
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3943 ;; for convenience, since it is called by core C code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3944
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3945 ;; XEmacs
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3946 (defun activate-region ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3947 "Activate the region, if `zmacs-regions' is true.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3948 Setting `zmacs-regions' to true causes LISPM-style active regions to be used.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3949 This function has no effect if `zmacs-regions' is false."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3950 (interactive)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3951 (and zmacs-regions (zmacs-activate-region)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3952
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3953 ;; XEmacs
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3954 (defsubst region-exists-p ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3955 "Return t if the region exists.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3956 If active regions are in use (i.e. `zmacs-regions' is true), this means that
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3957 the region is active. Otherwise, this means that the user has pushed
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3958 a mark in this buffer at some point in the past.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3959 The functions `region-beginning' and `region-end' can be used to find the
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3960 limits of the region.
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3961
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3962 You should use this, *NOT* `region-active-p', in a menu item
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3963 specification that you want grayed out when the region is not active:
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3964
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3965 [ ... ... :active (region-exists-p)]
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3966
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3967 This correctly caters to the user's setting of `zmacs-regions'."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3968 (not (null (mark))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3969
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3970 ;; XEmacs
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3971 (defun region-active-p ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3972 "Return non-nil if the region is active.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3973 If `zmacs-regions' is true, this is equivalent to `region-exists-p'.
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3974 Otherwise, this function always returns false.
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3975
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3976 You should generally *NOT* use this in a menu item specification that you
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3977 want grayed out when the region is not active. Instead, use this:
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3978
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3979 [ ... ... :active (region-exists-p)]
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3980
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3981 Which correctly caters to the user's setting of `zmacs-regions'."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3982 (and zmacs-regions zmacs-region-extent))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3983
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3984 (defvar zmacs-activate-region-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3985 "Function or functions called when the region becomes active;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3986 see the variable `zmacs-regions'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3987
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3988 (defvar zmacs-deactivate-region-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3989 "Function or functions called when the region becomes inactive;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3990 see the variable `zmacs-regions'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3991
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3992 (defvar zmacs-update-region-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3993 "Function or functions called when the active region changes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3994 This is called after each command that sets `zmacs-region-stays' to t.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3995 See the variable `zmacs-regions'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3996
487
54fa1a5c2d12 [xemacs-hg @ 2001-04-28 07:48:36 by ben]
ben
parents: 462
diff changeset
3997 (add-hook 'zmacs-deactivate-region-hook 'disown-selection)
54fa1a5c2d12 [xemacs-hg @ 2001-04-28 07:48:36 by ben]
ben
parents: 462
diff changeset
3998 (add-hook 'zmacs-activate-region-hook 'activate-region-as-selection)
54fa1a5c2d12 [xemacs-hg @ 2001-04-28 07:48:36 by ben]
ben
parents: 462
diff changeset
3999 (add-hook 'zmacs-update-region-hook 'activate-region-as-selection)
54fa1a5c2d12 [xemacs-hg @ 2001-04-28 07:48:36 by ben]
ben
parents: 462
diff changeset
4000
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4001 (defvar zmacs-region-extent nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4002 "The extent of the zmacs region; don't use this.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4003
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4004 (defvar zmacs-region-rectangular-p nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4005 "Whether the zmacs region is a rectangle; don't use this.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4006
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4007 (defun zmacs-make-extent-for-region (region)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4008 ;; Given a region, this makes an extent in the buffer which holds that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4009 ;; region, for highlighting purposes. If the region isn't associated
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4010 ;; with a buffer, this does nothing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4011 (let ((buffer nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4012 (valid (and (extentp zmacs-region-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4013 (extent-object zmacs-region-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4014 (buffer-live-p (extent-object zmacs-region-extent))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4015 start end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4016 (cond ((consp region)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4017 (setq start (min (car region) (cdr region))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4018 end (max (car region) (cdr region))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4019 valid (and valid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4020 (eq (marker-buffer (car region))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4021 (extent-object zmacs-region-extent)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4022 buffer (marker-buffer (car region))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4023 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4024 (signal 'error (list "Invalid region" region))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4025
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4026 (if valid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4027 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4028 ;; The condition case is in case any of the extents are dead or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4029 ;; otherwise incapacitated.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4030 (condition-case ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4031 (if (listp zmacs-region-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4032 (mapc 'delete-extent zmacs-region-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4033 (delete-extent zmacs-region-extent))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4034 (error nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4035
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4036 (if valid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4037 (set-extent-endpoints zmacs-region-extent start end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4038 (setq zmacs-region-extent (make-extent start end buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4039
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4040 ;; Make the extent be closed on the right, which means that if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4041 ;; characters are inserted exactly at the end of the extent, the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4042 ;; extent will grow to cover them. This is important for shell
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4043 ;; buffers - suppose one makes a region, and one end is at point-max.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4044 ;; If the shell produces output, that marker will remain at point-max
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4045 ;; (its position will increase). So it's important that the extent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4046 ;; exhibit the same behavior, lest the region covered by the extent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4047 ;; (the visual indication), and the region between point and mark
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4048 ;; (the actual region value) become different!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4049 (set-extent-property zmacs-region-extent 'end-open nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4050
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4051 ;; use same priority as mouse-highlighting so that conflicts between
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4052 ;; the region extent and a mouse-highlighted extent are resolved by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4053 ;; the usual size-and-endpoint-comparison method.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4054 (set-extent-priority zmacs-region-extent mouse-highlight-priority)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4055 (set-extent-face zmacs-region-extent 'zmacs-region)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4056
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4057 ;; #### It might be better to actually break
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4058 ;; default-mouse-track-next-move-rect out of mouse.el so that we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4059 ;; can use its logic here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4060 (cond
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4061 (zmacs-region-rectangular-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4062 (setq zmacs-region-extent (list zmacs-region-extent))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4063 (default-mouse-track-next-move-rect start end zmacs-region-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4064 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4065
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4066 zmacs-region-extent)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4067
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4068 (defun zmacs-region-buffer ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4069 "Return the buffer containing the zmacs region, or nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4070 ;; #### this is horrible and kludgy! This stuff needs to be rethought.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4071 (and zmacs-regions zmacs-region-active-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4072 (or (marker-buffer (mark-marker t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4073 (and (extent-live-p zmacs-region-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4074 (buffer-live-p (extent-object zmacs-region-extent))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4075 (extent-object zmacs-region-extent)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4076
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4077 (defun zmacs-activate-region ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4078 "Make the region between `point' and `mark' be active (highlighted),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4079 if `zmacs-regions' is true. Only a very small number of commands
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4080 should ever do this. Calling this function will call the hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4081 `zmacs-activate-region-hook', if the region was previously inactive.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4082 Calling this function ensures that the region stays active after the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4083 current command terminates, even if `zmacs-region-stays' is not set.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4084 Returns t if the region was activated (i.e. if `zmacs-regions' if t)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4085 (if (not zmacs-regions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4086 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4087 (setq zmacs-region-active-p t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4088 zmacs-region-stays t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4089 zmacs-region-rectangular-p (and (boundp 'mouse-track-rectangle-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4090 mouse-track-rectangle-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4091 (if (marker-buffer (mark-marker t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4092 (zmacs-make-extent-for-region (cons (point-marker t) (mark-marker t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4093 (run-hooks 'zmacs-activate-region-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4094 t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4095
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4096 (defun zmacs-deactivate-region ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4097 "Make the region between `point' and `mark' no longer be active,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4098 if `zmacs-regions' is true. You shouldn't need to call this; the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4099 command loop calls it when appropriate. Calling this function will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4100 call the hook `zmacs-deactivate-region-hook', if the region was
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4101 previously active. Returns t if the region had been active, nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4102 otherwise."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4103 (if (not zmacs-region-active-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4104 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4105 (setq zmacs-region-active-p nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4106 zmacs-region-stays nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4107 zmacs-region-rectangular-p nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4108 (if zmacs-region-extent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4109 (let ((inhibit-quit t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4110 (if (listp zmacs-region-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4111 (mapc 'delete-extent zmacs-region-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4112 (delete-extent zmacs-region-extent))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4113 (setq zmacs-region-extent nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4114 (run-hooks 'zmacs-deactivate-region-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4115 t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4116
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4117 (defun zmacs-update-region ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4118 "Update the highlighted region between `point' and `mark'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4119 You shouldn't need to call this; the command loop calls it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4120 when appropriate. Calling this function will call the hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4121 `zmacs-update-region-hook', if the region is active."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4122 (when zmacs-region-active-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4123 (when (marker-buffer (mark-marker t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4124 (zmacs-make-extent-for-region (cons (point-marker t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4125 (mark-marker t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4126 (run-hooks 'zmacs-update-region-hook)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4127
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4128
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4129 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4130 ;; message logging code ;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4131 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4132
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4133 ;;; #### Should this be moved to a separate file, for clarity?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4134 ;;; -hniksic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4135
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4136 ;;; The `message-stack' is an alist of labels with messages; the first
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4137 ;;; message in this list is always in the echo area. A call to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4138 ;;; `display-message' inserts a label/message pair at the head of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4139 ;;; list, and removes any other pairs with that label. Calling
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4140 ;;; `clear-message' causes any pair with matching label to be removed,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4141 ;;; and this may cause the displayed message to change or vanish. If
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4142 ;;; the label arg is nil, the entire message stack is cleared.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4143 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4144 ;;; Message/error filtering will be a little tricker to implement than
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4145 ;;; logging, since messages can be built up incrementally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4146 ;;; using clear-message followed by repeated calls to append-message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4147 ;;; (this happens with error messages). For messages which aren't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4148 ;;; created this way, filtering could be implemented at display-message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4149 ;;; very easily.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4150 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4151 ;;; Bits of the logging code are borrowed from log-messages.el by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4152 ;;; Robert Potter (rpotter@grip.cis.upenn.edu).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4153
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4154 ;; need this to terminate the currently-displayed message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4155 ;; ("Loading simple ...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4156 (when (and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4157 (not (fboundp 'display-message))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4158 (not (featurep 'debug)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4159 (send-string-to-terminal "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4160
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4161 (defvar message-stack nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4162 "An alist of label/string pairs representing active echo-area messages.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4163 The first element in the list is currently displayed in the echo area.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4164 Do not modify this directly--use the `message' or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4165 `display-message'/`clear-message' functions.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4166
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4167 (defvar remove-message-hook 'log-message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4168 "A function or list of functions to be called when a message is removed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4169 from the echo area at the bottom of the frame. The label of the removed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4170 message is passed as the first argument, and the text of the message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4171 as the second argument.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4172
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4173 (defcustom log-message-max-size 50000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4174 "Maximum size of the \" *Message-Log*\" buffer. See `log-message'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4175 :type 'integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4176 :group 'log-message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4177 (make-compatible-variable 'message-log-max 'log-message-max-size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4178
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4179 ;; We used to reject quite a lot of stuff here, but it was a bad idea,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4180 ;; for two reasons:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4181 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4182 ;; a) In most circumstances, you *want* to see the message in the log.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4183 ;; The explicitly non-loggable messages should be marked as such by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4184 ;; the issuer. Gratuitous non-displaying of random regexps made
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4185 ;; debugging harder, too (because various reasonable debugging
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4186 ;; messages would get eaten).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4187 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4188 ;; b) It slowed things down. Yes, visibly.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4189 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4190 ;; So, I left only a few of the really useless ones on this kill-list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4191 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4192 ;; --hniksic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4193 (defcustom log-message-ignore-regexps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4194 '(;; Note: adding entries to this list slows down messaging
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
4195 ;; significantly. Wherever possible, use message labels.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4196
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4197 ;; Often-seen messages
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4198 "\\`\\'" ; empty message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4199 "\\`\\(Beginning\\|End\\) of buffer\\'"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4200 ;;"^Quit$"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4201 ;; completions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4202 ;; Many packages print this -- impossible to categorize
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4203 ;;"^Making completion list"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4204 ;; Gnus
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4205 ;; "^No news is no news$"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4206 ;; "^No more\\( unread\\)? newsgroups$"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4207 ;; "^Opening [^ ]+ server\\.\\.\\."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4208 ;; "^[^:]+: Reading incoming mail"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4209 ;; "^Getting mail from "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4210 ;; "^\\(Generating Summary\\|Sorting threads\\|Making sparse threads\\|Scoring\\|Checking new news\\|Expiring articles\\|Sending\\)\\.\\.\\."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4211 ;; "^\\(Fetching headers for\\|Retrieving newsgroup\\|Reading active file\\)"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4212 ;; "^No more\\( unread\\)? articles"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4213 ;; "^Deleting article "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4214 ;; W3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4215 ;; "^Parsed [0-9]+ of [0-9]+ ([0-9]+%)"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4216 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4217 "List of regular expressions matching messages which shouldn't be logged.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4218 See `log-message'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4219
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4220 Ideally, packages which generate messages which might need to be ignored
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4221 should label them with 'progress, 'prompt, or 'no-log, so they can be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4222 filtered by the log-message-ignore-labels."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4223 :type '(repeat regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4224 :group 'log-message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4226 (defcustom log-message-ignore-labels
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4227 '(help-echo command progress prompt no-log garbage-collecting auto-saving)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4228 "List of symbols indicating labels of messages which shouldn't be logged.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4229 See `display-message' for some common labels. See also `log-message'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4230 :type '(repeat (symbol :tag "Label"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4231 :group 'log-message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4232
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4233 ;;Subsumed by view-lossage
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4234 ;; Not really, I'm adding it back by popular demand. -slb
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4235 (defun show-message-log ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4236 "Show the \" *Message-Log*\" buffer, which contains old messages and errors."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4237 (interactive)
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4238 (view-lossage t))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4239
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4240 (defvar log-message-filter-function 'log-message-filter
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4241 "Value must be a function of two arguments: a symbol (label) and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4242 a string (message). It should return non-nil to indicate a message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4243 should be logged. Possible values include 'log-message-filter and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4244 'log-message-filter-errors-only.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4245
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4246 (defun log-message-filter (label message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4247 "Default value of `log-message-filter-function'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4248 Messages whose text matches one of the `log-message-ignore-regexps'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4249 or whose label appears in `log-message-ignore-labels' are not saved."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4250 (let ((r log-message-ignore-regexps)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4251 (ok (not (memq label log-message-ignore-labels))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4252 (save-match-data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4253 (while (and r ok)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4254 (when (string-match (car r) message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4255 (setq ok nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4256 (setq r (cdr r))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4257 ok))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4258
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4259 (defun log-message-filter-errors-only (label message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4260 "For use as the `log-message-filter-function'. Only logs error messages."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4261 (eq label 'error))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4263 (defun log-message (label message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4264 "Stuff a copy of the message into the \" *Message-Log*\" buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4265 if it satisfies the `log-message-filter-function'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4266
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4267 For use on `remove-message-hook'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4268 (when (and (not noninteractive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4269 (funcall log-message-filter-function label message))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4270 ;; Use save-excursion rather than save-current-buffer because we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4271 ;; change the value of point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4272 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4273 (set-buffer (get-buffer-create " *Message-Log*"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4274 (goto-char (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4275 ;(insert (concat (upcase (symbol-name label)) ": " message "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4276 (let (extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4277 ;; Mark multiline message with an extent, which `view-lossage'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4278 ;; will recognize.
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4279 (save-match-data
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4280 (when (string-match "\n" message)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4281 (setq extent (make-extent (point) (point)))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4282 (set-extent-properties extent '(end-open nil message-multiline t)))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4283 )
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4284 (insert message "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4285 (when extent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4286 (set-extent-property extent 'end-open t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4287 (when (> (point-max) (max log-message-max-size (point-min)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4288 ;; Trim log to ~90% of max size.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4289 (goto-char (max (- (point-max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4290 (truncate (* 0.9 log-message-max-size)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4291 (point-min)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4292 (forward-line 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4293 (delete-region (point-min) (point))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4294
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4295 (defun message-displayed-p (&optional return-string frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4296 "Return a non-nil value if a message is presently displayed in the\n\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4297 minibuffer's echo area. If optional argument RETURN-STRING is non-nil,\n\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4298 return a string containing the message, otherwise just return t."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4299 ;; by definition, a message is displayed if the echo area buffer is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4300 ;; non-empty (see also echo_area_active()). It had better also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4301 ;; be the case that message-stack is nil exactly when the echo area
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4302 ;; is non-empty.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4303 (let ((buffer (get-buffer " *Echo Area*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4304 (and (< (point-min buffer) (point-max buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4305 (if return-string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4306 (buffer-substring nil nil buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4307 t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4308
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4309 ;;; Returns the string which remains in the echo area, or nil if none.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4310 ;;; If label is nil, the whole message stack is cleared.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4311 (defun clear-message (&optional label frame stdout-p no-restore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4312 "Remove any message with the given LABEL from the message-stack,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4313 erasing it from the echo area if it's currently displayed there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4314 If a message remains at the head of the message-stack and NO-RESTORE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4315 is nil, it will be displayed. The string which remains in the echo
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4316 area will be returned, or nil if the message-stack is now empty.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4317 If LABEL is nil, the entire message-stack is cleared.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4318
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4319 Unless you need the return value or you need to specify a label,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4320 you should just use (message nil)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4321 (or frame (setq frame (selected-frame)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4322 (let ((clear-stream (and message-stack (eq 'stream (frame-type frame)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4323 (remove-message label frame)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
4324 (let ((inhibit-read-only t))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4325 (erase-buffer " *Echo Area*"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4326 (if clear-stream
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4327 (send-string-to-terminal ?\n stdout-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4328 (if no-restore
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4329 nil ; just preparing to put another msg up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4330 (if message-stack
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4331 (let ((oldmsg (cdr (car message-stack))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4332 (raw-append-message oldmsg frame stdout-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4333 oldmsg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4334 ;; #### Should we (redisplay-echo-area) here? Messes some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4335 ;; things up.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4336 nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4338 (defun remove-message (&optional label frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4339 ;; If label is nil, we want to remove all matching messages.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4340 ;; Must reverse the stack first to log them in the right order.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4341 (let ((log nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4342 (while (and message-stack
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4343 (or (null label) ; null label means clear whole stack
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4344 (eq label (car (car message-stack)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4345 (push (car message-stack) log)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4346 (setq message-stack (cdr message-stack)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4347 (let ((s message-stack))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4348 (while (cdr s)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4349 (let ((msg (car (cdr s))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4350 (if (eq label (car msg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4351 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4352 (push msg log)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4353 (setcdr s (cdr (cdr s))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4354 (setq s (cdr s))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4355 ;; (possibly) log each removed message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4356 (while log
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4357 (with-trapping-errors
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4358 :operation 'remove-message-hook
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4359 :class 'message-log
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4360 :error-form (progn
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4361 (setq remove-message-hook nil)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4362 (let ((inhibit-read-only t))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4363 (erase-buffer " *Echo Area*")))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4364 :resignal t
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4365 (run-hook-with-args 'remove-message-hook
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4366 (car (car log)) (cdr (car log))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4367 (setq log (cdr log)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4368
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4369 (defun append-message (label message &optional frame stdout-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4370 (or frame (setq frame (selected-frame)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4371 ;; Add a new entry to the message-stack, or modify an existing one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4372 (let ((top (car message-stack)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4373 (if (eq label (car top))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4374 (setcdr top (concat (cdr top) message))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4375 (push (cons label message) message-stack)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4376 (raw-append-message message frame stdout-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4377
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4378 ;; Really append the message to the echo area. no fiddling with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4379 ;; message-stack.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4380 (defun raw-append-message (message &optional frame stdout-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4381 (unless (equal message "")
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
4382 (let ((inhibit-read-only t))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4383 (insert-string message " *Echo Area*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4384 ;; Conditionalizing on the device type in this way is not that clean,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4385 ;; but neither is having a device method, as I originally implemented
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4386 ;; it: all non-stream devices behave in the same way. Perhaps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4387 ;; the cleanest way is to make the concept of a "redisplayable"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4388 ;; device, which stream devices are not. Look into this more if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4389 ;; we ever create another non-redisplayable device type (e.g.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4390 ;; processes? printers?).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4391
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4392 ;; Don't redisplay the echo area if we are executing a macro.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4393 (if (not executing-kbd-macro)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4394 (if (eq 'stream (frame-type frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4395 (send-string-to-terminal message stdout-p (frame-device frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4396 (redisplay-echo-area))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4398 (defun display-message (label message &optional frame stdout-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4399 "Print a one-line message at the bottom of the frame. First argument
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4400 LABEL is an identifier for this message. MESSAGE is the string to display.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4401 Use `clear-message' to remove a labelled message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4402
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4403 Here are some standard labels (those marked with `*' are not logged
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4404 by default--see the `log-message-ignore-labels' variable):
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4405 message default label used by the `message' function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4406 error default label used for reporting errors
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4407 * progress progress indicators like \"Converting... 45%\"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4408 * prompt prompt-like messages like \"I-search: foo\"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4409 * command helper command messages like \"Mark set\"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4410 * no-log messages that should never be logged"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4411 (clear-message label frame stdout-p t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4412 (append-message label message frame stdout-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4413
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4414 (defun current-message (&optional frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4415 "Return the current message in the echo area, or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4416 The FRAME argument is currently unused."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4417 (cdr (car message-stack)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4418
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4419 ;;; may eventually be frame-dependent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4420 (defun current-message-label (&optional frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4421 (car (car message-stack)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4422
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4423 (defun message (fmt &rest args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4424 "Print a one-line message at the bottom of the frame.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4425 The arguments are the same as to `format'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4426
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4427 If the only argument is nil, clear any existing message; let the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4428 minibuffer contents show."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4429 ;; questionable junk in the C code
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4430 ;; (if (framep default-minibuffer-frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4431 ;; (make-frame-visible default-minibuffer-frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4432 (if (and (null fmt) (null args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4433 (prog1 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4434 (clear-message nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4435 (let ((str (apply 'format fmt args)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4436 (display-message 'message str)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4437 str)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4438
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4439 (defun lmessage (label fmt &rest args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4440 "Print a one-line message at the bottom of the frame.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4441 First argument LABEL is an identifier for this message. The rest of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4442 arguments are the same as to `format'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4443
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4444 See `display-message' for a list of standard labels."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4445 (if (and (null fmt) (null args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4446 (prog1 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4447 (clear-message label nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4448 (let ((str (apply 'format fmt args)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4449 (display-message label str)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4450 str)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4451
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4452
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4453 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4454 ;; warning code ;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4455 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4456
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4457 (defcustom log-warning-minimum-level 'info
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4458 "Minimum level of warnings that should be logged.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4459 The warnings in levels below this are completely ignored, as if they never
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4460 happened.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4461
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4462 The recognized warning levels, in decreasing order of priority, are
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4463 'emergency, 'critical, 'error, 'warning, 'alert, 'notice, 'info, and
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4464 'debug.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4465
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4466 See also `display-warning-minimum-level'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4467
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4468 You can also control which warnings are displayed on a class-by-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4469 basis. See `display-warning-suppressed-classes' and
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4470 `log-warning-suppressed-classes'.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4471
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4472 For a description of the meaning of the levels, see `display-warning.'"
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4473 :type '(choice (const emergency) (const critical)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4474 (const error) (const warning) (const alert) (const notice)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4475 (const info) (const debug))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4476 :group 'warnings)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4477
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4478 (defcustom display-warning-minimum-level 'warning
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4479 "Minimum level of warnings that cause the warnings buffer to be displayed.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4480 Warnings at this level or higher will force the *Warnings* buffer, in which
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4481 the warnings are logged, to be displayed. The warnings in levels below
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4482 this, but at least as high as `log-warning-suppressed-classes', will be
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4483 shown in the minibuffer.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4484
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4485 The recognized warning levels, in decreasing order of priority, are
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4486 'emergency, 'critical, 'error, 'warning, 'alert, 'notice, 'info, and
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4487 'debug.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4488
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4489 See also `log-warning-minimum-level'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4490
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4491 You can also control which warnings are displayed on a class-by-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4492 basis. See `display-warning-suppressed-classes' and
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4493 `log-warning-suppressed-classes'.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4494
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4495 For a description of the meaning of the levels, see `display-warning.'"
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4496 :type '(choice (const emergency) (const critical)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4497 (const error) (const warning) (const alert) (const notice)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4498 (const info) (const debug))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4499 :group 'warnings)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4500
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4501 (defvar log-warning-suppressed-classes nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4502 "List of classes of warnings that shouldn't be logged or displayed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4503 If any of the CLASS symbols associated with a warning is the same as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4504 any of the symbols listed here, the warning will be completely ignored,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4505 as it they never happened.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4506
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4507 NOTE: In most circumstances, you should *not* set this variable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4508 Set `display-warning-suppressed-classes' instead. That way the suppressed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4509 warnings are not displayed but are still unobtrusively logged.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4510
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4511 See also `log-warning-minimum-level' and `display-warning-minimum-level'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4512
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4513 (defcustom display-warning-suppressed-classes nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4514 "List of classes of warnings that shouldn't be displayed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4515 If any of the CLASS symbols associated with a warning is the same as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4516 any of the symbols listed here, the warning will not be displayed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4517 The warning will still logged in the *Warnings* buffer (unless also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4518 contained in `log-warning-suppressed-classes'), but the buffer will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4519 not be automatically popped up.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4520
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4521 See also `log-warning-minimum-level' and `display-warning-minimum-level'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4522 :type '(repeat symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4523 :group 'warnings)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4524
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4525 (defvar warning-count 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4526 "Count of the number of warning messages displayed so far.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4527
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4528 (defconst warning-level-alist '((emergency . 8)
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4529 (critical . 7)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4530 (error . 6)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4531 (warning . 5)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4532 (alert . 4)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4533 (notice . 3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4534 (info . 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4535 (debug . 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4536
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4537 (defun warning-level-p (level)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4538 "Non-nil if LEVEL specifies a warning level."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4539 (and (symbolp level) (assq level warning-level-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4540
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4541 (defun warning-level-< (level1 level2)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4542 "Non-nil if warning level LEVEL1 is lower than LEVEL2."
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4543 (check-argument-type 'warning-level-p level1)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4544 (check-argument-type 'warning-level-p level2)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4545 (< (cdr (assq level1 warning-level-alist))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4546 (cdr (assq level2 warning-level-alist))))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4547
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4548 ;; If you're interested in rewriting this function, be aware that it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4549 ;; could be called at arbitrary points in a Lisp program (when a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4550 ;; built-in function wants to issue a warning, it will call out to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4551 ;; this function the next time some Lisp code is evaluated). Therefore,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4552 ;; this function *must* not permanently modify any global variables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4553 ;; (e.g. the current buffer) except those that specifically apply
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4554 ;; to the warning system.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4555
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4556 (defvar before-init-deferred-warnings nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4557
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4558 (defun after-init-display-warnings ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4559 "Display warnings deferred till after the init file is run.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4560 Warnings that occur before then are deferred so that warning
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4561 suppression in the .emacs file will be honored."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4562 (while before-init-deferred-warnings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4563 (apply 'display-warning (car before-init-deferred-warnings))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4564 (setq before-init-deferred-warnings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4565 (cdr before-init-deferred-warnings))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4566
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4567 (add-hook 'after-init-hook 'after-init-display-warnings)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4568
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4569 (defun display-warning (class message &optional level)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4570 "Display a warning message.
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4571
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4572 \[This is the most basic entry point for displaying a warning. In practice,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4573 `lwarn' or `warn' are probably more convenient for most usages.]
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4574
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4575 CLASS should be a symbol describing what sort of warning this is, such as
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4576 `resource' or `key-mapping' -- this refers, more or less, to the module in
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4577 which the warning is generated and serves to group warnings together with
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4578 similar semantics. A list of such symbols is also accepted.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4579
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4580 Optional argument LEVEL can be used to specify a priority for the warning,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4581 other than default priority `warning'. The currently defined levels are,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4582 from highest to lowest:
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4583
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4584 Level Meaning
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4585 -----------------------------------------------------------------------------
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4586 emergency A fatal or near-fatal error. XEmacs is likely to crash.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4587
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4588 critical A serious, nonrecoverable problem has occurred -- e.g., the
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4589 loss of a major subsystem, such as the crash of the X server
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4590 when XEmacs is connected to the server.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4591
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4592 error A warning about a problematic condition that should be fixed,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4593 and XEmacs cannot work around it -- it causes a failure of an
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4594 operation. (In most circumstances, consider just signalling
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4595 an error). However, there is no permanent damage and the
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4596 situation is ultimately recoverable.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4597
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4598 warning A warning about a problematic condition that should be fixed,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4599 but XEmacs can work around it.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4600
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4601 \[By default, warnings above here, as well as being logged, cause the
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4602 *Warnings* buffer to be forcibly displayed, so that the warning (and
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4603 previous warnings, since often a whole series of warnings are issued at
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4604 once) can be examined in detail. Also, the annoying presence of the
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4605 *Warnings* buffer will encourage people to go out and fix the
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4606 problem. Warnings below here are displayed in the minibuffer as well as
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4607 logged in the *Warnings* buffer. but the *Warnings* buffer will not be
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4608 forcibly shown, as these represent conditions the user is not expected to
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4609 fix.]
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4610
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4611 alert A warning about a problematic condition that can't easily be
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4612 fixed (often having to do with the external environment), and
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4613 causes a failure. We don't force the *Warnings* buffer to be
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4614 displayed because the purpose of doing that is to force the
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4615 user to fix the problem so that the buffer no longer appears.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4616 When the problem is outside the user's control, forcing the
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4617 buffer is pointless and annoying.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4618
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4619 notice A warning about a problematic condition that can't easily be
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4620 fixed (often having to do with the external environment),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4621 but XEmacs can work around it.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4622
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4623 info Random info about something new or unexpected that was noticed;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4624 does not generally indicate a problem.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4625
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4626 \[By default, warnings below here are ignored entirely. All warnings above
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4627 here are logged in the *Warnings* buffer.]
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4628
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4629 debug A debugging notice; normally, not seen at all.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4630
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4631 NOTE: `specifier-instance' outputs warnings at level `debug' when errors occur
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4632 in the process of trying to instantiate a particular instantiator. If you
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4633 want to see these, change `log-warning-minimum-level'.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4634
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4635 There are two sets of variables. One controls the lower level (see the
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4636 above diagram) -- i.e. ignored entirely. One controls the upper level --
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4637 whether the *Warnings* buffer is forcibly displayed. In particular:
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4638
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4639 `display-warning-minimum-level' sets the upper level (see above), and
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4640 `log-warning-minimum-level' the lower level.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4641
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4642 Individual classes can be suppressed. `log-warning-suppressed-classes'
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4643 specifies a list of classes where warnings on those classes will be treated
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4644 as if their level is below `log-warning-minimum-level' (i.e. they will be
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4645 ignored completely), regardless of their actual level. Similarly,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4646 `display-warning-suppressed-classes' specifies a list of classes where
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4647 warnings on those classes will be treated as if their level is below
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4648 `display-warning-minimum-level', but above `log-warning-minimum-level' so
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4649 long as they're not listed in that variable as well."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4650 (or level (setq level 'warning))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4651 (or (listp class) (setq class (list class)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4652 (check-argument-type 'warning-level-p level)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4653 (if (and (not (featurep 'infodock))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4654 (not init-file-loaded))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4655 (push (list class message level) before-init-deferred-warnings)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4656 (catch 'ignored
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4657 (let ((display-p t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4658 (level-num (cdr (assq level warning-level-alist))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4659 (if (< level-num (cdr (assq log-warning-minimum-level
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4660 warning-level-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4661 (throw 'ignored nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4662 (if (intersection class log-warning-suppressed-classes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4663 (throw 'ignored nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4664
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4665 (if (< level-num (cdr (assq display-warning-minimum-level
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4666 warning-level-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4667 (setq display-p nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4668 (if (and display-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4669 (intersection class display-warning-suppressed-classes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4670 (setq display-p nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4671 (let ((buffer (get-buffer-create "*Warnings*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4672 (when display-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4673 ;; The C code looks at display-warning-tick to determine
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4674 ;; when it should call `display-warning-buffer'. Change it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4675 ;; to get the C code's attention.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4676 (incf display-warning-tick))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4677 (with-current-buffer buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4678 (goto-char (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4679 (incf warning-count)
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4680 (let ((start (point)))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4681 (princ (format "(%d) (%s/%s) "
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4682 warning-count
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4683 (mapconcat 'symbol-name class ",")
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4684 level)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4685 buffer)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4686 (princ message buffer)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4687 (terpri buffer)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4688 (terpri buffer)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4689 (let ((ex (make-extent start (point))))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4690 (set-extent-properties ex
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4691 `(warning t warning-count ,warning-count
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4692 warning-class ,class
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4693 warning-level ,level)))))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4694 (message "%s: %s" (capitalize (symbol-name level)) message))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4695
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4696 (defun warn (&rest args)
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4697 "Display a formatted warning message at default class and level.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4698 The message is constructed by passing all args to `format'. The message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4699 is placed in the *Warnings* buffer, which will be popped up at the next
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4700 redisplay. The class of the warning is `general'; the level is `warning'.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4701
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4702 See `display-warning' for more info."
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4703 (display-warning 'default (apply 'format args)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4704
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4705 (defun lwarn (class level &rest args)
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4706 "Display a formatted warning message at specified class and level.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4707 The message is constructed by passing all args to `format'. The message
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4708 is placed in the *Warnings* buffer, which will be popped up at the next
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4709 redisplay.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4710
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4711 See `display-warning' for more info."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4712 (display-warning class (apply 'format args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4713 (or level 'warning)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4714
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4715 (defvar warning-marker nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4716
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4717 ;; When this function is called by the C code, all non-local exits are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4718 ;; trapped and C-g is inhibited; therefore, it would be a very, very
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4719 ;; bad idea for this function to get into an infinite loop.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4720
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4721 (defun display-warning-buffer ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4722 "Make the buffer that contains the warnings be visible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4723 The C code calls this periodically, right before redisplay."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4724 (let ((buffer (get-buffer-create "*Warnings*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4725 (when (or (not warning-marker)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4726 (not (eq (marker-buffer warning-marker) buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4727 (setq warning-marker (make-marker))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4728 (set-marker warning-marker 1 buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4729 (if temp-buffer-show-function
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4730 (progn
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4731 (funcall temp-buffer-show-function buffer)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4732 (mapc #'(lambda (win) (set-window-start win warning-marker))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4733 (windows-of-buffer buffer nil t)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4734 (set-window-start (display-buffer buffer) warning-marker))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4735 (set-marker warning-marker (point-max buffer) buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4736
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4737
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4738 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4739 ;; misc junk ;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4740 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4741
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4742 (defun emacs-name ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4743 "Return the printable name of this instance of Emacs."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4744 (cond ((featurep 'infodock) "InfoDock")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4745 ((featurep 'xemacs) "XEmacs")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4746 (t "Emacs")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4747
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4748 (defun debug-print-1 (&rest args)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4749 "Send a debugging-type string to standard output.
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4750 If the first argument is a string, it is considered to be a format
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4751 specifier if there are sufficient numbers of other args, and the string is
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4752 formatted using (apply #'format args). Otherwise, each argument is printed
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4753 individually in a numbered list."
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4754 (let ((standard-output 'external-debugging-output)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4755 (fmt (condition-case nil
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4756 (and (stringp (first args))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4757 (apply #'format args))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4758 (error nil))))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4759 (if fmt
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4760 (progn
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4761 (prin1 (apply #'format args))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4762 (terpri))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4763 (princ "--> ")
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4764 (let ((i 1))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4765 (dolist (sgra args)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4766 (if (> i 1) (princ " "))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4767 (princ (format "%d. " i))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4768 (prin1 sgra)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4769 (incf i))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4770 (terpri)))))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4771
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4772 (defun debug-print (&rest args)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4773 "Send a string to the debugging output.
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4774 If the first argument is a string, it is considered to be a format
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4775 specifier if there are sufficient numbers of other args, and the string is
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4776 formatted using (apply #'format args). Otherwise, each argument is printed
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4777 individually in a numbered list."
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4778 (let ((standard-output 'external-debugging-output))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4779 (apply #'debug-print-1 args)))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4780
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4781 (defun debug-backtrace ()
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4782 "Send a backtrace to the debugging output."
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4783 (let ((standard-output 'external-debugging-output))
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4784 (backtrace nil t)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 776
diff changeset
4785 (terpri)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4786
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4787 ;;; simple.el ends here