;; screen-lines2.el
;; --------------
;; Sébastien Kirche <sebastien.kirche@free.fr>
;; (Merci à Olve de fr.comp.applications.emacs)
;;
;; Permet de se déplacer entre les «lignes écran» d'une ligne wrappée
;; Attention à utiliser une police à chasse fixe.
;;
;; Déplacement : S-up   monte
;;               S-down descend

(defsubst line-length nil
   (- (line-end-position) (line-beginning-position)))

(defun on-last-displayed-segment-p (cc)
   "When a long line is displayed, there appear
lines on the screen which we call segment.
This function answer t if point is on last segment,
nil otherwise."
   (let ((nb-segments (ceiling (/ (line-length) 1.0 (window-width))))
         (number (ceiling (/ cc 1.0 (window-width)))))
     (= number nb-segments)))

(defun previous-last-segment-length nil
   "Answer is the length of the last segment of
previous line. See `on-last-displayed-segment-p'
for the definition of a segment."
   (save-excursion
     (if (zerop (forward-line -1))
         (% (line-length) (window-width))
       0)))

(defun immediately-after-a-long-line-p nil
   "t if point is on a line following a line longer than
window-width, nil otherwise."
   (save-excursion
     (and (zerop (forward-line -1))
          (> (line-length) (window-width)))))

(defun vertical-temporary-goal-column (cc)
   (if temporary-goal-column
       (+ (* (floor (/ cc 1.0 (window-width))) (window-width))
          (% temporary-goal-column (window-width)))
     (current-column)))

(defun vertical-single-step-down (cc diff)
"CC is fictive-current-column according to
temporary-goal-column. DIFF is what it
differs from current-column."
   (if (< (line-length)
          (+ cc (window-width)))
       (if (on-last-displayed-segment-p (- cc diff))
           ;; We  change of line:
           (next-line 1)
         (end-of-line))
     (forward-char (- (window-width) diff))))

(defun vertical-single-step-up (cc diff)
"CC is fictive-current-column according to
temporary-goal-column. DIFF is what it
differs from current-column."
   (if (< cc (window-width))
       ;; We are on the first segment.
       (if (immediately-after-a-long-line-p)
           (let ((pl (- cc (previous-last-segment-length))))
             (beginning-of-line)
             (forward-char -1)
             (when (<  pl 0) (forward-char pl)))
         (previous-line 1))
     (backward-char (- (window-width) diff))))

;; shift up/down a line >on screen<
(defun next-screen-line (arg)
   (interactive "p")
   (if (< arg 0) (previous-screen-line (- arg))
     (unless arg (setq arg 1))
     (unless (member last-command '(next-line previous-line))
         (setq temporary-goal-column (% (current-column) (window-width))))
     (let*((ccp (current-column))
           (cc (vertical-temporary-goal-column ccp)))
       (while (> arg 0)
         (vertical-single-step-down cc (- cc ccp))
         (setq arg (- arg 1)))
       (setq this-command 'next-line))))

(defun previous-screen-line (arg)
   (interactive "p")
   (if (< arg 0) (next-screen-line (- arg))
     (unless arg (setq arg 1))
     (unless (member last-command '(next-line previous-line))
         (setq temporary-goal-column (% (current-column) (window-width))))
     (let*((ccp (current-column))
           (cc (vertical-temporary-goal-column ccp)))
       (while (> arg 0)
         (vertical-single-step-up cc (- cc ccp))
         (setq arg (- arg 1)))
       (setq this-command 'previous-line))))

(global-set-key [S-down] 'next-screen-line)
(global-set-key [S-up] 'previous-screen-line)

(provide 'screen-lines2)