/[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.515 by rms, Tue Dec 18 23:39:21 2001 UTC revision 1.516 by rms, Fri Dec 28 05:15:59 2001 UTC
# Line 2530  Outline mode sets this." Line 2530  Outline mode sets this."
2530    :type 'boolean    :type 'boolean
2531    :group 'editing-basics)    :group 'editing-basics)
2532    
2533    (defun line-move-invisible (pos)
2534      "Return non-nil if the character after POS is currently invisible."
2535      (let ((prop
2536             (get-char-property pos 'invisible)))
2537        (if (eq buffer-invisibility-spec t)
2538            prop
2539          (or (memq prop buffer-invisibility-spec)
2540              (assq prop buffer-invisibility-spec)))))
2541    
2542  ;; This is the guts of next-line and previous-line.  ;; This is the guts of next-line and previous-line.
2543  ;; Arg says how many lines to move.  ;; Arg says how many lines to move.
2544  (defun line-move (arg)  (defun line-move (arg)
# Line 2563  Outline mode sets this." Line 2572  Outline mode sets this."
2572                           (bolp)))                           (bolp)))
2573                    (signal (if (< arg 0)                    (signal (if (< arg 0)
2574                                'beginning-of-buffer                                'beginning-of-buffer
2575                              'end-of-buffer)  a                           'end-of-buffer)
2576                            nil))                            nil))
2577              ;; Move by arg lines, but ignore invisible ones.              ;; Move by arg lines, but ignore invisible ones.
2578              (while (> arg 0)              (while (> arg 0)
2579                  ;; If the following character is currently invisible,
2580                  ;; skip all characters with that same `invisible' property value.
2581                  (while (and (not (eobp)) (line-move-invisible (point)))
2582                    (goto-char (next-char-property-change (point))))
2583                  ;; Now move a line.
2584                (end-of-line)                (end-of-line)
2585                (and (zerop (vertical-motion 1))                (and (zerop (vertical-motion 1))
2586                     (signal 'end-of-buffer nil))                     (signal 'end-of-buffer nil))
               ;; If the following character is currently invisible,  
               ;; skip all characters with that same `invisible' property value.  
               (while (and (not (eobp))  
                           (let ((prop  
                                  (get-char-property (point) 'invisible)))  
                             (if (eq buffer-invisibility-spec t)  
                                 prop  
                               (or (memq prop buffer-invisibility-spec)  
                                   (assq prop buffer-invisibility-spec)))))  
                 (if (get-text-property (point) 'invisible)  
                     (goto-char (or (next-single-property-change (point) 'invisible)  
                                    (point-max)))  
                   (goto-char (next-overlay-change (point)))))  
2587                (setq arg (1- arg)))                (setq arg (1- arg)))
2588              (while (< arg 0)              (while (< arg 0)
2589                (beginning-of-line)                (beginning-of-line)
2590                (and (zerop (vertical-motion -1))                (and (zerop (vertical-motion -1))
2591                     (signal 'beginning-of-buffer nil))                     (signal 'beginning-of-buffer nil))
2592                (while (and (not (bobp))                (setq arg (1+ arg))
2593                            (let ((prop                (while (and (not (bobp)) (line-move-invisible (1- (point))))
2594                                   (get-char-property (1- (point)) 'invisible)))                  (goto-char (previous-char-property-change (point)))))))
2595                              (if (eq buffer-invisibility-spec t)  
2596                                  prop        (line-move-finish (or goal-column temporary-goal-column) opoint)))
                               (or (memq prop buffer-invisibility-spec)  
                                   (assq prop buffer-invisibility-spec)))))  
                 (if (get-text-property (1- (point)) 'invisible)  
                     (goto-char (or (previous-single-property-change (point) 'invisible)  
                                    (point-min)))  
                   (goto-char (previous-overlay-change (point)))))  
               (setq arg (1+ arg))))  
           (let ((buffer-invisibility-spec nil))  
             (move-to-column (or goal-column temporary-goal-column))))  
       (setq new (point))  
       ;; If we are moving into some intangible text,  
       ;; look for following text on the same line which isn't intangible  
       ;; and move there.  
       (setq line-end (save-excursion (end-of-line) (point)))  
       (setq line-beg (save-excursion (beginning-of-line) (point)))  
       (let ((after (and (< new (point-max))  
                         (get-char-property new 'intangible)))  
             (before (and (> new (point-min))  
                          (get-char-property (1- new) 'intangible))))  
         (when (and before (eq before after)  
                    (not (bolp)))  
           (goto-char (point-min))  
           (let ((inhibit-point-motion-hooks nil))  
             (goto-char new))  
           (if (<= new line-end)  
               (setq new (point)))))  
       ;; NEW is where we want to move to.  
       ;; LINE-BEG and LINE-END are the beginning and end of the line.  
       ;; Move there in just one step, from our starting position,  
       ;; with intangibility and point-motion hooks enabled this time.  
       (goto-char opoint)  
       (setq inhibit-point-motion-hooks nil)  
       (goto-char  
        (constrain-to-field new opoint nil t 'inhibit-line-move-field-capture))  
       ;; If intangibility processing moved us to a different line,  
       ;; readjust the horizontal position within the line we ended up at.  
       (when (or (< (point) line-beg) (> (point) line-end))  
         (setq new (point))  
         (setq inhibit-point-motion-hooks t)  
         (setq line-end (save-excursion (end-of-line) (point)))  
         (beginning-of-line)  
         (setq line-beg (point))  
         (let ((buffer-invisibility-spec nil))  
           (move-to-column (or goal-column temporary-goal-column)))  
         (if (<= (point) line-end)  
             (setq new (point)))  
         (goto-char (point-min))  
         (setq inhibit-point-motion-hooks nil)  
         (goto-char  
          (constrain-to-field new opoint nil t  
                              'inhibit-line-move-field-capture)))))  
2597    nil)    nil)
2598    
2599    (defun line-move-finish (column opoint)
2600      (let ((repeat t))
2601        (while repeat
2602          ;; Set REPEAT to t to repeat the whole thing.
2603          (setq repeat nil)
2604    
2605          ;; Move to the desired column.
2606          (line-move-to-column column)
2607    
2608          (let ((new (point))
2609                (line-beg (save-excursion (beginning-of-line) (point)))
2610                (line-end (save-excursion (end-of-line) (point))))
2611    
2612            ;; Process intangibility within a line.
2613            ;; Move to the chosen destination position from above,
2614            ;; with intangibility processing enabled.
2615    
2616            (goto-char (point-min))
2617            (let ((inhibit-point-motion-hooks nil))
2618              (goto-char new)
2619    
2620              ;; If intangibility moves us to a different (later) place
2621              ;; in the same line, use that as the destination.
2622              (if (<= (point) line-end)
2623                  (setq new (point))))
2624    
2625            ;; Now move to the updated destination, processing fields
2626            ;; as well as intangibility.
2627            (goto-char opoint)
2628            (let ((inhibit-point-motion-hooks nil))
2629              (goto-char
2630               (constrain-to-field new opoint nil t
2631                                   'inhibit-line-move-field-capture)))
2632    
2633            ;; If intangibility processing moved us to a different line,
2634            ;; retry everything within that new line.
2635            (when (or (< (point) line-beg) (> (point) line-end))
2636              ;; Repeat the intangibility and field processing.
2637              (setq repeat t))))))
2638    
2639    (defun line-move-to-column (col)
2640      "Try to find column COL, considering invisibility.
2641    This function works only in certain cases,
2642    because what we really need is for `move-to-column'
2643    and `current-column' to be able to ignore invisible text."
2644      (move-to-column col)
2645    
2646      (when (and line-move-ignore-invisible
2647                 (not (bolp)) (line-move-invisible (1- (point))))
2648        (let ((normal-location (point))
2649              (normal-column (current-column)))
2650          ;; If the following character is currently invisible,
2651          ;; skip all characters with that same `invisible' property value.
2652          (while (and (not (eobp))
2653                      (line-move-invisible (point)))
2654            (goto-char (next-char-property-change (point))))
2655          ;; Have we advanced to a larger column position?
2656          (if (> (current-column) normal-column)
2657              ;; We have made some progress towards the desired column.
2658              ;; See if we can make any further progress.
2659              (line-move-to-column (+ (current-column) (- col normal-column)))
2660            ;; Otherwise, go to the place we originally found
2661            ;; and move back over invisible text.
2662            ;; that will get us to the same place on the screen
2663            ;; but with a more reasonable buffer position.
2664            (goto-char normal-location)
2665            (let ((line-beg (save-excursion (beginning-of-line) (point))))
2666              (while (and (not (bolp)) (line-move-invisible (1- (point))))
2667                (goto-char (previous-char-property-change (point) line-beg))))))))
2668    
2669  ;;; Many people have said they rarely use this feature, and often type  ;;; Many people have said they rarely use this feature, and often type
2670  ;;; it by accident.  Maybe it shouldn't even be on a key.  ;;; it by accident.  Maybe it shouldn't even be on a key.
2671  (put 'set-goal-column 'disabled t)  (put 'set-goal-column 'disabled t)

Legend:
Removed from v.1.515  
changed lines
  Added in v.1.516

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