cgit.sxemacs.org Git - packages/blob - xemacs-packages/hyperbole/hhist.el

   1 ;;; hhist.el --- Maintains history of Hyperbole buttons selected.
   2
   3 ;; Copyright (C) 1991-1995 Free Software Foundation, Inc.
   4 ;; Developed with support from Motorola Inc.
   5
   6 ;; Author: Bob Weiner, Brown U.
   7 ;; Maintainer: Mats Lidell <matsl@contactor.se>
   8 ;; Keywords: hypermedia
   9
  10 ;; This file is part of GNU Hyperbole.
  11
  12 ;; GNU Hyperbole is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 3, or (at
  15 ;; your option) any later version.
  16
  17 ;; GNU Hyperbole is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28 ;;
  29 ;;   This is minimal right now and will be extended.
  30 ;;   Currently, it implements a push-pop stack of traversed locations.
  31 ;;
  32 ;;   It will be extended to allow random access to previous locations
  33 ;;   and to store traversal histories for later recall.
  34 ;;
  35
  36 ;;; Code:
  37
  38 ;;;
  39 ;;; Public functions
  40 ;;;
  41
  42 (defun hhist:add (elt)
  43   "Adds ELT to hyper-history list if not the same as current or previous loc.
  44 ELT must have been created via a call to 'hhist:element'."
  45   ;; Even though this next line looks useless, it cures a problem with
  46   ;; window buffer correspondences on startup, so don't remove it.
  47   (set-buffer (window-buffer (selected-window)))
  48   (let ((prev-buf (car elt)))
  49     (if (or (equal prev-buf (buffer-name))
  50             (equal prev-buf (car (car *hhist*))))
  51         nil
  52       (setq *hhist* (cons elt *hhist*)))))
  53
  54 (defun hhist:element ()
  55   "Returns a history element for current point location."
  56   (list (current-buffer) (point)))
  57
  58 (defun hhist:remove (&optional arg)
  59   "Removes optional prefix ARG entries from history, returns to ARGth location.
  60 The command is ignored with ARG < 1."
  61   (interactive "p")
  62   (setq arg (or arg 1))
  63   (let ((prev-buf-line))
  64     (if (null *hhist*)
  65         (and (> arg 0)
  66              (message "(hhist:remove): No previous source to which to return.")
  67              (beep))
  68       (while (and (> arg 0) *hhist*)
  69         (setq prev-buf-line (car *hhist*)
  70               *hhist* (cdr *hhist*)
  71               arg (1- arg)))
  72       (switch-to-buffer (car prev-buf-line))
  73       (goto-char (car (cdr prev-buf-line)))
  74       )))
  75
  76 (defun hhist:init ()
  77   "Resets history list."
  78   (interactive)
  79   (setq *hhist* nil))
  80
  81 ;;;
  82 ;;; Private functions
  83 ;;;
  84
  85 (defun hhist:wind-line ()
  86   "Returns window relative line number that point is on."
  87   (max 0 (1- (- (count-lines 1 (1+ (point)))
  88                 (count-lines 1 (window-start))))))
  89
  90 ;;;
  91 ;;; Private variables
  92 ;;;
  93
  94 (defconst *hhist* nil
  95   "List of previously visited Hyperbole button source locations.
  96 Car of list is most recent.")
  97
  98 (provide 'hhist)
  99
 100 ;;; hhist.el ends here