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. |
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) |