emacs_el/tiny-tools/tiny/tinyscroll.el

   1 ;;; tinyscroll.el --- Enable or disable auto-scroll for any buffer.
   2
   3 ;; This file is not part of Emacs
   4
   5 ;;{{{ Id
   6
   7 ;; Copyright (C) 1996-2007 Jari Aalto
   8 ;; Keywords:     extensions
   9 ;; Author:       Jari Aalto
  10 ;; Maintainer:   Jari Aalto
  11 ;;
  12 ;; To get information on this program, call M-x tinyscroll-version.
  13 ;; Look at the code with folding.el.
  14
  15 ;; COPYRIGHT NOTICE
  16 ;;
  17 ;; This program is free software; you can redistribute it and/or modify it
  18 ;; under the terms of the GNU General Public License as published by the Free
  19 ;; Software Foundation; either version 2 of the License, or (at your option)
  20 ;; any later version.
  21 ;;
  22 ;; This program is distributed in the hope that it will be useful, but
  23 ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  24 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  25 ;; for more details.
  26 ;;
  27 ;; You should have received a copy of the GNU General Public License
  28 ;; along with program; see the file COPYING. If not, write to the
  29 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  30 ;; Boston, MA 02110-1301, USA.
  31 ;;
  32 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
  33
  34 ;;}}}
  35 ;;{{{ Install
  36
  37 ;; ....................................................... &t-install ...
  38 ;; Put this file on your Emacs-Lisp load path, add following into your
  39 ;; ~/.emacs startup file.
  40 ;;
  41 ;;    (require 'tinyscroll)
  42 ;;
  43 ;; or use autoload; your .emacs loads up a bit quicker. In this package
  44 ;; however the above method is preferred, since it automatically
  45 ;; marks *compilation* buffer for auto-scrolling. Using the autoload
  46 ;; puts the scroll in effect only when you add entry to scroll list
  47 ;; with M-x tinyscroll-control.
  48 ;;
  49 ;;    (autoload 'tinyscroll-control                  "tinyscroll" "" t)
  50 ;;    (autoload 'tinyscroll-list                     "tinyscroll" "" t)
  51 ;;    (autoload 'tinyscroll-timer-process-control    "tinyscroll" "" t)
  52 ;;    (eval-after-load "compile" '(require 'tinyscroll))
  53 ;;
  54 ;; To activate/deactivate scrolling for a buffer or to check list, call
  55 ;;
  56 ;;      M-x tinyscroll-control
  57 ;;      M-x tinyscroll-list
  58 ;;
  59 ;; To set default buffers to scroll, change this variable
  60 ;;
  61 ;;      tinyscroll-:list
  62 ;;
  63 ;; If you have any questions, use these functions
  64 ;;
  65 ;;      M-x tinyscroll-debug-toggle             to toggle the package debug.
  66 ;;      M-x tinyscroll-submit-bug-report      to send bug report
  67
  68 ;;}}}
  69
  70 ;;{{{ Documentation
  71
  72 ;; ..................................................... &t-commentary ...
  73 ;;; Commentary:
  74
  75 ;;  Preface, May 1996
  76 ;;
  77 ;;      I was in the middle of testing one of my new packages which didn't
  78 ;;      quite work as I wanted, I was loading all the lisp files to see if
  79 ;;      it breaks. I watched the *Message* buffer to fill with statements
  80 ;;
  81 ;;          Loading abbrev...
  82 ;;          Loading abbrev...done
  83 ;;          ...
  84 ;;          Loading rmail...
  85 ;;          loading rmail done...
  86 ;;          ...
  87 ;;
  88 ;;      But suddendly the emacs died. It kicked me off to the shell and I
  89 ;;      had no idea what package was the last one that got loaded.
  90 ;;
  91 ;;      You see, the *Message* buffer keeps growing, but you have to tap
  92 ;;      the pgDown key to get to the end, all the time. Instead I decided
  93 ;;      to pull out some lisp to do general auto-scrolling for any buffer,
  94 ;;      so that I can just sit back and watch the buffer move. No more
  95 ;;      guessing in *Message* buffer what was the last message before Emacs
  96 ;;      sunk :-)
  97 ;;
  98 ;;  Overview of features
  99 ;;
 100 ;;      o   Select buffer, and hit auto scroll on/off. You can scroll any
 101 ;;          buffer.
 102 ;;      o   All windows for the buffer are scrolled in all frames.
 103 ;;          If frame is miimized and contains window to sroll, frame will
 104 ;;          be maximized ("popped up")
 105 ;;      o   If buffer's point-max doesn't move, scroll is ignored.
 106 ;;      o   Default scroll activated for: *Compilation* *Grep* and *Messages*
 107 ;;
 108 ;;  How to use this package
 109 ;;
 110 ;;      The scroling here is based on timers, where the lowest interval can
 111 ;;      be one 1 second. This means that you don't get smooth and
 112 ;;      continuous scrolling, but regular update of the buffer, which may
 113 ;;      in rare cases seem jerky. However, using timers is the only
 114 ;;      possibility if we want to have general scroll utility for *any* buffer.
 115 ;;
 116 ;;      To enable/disable auto-scroll for current buffer, use these:
 117 ;;
 118 ;;          M-x tinyscroll-control              ;to activate scroll
 119 ;;          C-u M-x tinyscroll-control  ;to deactivate scroll
 120 ;;
 121 ;;  Lowest window of the same buffer always scrolls
 122 ;;
 123 ;;      It is an interesting problem, when you have SAME buffer in multiple
 124 ;;      windows, to decide which window to scroll.  I didn't want to scroll
 125 ;;      all windows, since otherwise I wouldn't have used two/or more
 126 ;;      windows for the same buffer.
 127 ;;
 128 ;;      I decided that the lowest window for the buffer always scrolls. You
 129 ;;      can't change that. This was a design decision and I won't support
 130 ;;      scrolling middle/upper buffers. Just arrange your windows so that
 131 ;;      the scrolling one goes to the bottom.
 132
 133 ;;}}}
 134
 135 ;;; Change Log:
 136
 137 ;;; Code:
 138
 139 ;;{{{ setup: libraries
 140
 141 (require 'tinylibm)
 142
 143 (eval-and-compile
 144   (ti::package-package-require-timer))
 145
 146 (eval-when-compile (ti::package-use-dynamic-compilation))
 147
 148 (ti::package-defgroup-tiny TinyScroll tinyscroll-: extensions
 149   "Enable or Disable autos-croll for any buffer.
 150   Overview of features
 151
 152         o   Select buffer, and hit auto scroll on/off. You can scroll any
 153             buffer.
 154         o   If there are multiple windows for the same buffer, scroll only the
 155             bottom one. --> you can have \"permanent\" look window, while
 156             the buffer scrolls in other window.
 157         o   Smart scrolling: if buffer's point-max doesn't move, it ignores
 158             scrolling. This way you can browse buffer after there is
 159             no more output to window.
 160     ")
 161
 162 ;;}}}
 163 ;;{{{ setuo: public, user configurable
 164
 165 (defcustom tinyscroll-:load-hook nil
 166   "*Hook that is run when package is loaded."
 167   :type  'boolean
 168   :group 'TinyScroll)
 169
 170 (defcustom tinyscroll-:interval 3
 171   "*Interval in seconds when scrolling process activates.
 172 Must be bigger that 1."
 173   :type  'integer
 174   :group 'TinyScroll)
 175
 176 ;; Initalize this in tinyscroll-:load-hook if you want to have some
 177 ;; other default buffers at startup.
 178 (defcustom tinyscroll-:list
 179   '(
 180     ("*compilation*" . 1)               ;set this to auto scroll
 181     ("*grep*"        . 1)
 182     ("*igrep*"       . 1)
 183     ("*Messages*"    . 1))
 184   "*List of buffers  that have auto scroll active.
 185 Format: '((buffer-name-string . max-point) (BN . POINT) ..)"
 186   :type '(repeat
 187           (string :tag "buffer")
 188           (integer :tag "point"))
 189   :group 'TinyScroll)
 190
 191 ;;}}}
 192 ;;{{{ setup: private
 193
 194 (defvar tinyscroll-:tmp-buffer "*auto-scroll*"
 195   "Temporary buffer to display the active auto-scroll buffers.")
 196
 197 (defvar tinyscroll-:timer-elt nil
 198   "Timer process.")
 199
 200 ;;}}}
 201 ;;{{{ version
 202
 203 ;;;###autoload (autoload 'tinyscroll-version "tinyscroll" "Commentary." t)
 204 (eval-and-compile
 205   (ti::macrof-version-bug-report
 206    "tinyscroll.el"
 207    "tinyscroll"
 208    tinyscroll-:version-id
 209    "$Id: tinyscroll.el,v 2.41 2007/05/01 17:21:00 jaalto Exp $"
 210    '(tinyscroll-:version-id
 211      tinyscroll-:debug
 212      tinyscroll-:load-hook
 213      tinyscroll-:interval
 214      tinyscroll-:list
 215      tinyscroll-:tmp-buffer
 216      tinyscroll-:timer-elt)
 217    '(tinyscroll-:debug-buffer)))
 218
 219 ;;}}}
 220 ;;{{{ code: misc
 221
 222 ;;;### (autoload 'tinyscroll-debug-toggle "tinyscroll" "" t)
 223
 224 (eval-and-compile (ti::macrof-debug-standard "tinyscroll" "-:"))
 225
 226 ;;; ----------------------------------------------------------------------
 227 ;;;
 228 (defsubst tinyscroll-active-buffer-p (buffer-name)
 229   "Check is BUFFER-NAME name is in `tinyscroll-:list'."
 230   (assoc buffer-name tinyscroll-:list))
 231
 232 ;;; ----------------------------------------------------------------------
 233 ;;;
 234 (defsubst tinyscroll-add-1 (buffer-name position)
 235   "Add BUFFER-NAME and last POSITION to scroll list."
 236   (push (cons buffer-name position) tinyscroll-:list ))
 237
 238 ;;; ----------------------------------------------------------------------
 239 ;;;
 240 (defsubst tinyscroll-remove-1 (buffer-name)
 241   "Remove BUFFER-NAME from scroll list."
 242   (setq tinyscroll-:list (adelete 'tinyscroll-:list buffer-name)))
 243
 244 ;;; ----------------------------------------------------------------------
 245 ;;;
 246 (defsubst tinyscroll-point-max-moved-p (buffer-name max)
 247   "Find BUFFER-NAME; return t if MAX is not stored `point-max' for BUFFER-NAME.
 248 Also updates new `point-max' if MAX is different.
 249 If buffer does not exist, do nothing and return nil."
 250   (let* ((elt (tinyscroll-active-buffer-p buffer-name)))
 251     (tinyscroll-debug "Max-p check" elt buffer-name max "\n")
 252     (when (and elt (not (eq (cdr elt) max)))
 253       (setcdr elt max)
 254       max )))
 255
 256 ;;; ----------------------------------------------------------------------
 257 ;;;
 258 (defsubst tinyscroll-buffers ()
 259   "Return list of buffer that have auto scroll on."
 260   (mapcar 'car tinyscroll-:list))
 261
 262 ;;; ----------------------------------------------------------------------
 263 ;;;
 264 (defsubst tinyscroll-ti::temp-buffer ()
 265   "Set up temporary buffer and displays it."
 266   (ti::temp-buffer tinyscroll-:tmp-buffer 'clear)
 267   (pop-to-buffer  tinyscroll-:tmp-buffer) )
 268
 269 ;;; ----------------------------------------------------------------------
 270 ;;; if easier to trap "t" error condition.
 271 ;;;
 272 (defun tinyscroll-:list-add (buffer-name position &optional remove)
 273   "Check is BUFFER-NAME name is in 'tisc:-list'.
 274
 275 Input:
 276
 277   BUFFER-NAME   buffer name string
 278   POSITION      `point-max' in the buffer
 279   REMOVE        flag, remove buffer from list
 280
 281 Return:
 282
 283   nil           Yes, buffer is in list
 284   t             action not done"
 285   (let* ((exist (tinyscroll-active-buffer-p buffer-name))
 286          ret)
 287     (cond
 288      ((or (and remove           (null exist))
 289           (and (null remove)    exist))
 290       (setq ret t))
 291      (remove
 292       (tinyscroll-remove-1 buffer-name))
 293      (t
 294       (tinyscroll-add-1 buffer-name position)))
 295     ret))
 296
 297 ;;; ----------------------------------------------------------------------
 298 ;;;
 299 (defsubst tinyscroll-window-list ()
 300   "Return windows that have auto scroll enabled.
 301 Return:
 302    window list or nil"
 303   (let* (win
 304          win-list)
 305     (dolist (frame (frame-list))
 306       (dolist (buffer (tinyscroll-buffers))
 307         (if (setq win (get-buffer-window buffer frame))
 308             (push win win-list))))
 309     win-list))
 310
 311 ;;; ----------------------------------------------------------------------
 312 ;;;
 313 (defun tinyscroll-process ()
 314   "Scroll all window buffers in `tinyscroll-:list'.
 315 Activate This process activates itself only when the window, which
 316 should be scrolled, is visible"
 317   (let ((list   (tinyscroll-window-list))
 318         (oframe (selected-frame)))
 319     (when list                          ;if we bother to do anything?
 320       (dolist (win list)
 321         (ti::save-excursion-macro
 322           (set-buffer (window-buffer win))
 323           (tinyscroll-debug "tinyscroll-process: " (window-buffer win)
 324                             (buffer-name) (point-max) "\n")
 325
 326           ;;  Scrolling in fact means that, the point-max is
 327           ;;  always visible
 328           (select-window win)
 329           (when (tinyscroll-point-max-moved-p (buffer-name) (point-max))
 330             (ti::pmax) )))
 331       (select-frame oframe))
 332     nil))
 333
 334 ;;}}}
 335 ;;{{{ code: interactive
 336
 337 ;;; ----------------------------------------------------------------------
 338 ;;;
 339 ;;;###autoload
 340 (defun tinyscroll-timer-process-control (&optional delete verb)
 341   "Keep the auto scroll process and timer process alive.
 342 Optionally DELETE auto scroll process. VERB."
 343   (interactive "P")
 344   (setq tinyscroll-:timer-elt
 345         (ti::compat-timer-control "1 sec"
 346                                   tinyscroll-:interval
 347                                   'tinyscroll-process
 348                                   delete
 349                                   verb)))
 350
 351 ;;; ---------------------------------------------------7-------------------
 352 ;;;
 353 ;;;###autoload
 354 (defun tinyscroll-list (&optional print)
 355   "Show list of active auto scroll buffers.
 356 Buffers are listed inecho-area if they fit there, otherwise in separate buffer.
 357
 358 If optional PRINT flag is non-nil, always generate report to temporary buffer.
 359 If list if empty, do nothing.
 360
 361 Return:
 362
 363  t      report generated to temporary buffer
 364  nil    no report"
 365   (interactive)
 366   (let* ((str   (ti::list-to-string (mapcar 'car tinyscroll-:list)))
 367          (verb  (interactive-p))
 368          ret)
 369     (if (and (string= str "")  verb)
 370         (message "TinyScroll: no entries in `tinyscroll-:list'.")
 371       (setq ret t)
 372       (cond
 373        ((and (null print)
 374              (< (length str) 80))
 375         (message str))
 376        (t
 377         (tinyscroll-ti::temp-buffer)
 378         (insert (ti::list-to-string tinyscroll-:list "\n"))
 379         (setq buffer-read-only t)
 380         (shrink-window-if-larger-than-buffer))))
 381     ret))
 382
 383 ;;}}}
 384 ;;{{{ code: main
 385
 386 ;;; ----------------------------------------------------------------------
 387 ;;; - It's a bit slow to create buffer comletions this way.
 388 ;;;   Anybody has a better suggestion to amulate "bBuffer"
 389 ;;;   interactive tag? Mail me if you know...
 390 ;;;
 391 ;;;   But I couldn't get the on/off information to the prompt
 392 ;;;   otherwise.
 393 ;;;
 394 ;;;###autoload
 395 (defun tinyscroll-control (buffer-or-pointer &optional off verb)
 396   "Turn on auto scroll on/off for current buffer.
 397 If this command is called from `tinyscroll-:tmp-buffer' then the current
 398 word in the line is read and offered for default buffer name.
 399
 400 Input:
 401
 402   BUFFER-OR-POINTER     buffer to scroll
 403   OFF                   flag, prefix arg; is non-nil turn scrolling off
 404   VERB                  flag, allow verbose messages."
 405   (interactive
 406    (list
 407     (completing-read
 408      (format "Scroll [%s] buffer: " (if current-prefix-arg "off" "on"))
 409      (ti::list-to-assoc-menu
 410       (ti::dolist-buffer-list (string-match "." (buffer-name))))
 411      nil
 412      nil
 413      ;; Default buffer ...
 414      (if (string= (buffer-name) tinyscroll-:tmp-buffer)
 415          (ti::read-current-line)
 416        (buffer-name))) ;; completing-read
 417     current-prefix-arg))
 418   (let* ((bufferp       (if (bufferp buffer-or-pointer)
 419                             buffer-or-pointer
 420                           (get-buffer buffer-or-pointer)))
 421          buffern
 422          msg)
 423     (ti::verb)
 424     ;;  Check non-interactive errors
 425     (if (or (null bufferp)
 426             (not (buffer-live-p (get-buffer bufferp))))
 427         (error "Invalid arg, buffer %s" bufferp))
 428     (setq buffern (buffer-name bufferp))
 429     (if off
 430         (if (tinyscroll-:list-add buffern 0 'remove)
 431             (setq msg "TinyScroll: buffer already removed."))
 432       ;;  Keep the process alive all the time
 433       (tinyscroll-timer-process-control)
 434       (save-excursion
 435         ;;  We have to record the point-max
 436         (set-buffer buffern)
 437         (if (tinyscroll-:list-add buffern (point-max))
 438             (setq msg "TinyScroll: Already in list.")) ))
 439     (if verb
 440         (message msg))))
 441
 442 ;;}}}
 443
 444 (tinyscroll-timer-process-control) ;; wake it up !
 445 (provide   'tinyscroll)
 446 (run-hooks 'tinyscroll-:load-hook)
 447
 448 ;;; tinyscroll.el ends here