site-lisp/cedet-1.0pre4/ecb-2.32/ecb-navigate.el

   1 ;;; ecb-navigate.el --- Browser-navigation for ECB
   2
   3 ;; Copyright (C) 2000 - 2005 Jesper Nordenberg,
   4 ;;                           Klaus Berndl,
   5 ;;                           Kevin A. Burton,
   6 ;;                           Free Software Foundation, Inc.
   7
   8 ;; Author: Jesper Nordenberg <mayhem@home.se>
   9 ;;         Klaus Berndl <klaus.berndl@sdm.de>
  10 ;;         Kevin A. Burton <burton@openprivacy.org>
  11 ;; Maintainer: Klaus Berndl <klaus.berndl@sdm.de>
  12 ;;             Kevin A. Burton <burton@openprivacy.org>
  13 ;; Keywords: browser, code, programming, tools
  14 ;; Created: 2001
  15
  16 ;; This program is free software; you can redistribute it and/or modify it under
  17 ;; the terms of the GNU General Public License as published by the Free Software
  18 ;; Foundation; either version 2, or (at your option) any later version.
  19
  20 ;; This program is distributed in the hope that it will be useful, but WITHOUT
  21 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  22 ;; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
  23 ;; details.
  24
  25 ;; You should have received a copy of the GNU General Public License along with
  26 ;; GNU Emacs; see the file COPYING.  If not, write to the Free Software
  27 ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  28
  29 ;; $Id: ecb-navigate.el,v 1.22 2005/02/28 11:31:55 berndl Exp $
  30
  31 ;;; Commentary:
  32
  33 ;;; History
  34 ;;
  35 ;; For the ChangeLog of this file see the CVS-repository. For a complete
  36 ;; history of the ECB-package see the file NEWS.
  37
  38
  39 ;;; Code:
  40
  41 (eval-when-compile
  42   (require 'silentcomp))
  43
  44 (require 'eieio)
  45
  46
  47 ;;====================================================
  48 ;;
  49 ;;====================================================
  50
  51 (defclass ecb-dlist-node ()
  52   ((previous :initform nil); :protection :private)
  53    (next :initform nil); :protection :private)
  54    (data :initarg :data :initform nil); :protection :private)
  55    )
  56   "A node in a double linked list."
  57   )
  58
  59 (defun ecb-dlist-node-new (data)
  60   (ecb-dlist-node "node" :data data))
  61
  62 (defmethod ecb-get-data ((node ecb-dlist-node))
  63   (oref node data))
  64
  65 (defmethod ecb-get-next ((node ecb-dlist-node))
  66   (oref node next))
  67
  68 (defmethod ecb-get-previous ((node ecb-dlist-node))
  69   (oref node previous))
  70
  71 (defmethod ecb-set-data ((node ecb-dlist-node) data)
  72   (oset node data data))
  73
  74 (defmethod ecb-set-next ((node ecb-dlist-node) next)
  75   (let ((old-next (ecb-get-next node)))
  76     (when old-next
  77       (oset old-next previous nil))
  78     (oset node next next)
  79     (when next
  80       (ecb-set-previous next nil)
  81       (oset next previous node))))
  82
  83 (defmethod ecb-set-previous ((node ecb-dlist-node) previous)
  84   (let ((old-previous (ecb-get-previous node)))
  85     (when old-previous
  86       (oset old-previous next nil))
  87     (oset node previous previous)
  88     (when previous
  89       (ecb-set-next previous nil)
  90       (oset previous next node))))
  91
  92
  93 ;;====================================================
  94 ;;
  95 ;;====================================================
  96
  97 (defclass ecb-nav-history-item ()
  98   ((pos :initarg :pos :initform 0); :protection :private)
  99    (window-start :initarg :window-start :initform 0); :protection :private)
 100    )
 101   )
 102
 103 (defmethod ecb-nav-set-pos ((item ecb-nav-history-item) pos)
 104   (oset item pos pos))
 105
 106 (defmethod ecb-nav-set-window-start ((item ecb-nav-history-item) point)
 107   (oset item window-start point))
 108
 109 (defmethod ecb-nav-get-pos ((item ecb-nav-history-item))
 110   (oref item pos))
 111
 112 (defmethod ecb-nav-get-window-start ((item ecb-nav-history-item))
 113   (oref item window-start))
 114
 115 (defmethod ecb-nav-to-string ((item ecb-nav-history-item))
 116   (concat (int-to-string (ecb-nav-get-pos item)) ":"
 117           (int-to-string (ecb-nav-get-window-start item))))
 118
 119 ;; This method must return nil if saving can not be performed and otherwise
 120 ;; not nil!
 121 (defmethod ecb-nav-save ((item ecb-nav-history-item))
 122   t)
 123
 124 (defmethod ecb-nav-is-valid ((item ecb-nav-history-item))
 125   t)
 126
 127
 128 ;;====================================================
 129 ;;
 130 ;;====================================================
 131
 132 ;; Klaus Berndl <klaus.berndl@sdm.de>: Changed this class from storing the
 133 ;; whole tag to storing explicitly the tag-buffer, the marker of the
 134 ;; tag-start, the marker of the tag-end. This prevents the stored
 135 ;; navigation-items from getting invalid and unusable after a full
 136 ;; semantic-reparse because such a reparse makes the overlays contained in the
 137 ;; stored tags invalid so we can not uses their informations.
 138 (defclass ecb-nav-tag-history-item (ecb-nav-history-item)
 139   ((tag-buffer :initarg :tag-buffer :initform nil); :protection :private)
 140    (tag-start :initarg :tag-start :initform nil) ; :protection :private)
 141    (tag-end :initarg :tag-end :initform nil) ; :protection :private)
 142    (tag-name :initarg :tag-name :initform nil) ; :protection :private)
 143    (narrow :initarg :narrow :initform nil); :protection :private)
 144    )
 145   )
 146
 147 (defun ecb-nav-tag-history-item-new (tag-name tag-buffer tag-start
 148                                                   tag-end &optional narrow)
 149   (ecb-nav-tag-history-item tag-name
 150                               :tag-buffer tag-buffer
 151                               :tag-start tag-start
 152                               :tag-end tag-end
 153                               :tag-name tag-name
 154                               :narrow narrow))
 155
 156 (defmethod ecb-nav-get-tag-buffer ((item ecb-nav-tag-history-item))
 157   (oref item tag-buffer))
 158
 159 (defmethod ecb-nav-get-tag-start ((item ecb-nav-tag-history-item))
 160   (oref item tag-start))
 161
 162 (defmethod ecb-nav-get-tag-end ((item ecb-nav-tag-history-item))
 163   (oref item tag-end))
 164
 165 (defmethod ecb-nav-get-tag-name ((item ecb-nav-tag-history-item))
 166   (oref item tag-name))
 167
 168 (defmethod ecb-nav-get-narrow ((item ecb-nav-tag-history-item))
 169   (oref item narrow))
 170
 171 (defmethod ecb-nav-goto ((item ecb-nav-tag-history-item))
 172   (let ((tag-buffer (ecb-nav-get-tag-buffer item))
 173         (tag-start (ecb-nav-get-tag-start item))
 174         (tag-end (ecb-nav-get-tag-end item)))
 175     (set-window-buffer (selected-window) tag-buffer)
 176     (widen)
 177     (goto-char tag-start)
 178     (when (ecb-nav-get-narrow item)
 179       (narrow-to-region (ecb-line-beginning-pos) tag-end))
 180     (goto-char (+ tag-start (ecb-nav-get-pos item)))
 181     (set-window-start (selected-window)
 182                       (+ tag-start (ecb-nav-get-window-start item)))))
 183
 184 (defmethod ecb-nav-save ((item ecb-nav-tag-history-item))
 185   "Return only nil if tag-start of ITEM points into a dead buffer. In this
 186 case no position saving is done."
 187   (let ((tag-start (ecb-nav-get-tag-start item)))
 188     (if (and tag-start (marker-buffer tag-start))
 189         (progn
 190           (ecb-nav-set-pos item (- (point) tag-start))
 191           (ecb-nav-set-window-start item (- (window-start) tag-start))
 192           t)
 193       nil)))
 194
 195 (defmethod ecb-nav-to-string ((item ecb-nav-tag-history-item))
 196   (concat (ecb-nav-get-tag-name item) ":" (call-next-method)))
 197
 198 (defmethod ecb-nav-is-valid ((item ecb-nav-tag-history-item))
 199    (let ((tag-start (ecb-nav-get-tag-start item))
 200          (tag-buf (ecb-nav-get-tag-buffer item))
 201          (tag-end (ecb-nav-get-tag-end item)))
 202      (if (and tag-start (marker-buffer tag-start)
 203               tag-end (marker-buffer tag-end)
 204               tag-buf (buffer-live-p tag-buf))
 205          t)))
 206
 207
 208 ;;====================================================
 209 ;;
 210 ;;====================================================
 211
 212 (defclass ecb-nav-file-history-item (ecb-nav-history-item)
 213   ((file :initarg :file :initform ""); :protection :private)
 214    )
 215   )
 216
 217 (defun ecb-nav-file-history-item-new ()
 218   (let ((item (ecb-nav-file-history-item (buffer-file-name)
 219                :file (buffer-file-name))))
 220     (ecb-nav-set-pos item (point))
 221     (ecb-nav-set-window-start item
 222                           (window-start (get-buffer-window (current-buffer))))
 223     item))
 224
 225 (defmethod ecb-nav-get-file ((item ecb-nav-file-history-item))
 226   (oref item file))
 227
 228 (defmethod ecb-nav-set-file ((item ecb-nav-file-history-item) file)
 229   (oset item file file))
 230
 231 (defmethod ecb-nav-save ((item ecb-nav-file-history-item))
 232   (ecb-nav-set-pos item (point))
 233   (ecb-nav-set-window-start item (window-start))
 234   (ecb-nav-set-file item (buffer-file-name))
 235   t)
 236
 237 (defmethod ecb-nav-goto ((item ecb-nav-file-history-item))
 238   (find-file (ecb-nav-get-file item))
 239   (widen)
 240   (goto-char (ecb-nav-get-pos item))
 241   (set-window-start (selected-window) (ecb-nav-get-window-start item)))
 242
 243 (defmethod ecb-nav-to-string ((item ecb-nav-file-history-item))
 244   (concat (ecb-nav-get-file item) ":" (call-next-method)))
 245
 246 (defmethod ecb-nav-is-valid ((item ecb-nav-file-history-item))
 247   t)
 248
 249 ;;====================================================
 250 ;;
 251 ;;====================================================
 252
 253 (defvar ecb-nav-first-node nil)
 254 (setq ecb-nav-first-node (ecb-dlist-node-new (ecb-nav-history-item "First item")))
 255
 256 (defvar ecb-nav-current-node nil)
 257 (setq ecb-nav-current-node ecb-nav-first-node)
 258
 259
 260 (defun ecb-nav-initialize ()
 261   (setq ecb-nav-first-node
 262         (ecb-dlist-node-new (ecb-nav-history-item "First item")))
 263   (setq ecb-nav-current-node ecb-nav-first-node))
 264
 265
 266 (defun ecb-nav-jump-to-tag (file tag &optional narrow)
 267   (ecb-nav-save-current)
 268   (find-file file)
 269   (ecb-nav-add-item (ecb-nav-tag-history-item tag narrow)))
 270
 271 (defun ecb-nav-jump-to-file (file)
 272   (ecb-nav-save-current)
 273   (find-file file)
 274   (ecb-nav-add-item (ecb-nav-file-history-item file)))
 275
 276 (defun ecb-nav-add-item (item)
 277   (let ((node (ecb-dlist-node-new item)))
 278     (ecb-set-next node (ecb-get-next ecb-nav-current-node))
 279     (ecb-set-next ecb-nav-current-node node)
 280     (setq ecb-nav-current-node node)))
 281
 282 (defun ecb-nav-remove-current-node ()
 283   (ecb-nav-remove-node ecb-nav-current-node))
 284
 285 (defun ecb-nav-remove-node (node)
 286   "Remove NODE and set `ecb-nav-first-node' and `ecb-nav-current-node' if
 287 necessary."
 288   (let ((prev (ecb-get-previous node))
 289         (next (ecb-get-next node)))
 290     (if prev
 291         (ecb-set-next prev (ecb-get-next node)))
 292     (if next
 293         (ecb-set-previous next (ecb-get-previous node)))
 294     (if (eq node ecb-nav-current-node)
 295         (setq ecb-nav-current-node (or prev
 296                                        next
 297                                        ecb-nav-first-node)))
 298     (if (eq node ecb-nav-first-node)
 299         (if next
 300             (setq ecb-nav-first-node next)
 301         (ecb-nav-initialize)))))
 302
 303 (defun ecb-nav-remove-invalid-nodes ()
 304   (let ((node ecb-nav-first-node)
 305         (next-node nil))
 306     (while node
 307       (setq next-node (ecb-get-next node))
 308       (if (not (ecb-nav-is-valid (ecb-get-data node)))
 309           (ecb-nav-remove-node node))
 310       (setq node next-node))))
 311
 312 (defun ecb-nav-save-current ()
 313   (while (not (ecb-nav-save (ecb-get-data ecb-nav-current-node)))
 314     (ecb-nav-remove-current-node)))
 315
 316 (defun ecb-nav-goto-next ()
 317   "Go forward in the navigation history list."
 318   (interactive)
 319   (ecb-nav-goto--internal (ecb-get-next ecb-nav-current-node)))
 320
 321 (defun ecb-nav-goto-previous ()
 322   "Go back in the navigation history list."
 323   (interactive)
 324   (ecb-nav-goto--internal (ecb-get-previous ecb-nav-current-node)))
 325
 326 (defun ecb-nav-dump-history ()
 327   (interactive)
 328   (ecb-nav-remove-invalid-nodes)
 329   (ecb-nav-dump-history--internal ecb-nav-first-node))
 330
 331 (defun ecb-nav-dump-history--internal (node)
 332   (when node
 333     (insert (ecb-nav-to-string (ecb-get-data node)) "\n")
 334     (ecb-nav-dump-history--internal (ecb-get-next node))))
 335
 336 (defun ecb-nav-goto--internal (node)
 337   (if (or (not node) (eq ecb-nav-first-node node))
 338       (message "No more valid history items!")
 339     ;; before doing something we have to clear the history from now invalid
 340     ;; nodes means removing nodes which does not point into a live buffer
 341     (ecb-nav-remove-invalid-nodes)
 342     (ecb-nav-save-current)
 343     (setq ecb-nav-current-node node)
 344     (ecb-nav-goto (ecb-get-data node))))
 345
 346
 347 (silentcomp-provide 'ecb-navigate)
 348
 349 ;;; ecb-navigate.el ends here