code.delx.au - gnu-emacs-elpa/blob - packages/nlinum/nlinum.el

   1 ;;; nlinum.el --- Show line numbers in the margin  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2012, 2014  Free Software Foundation, Inc.
   4
   5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
   6 ;; Keywords: convenience
   7 ;; Version: 1.5
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; This is like linum-mode, but uses jit-lock to be (hopefully)
  25 ;; more efficient.
  26
  27 ;;; News:
  28
  29 ;; v1.3:
  30 ;; - New custom variable `nlinum-format'.
  31 ;; - Change in calling convention of `nlinum-format-function'.
  32
  33 ;; v1.2:
  34 ;; - New global mode `global-nlinum-mode'.
  35 ;; - New config var `nlinum-format-function'.
  36
  37 ;;; Code:
  38
  39 (require 'linum)                        ;For its face.
  40
  41 (defvar nlinum--width 2)
  42 (make-variable-buffer-local 'nlinum--width)
  43
  44 ;; (defvar nlinum--desc "")
  45
  46 ;;;###autoload
  47 (define-minor-mode nlinum-mode
  48   "Toggle display of line numbers in the left margin (Linum mode).
  49 With a prefix argument ARG, enable Linum mode if ARG is positive,
  50 and disable it otherwise.  If called from Lisp, enable the mode
  51 if ARG is omitted or nil.
  52
  53 Linum mode is a buffer-local minor mode."
  54   :lighter nil ;; (" NLinum" nlinum--desc)
  55   (jit-lock-unregister #'nlinum--region)
  56   (remove-hook 'window-configuration-change-hook #'nlinum--setup-window t)
  57   (remove-hook 'after-change-functions #'nlinum--after-change t)
  58   (kill-local-variable 'nlinum--line-number-cache)
  59   (remove-overlays (point-min) (point-max) 'nlinum t)
  60   ;; (kill-local-variable 'nlinum--ol-counter)
  61   (kill-local-variable 'nlinum--width)
  62   (when nlinum-mode
  63     ;; FIXME: Another approach would be to make the mode permanent-local,
  64     ;; which might indeed be preferable.
  65     (add-hook 'change-major-mode-hook (lambda () (nlinum-mode -1)))
  66     (add-hook 'window-configuration-change-hook #'nlinum--setup-window nil t)
  67     (add-hook 'after-change-functions #'nlinum--after-change nil t)
  68     (jit-lock-register #'nlinum--region t))
  69   (nlinum--setup-windows))
  70
  71 (defun nlinum--face-height (face)
  72   (aref (font-info (face-font face)) 2))
  73
  74 (defun nlinum--setup-window ()
  75   (let ((width (if (display-graphic-p)
  76                    (ceiling
  77                     ;; We'd really want to check the widths rather than the
  78                     ;; heights, but it's a start.
  79                     (/ (* nlinum--width 1.0
  80                           (nlinum--face-height 'linum))
  81                        (frame-char-height)))
  82                  nlinum--width)))
  83     (set-window-margins nil (if nlinum-mode width)
  84                         (cdr (window-margins)))))
  85
  86 (defun nlinum--setup-windows ()
  87   (dolist (win (get-buffer-window-list nil nil t))
  88     (with-selected-window win (nlinum--setup-window))))
  89
  90 (defun nlinum--flush ()
  91   (nlinum--setup-windows)
  92   ;; (kill-local-variable 'nlinum--ol-counter)
  93   (remove-overlays (point-min) (point-max) 'nlinum t)
  94   (run-with-timer 0 nil
  95                   (lambda (buf)
  96                     (with-current-buffer buf
  97                       (with-silent-modifications
  98                         ;; FIXME: only remove `fontified' on those parts of the
  99                         ;; buffer that had an nlinum overlay!
 100                         (remove-text-properties
 101                          (point-min) (point-max) '(fontified)))))
 102                   (current-buffer)))
 103
 104 ;; (defun nlinum--ol-count ()
 105 ;;   (let ((i 0))
 106 ;;     (dolist (ol (overlays-in (point-min) (point-max)))
 107 ;;       (when (overlay-get ol 'nlinum) (incf i)))
 108 ;;     i))
 109
 110 ;; (defvar nlinum--ol-counter 100)
 111 ;; (make-variable-buffer-local 'nlinum--ol-counter)
 112
 113 ;; (defun nlinum--flush-overlays (buffer)
 114 ;;   (with-current-buffer buffer
 115 ;;     (kill-local-variable 'nlinum--ol-counter)
 116 ;;     ;; We've created many overlays in this buffer, which can slow
 117 ;;     ;; down operations significantly.  Let's flush them.
 118 ;;     ;; An easy way to flush them is
 119 ;;     ;;   (remove-overlays min max 'nlinum t)
 120 ;;     ;;   (put-text-property min max 'fontified nil)
 121 ;;     ;; but if the visible part of the buffer requires more than
 122 ;;     ;; nlinum-overlay-threshold overlays, then we'll inf-loop.
 123 ;;     ;; So let's be more careful about removing overlays.
 124 ;;     (let ((windows (get-buffer-window-list nil nil t))
 125 ;;           (start (point-min))
 126 ;;           (debug-count (nlinum--ol-count)))
 127 ;;       (with-silent-modifications
 128 ;;         (while (< start (point-max))
 129 ;;           (let ((end (point-max)))
 130 ;;             (dolist (window windows)
 131 ;;               (cond
 132 ;;                ((< start (1- (window-start window)))
 133 ;;                 (setq end (min (1- (window-start window)) end)))
 134 ;;                ((< start (1+ (window-end window)))
 135 ;;                 (setq start (1+ (window-end window))))))
 136 ;;             (when (< start end)
 137 ;;               (remove-overlays start end 'nlinum t)
 138 ;;               ;; Warn jit-lock that this part of the buffer is not done any
 139 ;;               ;; more.  This has the downside that font-lock will be re-applied
 140 ;;               ;; as well.  But jit-lock doesn't know how to (and doesn't want
 141 ;;               ;; to) keep track of the status of its various
 142 ;;               ;; clients independently.
 143 ;;               (put-text-property start end 'fontified nil)
 144 ;;               (setq start (+ end 1))))))
 145 ;;       (let ((debug-new-count (nlinum--ol-count)))
 146 ;;         (message "Flushed %d overlays, %d remaining"
 147 ;;                  (- debug-count debug-new-count) debug-new-count)))))
 148
 149
 150 (defvar nlinum--line-number-cache nil)
 151 (make-variable-buffer-local 'nlinum--line-number-cache)
 152
 153 ;; We could try and avoid flushing the cache at every change, e.g. with:
 154 ;;   (defun nlinum--before-change (start _end)
 155 ;;     (if (and nlinum--line-number-cache
 156 ;;              (< start (car nlinum--line-number-cache)))
 157 ;;         (save-excursion (goto-char start) (nlinum--line-number-at-pos))))
 158 ;; But it's far from clear that it's worth the trouble.  The current simplistic
 159 ;; approach seems to be good enough in practice.
 160
 161 (defun nlinum--after-change (&rest _args)
 162   (setq nlinum--line-number-cache nil))
 163
 164 (defun nlinum--line-number-at-pos ()
 165   "Like `line-number-at-pos' but sped up with a cache."
 166   ;; (assert (bolp))
 167   (let ((pos
 168          (if (and nlinum--line-number-cache
 169                   (> (- (point) (point-min))
 170                      (abs (- (point) (car nlinum--line-number-cache)))))
 171              (funcall (if (> (point) (car nlinum--line-number-cache))
 172                           #'+ #'-)
 173                       (cdr nlinum--line-number-cache)
 174                       (count-lines (point) (car nlinum--line-number-cache)))
 175            (line-number-at-pos))))
 176     ;;(assert (= pos (line-number-at-pos)))
 177     (setq nlinum--line-number-cache (cons (point) pos))
 178     pos))
 179
 180 (defcustom nlinum-format "%d"
 181   "Format of the line numbers.
 182 Used by the default `nlinum-format-function'."
 183   :type 'string
 184   :group 'linum)
 185
 186 (defvar nlinum-format-function
 187   (lambda (line width)
 188     (let ((str (format nlinum-format line)))
 189       (when (< (length str) width)
 190         ;; Left pad to try and right-align the line-numbers.
 191         (setq str (concat (make-string (- width (length str)) ?\ ) str)))
 192       (put-text-property 0 width 'face 'linum str)
 193       str))
 194   "Function to build the string representing the line number.
 195 Takes 2 arguments LINE and WIDTH, both of them numbers, and should return
 196 a string.  WIDTH is the ideal width of the result.  If the result is larger,
 197 it may cause the margin to be resized and line numbers to be recomputed.")
 198
 199 (defun nlinum--region (start limit)
 200   (save-excursion
 201     ;; Text may contain those nasty intangible properties, but
 202     ;; that shouldn't prevent us from counting those lines.
 203     (let ((inhibit-point-motion-hooks t))
 204       (goto-char start)
 205       (unless (bolp) (forward-line 1))
 206       (remove-overlays (point) limit 'nlinum t)
 207       (let ((line (nlinum--line-number-at-pos)))
 208         (while
 209             (and (not (eobp)) (< (point) limit)
 210                  (let* ((ol (make-overlay (point) (1+ (point))))
 211                         (str (funcall nlinum-format-function
 212                                       line nlinum--width))
 213                         (width (string-width str)))
 214                    (when (< nlinum--width width)
 215                      (setq nlinum--width width)
 216                      (nlinum--flush))
 217                    (overlay-put ol 'nlinum t)
 218                    (overlay-put ol 'evaporate t)
 219                    (overlay-put ol 'before-string
 220                                 (propertize " " 'display
 221                                             `((margin left-margin) ,str)))
 222                    ;; (setq nlinum--ol-counter (1- nlinum--ol-counter))
 223                    ;; (when (= nlinum--ol-counter 0)
 224                    ;;   (run-with-idle-timer 0.5 nil #'nlinum--flush-overlays
 225                    ;;                        (current-buffer)))
 226                    (setq line (1+ line))
 227                    (zerop (forward-line 1))))))))
 228   ;; (setq nlinum--desc (format "-%d" (nlinum--ol-count)))
 229   nil)
 230
 231 ;;;###autoload
 232 (define-globalized-minor-mode global-nlinum-mode nlinum-mode
 233   (lambda () (unless (minibufferp) (nlinum-mode))))
 234
 235 (provide 'nlinum)
 236 ;;; nlinum.el ends here