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.2
   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.2:
  30 ;; - New global mode `global-nlinum-mode'.
  31 ;; - New config var `nlinum-format-function'.
  32
  33 ;;; Code:
  34
  35 (require 'linum)                        ;For its face.
  36
  37 (defvar nlinum--width 2)
  38 (make-variable-buffer-local 'nlinum--width)
  39
  40 ;; (defvar nlinum--desc "")
  41
  42 ;;;###autoload
  43 (define-minor-mode nlinum-mode
  44   "Toggle display of line numbers in the left margin (Linum mode).
  45 With a prefix argument ARG, enable Linum mode if ARG is positive,
  46 and disable it otherwise.  If called from Lisp, enable the mode
  47 if ARG is omitted or nil.
  48
  49 Linum mode is a buffer-local minor mode."
  50   :lighter nil ;; (" NLinum" nlinum--desc)
  51   (jit-lock-unregister #'nlinum--region)
  52   (remove-hook 'window-configuration-change-hook #'nlinum--setup-window t)
  53   (remove-hook 'after-change-functions #'nlinum--after-change)
  54   (kill-local-variable 'nlinum--line-number-cache)
  55   (remove-overlays (point-min) (point-max) 'nlinum t)
  56   ;; (kill-local-variable 'nlinum--ol-counter)
  57   (kill-local-variable 'nlinum--width)
  58   (when nlinum-mode
  59     (add-hook 'window-configuration-change-hook #'nlinum--setup-window nil t)
  60     (add-hook 'after-change-functions #'nlinum--after-change nil t)
  61     (jit-lock-register #'nlinum--region t))
  62   (nlinum--setup-windows))
  63
  64 (defun nlinum--setup-window ()
  65   (set-window-margins nil (if nlinum-mode nlinum--width)
  66                       (cdr (window-margins))))
  67
  68 (defun nlinum--setup-windows ()
  69   (dolist (win (get-buffer-window-list nil nil t))
  70     (with-selected-window win (nlinum--setup-window))))
  71
  72 (defun nlinum--flush ()
  73   (nlinum--setup-windows)
  74   ;; (kill-local-variable 'nlinum--ol-counter)
  75   (remove-overlays (point-min) (point-max) 'nlinum t)
  76   (run-with-timer 0 nil
  77                   (lambda (buf)
  78                     (with-current-buffer buf
  79                       (with-silent-modifications
  80                         (remove-text-properties
  81                          (point-min) (point-max) '(fontified)))))
  82                   (current-buffer)))
  83
  84 ;; (defun nlinum--ol-count ()
  85 ;;   (let ((i 0))
  86 ;;     (dolist (ol (overlays-in (point-min) (point-max)))
  87 ;;       (when (overlay-get ol 'nlinum) (incf i)))
  88 ;;     i))
  89
  90 ;; (defvar nlinum--ol-counter 100)
  91 ;; (make-variable-buffer-local 'nlinum--ol-counter)
  92
  93 ;; (defun nlinum--flush-overlays (buffer)
  94 ;;   (with-current-buffer buffer
  95 ;;     (kill-local-variable 'nlinum--ol-counter)
  96 ;;     ;; We've created many overlays in this buffer, which can slow
  97 ;;     ;; down operations significantly.  Let's flush them.
  98 ;;     ;; An easy way to flush them is
  99 ;;     ;;   (remove-overlays min max 'nlinum t)
 100 ;;     ;;   (put-text-property min max 'fontified nil)
 101 ;;     ;; but if the visible part of the buffer requires more than
 102 ;;     ;; nlinum-overlay-threshold overlays, then we'll inf-loop.
 103 ;;     ;; So let's be more careful about removing overlays.
 104 ;;     (let ((windows (get-buffer-window-list nil nil t))
 105 ;;           (start (point-min))
 106 ;;           (debug-count (nlinum--ol-count)))
 107 ;;       (with-silent-modifications
 108 ;;         (while (< start (point-max))
 109 ;;           (let ((end (point-max)))
 110 ;;             (dolist (window windows)
 111 ;;               (cond
 112 ;;                ((< start (1- (window-start window)))
 113 ;;                 (setq end (min (1- (window-start window)) end)))
 114 ;;                ((< start (1+ (window-end window)))
 115 ;;                 (setq start (1+ (window-end window))))))
 116 ;;             (when (< start end)
 117 ;;               (remove-overlays start end 'nlinum t)
 118 ;;               ;; Warn jit-lock that this part of the buffer is not done any
 119 ;;               ;; more.  This has the downside that font-lock will be re-applied
 120 ;;               ;; as well.  But jit-lock doesn't know how to (and doesn't want
 121 ;;               ;; to) keep track of the status of its various
 122 ;;               ;; clients independently.
 123 ;;               (put-text-property start end 'fontified nil)
 124 ;;               (setq start (+ end 1))))))
 125 ;;       (let ((debug-new-count (nlinum--ol-count)))
 126 ;;         (message "Flushed %d overlays, %d remaining"
 127 ;;                  (- debug-count debug-new-count) debug-new-count)))))
 128
 129
 130 (defvar nlinum--line-number-cache nil)
 131 (make-variable-buffer-local 'nlinum--line-number-cache)
 132
 133 (defun nlinum--after-change (&rest _args)
 134   (setq nlinum--line-number-cache nil))
 135
 136 (defun nlinum--line-number-at-pos ()
 137   "Like `line-number-at-pos' but sped up with a cache."
 138   ;; (assert (bolp))
 139   (let ((pos
 140          (if (and nlinum--line-number-cache
 141                   (> (- (point) (point-min))
 142                      (abs (- (point) (car nlinum--line-number-cache)))))
 143              (funcall (if (> (point) (car nlinum--line-number-cache))
 144                           #'+ #'-)
 145                       (cdr nlinum--line-number-cache)
 146                       (count-lines (point) (car nlinum--line-number-cache)))
 147            (line-number-at-pos))))
 148     ;;(assert (= pos (line-number-at-pos)))
 149     (setq nlinum--line-number-cache (cons (point) pos))
 150     pos))
 151
 152 (defvar nlinum-format-function
 153   (lambda (line)
 154     (let* ((fmt (format "%%%dd" nlinum--width))
 155            (str (propertize (format fmt line) 'face 'linum)))
 156       str))
 157   "Function to build the string representing the line number.
 158 Takes one argument (the line number) and returns a string whose width
 159 should be at least equal to `nlinum--width'.")
 160
 161 (defun nlinum--region (start limit)
 162   (save-excursion
 163     ;; Text may contain those nasty intangible properties, but
 164     ;; that shouldn't prevent us from counting those lines.
 165     (let ((inhibit-point-motion-hooks t))
 166       (goto-char start)
 167       (unless (bolp) (forward-line 1))
 168       (remove-overlays (point) limit 'nlinum t)
 169       (let ((line (nlinum--line-number-at-pos)))
 170         (while
 171             (and (not (eobp)) (< (point) limit)
 172                  (let* ((ol (make-overlay (point) (1+ (point))))
 173                         (str (funcall nlinum-format-function line))
 174                         (width (string-width str)))
 175                    (when (< nlinum--width width)
 176                      (setq nlinum--width width)
 177                      (nlinum--flush))
 178                    (overlay-put ol 'nlinum t)
 179                    (overlay-put ol 'evaporate t)
 180                    (overlay-put ol 'before-string
 181                                 (propertize " " 'display
 182                                             `((margin left-margin) ,str)))
 183                    ;; (setq nlinum--ol-counter (1- nlinum--ol-counter))
 184                    ;; (when (= nlinum--ol-counter 0)
 185                    ;;   (run-with-idle-timer 0.5 nil #'nlinum--flush-overlays
 186                    ;;                        (current-buffer)))
 187                    (setq line (1+ line))
 188                    (zerop (forward-line 1))))))))
 189   ;; (setq nlinum--desc (format "-%d" (nlinum--ol-count)))
 190   nil)
 191
 192 ;;;###autoload
 193 (define-globalized-minor-mode global-nlinum-mode nlinum-mode
 194   (lambda () (unless (minibufferp) (nlinum-mode))))
 195
 196 (provide 'nlinum)
 197 ;;; nlinum.el ends here