aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/simple.el
diff options
context:
space:
mode:
authorKaroly Lorentey2004-11-13 18:34:40 +0000
committerKaroly Lorentey2004-11-13 18:34:40 +0000
commite417405015c93c81641f5c4a33ec898b5c353772 (patch)
tree017a980c35c8a71c372304418d151e3826f88636 /lisp/simple.el
parentf590a2a442d19f3a74d7bbd02bbcb4e3239f2327 (diff)
parent68d1b30d251b4771f739d20f507cd9523ae3919b (diff)
downloademacs-e417405015c93c81641f5c4a33ec898b5c353772.tar.gz
emacs-e417405015c93c81641f5c4a33ec898b5c353772.zip
Merged in changes from CVS trunk.
Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-673 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-674 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-675 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-676 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-677 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-678 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-679 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-680 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-681 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-682 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-683 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-684 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-685 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-686 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-687 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-688 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-689 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-690 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-691 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-692 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-693 Update from CVS * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-69 Merge from emacs--cvs-trunk--0 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-70 Update from CVS * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-71 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-267
Diffstat (limited to 'lisp/simple.el')
-rw-r--r--lisp/simple.el201
1 files changed, 130 insertions, 71 deletions
diff --git a/lisp/simple.el b/lisp/simple.el
index b45d9eee348..8f38dfde2ec 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -67,6 +67,44 @@
67 (switch-to-buffer found))) 67 (switch-to-buffer found)))
68 68
69;;; next-error support framework 69;;; next-error support framework
70
71(defgroup next-error nil
72 "next-error support framework."
73 :group 'compilation
74 :version "21.4")
75
76(defface next-error
77 '((t (:inherit region)))
78 "Face used to highlight next error locus."
79 :group 'next-error
80 :version "21.4")
81
82(defcustom next-error-highlight 0.1
83 "*Highlighting of locations in selected source buffers.
84If number, highlight the locus in next-error face for given time in seconds.
85If t, use persistent overlays fontified in next-error face.
86If nil, don't highlight the locus in the source buffer.
87If `fringe-arrow', indicate the locus by the fringe arrow."
88 :type '(choice (number :tag "Delay")
89 (const :tag "Persistent overlay" t)
90 (const :tag "No highlighting" nil)
91 (const :tag "Fringe arrow" 'fringe-arrow))
92 :group 'next-error
93 :version "21.4")
94
95(defcustom next-error-highlight-no-select 0.1
96 "*Highlighting of locations in non-selected source buffers.
97If number, highlight the locus in next-error face for given time in seconds.
98If t, use persistent overlays fontified in next-error face.
99If nil, don't highlight the locus in the source buffer.
100If `fringe-arrow', indicate the locus by the fringe arrow."
101 :type '(choice (number :tag "Delay")
102 (const :tag "Persistent overlay" t)
103 (const :tag "No highlighting" nil)
104 (const :tag "Fringe arrow" 'fringe-arrow))
105 :group 'next-error
106 :version "21.4")
107
70(defvar next-error-last-buffer nil 108(defvar next-error-last-buffer nil
71 "The most recent next-error buffer. 109 "The most recent next-error buffer.
72A buffer becomes most recent when its compilation, grep, or 110A buffer becomes most recent when its compilation, grep, or
@@ -213,43 +251,6 @@ select the source buffer."
213 (interactive "p") 251 (interactive "p")
214 (next-error-no-select (- (or n 1)))) 252 (next-error-no-select (- (or n 1))))
215 253
216(defgroup next-error nil
217 "next-error support framework."
218 :group 'compilation
219 :version "21.4")
220
221(defface next-error
222 '((t (:inherit region)))
223 "Face used to highlight next error locus."
224 :group 'next-error
225 :version "21.4")
226
227(defcustom next-error-highlight 0.1
228 "*Highlighting of locations in selected source buffers.
229If number, highlight the locus in next-error face for given time in seconds.
230If t, use persistent overlays fontified in next-error face.
231If nil, don't highlight the locus in the source buffer.
232If `fringe-arrow', indicate the locus by the fringe arrow."
233 :type '(choice (number :tag "Delay")
234 (const :tag "Persistent overlay" t)
235 (const :tag "No highlighting" nil)
236 (const :tag "Fringe arrow" 'fringe-arrow))
237 :group 'next-error
238 :version "21.4")
239
240(defcustom next-error-highlight-no-select 0.1
241 "*Highlighting of locations in non-selected source buffers.
242If number, highlight the locus in next-error face for given time in seconds.
243If t, use persistent overlays fontified in next-error face.
244If nil, don't highlight the locus in the source buffer.
245If `fringe-arrow', indicate the locus by the fringe arrow."
246 :type '(choice (number :tag "Delay")
247 (const :tag "Persistent overlay" t)
248 (const :tag "No highlighting" nil)
249 (const :tag "Fringe arrow" 'fringe-arrow))
250 :group 'next-error
251 :version "21.4")
252
253;;; Internal variable for `next-error-follow-mode-post-command-hook'. 254;;; Internal variable for `next-error-follow-mode-post-command-hook'.
254(defvar next-error-follow-last-line nil) 255(defvar next-error-follow-last-line nil)
255 256
@@ -2284,6 +2285,8 @@ This command is similar to `copy-region-as-kill', except that it gives
2284visual feedback indicating the extent of the region being copied." 2285visual feedback indicating the extent of the region being copied."
2285 (interactive "r") 2286 (interactive "r")
2286 (copy-region-as-kill beg end) 2287 (copy-region-as-kill beg end)
2288 ;; This use of interactive-p is correct
2289 ;; because the code it controls just gives the user visual feedback.
2287 (if (interactive-p) 2290 (if (interactive-p)
2288 (let ((other-end (if (= (point) beg) end beg)) 2291 (let ((other-end (if (= (point) beg) end beg))
2289 (opoint (point)) 2292 (opoint (point))
@@ -3085,13 +3088,13 @@ It is the column where point was
3085at the start of current run of vertical motion commands. 3088at the start of current run of vertical motion commands.
3086When the `track-eol' feature is doing its job, the value is 9999.") 3089When the `track-eol' feature is doing its job, the value is 9999.")
3087 3090
3088(defcustom line-move-ignore-invisible nil 3091(defcustom line-move-ignore-invisible t
3089 "*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines. 3092 "*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines.
3090Outline mode sets this." 3093Outline mode sets this."
3091 :type 'boolean 3094 :type 'boolean
3092 :group 'editing-basics) 3095 :group 'editing-basics)
3093 3096
3094(defun line-move-invisible (pos) 3097(defun line-move-invisible-p (pos)
3095 "Return non-nil if the character after POS is currently invisible." 3098 "Return non-nil if the character after POS is currently invisible."
3096 (let ((prop 3099 (let ((prop
3097 (get-char-property pos 'invisible))) 3100 (get-char-property pos 'invisible)))
@@ -3102,7 +3105,8 @@ Outline mode sets this."
3102 3105
3103;; This is the guts of next-line and previous-line. 3106;; This is the guts of next-line and previous-line.
3104;; Arg says how many lines to move. 3107;; Arg says how many lines to move.
3105(defun line-move (arg) 3108;; The value is t if we can move the specified number of lines.
3109(defun line-move (arg &optional noerror to-end)
3106 ;; Don't run any point-motion hooks, and disregard intangibility, 3110 ;; Don't run any point-motion hooks, and disregard intangibility,
3107 ;; for intermediate positions. 3111 ;; for intermediate positions.
3108 (let ((inhibit-point-motion-hooks t) 3112 (let ((inhibit-point-motion-hooks t)
@@ -3118,6 +3122,7 @@ Outline mode sets this."
3118 (or (not (bolp)) (eq last-command 'end-of-line))) 3122 (or (not (bolp)) (eq last-command 'end-of-line)))
3119 9999 3123 9999
3120 (current-column)))) 3124 (current-column))))
3125
3121 (if (and (not (integerp selective-display)) 3126 (if (and (not (integerp selective-display))
3122 (not line-move-ignore-invisible)) 3127 (not line-move-ignore-invisible))
3123 ;; Use just newline characters. 3128 ;; Use just newline characters.
@@ -3133,28 +3138,43 @@ Outline mode sets this."
3133 (and (zerop (forward-line arg)) 3138 (and (zerop (forward-line arg))
3134 (bolp) 3139 (bolp)
3135 (setq arg 0))) 3140 (setq arg 0)))
3136 (signal (if (< arg 0) 3141 (unless noerror
3137 'beginning-of-buffer 3142 (signal (if (< arg 0)
3138 'end-of-buffer) 3143 'beginning-of-buffer
3139 nil)) 3144 'end-of-buffer)
3145 nil)))
3140 ;; Move by arg lines, but ignore invisible ones. 3146 ;; Move by arg lines, but ignore invisible ones.
3141 (while (> arg 0) 3147 (let (done)
3142 ;; If the following character is currently invisible, 3148 (while (and (> arg 0) (not done))
3143 ;; skip all characters with that same `invisible' property value. 3149 ;; If the following character is currently invisible,
3144 (while (and (not (eobp)) (line-move-invisible (point))) 3150 ;; skip all characters with that same `invisible' property value.
3145 (goto-char (next-char-property-change (point)))) 3151 (while (and (not (eobp)) (line-move-invisible-p (point)))
3146 ;; Now move a line. 3152 (goto-char (next-char-property-change (point))))
3147 (end-of-line) 3153 ;; Now move a line.
3148 (and (zerop (vertical-motion 1)) 3154 (end-of-line)
3149 (signal 'end-of-buffer nil)) 3155 (and (zerop (vertical-motion 1))
3150 (setq arg (1- arg))) 3156 (if (not noerror)
3151 (while (< arg 0) 3157 (signal 'end-of-buffer nil)
3152 (beginning-of-line) 3158 (setq done t)))
3153 (and (zerop (vertical-motion -1)) 3159 (unless done
3154 (signal 'beginning-of-buffer nil)) 3160 (setq arg (1- arg))))
3155 (setq arg (1+ arg)) 3161 (while (and (< arg 0) (not done))
3156 (while (and (not (bobp)) (line-move-invisible (1- (point)))) 3162 (beginning-of-line)
3157 (goto-char (previous-char-property-change (point))))))) 3163
3164 (if (zerop (vertical-motion -1))
3165 (if (not noerror)
3166 (signal 'beginning-of-buffer nil)
3167 (setq done t)))
3168 (unless done
3169 (setq arg (1+ arg))
3170 (while (and ;; Don't move over previous invis lines
3171 ;; if our target is the middle of this line.
3172 (or (zerop (or goal-column temporary-goal-column))
3173 (< arg 0))
3174 (not (bobp)) (line-move-invisible-p (1- (point))))
3175 (goto-char (previous-char-property-change (point))))))))
3176 ;; This is the value the function returns.
3177 (= arg 0))
3158 3178
3159 (cond ((> arg 0) 3179 (cond ((> arg 0)
3160 ;; If we did not move down as far as desired, 3180 ;; If we did not move down as far as desired,
@@ -3165,8 +3185,7 @@ Outline mode sets this."
3165 ;; at least go to end of line. 3185 ;; at least go to end of line.
3166 (beginning-of-line)) 3186 (beginning-of-line))
3167 (t 3187 (t
3168 (line-move-finish (or goal-column temporary-goal-column) opoint))))) 3188 (line-move-finish (or goal-column temporary-goal-column) opoint))))))
3169 nil)
3170 3189
3171(defun line-move-finish (column opoint) 3190(defun line-move-finish (column opoint)
3172 (let ((repeat t)) 3191 (let ((repeat t))
@@ -3179,9 +3198,11 @@ Outline mode sets this."
3179 (line-end 3198 (line-end
3180 ;; Compute the end of the line 3199 ;; Compute the end of the line
3181 ;; ignoring effectively intangible newlines. 3200 ;; ignoring effectively intangible newlines.
3182 (let ((inhibit-point-motion-hooks nil) 3201 (save-excursion
3183 (inhibit-field-text-motion t)) 3202 (let ((inhibit-point-motion-hooks nil)
3184 (save-excursion (end-of-line) (point))))) 3203 (inhibit-field-text-motion t))
3204 (end-of-line))
3205 (point))))
3185 3206
3186 ;; Move to the desired column. 3207 ;; Move to the desired column.
3187 (line-move-to-column column) 3208 (line-move-to-column column)
@@ -3232,13 +3253,13 @@ and `current-column' to be able to ignore invisible text."
3232 (move-to-column col)) 3253 (move-to-column col))
3233 3254
3234 (when (and line-move-ignore-invisible 3255 (when (and line-move-ignore-invisible
3235 (not (bolp)) (line-move-invisible (1- (point)))) 3256 (not (bolp)) (line-move-invisible-p (1- (point))))
3236 (let ((normal-location (point)) 3257 (let ((normal-location (point))
3237 (normal-column (current-column))) 3258 (normal-column (current-column)))
3238 ;; If the following character is currently invisible, 3259 ;; If the following character is currently invisible,
3239 ;; skip all characters with that same `invisible' property value. 3260 ;; skip all characters with that same `invisible' property value.
3240 (while (and (not (eobp)) 3261 (while (and (not (eobp))
3241 (line-move-invisible (point))) 3262 (line-move-invisible-p (point)))
3242 (goto-char (next-char-property-change (point)))) 3263 (goto-char (next-char-property-change (point))))
3243 ;; Have we advanced to a larger column position? 3264 ;; Have we advanced to a larger column position?
3244 (if (> (current-column) normal-column) 3265 (if (> (current-column) normal-column)
@@ -3251,9 +3272,45 @@ and `current-column' to be able to ignore invisible text."
3251 ;; but with a more reasonable buffer position. 3272 ;; but with a more reasonable buffer position.
3252 (goto-char normal-location) 3273 (goto-char normal-location)
3253 (let ((line-beg (save-excursion (beginning-of-line) (point)))) 3274 (let ((line-beg (save-excursion (beginning-of-line) (point))))
3254 (while (and (not (bolp)) (line-move-invisible (1- (point)))) 3275 (while (and (not (bolp)) (line-move-invisible-p (1- (point))))
3255 (goto-char (previous-char-property-change (point) line-beg)))))))) 3276 (goto-char (previous-char-property-change (point) line-beg))))))))
3256 3277
3278(defun move-end-of-line (arg)
3279 "Move point to end of current line.
3280With argument ARG not nil or 1, move forward ARG - 1 lines first.
3281If point reaches the beginning or end of buffer, it stops there.
3282To ignore intangibility, bind `inhibit-point-motion-hooks' to t.
3283
3284This command does not move point across a field boundary unless doing so
3285would move beyond there to a different line; if ARG is nil or 1, and
3286point starts at a field boundary, point does not move. To ignore field
3287boundaries bind `inhibit-field-text-motion' to t."
3288 (interactive "p")
3289 (or arg (setq arg 1))
3290 (let (done)
3291 (while (not done)
3292 (let ((newpos
3293 (save-excursion
3294 (let ((goal-column 0))
3295 (and (line-move arg t)
3296 (not (bobp))
3297 (progn
3298 (while (and (not (bobp)) (line-move-invisible-p (1- (point))))
3299 (goto-char (previous-char-property-change (point))))
3300 (backward-char 1)))
3301 (point)))))
3302 (goto-char newpos)
3303 (if (and (> (point) newpos)
3304 (eq (preceding-char) ?\n))
3305 (backward-char 1)
3306 (if (and (> (point) newpos) (not (eobp))
3307 (not (eq (following-char) ?\n)))
3308 ;; If we skipped something intangible
3309 ;; and now we're not really at eol,
3310 ;; keep going.
3311 (setq arg 1)
3312 (setq done t)))))))
3313
3257;;; Many people have said they rarely use this feature, and often type 3314;;; Many people have said they rarely use this feature, and often type
3258;;; it by accident. Maybe it shouldn't even be on a key. 3315;;; it by accident. Maybe it shouldn't even be on a key.
3259(put 'set-goal-column 'disabled t) 3316(put 'set-goal-column 'disabled t)
@@ -3302,7 +3359,8 @@ With arg N, put point N/10 of the way from the true beginning."
3302 (progn 3359 (progn
3303 (select-window window) 3360 (select-window window)
3304 ;; Set point and mark in that window's buffer. 3361 ;; Set point and mark in that window's buffer.
3305 (beginning-of-buffer arg) 3362 (with-no-warnings
3363 (beginning-of-buffer arg))
3306 ;; Set point accordingly. 3364 ;; Set point accordingly.
3307 (recenter '(t))) 3365 (recenter '(t)))
3308 (select-window orig-window)))) 3366 (select-window orig-window))))
@@ -3318,7 +3376,8 @@ With arg N, put point N/10 of the way from the true end."
3318 (unwind-protect 3376 (unwind-protect
3319 (progn 3377 (progn
3320 (select-window window) 3378 (select-window window)
3321 (end-of-buffer arg) 3379 (with-no-warnings
3380 (end-of-buffer arg))
3322 (recenter '(t))) 3381 (recenter '(t)))
3323 (select-window orig-window)))) 3382 (select-window orig-window))))
3324 3383