aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman2004-11-08 16:59:43 +0000
committerRichard M. Stallman2004-11-08 16:59:43 +0000
commitbbf416903285fdea95ee181dd65cb12332070b54 (patch)
treeeb09d1087ace2f3e867a4294fdca69c7ae94d565
parent7e1963161dc19faa39e449ec2e38679056af4dcc (diff)
downloademacs-bbf416903285fdea95ee181dd65cb12332070b54.tar.gz
emacs-bbf416903285fdea95ee181dd65cb12332070b54.zip
(next-error group, face): Move before first use.
(next-error-highlight, next-error-highlight-no-select): Likewise. (line-move-invisible-p): Renamed from line-move-invisible. (line-move): New args NOERROR and TO-END. Return t if if succeed in moving specified number of lines. (move-end-of-line): New function. (beginning-of-buffer-other-window, end-of-buffer-other-window): Use with-no-warnings.
-rw-r--r--lisp/simple.el201
1 files changed, 130 insertions, 71 deletions
diff --git a/lisp/simple.el b/lisp/simple.el
index 864340e25d4..f3532226d85 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
@@ -2280,6 +2281,8 @@ This command is similar to `copy-region-as-kill', except that it gives
2280visual feedback indicating the extent of the region being copied." 2281visual feedback indicating the extent of the region being copied."
2281 (interactive "r") 2282 (interactive "r")
2282 (copy-region-as-kill beg end) 2283 (copy-region-as-kill beg end)
2284 ;; This use of interactive-p is correct
2285 ;; because the code it controls just gives the user visual feedback.
2283 (if (interactive-p) 2286 (if (interactive-p)
2284 (let ((other-end (if (= (point) beg) end beg)) 2287 (let ((other-end (if (= (point) beg) end beg))
2285 (opoint (point)) 2288 (opoint (point))
@@ -3081,13 +3084,13 @@ It is the column where point was
3081at the start of current run of vertical motion commands. 3084at the start of current run of vertical motion commands.
3082When the `track-eol' feature is doing its job, the value is 9999.") 3085When the `track-eol' feature is doing its job, the value is 9999.")
3083 3086
3084(defcustom line-move-ignore-invisible nil 3087(defcustom line-move-ignore-invisible t
3085 "*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines. 3088 "*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines.
3086Outline mode sets this." 3089Outline mode sets this."
3087 :type 'boolean 3090 :type 'boolean
3088 :group 'editing-basics) 3091 :group 'editing-basics)
3089 3092
3090(defun line-move-invisible (pos) 3093(defun line-move-invisible-p (pos)
3091 "Return non-nil if the character after POS is currently invisible." 3094 "Return non-nil if the character after POS is currently invisible."
3092 (let ((prop 3095 (let ((prop
3093 (get-char-property pos 'invisible))) 3096 (get-char-property pos 'invisible)))
@@ -3098,7 +3101,8 @@ Outline mode sets this."
3098 3101
3099;; This is the guts of next-line and previous-line. 3102;; This is the guts of next-line and previous-line.
3100;; Arg says how many lines to move. 3103;; Arg says how many lines to move.
3101(defun line-move (arg) 3104;; The value is t if we can move the specified number of lines.
3105(defun line-move (arg &optional noerror to-end)
3102 ;; Don't run any point-motion hooks, and disregard intangibility, 3106 ;; Don't run any point-motion hooks, and disregard intangibility,
3103 ;; for intermediate positions. 3107 ;; for intermediate positions.
3104 (let ((inhibit-point-motion-hooks t) 3108 (let ((inhibit-point-motion-hooks t)
@@ -3114,6 +3118,7 @@ Outline mode sets this."
3114 (or (not (bolp)) (eq last-command 'end-of-line))) 3118 (or (not (bolp)) (eq last-command 'end-of-line)))
3115 9999 3119 9999
3116 (current-column)))) 3120 (current-column))))
3121
3117 (if (and (not (integerp selective-display)) 3122 (if (and (not (integerp selective-display))
3118 (not line-move-ignore-invisible)) 3123 (not line-move-ignore-invisible))
3119 ;; Use just newline characters. 3124 ;; Use just newline characters.
@@ -3129,28 +3134,43 @@ Outline mode sets this."
3129 (and (zerop (forward-line arg)) 3134 (and (zerop (forward-line arg))
3130 (bolp) 3135 (bolp)
3131 (setq arg 0))) 3136 (setq arg 0)))
3132 (signal (if (< arg 0) 3137 (unless noerror
3133 'beginning-of-buffer 3138 (signal (if (< arg 0)
3134 'end-of-buffer) 3139 'beginning-of-buffer
3135 nil)) 3140 'end-of-buffer)
3141 nil)))
3136 ;; Move by arg lines, but ignore invisible ones. 3142 ;; Move by arg lines, but ignore invisible ones.
3137 (while (> arg 0) 3143 (let (done)
3138 ;; If the following character is currently invisible, 3144 (while (and (> arg 0) (not done))
3139 ;; skip all characters with that same `invisible' property value. 3145 ;; If the following character is currently invisible,
3140 (while (and (not (eobp)) (line-move-invisible (point))) 3146 ;; skip all characters with that same `invisible' property value.
3141 (goto-char (next-char-property-change (point)))) 3147 (while (and (not (eobp)) (line-move-invisible-p (point)))
3142 ;; Now move a line. 3148 (goto-char (next-char-property-change (point))))
3143 (end-of-line) 3149 ;; Now move a line.
3144 (and (zerop (vertical-motion 1)) 3150 (end-of-line)
3145 (signal 'end-of-buffer nil)) 3151 (and (zerop (vertical-motion 1))
3146 (setq arg (1- arg))) 3152 (if (not noerror)
3147 (while (< arg 0) 3153 (signal 'end-of-buffer nil)
3148 (beginning-of-line) 3154 (setq done t)))
3149 (and (zerop (vertical-motion -1)) 3155 (unless done
3150 (signal 'beginning-of-buffer nil)) 3156 (setq arg (1- arg))))
3151 (setq arg (1+ arg)) 3157 (while (and (< arg 0) (not done))
3152 (while (and (not (bobp)) (line-move-invisible (1- (point)))) 3158 (beginning-of-line)
3153 (goto-char (previous-char-property-change (point))))))) 3159
3160 (if (zerop (vertical-motion -1))
3161 (if (not noerror)
3162 (signal 'beginning-of-buffer nil)
3163 (setq done t)))
3164 (unless done
3165 (setq arg (1+ arg))
3166 (while (and ;; Don't move over previous invis lines
3167 ;; if our target is the middle of this line.
3168 (or (zerop (or goal-column temporary-goal-column))
3169 (< arg 0))
3170 (not (bobp)) (line-move-invisible-p (1- (point))))
3171 (goto-char (previous-char-property-change (point))))))))
3172 ;; This is the value the function returns.
3173 (= arg 0))
3154 3174
3155 (cond ((> arg 0) 3175 (cond ((> arg 0)
3156 ;; If we did not move down as far as desired, 3176 ;; If we did not move down as far as desired,
@@ -3161,8 +3181,7 @@ Outline mode sets this."
3161 ;; at least go to end of line. 3181 ;; at least go to end of line.
3162 (beginning-of-line)) 3182 (beginning-of-line))
3163 (t 3183 (t
3164 (line-move-finish (or goal-column temporary-goal-column) opoint))))) 3184 (line-move-finish (or goal-column temporary-goal-column) opoint))))))
3165 nil)
3166 3185
3167(defun line-move-finish (column opoint) 3186(defun line-move-finish (column opoint)
3168 (let ((repeat t)) 3187 (let ((repeat t))
@@ -3175,9 +3194,11 @@ Outline mode sets this."
3175 (line-end 3194 (line-end
3176 ;; Compute the end of the line 3195 ;; Compute the end of the line
3177 ;; ignoring effectively intangible newlines. 3196 ;; ignoring effectively intangible newlines.
3178 (let ((inhibit-point-motion-hooks nil) 3197 (save-excursion
3179 (inhibit-field-text-motion t)) 3198 (let ((inhibit-point-motion-hooks nil)
3180 (save-excursion (end-of-line) (point))))) 3199 (inhibit-field-text-motion t))
3200 (end-of-line))
3201 (point))))
3181 3202
3182 ;; Move to the desired column. 3203 ;; Move to the desired column.
3183 (line-move-to-column column) 3204 (line-move-to-column column)
@@ -3228,13 +3249,13 @@ and `current-column' to be able to ignore invisible text."
3228 (move-to-column col)) 3249 (move-to-column col))
3229 3250
3230 (when (and line-move-ignore-invisible 3251 (when (and line-move-ignore-invisible
3231 (not (bolp)) (line-move-invisible (1- (point)))) 3252 (not (bolp)) (line-move-invisible-p (1- (point))))
3232 (let ((normal-location (point)) 3253 (let ((normal-location (point))
3233 (normal-column (current-column))) 3254 (normal-column (current-column)))
3234 ;; If the following character is currently invisible, 3255 ;; If the following character is currently invisible,
3235 ;; skip all characters with that same `invisible' property value. 3256 ;; skip all characters with that same `invisible' property value.
3236 (while (and (not (eobp)) 3257 (while (and (not (eobp))
3237 (line-move-invisible (point))) 3258 (line-move-invisible-p (point)))
3238 (goto-char (next-char-property-change (point)))) 3259 (goto-char (next-char-property-change (point))))
3239 ;; Have we advanced to a larger column position? 3260 ;; Have we advanced to a larger column position?
3240 (if (> (current-column) normal-column) 3261 (if (> (current-column) normal-column)
@@ -3247,9 +3268,45 @@ and `current-column' to be able to ignore invisible text."
3247 ;; but with a more reasonable buffer position. 3268 ;; but with a more reasonable buffer position.
3248 (goto-char normal-location) 3269 (goto-char normal-location)
3249 (let ((line-beg (save-excursion (beginning-of-line) (point)))) 3270 (let ((line-beg (save-excursion (beginning-of-line) (point))))
3250 (while (and (not (bolp)) (line-move-invisible (1- (point)))) 3271 (while (and (not (bolp)) (line-move-invisible-p (1- (point))))
3251 (goto-char (previous-char-property-change (point) line-beg)))))))) 3272 (goto-char (previous-char-property-change (point) line-beg))))))))
3252 3273
3274(defun move-end-of-line (arg)
3275 "Move point to end of current line.
3276With argument ARG not nil or 1, move forward ARG - 1 lines first.
3277If point reaches the beginning or end of buffer, it stops there.
3278To ignore intangibility, bind `inhibit-point-motion-hooks' to t.
3279
3280This command does not move point across a field boundary unless doing so
3281would move beyond there to a different line; if ARG is nil or 1, and
3282point starts at a field boundary, point does not move. To ignore field
3283boundaries bind `inhibit-field-text-motion' to t."
3284 (interactive "p")
3285 (or arg (setq arg 1))
3286 (let (done)
3287 (while (not done)
3288 (let ((newpos
3289 (save-excursion
3290 (let ((goal-column 0))
3291 (and (line-move arg t)
3292 (not (bobp))
3293 (progn
3294 (while (and (not (bobp)) (line-move-invisible-p (1- (point))))
3295 (goto-char (previous-char-property-change (point))))
3296 (backward-char 1)))
3297 (point)))))
3298 (goto-char newpos)
3299 (if (and (> (point) newpos)
3300 (eq (preceding-char) ?\n))
3301 (backward-char 1)
3302 (if (and (> (point) newpos) (not (eobp))
3303 (not (eq (following-char) ?\n)))
3304 ;; If we skipped something intangible
3305 ;; and now we're not really at eol,
3306 ;; keep going.
3307 (setq arg 1)
3308 (setq done t)))))))
3309
3253;;; Many people have said they rarely use this feature, and often type 3310;;; Many people have said they rarely use this feature, and often type
3254;;; it by accident. Maybe it shouldn't even be on a key. 3311;;; it by accident. Maybe it shouldn't even be on a key.
3255(put 'set-goal-column 'disabled t) 3312(put 'set-goal-column 'disabled t)
@@ -3298,7 +3355,8 @@ With arg N, put point N/10 of the way from the true beginning."
3298 (progn 3355 (progn
3299 (select-window window) 3356 (select-window window)
3300 ;; Set point and mark in that window's buffer. 3357 ;; Set point and mark in that window's buffer.
3301 (beginning-of-buffer arg) 3358 (with-no-warnings
3359 (beginning-of-buffer arg))
3302 ;; Set point accordingly. 3360 ;; Set point accordingly.
3303 (recenter '(t))) 3361 (recenter '(t)))
3304 (select-window orig-window)))) 3362 (select-window orig-window))))
@@ -3314,7 +3372,8 @@ With arg N, put point N/10 of the way from the true end."
3314 (unwind-protect 3372 (unwind-protect
3315 (progn 3373 (progn
3316 (select-window window) 3374 (select-window window)
3317 (end-of-buffer arg) 3375 (with-no-warnings
3376 (end-of-buffer arg))
3318 (recenter '(t))) 3377 (recenter '(t)))
3319 (select-window orig-window)))) 3378 (select-window orig-window))))
3320 3379