/[emacs]/emacs/lisp/ruler-mode.el
ViewVC logotype

Diff of /emacs/lisp/ruler-mode.el

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

revision 1.2 by rms, Sun Nov 25 00:10:03 2001 UTC revision 1.3 by rms, Thu Dec 13 07:55:49 2001 UTC
# Line 5  Line 5 
5  ;; Author: David Ponce <david@dponce.com>  ;; Author: David Ponce <david@dponce.com>
6  ;; Maintainer: David Ponce <david@dponce.com>  ;; Maintainer: David Ponce <david@dponce.com>
7  ;; Created: 24 Mar 2001  ;; Created: 24 Mar 2001
8  ;; Version: 1.3.1  ;; Version: 1.4
9  ;; Keywords: environment  ;; Keywords: environment
10    
11  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 438  C-mouse-2: hide tabs" Line 438  C-mouse-2: hide tabs"
438    "Right margin %S"    "Right margin %S"
439    "Help string shown when mouse is over the right margin area.")    "Help string shown when mouse is over the right margin area.")
440    
441  (defvar ruler-mode-left-fringe-cols nil  (defun ruler-mode-extra-left-cols ()
442    "Hold last result of function `ruler-mode-left-fringe-cols'.    "Return number of extra columns on the left side of selected frame.
443  This cache is local to each frame.")  That is the number of columns occupied by the left fringe area and
444  (make-variable-frame-local 'ruler-mode-left-fringe-cols)  vertical scrollbar on the left side of the selected frame."
445      (let ((w  (frame-first-window))
446  (defun ruler-mode-left-fringe-cols (&optional check)          (xy (cons 0 0)))
447    "Return the character width of fringe and left vertical scrollbar.      (with-current-buffer (window-buffer w)
448  That is a pair (FRINGE-COLS . VSCROLLBAR-COLS) where:        (let (header-line-format)
449            (while (not (listp (coordinates-in-window-p xy w)))
450  - - FRINGE-COLS is the number of columns occupied by a fringe area.            (setcar xy (1+ (car xy))))
451            (car xy)))))
 - - VSCROLLBAR-COLS is the number of columns occupied by the left  
     vertical scrollbar or 0 if there is no vertical scrollbar on the  
     left side.  
   
 The first time this function is called its result is saved in a frame  
 local cache and then returned on next calls.  If optional argument  
 CHECK is non-nil or if the frame 'vertical-scroll-bars parameter has  
 been changed the function re-computes the result."  
   (let* ((f   (selected-frame))  
          (vsb (frame-parameter f 'vertical-scroll-bars))  
          (lfc (frame-parameter f 'ruler-mode-left-fringe-cols)))  
     (if (or check (not (eq (cdr lfc) vsb)))  
         (let* ((w   (frame-first-window f))  
                (sbw (frame-pixel-width f))  
                (chw (frame-char-width f))  
                (chx (/ 1.0 (float chw)))  
                (pos (cons 0.0 0))  
                (lfw 0.0)  
                coord)  
           (if vsb  
               (modify-frame-parameters  
                f '((vertical-scroll-bars . nil))))  
           (setq coord (coordinates-in-window-p pos w))  
           (while (not (memq coord '(left-fringe mode-line)))  
             (setcdr pos (1+ (cdr pos)))  
             (setq coord (coordinates-in-window-p pos w)))  
           (while (eq coord 'left-fringe)  
             (setcar pos (+ (car pos) chx))  
             (setq lfw   (+ lfw chx)  
                   coord (coordinates-in-window-p pos w)))  
           (or vsb  
               (modify-frame-parameters  
                f '((vertical-scroll-bars . right))))  
           (setq sbw (/ (abs (- sbw (frame-pixel-width f))) chw)  
                 lfw (floor lfw))  
           (setq lfc (cons (cons lfw (if (eq vsb 'left) sbw 0)) vsb))  
           (modify-frame-parameters  
            f (list (cons 'vertical-scroll-bars vsb)  
                    (cons 'ruler-mode-left-fringe-cols lfc)))))  
     (car lfc)))  
452    
453  (defun ruler-mode-ruler ()  (defun ruler-mode-ruler ()
454    "Return a string ruler."    "Return a string ruler."
455    (if ruler-mode    (if ruler-mode
456        (let* ((lfr   (ruler-mode-left-fringe-cols))        (let* ((j     (ruler-mode-extra-left-cols))
457               (w     (+ (window-width) 1 (cdr lfr)))               (k     (/ (or (frame-parameter nil 'right-fringe) 0)
458                           (frame-char-width)))
459                 (w     (+ (window-width) j))
460               (m     (window-margins))               (m     (window-margins))
461               (l     (or (car m) 0))               (l     (or (car m) 0))
462               (r     (or (cdr m) 0))               (r     (or (cdr m) 0))
              (j     (+ (car lfr) (cdr lfr)))  
463               (o     (- (window-hscroll) l j))               (o     (- (window-hscroll) l j))
464               (i     0)               (i     0)
465               (ruler (concat               (ruler (concat
466                       ;; unit graduations                       ;; unit graduations
467                       (make-string w ruler-mode-basic-graduation-char)                       (make-string w ruler-mode-basic-graduation-char)
468                       ;; extra space to fill the header line                       ;; extra space to fill the header line
469                       (make-string j ?\ )))                       (make-string k ?\ )))
470               c k)               c)
471    
472          ;; Setup default face and help echo.          ;; Setup default face and help echo.
473          (put-text-property 0 (length ruler)          (put-text-property 0 (length ruler)

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

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