c-L

[cgay@majestix.cs.uoregon.edu (Carl L. Gay)]

I offer the following disgusting-but-useful Fred hack in the spirit of
"maybe someone who knows about views and fonts will fix it up and post
the results."  If not, well, it's still extremely useful.  No
emacsalike should be without c-L.  (If it's already there, but bound
to some other keystroke and I just haven't found it, lemme know...)


;;; Dynamically scoped numeric arg.
(defvar *numeric-arg* nil)
 
(defmacro with-numeric-arg ((window &key default allow-control-u)
                               &body body)
  `(let ((*numeric-arg* (or (slot-value ,window 'ccl::prefix-argument)
                            ,default)))
     (when (and (not ,allow-control-u) (consp *numeric-arg*))
       (setq *numeric-arg* (car *numeric-arg*)))
     . ,body))


;;; ________________________________________
;;; c-L
 
;;; Bugs:
;;; - Doesn't take multiple font sizes into account.
;;; - Can be off by one line when the cursor is on a blank line at the time
;;;   c-L is pressed.
 
(defmethod ed-recenter-window ((w fred-mixin))
  (with-numeric-arg (w)
    (when (> (buffer-size (fred-buffer w)) 0)
      (set-fred-display-start-mark
       w
       (loop with mark = (fred-buffer w)
             with max-line-height = 11          ; for now...
             with view-lines = (floor (point-v (view-size w))
                                      max-line-height)
             with n = (or (and *numeric-arg* (+ *numeric-arg* 1))
                          (floor view-lines 2))
             for pos from (max 0 (min (buffer-line-start mark)
                                      (- (buffer-size mark) 1))) downto 0
             do (when (char-equal (buffer-char mark pos) #\Newline)
                  (decf n))
             until (= n 0)
             finally (return (+ pos 1))))
      (fred-update w))))
 
(comtab-set-key *comtab* '(:control #\l) 'ed-recenter-window
                "Move the current cursor position to the center of the window.
  With a numeric argument, move it to ARG lines from the top.")