;;; vi-style line number mode for Emacs ;;; (requires Emacs 19.29 or later, or XEmacs 19.11 or later) ;;; Copyright (C) 1994, 1995, 1997 Kyle E. Jones ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 2, or (at your option) ;;; any later version. ;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; A copy of the GNU General Public License can be obtained from this ;;; program's author (send electronic mail to kyle@uunet.uu.net) or from ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA ;;; 02139, USA. ;;; ;;; Send bug reports to kyle@wonderworks.com ;; ;; M-x setnu-mode toggles the line number mode on and off. ;; ;; turn-on-setnu-mode is useful for adding to a major-mode hook ;; variable. ;; Example: ;; (add-hook 'text-mode-hook 'turn-on-setnu-mode) ;; to automatically turn on line numbering when enterting text-mode." (provide 'setnu) (defconst setnu-running-under-xemacs (or (string-match "XEmacs" emacs-version) (string-match "Lucid" emacs-version))) (defconst setnu-mode-version "1.05" "Version number for this release of setnu-mode.") (defvar setnu-mode nil "Non-nil if setnu-mode is active in the current buffer.") (make-variable-buffer-local 'setnu-mode) (defvar setnu-start-extent nil "First extent of a chain of extents used by setnu-mode. Each line has its own extent. Each line extent has a `setnu-next-extent' property that points to the next extent in the chain, which is the extent for the next line in the buffer. There is also a `setnu-prev-extent' that points at the previous extent in the chain. To distinguish them from other extents the setnu-mode extents all have a non-nil `setnu' property.") (make-variable-buffer-local 'setnu-start-extent) (defvar setnu-glyph-obarray (make-vector 401 0) "Obarray of symbols whose values are line number glyphs. Each symbol name is the string represnetation of a number, perhaps passed with spaces. The value of the symbol is a glyph that can be made the begin glyph of an extent to display as a line number.") (defvar setnu-begin-glyph-property (if (fboundp 'extent-property) 'begin-glyph 'before-string) "Property name to use to set the begin glyph of an extent.") (defvar setnu-line-number-format (if setnu-running-under-xemacs "%4d" "%4d ") "String suitable for `format' that will generate a line number string. `format' will be called with this string and one other argument which will be an integer, the line number.") (defvar setnu-line-number-face 'bold "*Face used to display the line numbers. Currently this works for XEmacs 19.12 and later versions only.") (defun setnu-mode (&optional arg) "Toggle setnu-mode. With prefix argument, turn setnu-mode on if argument is positive. When setnu-mode is enabled, a line number will appear at the left margin of each line." (interactive "P") (let ((oldmode (not (not setnu-mode))) (inhibit-quit t)) (setq setnu-mode (or (and arg (> (prefix-numeric-value arg) 0)) (and (null arg) (null setnu-mode)))) (if (not (eq oldmode setnu-mode)) (if setnu-mode (setnu-mode-on) (setnu-mode-off))))) (defun turn-on-setnu-mode () "Turn on setnu-mode. Useful for adding to a major-mode hook variable. Example: (add-hook 'text-mode-hook 'turn-on-setnu-mode) to automatically turn on line numbering when enterting text-mode." (setnu-mode 1)) ;;; Internal functions ;;; The program is written using XEmacs terminology, ;;; e.g. extents, glyphs, etc. Functions are defined to twist ;;; the FSF Emacs overlay API into the XEmacs model. (defconst setnu-running-under-xemacs (or (string-match "XEmacs" emacs-version) (string-match "Lucid" emacs-version))) (if setnu-running-under-xemacs (fset 'setnu-make-extent 'make-extent) (fset 'setnu-make-extent 'make-overlay)) (if setnu-running-under-xemacs (fset 'setnu-delete-extent 'delete-extent) (fset 'setnu-delete-extent 'delete-overlay)) (if setnu-running-under-xemacs (fset 'setnu-extent-property 'extent-property) (fset 'setnu-extent-property 'overlay-get)) (if setnu-running-under-xemacs (fset 'setnu-set-extent-property 'set-extent-property) (fset 'setnu-set-extent-property 'overlay-put)) (if setnu-running-under-xemacs (fset 'setnu-set-extent-endpoints 'set-extent-endpoints) (fset 'setnu-set-extent-endpoints 'move-overlay)) (if setnu-running-under-xemacs (fset 'setnu-extent-end-position 'extent-end-position) (fset 'setnu-extent-end-position 'overlay-end)) (if setnu-running-under-xemacs (fset 'setnu-extent-start-position 'extent-start-position) (fset 'setnu-extent-start-position 'overlay-start)) (if setnu-running-under-xemacs (defun setnu-set-extent-begin-glyph (e g) (set-extent-begin-glyph e g 'outside-margin)) (defun setnu-set-extent-begin-glyph (e g) (overlay-put e setnu-begin-glyph-property g))) (fset 'setnu-make-glyph (if setnu-running-under-xemacs 'make-glyph 'identity)) (cond ((and setnu-running-under-xemacs (fboundp 'set-glyph-face)) (fset 'setnu-set-glyph-face 'set-glyph-face)) (setnu-running-under-xemacs (fset 'setnu-set-glyph-face 'ignore)) (t ; FSF Emacs (defun setnu-set-glyph-face (g face) (put-text-property 0 (length g) 'face face g)))) (defun setnu-mode-off () "Internal shutdown of setnu-mode. Deletes the extents associated with setnu-mode." (if (and setnu-running-under-xemacs (fboundp 'remove-specifier)) (remove-specifier left-margin-width (current-buffer))) (if setnu-start-extent (let (e ee) (setq e setnu-start-extent) (while e (setq ee e) (setq e (setnu-extent-property e 'setnu-next-extent)) (setnu-delete-extent ee)) (setq setnu-start-extent nil)))) (defun setnu-mode-on () "Internal startup of setnu-mode. Sets up the extents associated with setnu-mode." (if (and setnu-running-under-xemacs (fboundp 'set-specifier)) (set-specifier left-margin-width 6 (current-buffer))) (let ((done nil) (curr-e nil) (n 1) (match-data (match-data)) e start numstr) (unwind-protect (save-excursion (save-restriction (widen) (goto-char (point-min)) (setq start (point)) (while (not done) (setq done (null (search-forward "\n" nil 0))) (setq e (setnu-make-setnu-extent start (point))) (if (null setnu-start-extent) (setq setnu-start-extent e curr-e e) (setnu-set-extent-property curr-e 'setnu-next-extent e) (setnu-set-extent-property e 'setnu-prev-extent curr-e) (setq curr-e e)) (setq numstr (format setnu-line-number-format n)) (setnu-set-extent-property e 'line-number numstr) (setnu-set-extent-begin-glyph e (setnu-number-glyph numstr)) (setq n (1+ n) start (point))))) (store-match-data match-data)))) (defun setnu-before-change-function (start end) "Before change function for setnu-mode. Notices when a delete is about to delete some lines and adjusts the line number extents accordingly." (if (or (not setnu-mode) (= start end)) () ;; not in setnu-mode or this is an insertion (let ((inhibit-quit t) (start-e nil) (match-data (match-data)) end-e saved-next e ee) (unwind-protect (save-excursion (save-restriction (widen) (goto-char start) (if (search-forward "\n" end t) (progn (setq start-e (setnu-extent-at-create start nil) saved-next (setnu-extent-property start-e 'setnu-next-extent)) (setq end-e (setnu-extent-at-create end nil)) (setnu-set-extent-endpoints start-e (setnu-extent-start-position start-e) (setnu-extent-end-position end-e)) (setnu-set-extent-property start-e 'setnu-next-extent (setnu-extent-property end-e 'setnu-next-extent)))) (if start-e (progn (setq e (setnu-extent-property start-e 'setnu-next-extent) ee saved-next) (while (and e (setnu-extent-property e 'setnu-next-extent)) (setq e (setnu-extent-property e 'setnu-next-extent) ee (setnu-extent-property ee 'setnu-next-extent))) (while (and e (not (eq ee start-e))) (setnu-set-extent-begin-glyph e (setnu-extent-property ee setnu-begin-glyph-property)) (setnu-set-extent-property e 'line-number (setnu-extent-property ee 'line-number)) (setq e (setnu-extent-property e 'setnu-prev-extent) ee (setnu-extent-property ee 'setnu-prev-extent))) (setq end-e (setnu-extent-property start-e 'setnu-next-extent)) (and end-e (setnu-set-extent-property end-e 'setnu-prev-extent start-e)) (setq e saved-next) (while (not (eq e end-e)) (setq ee e e (setnu-extent-property e 'setnu-next-extent)) (setnu-delete-extent ee)))))) (store-match-data match-data))))) (defun setnu-after-change-function (start end length) "After change function for setnu-mode. Notices when an insert has added some lines and adjusts the line number extents accordingly." (if (or (not setnu-mode) (= start end)) () ; not in setnu-mode or this is a deletion (let ((inhibit-quit t) (ee nil) (match-data (match-data)) (new-lines 0) start-e e saved-end saved-next n numstr) (unwind-protect (save-excursion (save-restriction (widen) (setq start-e (setnu-extent-at-create start nil)) (if (< (setnu-extent-end-position start-e) (point)) ;; bogus! insertion didn't put the text into ;; the extent because, ;; a. the extent was zero length or ;; b. this is FSF Emacs which means chars ;; inserted at the end position of an extent ;; are not inserted into the extent. (setnu-set-extent-endpoints start-e (setnu-extent-start-position start-e) end)) (setq saved-next (setnu-extent-property start-e 'setnu-next-extent) saved-end (setnu-extent-end-position start-e) e start-e) (goto-char start) (while (search-forward "\n" end 0) (setnu-set-extent-endpoints e (setnu-extent-start-position e) (point)) (setq ee (setnu-make-setnu-extent (point) (point))) (setnu-set-extent-property e 'setnu-next-extent ee) (setnu-set-extent-property ee 'setnu-prev-extent e) (setq e ee new-lines (1+ new-lines))) (if ee (progn (setnu-set-extent-endpoints e (setnu-extent-start-position e) saved-end) (setnu-set-extent-property e 'setnu-next-extent saved-next) (and saved-next (setnu-set-extent-property saved-next 'setnu-prev-extent e)) (setq e (setnu-extent-property start-e 'setnu-next-extent) ee saved-next) (while ee (setnu-set-extent-begin-glyph e (setnu-extent-property ee setnu-begin-glyph-property)) (setnu-set-extent-property e 'line-number (setnu-extent-property ee 'line-number)) (setq e (setnu-extent-property e 'setnu-next-extent) ee (setnu-extent-property ee 'setnu-next-extent))) (setq n (1+ (string-to-int (setnu-extent-property (setnu-extent-property e 'setnu-prev-extent) 'line-number)))) (while e (setq numstr (format setnu-line-number-format n)) (setnu-set-extent-property e 'line-number numstr) (setnu-set-extent-begin-glyph e (setnu-number-glyph numstr)) (setq e (setnu-extent-property e 'setnu-next-extent) n (1+ n))))))) (store-match-data match-data))))) (defun setnu-number-glyph (number-string) (let ((sym (intern number-string setnu-glyph-obarray))) (if (boundp sym) (symbol-value sym) (let ((g (setnu-make-glyph number-string))) (set sym g) (setnu-set-glyph-face g setnu-line-number-face) g )))) (defun setnu-make-setnu-extent (beg end) "Create an extent and set some properties that all setnu extents have." (let ((e (setnu-make-extent beg end))) (setnu-set-extent-property e 'setnu t) ;; (setnu-set-extent-property e 'begin-glyph-layout 'outside-margin) (setnu-set-extent-property e 'detachable nil) (setnu-set-extent-property e 'evaporate nil) e )) (cond ((fboundp 'overlays-in) ;; expect to see this in 19.30 (defun setnu-extent-at (pos buf) "Finds the setnu extent at the position POS in the buffer BUF." (catch 'done (save-excursion (and buf (set-buffer buf)) (let ((o-list (overlays-in pos (1+ pos)))) (while o-list (if (overlay-get (car o-list) 'setnu) (throw 'done (car o-list))) (setq o-list (cdr o-list))) nil ))))) ((fboundp 'overlays-at) (defun setnu-extent-at (pos buf) "Finds the setnu extent at the position POS in the buffer BUF." (catch 'done (save-excursion (and buf (set-buffer buf)) (let ((o-list (overlays-at pos)) o-lists) ;; search what overlays-at returns first. for all ;; but zero length extents this will return the ;; extent we want. (while o-list (if (overlay-get (car o-list) 'setnu) (throw 'done (car o-list))) (setq o-list (cdr o-list))) ;; No luck. Search the lists returned by ;; overlay-lists. Use overlays-recenter so we only ;; have to search the `before' lobe of the return ;; value. (overlay-recenter (1- pos)) (setq o-lists (overlay-lists)) (setq o-list (cdr o-lists)) (while o-list (if (and (overlay-get (car o-list) 'setnu) (or (and (= pos (overlay-start (car o-list))) (= pos (overlay-end (car o-list)))) (and (>= pos (overlay-start (car o-list))) (< pos (overlay-end (car o-list)))))) (throw 'done (car o-list))) (setq o-list (cdr o-list))) nil ))))) ((fboundp 'map-extents) (defun setnu-extent-at (pos buf) "Finds the setnu extent at the position POS in the buffer BUF." (map-extents (function (lambda (e maparg) (if (setnu-extent-property e 'setnu) e nil))) buf pos pos))) (t (error "can't find overlays-in, overlays-at, or map-extents!"))) (defun setnu-extent-at-create (pos buf) "Like `setnu-extent-at' except if an extent isn't found, then it is created based on where the extent failed to be found." (let ((e (setnu-extent-at pos buf)) ee beg numstr) (if e e ;; no extent found so one must be created. (save-excursion (goto-char pos) (beginning-of-line) (setq e (setnu-extent-at (point) buf)) (cond (e ;; found one. extend it to cover this whole line. ;; this takes care of zero length extents that ;; might exist at bob or eob that can't be ;; inserted into. (setq beg (point)) (forward-line 1) (setnu-set-extent-endpoints e beg (point)) e ) ((bobp) ;; we are at bob and there's no extent. ;; ;; this is because the extent that was there got ;; detached because all the text in the buffer was ;; deleted. so we create a new extent and make it ;; contain the whole buffer, since there can be no ;; other attached extents. (setq e (setnu-make-setnu-extent (point-min) (point-max)) numstr (format setnu-line-number-format 1)) (setnu-set-extent-property e 'line-number numstr) (setnu-set-extent-begin-glyph e (setnu-number-glyph numstr)) (setq setnu-start-extent e) e ) (t ;; we must be at eob and there's no extent. ;; ;; this is because the extent that was there ;; shrank to zero length and was detached. create ;; a new extent that contains all text from point ;; to pos. (setq e (setnu-make-setnu-extent (point) pos)) (setq ee (setnu-extent-at (1- (point)) buf)) (setnu-set-extent-property e 'setnu-prev-extent ee) (setnu-set-extent-property ee 'setnu-next-extent e) (setq numstr (format setnu-line-number-format (1+ (string-to-int (setnu-extent-property ee 'line-number))))) (setnu-set-extent-property e 'line-number numstr) (setnu-set-extent-begin-glyph e (setnu-number-glyph numstr)) e )))))) (add-hook 'before-change-functions 'setnu-before-change-function) (add-hook 'after-change-functions 'setnu-after-change-function)