diff options
| author | Karoly Lorentey | 2004-11-13 18:34:40 +0000 |
|---|---|---|
| committer | Karoly Lorentey | 2004-11-13 18:34:40 +0000 |
| commit | e417405015c93c81641f5c4a33ec898b5c353772 (patch) | |
| tree | 017a980c35c8a71c372304418d151e3826f88636 /lisp/simple.el | |
| parent | f590a2a442d19f3a74d7bbd02bbcb4e3239f2327 (diff) | |
| parent | 68d1b30d251b4771f739d20f507cd9523ae3919b (diff) | |
| download | emacs-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.el | 201 |
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. | ||
| 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 | |||
| 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. |
| 72 | A buffer becomes most recent when its compilation, grep, or | 110 | A 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. | ||
| 229 | If number, highlight the locus in next-error face for given time in seconds. | ||
| 230 | If t, use persistent overlays fontified in next-error face. | ||
| 231 | If nil, don't highlight the locus in the source buffer. | ||
| 232 | If `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. | ||
| 242 | If number, highlight the locus in next-error face for given time in seconds. | ||
| 243 | If t, use persistent overlays fontified in next-error face. | ||
| 244 | If nil, don't highlight the locus in the source buffer. | ||
| 245 | If `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 | |||
| 2284 | visual feedback indicating the extent of the region being copied." | 2285 | visual 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 | |||
| 3085 | at the start of current run of vertical motion commands. | 3088 | at the start of current run of vertical motion commands. |
| 3086 | When the `track-eol' feature is doing its job, the value is 9999.") | 3089 | When 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. |
| 3090 | Outline mode sets this." | 3093 | Outline 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. | ||
| 3280 | With argument ARG not nil or 1, move forward ARG - 1 lines first. | ||
| 3281 | If point reaches the beginning or end of buffer, it stops there. | ||
| 3282 | To ignore intangibility, bind `inhibit-point-motion-hooks' to t. | ||
| 3283 | |||
| 3284 | This command does not move point across a field boundary unless doing so | ||
| 3285 | would move beyond there to a different line; if ARG is nil or 1, and | ||
| 3286 | point starts at a field boundary, point does not move. To ignore field | ||
| 3287 | boundaries 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 | ||