home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / h / hscroll.zip / HSCROLL.EL next >
Lisp/Scheme  |  1993-03-25  |  7KB  |  206 lines
  1. ;;; hscroll.el: Minor mode to automatically scroll truncated lines horizontally
  2. ;;; Copyright (C) 1992 Wayne Mesard
  3. ;;;
  4. ;;; This program is free software; you can redistribute it and/or modify
  5. ;;; it under the terms of the GNU General Public License as published by
  6. ;;; the Free Software Foundation; either version 1, or (at your option)
  7. ;;; any later version.
  8. ;;;
  9. ;;; This program is distributed in the hope that it will be useful,
  10. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. ;;; GNU General Public License for more details.
  13. ;;;
  14. ;;; The GNU General Public License is available by anonymouse ftp from
  15. ;;; prep.ai.mit.edu in pub/gnu/COPYING.  Alternately, you can write to
  16. ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,
  17. ;;; USA.
  18. ;;--------------------------------------------------------------------
  19.  
  20. ;;; DESCRIPTION
  21. ;;    Automatically scroll horizontally when the point moves off the
  22. ;;    left or right edge of the window.  Type "M-x hscroll-mode" to
  23. ;;    invoke it in the current buffer.  This only has effect when
  24. ;;    the current line is truncated by Emacs.  Say "Control-h f 
  25. ;;    hscroll-truncate-lines" for details.
  26. ;;
  27. ;;    HScroll's sensitivity is controlled by the variable hscroll-margin.
  28. ;;    How much HScroll adjusts the window is determined by hscroll-step.
  29. ;;
  30. ;;    Most users won't have to mess with the other variables and functions 
  31. ;;    defined here.  But they're all documented, and they all start with 
  32. ;;    "hscroll-" if you're curious.
  33. ;;
  34. ;;    Oh, you should also know that if you set the hscroll-margin and
  35. ;;    hscroll-step large enough, you can get an interesting, but
  36. ;;    undesired ping-pong effect as the point bounces from one edge to
  37. ;;    the other.
  38. ;;
  39. ;;    WMesard@cs.stanford.edu
  40.  
  41. ;;; HISTORY
  42. ;;    1.1 wmesard - Aug 18, 1992: Fixed setq-default bug
  43. ;;    1.0 wmesard - Aug 11, 1992: Created
  44.  
  45. ;;  LCD Archive Entry:
  46. ;;  hscroll|Wayne Mesard|wmesard@cs.stanford.edu|
  47. ;;  Minor mode to automatically scroll horizontally|
  48. ;;  92-11-11|1.1|~/modes/hscroll.el.Z|
  49.  
  50.  
  51. ;;; 
  52. ;;; PUBLIC VARIABLES
  53. ;;; 
  54.  
  55. (defvar hscroll-margin 5 
  56.   "*How many columns away from the edge of the window point is allowed to get
  57. before HScroll will horizontally scroll the window.")
  58.  
  59. (defvar hscroll-step 25
  60.   "*How far away to place the point from the window's edge when scrolling.
  61. Expressed as a percentage of the window's width.")
  62.  
  63. (defvar hscroll-poll-period "1"
  64.   "*Interval between polling for HScroll mode (in seconds).
  65. This is how often HScroll will test to see if the point has exceeded
  66. a horizontal margin.  If nil, it will test continuously (but this is
  67. not recommended, since it will slow down your machine and annoy Emacs).")
  68.  
  69. (defvar hscroll-mode nil 
  70.   "Whether hscroll-mode is enabled for the current buffer.
  71. Ordinarily set indirectly (via \\[hscroll-mode]).  However,
  72.    (setq-default hscroll-mode t)
  73. will put buffers in HScroll mode by default.  Automatically becomes local
  74. when set.")
  75.  
  76.  
  77. ;;; 
  78. ;;; PRIVATE VARIABLES
  79. ;;; 
  80.  
  81. (defvar hscroll-process nil)
  82.  
  83. ;;; 
  84. ;;; PUBLIC FUNCTIONS
  85. ;;; 
  86.  
  87. (defun hscroll-mode (&optional onoff)
  88.   "Toggle HScroll mode in the current buffer.
  89. With arg, turn HScroll mode on if arg is positive, off otherwise.
  90. In HScroll mode, truncated lines will automatically scroll left or right
  91. when point gets near either edge of the window."
  92.   (interactive "P")
  93.   (if (null hscroll-process)
  94.       (progn
  95.     (make-variable-buffer-local 'hscroll-mode)
  96.     ;; So that the last line in this func will do the right thing
  97.     ;; when default value is t and this is the first buffer.
  98.     (setq hscroll-mode nil)
  99.     (or (assq 'hscroll-mode minor-mode-alist)
  100.         (setq minor-mode-alist
  101.           (cons '(hscroll-mode " HScr")
  102.             minor-mode-alist)))
  103.     (setq hscroll-process (start-process "hscroll" nil
  104.                          (concat exec-directory "wakeup")
  105.                          (or hscroll-poll-period
  106.                          "0")))
  107.     (set-process-sentinel hscroll-process 'hscroll-sentinel)
  108.     (set-process-filter hscroll-process 'hscroll-filter)
  109.     (process-kill-without-query hscroll-process)
  110.     ))
  111.   (setq hscroll-mode (if onoff
  112.              (> (if (numberp onoff) onoff
  113.                   (prefix-numeric-value onoff))
  114.                 0)
  115.                (not hscroll-mode))
  116.     ))
  117.  
  118.  
  119. (defun hscroll-shutdown ()
  120.   "Disable HScroll mode in all buffers, and terminate the HScroll subprocess.
  121. This command is an \"emergency switch\" for use if the subprocess starts
  122. hogging up too many system resources."
  123.   (interactive)
  124.   (or (assq 'hscroll-mode minor-mode-alist)
  125.       (setq minor-mode-alist
  126.         (cons '(hscroll-mode "")
  127.           minor-mode-alist)))
  128.   (if (eq 'run (process-status hscroll-process))
  129.       (kill-process hscroll-process))
  130.   (setq hscroll-process nil)
  131.   )
  132.  
  133.  
  134. (defun hscroll-truncate-lines (&optional onoff)
  135.   "Toggle the value of the Emacs variable truncate-lines in the current buffer.  
  136. With arg, set to t if arg is positive, nil otherwise.  This is just a
  137. convenience function and not really part of HScroll.  Without it, you'd
  138. have to use set-variable to change the value of truncate-lines.
  139.  
  140. Say \\[describe-variable] truncate-lines and \\[describe-variable] \
  141. truncate-partial-width-windows for details."
  142.   (interactive "P")
  143.   (setq truncate-lines (if onoff
  144.                (> (if (numberp onoff) onoff 
  145.                 (prefix-numeric-value onoff))
  146.                   0)
  147.              (not truncate-lines))
  148.     ))
  149.  
  150.  
  151. (defun hscroll-window-maybe ()
  152.   "Scroll horizontally if point is off or nearly off the edge of the window.
  153. This is called automatically when in HScroll mode, but it can be explicitly
  154. invoked as well."
  155.   (interactive)
  156.   ;; Only consider scrolling if truncate-lines is true, 
  157.   ;; the window is already scrolled or partial-widths is true and this is
  158.   ;; a partial width window.  See display_text_line() in xdisp.c.
  159.   (if (or truncate-lines
  160.       (not (zerop (window-hscroll)))
  161.       (and truncate-partial-width-windows
  162.            (< (window-width) (screen-width))))
  163.       (let ((linelen (save-excursion (end-of-line) (current-column)))
  164.         (rightmost-char (+ (window-width) (window-hscroll)))
  165.         )
  166.     (if (>= (current-column)
  167.         (- rightmost-char hscroll-margin
  168.            ;; Off-by-one if the left edge is scrolled
  169.            (if (not (zerop (window-hscroll))) 1 0)
  170.            ;; Off by one if the right edge is scrolled
  171.            (if (> linelen rightmost-char) 1 0)))
  172.         ;; Scroll to the left a proportion of the window's width.
  173.         (set-window-hscroll 
  174.          (selected-window) 
  175.          (- (+ (current-column) 
  176.            (/ (* (window-width) hscroll-step) 100))
  177.         (window-width)))
  178.       (if (< (current-column) (+ (window-hscroll) hscroll-margin))
  179.           ;; Scroll to the right a proportion of the window's width.
  180.           (set-window-hscroll
  181.            (selected-window)
  182.            (- (current-column) (/ (* (window-width) hscroll-step) 100)))
  183.         ))
  184.     )))
  185.  
  186.  
  187. ;;; 
  188. ;;; PRIVATE FUNCTIONS
  189. ;;; 
  190.  
  191. (defun hscroll-filter (ignore ignore)
  192.   ;; Don't even bother if we're not in the mode.
  193.   (if hscroll-mode
  194.       (hscroll-window-maybe)))
  195.  
  196.  
  197. (defun hscroll-sentinel (ignore reason)
  198.   (hscroll-shutdown)
  199.   (error "Whoa: the HScroll process died unexpectedly: %s." reason))
  200.  
  201.  
  202. ------- End of Forwarded Message
  203.  
  204.  
  205.  
  206.