67 |
(switch-to-buffer found))) |
(switch-to-buffer found))) |
68 |
|
|
69 |
;;; next-error support framework |
;;; 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. |
84 |
|
If number, highlight the locus in next-error face for given time in seconds. |
85 |
|
If t, use persistent overlays fontified in next-error face. |
86 |
|
If nil, don't highlight the locus in the source buffer. |
87 |
|
If `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. |
97 |
|
If number, highlight the locus in next-error face for given time in seconds. |
98 |
|
If t, use persistent overlays fontified in next-error face. |
99 |
|
If nil, don't highlight the locus in the source buffer. |
100 |
|
If `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 |
|
|
108 |
(defvar next-error-last-buffer nil |
(defvar next-error-last-buffer nil |
109 |
"The most recent next-error buffer. |
"The most recent next-error buffer. |
110 |
A buffer becomes most recent when its compilation, grep, or |
A buffer becomes most recent when its compilation, grep, or |
251 |
(interactive "p") |
(interactive "p") |
252 |
(next-error-no-select (- (or n 1)))) |
(next-error-no-select (- (or n 1)))) |
253 |
|
|
|
(defgroup next-error nil |
|
|
"next-error support framework." |
|
|
:group 'compilation |
|
|
:version "21.4") |
|
|
|
|
|
(defface next-error |
|
|
'((t (:inherit region))) |
|
|
"Face used to highlight next error locus." |
|
|
:group 'next-error |
|
|
:version "21.4") |
|
|
|
|
|
(defcustom next-error-highlight 0.1 |
|
|
"*Highlighting of locations in selected source buffers. |
|
|
If number, highlight the locus in next-error face for given time in seconds. |
|
|
If t, use persistent overlays fontified in next-error face. |
|
|
If nil, don't highlight the locus in the source buffer. |
|
|
If `fringe-arrow', indicate the locus by the fringe arrow." |
|
|
:type '(choice (number :tag "Delay") |
|
|
(const :tag "Persistent overlay" t) |
|
|
(const :tag "No highlighting" nil) |
|
|
(const :tag "Fringe arrow" 'fringe-arrow)) |
|
|
:group 'next-error |
|
|
:version "21.4") |
|
|
|
|
|
(defcustom next-error-highlight-no-select 0.1 |
|
|
"*Highlighting of locations in non-selected source buffers. |
|
|
If number, highlight the locus in next-error face for given time in seconds. |
|
|
If t, use persistent overlays fontified in next-error face. |
|
|
If nil, don't highlight the locus in the source buffer. |
|
|
If `fringe-arrow', indicate the locus by the fringe arrow." |
|
|
:type '(choice (number :tag "Delay") |
|
|
(const :tag "Persistent overlay" t) |
|
|
(const :tag "No highlighting" nil) |
|
|
(const :tag "Fringe arrow" 'fringe-arrow)) |
|
|
:group 'next-error |
|
|
:version "21.4") |
|
|
|
|
254 |
;;; Internal variable for `next-error-follow-mode-post-command-hook'. |
;;; Internal variable for `next-error-follow-mode-post-command-hook'. |
255 |
(defvar next-error-follow-last-line nil) |
(defvar next-error-follow-last-line nil) |
256 |
|
|
2281 |
visual feedback indicating the extent of the region being copied." |
visual feedback indicating the extent of the region being copied." |
2282 |
(interactive "r") |
(interactive "r") |
2283 |
(copy-region-as-kill beg end) |
(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. |
2286 |
(if (interactive-p) |
(if (interactive-p) |
2287 |
(let ((other-end (if (= (point) beg) end beg)) |
(let ((other-end (if (= (point) beg) end beg)) |
2288 |
(opoint (point)) |
(opoint (point)) |
3084 |
at the start of current run of vertical motion commands. |
at the start of current run of vertical motion commands. |
3085 |
When the `track-eol' feature is doing its job, the value is 9999.") |
When the `track-eol' feature is doing its job, the value is 9999.") |
3086 |
|
|
3087 |
(defcustom line-move-ignore-invisible nil |
(defcustom line-move-ignore-invisible t |
3088 |
"*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines. |
"*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines. |
3089 |
Outline mode sets this." |
Outline mode sets this." |
3090 |
:type 'boolean |
:type 'boolean |
3091 |
:group 'editing-basics) |
:group 'editing-basics) |
3092 |
|
|
3093 |
(defun line-move-invisible (pos) |
(defun line-move-invisible-p (pos) |
3094 |
"Return non-nil if the character after POS is currently invisible." |
"Return non-nil if the character after POS is currently invisible." |
3095 |
(let ((prop |
(let ((prop |
3096 |
(get-char-property pos 'invisible))) |
(get-char-property pos 'invisible))) |
3101 |
|
|
3102 |
;; This is the guts of next-line and previous-line. |
;; This is the guts of next-line and previous-line. |
3103 |
;; Arg says how many lines to move. |
;; Arg says how many lines to move. |
3104 |
(defun line-move (arg) |
;; The value is t if we can move the specified number of lines. |
3105 |
|
(defun line-move (arg &optional noerror to-end) |
3106 |
;; Don't run any point-motion hooks, and disregard intangibility, |
;; Don't run any point-motion hooks, and disregard intangibility, |
3107 |
;; for intermediate positions. |
;; for intermediate positions. |
3108 |
(let ((inhibit-point-motion-hooks t) |
(let ((inhibit-point-motion-hooks t) |
3118 |
(or (not (bolp)) (eq last-command 'end-of-line))) |
(or (not (bolp)) (eq last-command 'end-of-line))) |
3119 |
9999 |
9999 |
3120 |
(current-column)))) |
(current-column)))) |
3121 |
|
|
3122 |
(if (and (not (integerp selective-display)) |
(if (and (not (integerp selective-display)) |
3123 |
(not line-move-ignore-invisible)) |
(not line-move-ignore-invisible)) |
3124 |
;; Use just newline characters. |
;; Use just newline characters. |
3134 |
(and (zerop (forward-line arg)) |
(and (zerop (forward-line arg)) |
3135 |
(bolp) |
(bolp) |
3136 |
(setq arg 0))) |
(setq arg 0))) |
3137 |
(signal (if (< arg 0) |
(unless noerror |
3138 |
'beginning-of-buffer |
(signal (if (< arg 0) |
3139 |
'end-of-buffer) |
'beginning-of-buffer |
3140 |
nil)) |
'end-of-buffer) |
3141 |
|
nil))) |
3142 |
;; Move by arg lines, but ignore invisible ones. |
;; Move by arg lines, but ignore invisible ones. |
3143 |
(while (> arg 0) |
(let (done) |
3144 |
;; If the following character is currently invisible, |
(while (and (> arg 0) (not done)) |
3145 |
;; skip all characters with that same `invisible' property value. |
;; If the following character is currently invisible, |
3146 |
(while (and (not (eobp)) (line-move-invisible (point))) |
;; skip all characters with that same `invisible' property value. |
3147 |
(goto-char (next-char-property-change (point)))) |
(while (and (not (eobp)) (line-move-invisible-p (point))) |
3148 |
;; Now move a line. |
(goto-char (next-char-property-change (point)))) |
3149 |
(end-of-line) |
;; Now move a line. |
3150 |
(and (zerop (vertical-motion 1)) |
(end-of-line) |
3151 |
(signal 'end-of-buffer nil)) |
(and (zerop (vertical-motion 1)) |
3152 |
(setq arg (1- arg))) |
(if (not noerror) |
3153 |
(while (< arg 0) |
(signal 'end-of-buffer nil) |
3154 |
(beginning-of-line) |
(setq done t))) |
3155 |
(and (zerop (vertical-motion -1)) |
(unless done |
3156 |
(signal 'beginning-of-buffer nil)) |
(setq arg (1- arg)))) |
3157 |
(setq arg (1+ arg)) |
(while (and (< arg 0) (not done)) |
3158 |
(while (and (not (bobp)) (line-move-invisible (1- (point)))) |
(beginning-of-line) |
3159 |
(goto-char (previous-char-property-change (point))))))) |
|
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)) |
3174 |
|
|
3175 |
(cond ((> arg 0) |
(cond ((> arg 0) |
3176 |
;; If we did not move down as far as desired, |
;; If we did not move down as far as desired, |
3181 |
;; at least go to end of line. |
;; at least go to end of line. |
3182 |
(beginning-of-line)) |
(beginning-of-line)) |
3183 |
(t |
(t |
3184 |
(line-move-finish (or goal-column temporary-goal-column) opoint))))) |
(line-move-finish (or goal-column temporary-goal-column) opoint)))))) |
|
nil) |
|
3185 |
|
|
3186 |
(defun line-move-finish (column opoint) |
(defun line-move-finish (column opoint) |
3187 |
(let ((repeat t)) |
(let ((repeat t)) |
3194 |
(line-end |
(line-end |
3195 |
;; Compute the end of the line |
;; Compute the end of the line |
3196 |
;; ignoring effectively intangible newlines. |
;; ignoring effectively intangible newlines. |
3197 |
(let ((inhibit-point-motion-hooks nil) |
(save-excursion |
3198 |
(inhibit-field-text-motion t)) |
(let ((inhibit-point-motion-hooks nil) |
3199 |
(save-excursion (end-of-line) (point))))) |
(inhibit-field-text-motion t)) |
3200 |
|
(end-of-line)) |
3201 |
|
(point)))) |
3202 |
|
|
3203 |
;; Move to the desired column. |
;; Move to the desired column. |
3204 |
(line-move-to-column column) |
(line-move-to-column column) |
3249 |
(move-to-column col)) |
(move-to-column col)) |
3250 |
|
|
3251 |
(when (and line-move-ignore-invisible |
(when (and line-move-ignore-invisible |
3252 |
(not (bolp)) (line-move-invisible (1- (point)))) |
(not (bolp)) (line-move-invisible-p (1- (point)))) |
3253 |
(let ((normal-location (point)) |
(let ((normal-location (point)) |
3254 |
(normal-column (current-column))) |
(normal-column (current-column))) |
3255 |
;; If the following character is currently invisible, |
;; If the following character is currently invisible, |
3256 |
;; skip all characters with that same `invisible' property value. |
;; skip all characters with that same `invisible' property value. |
3257 |
(while (and (not (eobp)) |
(while (and (not (eobp)) |
3258 |
(line-move-invisible (point))) |
(line-move-invisible-p (point))) |
3259 |
(goto-char (next-char-property-change (point)))) |
(goto-char (next-char-property-change (point)))) |
3260 |
;; Have we advanced to a larger column position? |
;; Have we advanced to a larger column position? |
3261 |
(if (> (current-column) normal-column) |
(if (> (current-column) normal-column) |
3268 |
;; but with a more reasonable buffer position. |
;; but with a more reasonable buffer position. |
3269 |
(goto-char normal-location) |
(goto-char normal-location) |
3270 |
(let ((line-beg (save-excursion (beginning-of-line) (point)))) |
(let ((line-beg (save-excursion (beginning-of-line) (point)))) |
3271 |
(while (and (not (bolp)) (line-move-invisible (1- (point)))) |
(while (and (not (bolp)) (line-move-invisible-p (1- (point)))) |
3272 |
(goto-char (previous-char-property-change (point) line-beg)))))))) |
(goto-char (previous-char-property-change (point) line-beg)))))))) |
3273 |
|
|
3274 |
|
(defun move-end-of-line (arg) |
3275 |
|
"Move point to end of current line. |
3276 |
|
With argument ARG not nil or 1, move forward ARG - 1 lines first. |
3277 |
|
If point reaches the beginning or end of buffer, it stops there. |
3278 |
|
To ignore intangibility, bind `inhibit-point-motion-hooks' to t. |
3279 |
|
|
3280 |
|
This command does not move point across a field boundary unless doing so |
3281 |
|
would move beyond there to a different line; if ARG is nil or 1, and |
3282 |
|
point starts at a field boundary, point does not move. To ignore field |
3283 |
|
boundaries 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 |
|
|
3310 |
;;; Many people have said they rarely use this feature, and often type |
;;; Many people have said they rarely use this feature, and often type |
3311 |
;;; it by accident. Maybe it shouldn't even be on a key. |
;;; it by accident. Maybe it shouldn't even be on a key. |
3312 |
(put 'set-goal-column 'disabled t) |
(put 'set-goal-column 'disabled t) |
3355 |
(progn |
(progn |
3356 |
(select-window window) |
(select-window window) |
3357 |
;; Set point and mark in that window's buffer. |
;; Set point and mark in that window's buffer. |
3358 |
(beginning-of-buffer arg) |
(with-no-warnings |
3359 |
|
(beginning-of-buffer arg)) |
3360 |
;; Set point accordingly. |
;; Set point accordingly. |
3361 |
(recenter '(t))) |
(recenter '(t))) |
3362 |
(select-window orig-window)))) |
(select-window orig-window)))) |
3372 |
(unwind-protect |
(unwind-protect |
3373 |
(progn |
(progn |
3374 |
(select-window window) |
(select-window window) |
3375 |
(end-of-buffer arg) |
(with-no-warnings |
3376 |
|
(end-of-buffer arg)) |
3377 |
(recenter '(t))) |
(recenter '(t))) |
3378 |
(select-window orig-window)))) |
(select-window orig-window)))) |
3379 |
|
|