/[emacs]/emacs/lisp/simple.el
ViewVC logotype

Diff of /emacs/lisp/simple.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.665 by kfstorm, Mon Nov 1 23:03:12 2004 UTC revision 1.666 by rms, Mon Nov 8 16:59:43 2004 UTC
# Line 67  Line 67 
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
# Line 213  select the source buffer." Line 251  select the source buffer."
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    
# Line 2280  This command is similar to `copy-region- Line 2281  This command is similar to `copy-region-
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))
# Line 3081  It is the column where point was Line 3084  It is the column where point was
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)))
# Line 3098  Outline mode sets this." Line 3101  Outline mode sets this."
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)
# Line 3114  Outline mode sets this." Line 3118  Outline mode sets this."
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.
# Line 3129  Outline mode sets this." Line 3134  Outline mode sets this."
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,
# Line 3161  Outline mode sets this." Line 3181  Outline mode sets this."
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))
# Line 3175  Outline mode sets this." Line 3194  Outline mode sets this."
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)
# Line 3228  and `current-column' to be able to ignor Line 3249  and `current-column' to be able to ignor
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)
# Line 3247  and `current-column' to be able to ignor Line 3268  and `current-column' to be able to ignor
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)
# Line 3298  With arg N, put point N/10 of the way fr Line 3355  With arg N, put point N/10 of the way fr
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))))
# Line 3314  With arg N, put point N/10 of the way fr Line 3372  With arg N, put point N/10 of the way fr
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    

Legend:
Removed from v.1.665  
changed lines
  Added in v.1.666

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26