home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / bmark.el < prev    next >
Encoding:
Text File  |  1993-06-15  |  5.6 KB  |  145 lines
  1. ;; -*- Mode: Emacs-Lisp -*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;; File:    bmark.el
  4. ;; Description:    Interbuffer mark ring support.
  5. ;; Author:    Ken Laprade <laprade@trantor.harris-atd.com>
  6. ;; Created:    Thu Sep  6 18:15:33 1990
  7. ;; Modified:    Thu Sep 20 07:59:50 1990
  8. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  9.  
  10. ;; Harris-ATD-style interbuffer mark ring support.
  11. ;;
  12. ;; Copyright (C) 1990 Ken Laprade <laprade@trantor.harris-atd.com>
  13.  
  14. ;; This file is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  16. ;; accepts responsibility to anyone for the consequences of using it
  17. ;; or for whether it serves any particular purpose or works at all,
  18. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  19. ;; License for full details.
  20.  
  21. ;; Everyone is granted permission to copy, modify and redistribute
  22. ;; this file, but only under the conditions described in the
  23. ;; GNU Emacs General Public License.   A copy of this license is
  24. ;; supposed to have been given to you along with GNU Emacs so you
  25. ;; can know your rights and responsibilities.  It should be in a
  26. ;; file named COPYING.  Among other things, the copyright notice
  27. ;; and this notice must be preserved on all copies.
  28.  
  29. ;; This file contains, in part, code originally distributed with GNU Emacs.
  30.  
  31. ;; --- Usage:
  32. ;; These functions provide an inter-buffer mark ring quite similar to the
  33. ;; individual buffer mark rings provided with GNU emacs. set-bmark-command
  34. ;; works practically just like set-mark-command, but the bmark-ring is
  35. ;; global rather than buffer-local, so its marks can be in any buffer.
  36. ;; pop-bmark is the same as set-bmark-command with an argument.  There is
  37. ;; also an unpop-bmark function that reverses the order the bmark-ring is
  38. ;; traversed.
  39.  
  40. ;; --- Installation:
  41. ;; Put these in default.el or ~/.emacs:
  42. ;(autoload 'set-bmark-command "bmark" "Add point to inter-buffer mark ring, or jump to top entry on ring." t)
  43. ;(autoload 'push-bmark "bmark" "Push point onto top of inter-buffer mark ring." t)
  44. ;(autoload 'pop-bmark "bmark" "Pop top of inter-buffer mark ring." t)
  45. ;(autoload 'exchange-point-and-bmark "bmark" "Exchange point and top of inter-buffer mark ring." t)
  46. ;(or (key-binding "\C-X\C-@")
  47. ;    (global-set-key "\C-X\C-@" 'set-bmark-command))
  48.  
  49.  
  50. (defvar bmark-ring nil
  51.   "The list of saved inter-buffer marks, most recent first.")
  52.  
  53. (defvar bmark-ring-max 16
  54.   "*Maximum size of inter-buffer mark ring.  Start discarding off
  55. end if it gets this big.")
  56.  
  57. (defun cleanup-bmark-ring ()
  58.   "Remove all markers that no longer are valid from the bmark-ring."
  59.   (while (and bmark-ring
  60.           (null (marker-buffer (car bmark-ring))))
  61.     (setq bmark-ring (cdr bmark-ring)))
  62.   (let ((l bmark-ring))
  63.     (while (cdr l)
  64.       (if (marker-buffer (car (cdr l)))
  65.       (setq l (cdr l))
  66.     (setcdr l (cdr (cdr l)))))))
  67.  
  68. (defun set-bmark-command (arg)
  69.   "Add point to inter-buffer mark ring, or jump to top entry on ring.
  70. With no prefix argument, push point mark on inter-buffer mark ring.
  71. With positive argument, pop top entry off inter-buffer mark ring and
  72. move point to it, switching buffer if necessary.  With negative
  73. argument, pop into other window."
  74.   (interactive "P")
  75.   (if (null arg)
  76.       (push-bmark)
  77.     (if (null bmark-ring)
  78.     (error "Nothing in inter-buffer mark ring")
  79.       (pop-bmark (< (prefix-numeric-value arg) 0)))))
  80.  
  81. (defun push-bmark (&optional location buffer nomsg)
  82.   "Add LOCATION in BUFFER (point in current buffer, by default)
  83. to the inter-buffer mark ring.  Displays \"Inter-buffer mark set\"
  84. unless the optional third arg NOMSG is non-nil."
  85.   (cleanup-bmark-ring)
  86.   (let ((marker (make-marker)))
  87.     (set-marker marker (or location (point)) buffer)
  88.     (setq bmark-ring (cons marker bmark-ring))
  89.     (if (> (length bmark-ring) bmark-ring-max)
  90.     (progn
  91.       (set-marker (nth bmark-ring-max bmark-ring) nil)
  92.       (setcdr (nthcdr (1- bmark-ring-max) bmark-ring) nil))))
  93.   (or nomsg executing-macro (> (minibuffer-depth) 0)
  94.       (message "Inter-buffer mark set")))
  95.  
  96. (defun pop-bmark (&optional other)
  97.   "Pop top of inter-buffer mark ring, switch buffer if necessary,
  98. and set point.  Does nothing if inter-buffer mark ring is empty.
  99. With optional OTHER, does pop in other window."
  100.   (interactive "P")
  101.   (cleanup-bmark-ring)
  102.   (if bmark-ring
  103.       (let ((bmark (car bmark-ring)))
  104.     (if other
  105.         (switch-to-buffer-other-window (marker-buffer bmark))
  106.       (switch-to-buffer (marker-buffer bmark)))
  107.     (goto-char (marker-position bmark))
  108.     (setq bmark-ring (nconc (cdr bmark-ring) (list bmark))))))
  109.  
  110. (defun unpop-bmark (&optional other)
  111.   "Goto bottom of inter-buffer mark ring, switch buffer if necessary,
  112. and set point.  Needs at least two entries in inter-buffer mark ring.
  113. Rotates the ring in the opposite direction of pop-bmark.
  114. With optional OTHER, does unpop in other window."
  115.   (interactive "P")
  116.   (cleanup-bmark-ring)
  117.   (if (and bmark-ring (cdr bmark-ring))
  118.       (let ((l bmark-ring)
  119.         bmark)
  120.     (while (cdr (cdr l))
  121.       (setq l (cdr l)))
  122.     ;; Previous bmark is really second from bottom.  Bottom is current.
  123.     (setq bmark (car l))
  124.     (if other
  125.         (switch-to-buffer-other-window (marker-buffer bmark))
  126.       (switch-to-buffer (marker-buffer bmark)))
  127.     (goto-char (marker-position bmark))
  128.     (setcdr (cdr l) bmark-ring)
  129.     (setq bmark-ring (cdr l))
  130.     (setcdr l nil))))
  131.  
  132. (defun exchange-point-and-bmark ()
  133.   "Put current point on top of the inter-buffer mark ring
  134. and put point in its place."
  135.   (interactive)
  136.   (cleanup-bmark-ring)
  137.   (let* ((bmark (car bmark-ring))
  138.     (b (marker-buffer bmark))
  139.     (p (marker-position bmark)))
  140.     (set-marker bmark (point))
  141.     (switch-to-buffer b)
  142.     (goto-char p)))
  143.  
  144. (provide 'bmark)
  145.