home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / line+.el < prev    next >
Encoding:
Text File  |  1993-03-03  |  14.7 KB  |  426 lines
  1. ;------------------------------------------------------------;
  2. ; line+.el
  3. ;
  4. ; version 1.1
  5. ;
  6. ; This has not (yet) been accepted by the Emacs Lisp archive,
  7. ; but if it is the archive entry will probably be something like this:
  8.  
  9. ;; LCD Archive Entry:
  10. ;; line+|Neil Jerram|nj104@cus.cam.ac.uk|
  11. ;; Line numbering and interrupt driven actions.|
  12. ;; 1993-02-18|1.1|~/misc/line+.el.Z|
  13.  
  14. ; Mished and mashed by Neil Jerram <nj104@cus.cam.ac.uk>,
  15. ; Monday 21 December 1992.
  16. ; Copyright (C) 1993 Neil Jerram.
  17. ;
  18. ; Horizontal scrolling code is by Wayne Mesard <WMesard@cs.stanford.edu>,
  19. ; Copyright (C) 1992 Wayne Mesard.
  20.  
  21. ;;; This program is free software; you can redistribute it and/or modify
  22. ;;; it under the terms of the GNU General Public License as published by
  23. ;;; the Free Software Foundation; either version 1, or (at your option)
  24. ;;; any later version.
  25. ;;;
  26. ;;; This program is distributed in the hope that it will be useful,
  27. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  28. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  29. ;;; GNU General Public License for more details.
  30. ;;;
  31. ;;; The GNU General Public License is available by anonymous ftp from
  32. ;;; prep.ai.mit.edu in pub/gnu/COPYING.  Alternately, you can write to
  33. ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,
  34. ;;; USA.
  35.  
  36. ; A mix'n'match of linenumbers.el by Ajay Shekhawat
  37. ;              and hscroll.el by Wayne Mesard
  38. ;
  39. ; OR...
  40. ;
  41. ; ``If it's acceptable to have 1 second polling for horizontal scroll
  42. ;   checking, then why not do line numbers the easy way ?''
  43. ;
  44. ; USAGE:
  45. ;
  46. ; `M-x linenumbers' to toggle line numbering in the current buffer.
  47. ;
  48. ; `M-x linenumbers-shutdown' to kill the external process and turn off
  49. ;                            line numbering in all buffers.
  50. ;
  51. ; `M-x ln-start-process' to start/restart the external process
  52. ;                        (perhaps with a new polling period).
  53. ;
  54. ; `M-x linenumbers-all-buffers' to switch on line numbering in all
  55. ;                               future buffers.
  56. ;
  57. ; `C-u M-x linenumbers-all-buffers' to switch on line numbering in all
  58. ;                                   future and existing buffers.
  59. ;                                   
  60. ; `M-x linenumbers-in-certain-modes' to switch on line numbering in all
  61. ;                                    future buffers whose major mode is
  62. ;                                    represented in the variable
  63. ;                                    `ln-mode-hook-list'
  64. ;
  65. ; INSTALLATION EXAMPLES (in your `.emacs' file):
  66. ;
  67. ; (1) Loading code upon starting Emacs:
  68. ;
  69. ; ; either
  70. ; (load "line+")
  71. ; ; if the file `line+.el' lies in your `load-path',
  72. ; ; or, for example,
  73. ; (load "/home/neil/emacs-lisp/line+")
  74. ; ; followed by
  75. ; ; any changes to the default values of `ln-format',
  76. ; ; `ln-format-options', `ln-mode-hook-list',
  77. ; ; followed by
  78. ; ; either
  79. ; (linenumbers-all-buffers t)
  80. ; ; or
  81. ; (linenumbers-in-certain-modes)
  82. ; ; according to your preference.
  83. ;
  84. ; (2) Autoloading the code upon invocation of `M-x linenumbers':
  85. ;
  86. ; ; either
  87. ; (autoload 'linenumbers "line+"
  88. ;           "Switch on line numbers in the current buffer." t)
  89. ; ; or
  90. ; (autoload 'linenumbers "/home/neil/emacs-lisp/line+"
  91. ;           "Switch on line numbers in the current buffer." t)
  92. ; ; depending on your `load-path' as in (1).
  93.  
  94. (provide 'line+)
  95.  
  96. ; ----------------
  97. ; Public variables
  98. ; ----------------
  99.  
  100. (defvar ln-format " l.%l%h"
  101.   "*A string describing what information is presented in the mode line.
  102. Percentage constructs in this string cause substitution of the
  103. relevant information.  The currently understood options are:
  104.  
  105.     %l    insert current line number (within current restriction)
  106.     %m    insert current line number (after widening any restrictions)
  107.     %c    insert current column
  108.     %t    insert the 24hr clock time in format hh:mm:ss
  109.     %h    scrolls window horizontally when necessary, inserts nothing
  110.     %H    scrolls window horizontally when necessary and
  111.         inserts the left margin offset
  112.     %%    insert `%'
  113.  
  114. Further options may be defined by adding to the variable
  115. `ln-format-options'.")
  116.  
  117. ; My thanks to John M. Klassa for spurring me on to extend `ln-format'
  118. ; in this way.
  119.  
  120. ; As an example of alternative formats, you might write
  121. ;  (setq ln-format "-= line %l column %c =-")
  122. ; in your `.emacs' file after the instruction to load in the lisp code.
  123. ; The code as it stands does not allow the format to be different in
  124. ; different buffers, but you can achieve this if you want it by adding
  125. ;  (make-variable-buffer-local 'ln-format)
  126. ; in your `.emacs' file.
  127. ;   Changes to ln-format will not carry into other buffers until they
  128. ; become active (even 'though they may be visible in another window).
  129. ; This could be remedied, by making ln-filter cycle through all existing
  130. ; buffers every time it gets a signal from "Wakeup!", but I don't
  131. ; really think it's worth it.
  132.  
  133. (defvar ln-format-options (list (list "%l" "%d" '(ln-which-line))
  134.                 (list "%m" "%d" '(save-restriction
  135.                            (widen)
  136.                            (ln-which-line)))
  137.                 (list "%c" "%d" '(1+ (current-column)))
  138.                 (list "%t" "%s" '(ln-time))
  139.                 (list "%h" "" '(hscroll-window-maybe))
  140.                 (list "%H" "%d" '(hscroll-window-maybe)))
  141.   "This variable is a list, each of whose elements looks like
  142. (list FORMAT-LN-TYPE FORMAT-C-TYPE LISP-FORM).
  143.   FORMAT-LN-TYPE is the percentage string that should appear
  144. in `ln-format', e.g. \"%l\" in `ln-format' means include the
  145. current line number.
  146.   FORMAT-C-TYPE describes the way that the information should
  147. be inserted into the printed string, e.g. as a decimal number \"%d\"
  148. or as a string \"%s\" (the %'s here are as understood by `format').
  149.   LISP-FORM is the lisp expression that should be evaluated to
  150. produce the relevant information.")
  151.  
  152. (defvar ln-poll-period "1"
  153.   "*Interval between checking the current line number (in seconds).
  154. If nil, it will test continuously (but this is not recommended, 
  155. since it will slow down your machine and annoy Emacs).")
  156.  
  157. (defvar ln-mode nil 
  158.   "*Whether ln-mode is enabled for the current buffer.
  159. Ordinarily set indirectly (via \\[linenumbers]).")
  160. (make-variable-buffer-local 'ln-mode)
  161.  
  162. ; ----------------
  163. ; Public functions
  164. ; ----------------
  165.  
  166. (defun linenumbers (&optional onoff)
  167.   "Toggle line+ mode in the current buffer.
  168. With arg, turn line+ mode on if arg is positive, off otherwise."
  169.   (interactive "P")
  170.   (setq ln-mode (if onoff
  171.             (> (prefix-numeric-value onoff) 0)
  172.           (not ln-mode)))
  173.   (or ln-mode
  174.       (setq ln-string ""))
  175.   (and ln-mode
  176.        (null ln-process)
  177.        (ln-start-process)))
  178.  
  179. (defun linenumbers-shutdown ()
  180.   "Disable line+ mode in all buffers, and terminate 
  181. the line+ subprocess.  This command is an \"emergency switch\"
  182. for use if the subprocess starts hogging up too many system resources."
  183.   (interactive)
  184.   (ln-kill-process-quietly ln-process)
  185.   (setq ln-process nil)
  186.   (let* ((buffers (buffer-list))
  187.      (i (length buffers)))
  188.     (while (>= (setq i (1- i)) 0)
  189.       (set-buffer (nth i buffers))
  190.       (linenumbers -1))))
  191.  
  192. (defun linenumbers-all-buffers (arg)
  193.   "Set up for line numbering to come on in all buffers.
  194. Explicitly sets ln-mode to t everywhere if ARG is given."
  195.   (interactive "P")
  196.   (setq-default ln-mode t)
  197.   (if arg
  198.       (let* ((buffers (buffer-list))
  199.          (i (length buffers)))
  200.     (while (>= (setq i (1- i)) 0)
  201.       (set-buffer (nth i buffers))
  202.       (setq ln-mode t))))
  203.   (ln-start-process))
  204.  
  205. (defun linenumbers-in-certain-modes ()
  206.   "Set up for line numbering in certain major modes."
  207.   (interactive)
  208.   (ln-modify-mode-hooks ln-mode-hook-list))
  209.  
  210. (defun ln-start-process ()
  211.   "Starts (or restarts) the \"wakeup\" process for line+ mode."
  212.   (interactive)
  213.   (ln-kill-process-quietly ln-process)
  214.   (let ((process-connection-type nil))
  215.     (setq ln-process (start-process "line+" nil
  216.                     (concat exec-directory "wakeup")
  217.                     (or ln-poll-period "0"))))
  218.   (set-process-sentinel ln-process 'ln-sentinel)
  219.   (set-process-filter ln-process 'ln-filter)
  220.   (process-kill-without-query ln-process))
  221.  
  222. ; ---------
  223. ; Internals
  224. ; ---------
  225.  
  226. (defvar ln-string nil
  227.   "String printed in the mode line describing the current line number.")
  228. (make-variable-buffer-local 'ln-string)
  229.  
  230. (defvar ln-process nil
  231.   "Variable holding the line+ process object.")
  232.  
  233. (defun ln-modify-mode-line-format ()
  234.   "Modify the mode-line-format to insert the line number after
  235. mode-line-buffer-identification."
  236.   (or (memq 'ln-string mode-line-format)
  237.       (let ((mlbi (memq 'mode-line-buffer-identification 
  238.             mode-line-format)))
  239.     (if mlbi
  240.         (setq mode-line-format
  241.           (append (reverse (memq 'mode-line-buffer-identification
  242.                      (reverse mode-line-format)))
  243.               '(ln-string)
  244.               (cdr mlbi)))))))
  245.  
  246.  
  247. (defun ln-kill-process-quietly (proc)
  248.   "Turns off filter and sentinel before killing the process PROC."
  249.   (and (processp proc)
  250.        (eq (process-status proc) 'run)
  251.        (progn
  252.      (set-process-filter proc nil)
  253.      (set-process-sentinel proc nil)
  254.      (kill-process proc))))
  255.  
  256. (defun ln-which-line ()
  257.   "Returns the current line number, counting from 1."
  258.   (1+ (count-lines (point-min)
  259.            (save-excursion (beginning-of-line) (point)))))
  260.  
  261. (defun ln-time ()
  262.   "Returns a string describing the time."
  263.   (let* ((cts (current-time-string))
  264.      (col (string-match ":" cts)))
  265.     (substring cts (- col 2) (+ col 6))))
  266.   
  267. (defun ln-make-ln-string (format)
  268.   (let (ppos
  269.     format-ln-type
  270.     format-option
  271.     (string nil))
  272.     (while (setq ppos (string-match "%" format))
  273.       (setq string (concat string (substring format 0 ppos))
  274.         format (substring format ppos)
  275.         format-ln-type (substring format 0 2)
  276.         format (substring format 2))
  277.       (cond
  278.        ((string= format-ln-type "%%")
  279.     (setq string (concat string "%")))
  280.        ((setq format-option (assoc format-ln-type ln-format-options))
  281.     (setq string (concat string (format (nth 1 format-option)
  282.                         (save-restriction
  283.                           (eval (nth 2 format-option)))))))
  284.        (t
  285.     (setq string (concat string format-ln-type)))))
  286.     (concat string format)))
  287.  
  288. (defun ln-filter (ignore ignore)
  289.   ;; Don't even bother if we're not in the mode.
  290.   (if ln-mode
  291.       (progn
  292.     (setq ln-string (ln-make-ln-string ln-format))
  293.     (ln-modify-mode-line-format))))
  294.  
  295. (defun ln-sentinel (ignore reason)
  296.   (linenumbers-shutdown)
  297.   (error "Whoa: the line+ process died unexpectedly: %s." reason))
  298.  
  299. ; ------------------------------------------------------------------
  300. ; Additions to persuade line numbers to appear only in certain modes
  301. ; ------------------------------------------------------------------
  302.  
  303. (defun linenumbers-1 ()
  304.   (linenumbers 1))
  305.  
  306. (defun ln-existify (sym)
  307.   "Give symbol SYM a value of nil if it isn't already bound."
  308.   (or (boundp sym)
  309.       (set sym nil)))
  310.  
  311. (defun ln-modify-mode-hooks (hooklist)
  312.   "Add a function to turn on line numbering to each of the
  313. major mode hooks (symbols) listed in HOOKLIST."
  314.   (let ((i (length hooklist))
  315.     hooksym
  316.     hookval)
  317.     (while (>= (setq i (1- i)) 0)
  318.       (setq hooksym (nth i hooklist))
  319.       (ln-existify hooksym)
  320.       (setq hookval (symbol-value hooksym))
  321.       (or (listp hookval)
  322.       (setq hookval (list hookval)))
  323.       (or (memq 'linenumbers-1 hookval)
  324.       (set hooksym (cons 'linenumbers-1 hookval))))))
  325.  
  326. (defvar ln-mode-hook-list (list 'fortran-mode-hook
  327.                 'c-mode-hook
  328.                 'emacs-lisp-mode-hook
  329.                 'TeX-mode-hook
  330.                 'lisp-mode-hook)
  331.   "List of mode hooks which should be modified to insert
  332. a command for switching line numbers on.")
  333.  
  334. ; --------------------------------------------------
  335. ; Horizontal scrolling code, written by Wayne Mesard
  336. ; Copyright (C) 1992 Wayne Mesard
  337. ; --------------------------------------------------
  338.  
  339. ;;; DESCRIPTION
  340. ;;    Automatically scroll horizontally when the point moves off the
  341. ;;    left or right edge of the window.  Include "%h" in the value of
  342. ;;    `ln-format' to enable automatic horizontal scrolling.
  343. ;;    This only has effect when the current line is truncated by Emacs.
  344. ;;    Say "Control-h f hscroll-truncate-lines" for details.
  345. ;;
  346. ;;    HScroll's sensitivity is controlled by the variable hscroll-margin.
  347. ;;    How much HScroll adjusts the window is determined by hscroll-step.
  348. ;;
  349. ;;    Most users won't have to mess with the other variables and functions 
  350. ;;    defined here.  But they're all documented, and they all start with 
  351. ;;    "hscroll-" if you're curious.
  352. ;;
  353. ;;    Oh, you should also know that if you set the hscroll-margin and
  354. ;;    hscroll-step large enough, you can get an interesting, but
  355. ;;    undesired ping-pong effect as the point bounces from one edge to
  356. ;;    the other.
  357. ;;
  358. ;;    WMesard@cs.stanford.edu
  359.  
  360. (defvar hscroll-margin 5 
  361.   "*How many columns away from the edge of the window point is allowed to get
  362. before HScroll will horizontally scroll the window.")
  363.  
  364. (defvar hscroll-step 25
  365.   "*How far away to place the point from the window's edge when scrolling.
  366. Expressed as a percentage of the window's width.")
  367.  
  368. (defun hscroll-truncate-lines (&optional onoff)
  369.   "Toggle the value of the Emacs variable truncate-lines in the current buffer.  
  370. With arg, set to t if arg is positive, nil otherwise.  This is just a
  371. convenience function and not really part of HScroll.  Without it, you'd
  372. have to use set-variable to change the value of truncate-lines.
  373.  
  374. Say \\[describe-variable] truncate-lines and \\[describe-variable] \
  375. truncate-partial-width-windows for details."
  376.   (interactive "P")
  377.   (setq truncate-lines (if onoff
  378.                (> (if (numberp onoff) onoff 
  379.                 (prefix-numeric-value onoff))
  380.                   0)
  381.              (not truncate-lines))
  382.     ))
  383.  
  384. (defun hscroll-window-maybe ()
  385.   "Scroll horizontally if point is off or nearly off the edge of the window.
  386. This is called automatically when \"%h\" or \"%H\" is included in the variable
  387. `ln-format', but it can be explicitly invoked as well.  This function
  388. returns the left margin offset, which will be inserted in the string
  389. displayed in the mode line if invoked via \"%H\"."
  390.   (interactive)
  391.   ;; Only consider scrolling if truncate-lines is true, 
  392.   ;; the window is already scrolled or partial-widths is true and this is
  393.   ;; a partial width window.  See display_text_line() in xdisp.c.
  394.   (if (or truncate-lines
  395.       (not (zerop (window-hscroll)))
  396.       (and truncate-partial-width-windows
  397.            (< (window-width) (screen-width))))
  398.       (let ((linelen (save-excursion (end-of-line) (current-column)))
  399.         (rightmost-char (+ (window-width) (window-hscroll)))
  400.         )
  401.     (if (>= (current-column)
  402.         (- rightmost-char hscroll-margin
  403.            ;; Off-by-one if the left edge is scrolled
  404.            (if (not (zerop (window-hscroll))) 1 0)
  405.            ;; Off by one if the right edge is scrolled
  406.            (if (> linelen rightmost-char) 1 0)))
  407.         ;; Scroll to the left a proportion of the window's width.
  408.         (set-window-hscroll 
  409.          (selected-window) 
  410.          (- (+ (current-column) 
  411.            (/ (* (window-width) hscroll-step) 100))
  412.         (window-width)))
  413.       (if (< (current-column) (+ (window-hscroll) hscroll-margin))
  414.           ;; Scroll to the right a proportion of the window's width.
  415.           (set-window-hscroll
  416.            (selected-window)
  417.            (- (current-column) (/ (* (window-width) hscroll-step) 100)))
  418.         ))
  419.     ))
  420.   (window-hscroll))
  421.  
  422. ; ---
  423. ; End
  424. ; ---
  425. ;------------------------------------------------------------;
  426.