1 ;;; sml-modeline.el --- Show position in a scrollbar like way in mode-line
3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
4 ;; Created: 2010-03-16 Tue
6 ;; Last-Updated: 2010-03-18 Thu
7 ;; URL: http://bazaar.launchpad.net/~nxhtml/nxhtml/main/annotate/head%3A/util/sml-modeline.el
11 ;; Features that might be required by this library:
15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
19 ;; Show scrollbar like position indicator in mode line.
20 ;; See the global minor mode `sml-modeline-mode' for more information.
22 ;; Idea and part of this code is adapted from David Engster's and Drew
23 ;; Adam's code in these mail messages:
25 ;; http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg00523.html
26 ;; http://permalink.gmane.org/gmane.emacs.devel/122038
28 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
33 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
35 ;; This program is free software; you can redistribute it and/or
36 ;; modify it under the terms of the GNU General Public License as
37 ;; published by the Free Software Foundation; either version 3, or
38 ;; (at your option) any later version.
40 ;; This program is distributed in the hope that it will be useful,
41 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
42 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
43 ;; General Public License for more details.
45 ;; You should have received a copy of the GNU General Public License
46 ;; along with this program; see the file COPYING. If not, write to
47 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
48 ;; Floor, Boston, MA 02110-1301, USA.
50 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
55 (defgroup sml-modeline nil
56 "Customization group for `sml-modeline-mode'."
59 (defun sml-modeline-refresh ()
60 "Refresh after option changes if loaded."
61 (when (featurep 'sml-modeline)
62 (when (and (boundp 'sml-modeline-mode)
64 (sml-modeline-mode -1)
65 (sml-modeline-mode 1))))
67 (defcustom sml-modeline-len 12
68 "Mode line indicator total length."
70 :set (lambda (sym val)
72 (sml-modeline-refresh))
75 (defcustom sml-modeline-borders nil
77 This is a pair of indicators, like [] or nil."
78 :type '(choice (const :tag "None" nil)
79 (cons (string :tag "Left border")
80 (string :tag "Right border")))
81 :set (lambda (sym val)
83 (sml-modeline-refresh))
86 (defcustom sml-modeline-numbers 'percentage
87 "Position number style.
88 This can be 'percentage or 'line-number."
89 :type '(choice (const :tag "Line numbers" line-numbers)
90 (const :tag "Percentage" percentage))
91 :set (lambda (sym val)
93 (sml-modeline-refresh))
96 (defface sml-modeline-end-face
97 '((t (:inherit match)))
98 "Face for invisible buffer parts."
100 ;; 'face `(:background ,(face-foreground 'mode-line-inactive)
101 ;; :foreground ,(face-background 'mode-line))
103 (defface sml-modeline-vis-face
104 '((t (:inherit region)))
105 "Face for invisible buffer parts."
106 :group 'sml-modeline)
107 ;; 'face `(:background ,(face-foreground 'mode-line)
108 ;; :foreground ,(face-background 'mode-line))
110 ;;(sml-modeline-create)
111 (defun sml-modeline-create ()
112 (let* ((wstart (window-start))
114 number-max number-beg number-end
115 (sml-begin (or (car sml-modeline-borders) ""))
116 (sml-end (or (cdr sml-modeline-borders) ""))
117 (inner-len (- sml-modeline-len (length sml-begin) (length sml-end)))
122 (if (not (or (< wend (save-restriction (widen) (point-max)))
126 ((eq sml-modeline-numbers 'percentage)
127 (setq number-max (save-restriction (widen) (point-max)))
128 (setq number-beg (/ (float wstart) (float number-max)))
129 (setq number-end (/ (float wend) (float number-max)))
130 (setq start (floor (* number-beg inner-len)))
131 (setq end (floor (* number-end inner-len)))
133 (concat (format "%02d" (round (* number-beg 100)))
135 (format "%02d" (round (* number-end 100))) "%%")))
136 ((eq sml-modeline-numbers 'line-numbers)
139 (setq number-max (line-number-at-pos (point-max)))
140 (setq number-beg (line-number-at-pos wstart))
141 (setq number-end (line-number-at-pos wend)))
142 (setq start (floor (* (/ number-beg (float number-max)) inner-len)))
143 (setq end (floor (* (/ number-end (float number-max)) inner-len)))
146 (format "%02d" number-beg)
148 (format "%02d" number-end))))
149 (t (error "Unknown sml-modeline-numbers=%S" sml-modeline-numbers)))
150 (setq inner-len (max inner-len (length string)))
151 (setq bpad-len (floor (/ (- inner-len (length string)) 2.0)))
152 (setq epad-len (- inner-len (length string) bpad-len))
153 (setq pos-% (+ bpad-len (length string) -1))
154 (setq string (concat sml-begin
155 (make-string bpad-len 32)
157 (make-string epad-len 32)
159 ;;(assert (= (length string) sml-modeline-len) t)
160 (when (= start sml-modeline-len) (setq start (1- start)))
161 (setq start (+ start (length sml-begin)))
162 (when (= start end) (setq end (1+ end)))
163 (when (= end pos-%) (setq end (1+ end))) ;; If on % add 1
164 (put-text-property start end 'face 'sml-modeline-vis-face string)
165 (when (and (= 0 (length sml-begin))
166 (= 0 (length sml-end)))
167 (put-text-property 0 start 'face 'sml-modeline-end-face string)
168 (put-text-property end sml-modeline-len 'face 'sml-modeline-end-face string))
171 (defvar sml-modeline-old-car-mode-line-position nil)
174 (define-minor-mode sml-modeline-mode
175 "Show buffer size and position like scrollbar in mode line.
176 You can customize this minor mode, see option `sml-modeline-mode'.
178 Note: If you turn this mode on then you probably want to turn off
179 option `scroll-bar-mode'."
182 (if sml-modeline-mode
184 (unless sml-modeline-old-car-mode-line-position
185 (setq sml-modeline-old-car-mode-line-position (car mode-line-position)))
186 (setcar mode-line-position '(:eval (list (sml-modeline-create)))))
187 (setcar mode-line-position sml-modeline-old-car-mode-line-position)))
190 (provide 'sml-modeline)
191 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
192 ;;; sml-modeline.el ends here