Initial Commit

[packages] / xemacs-packages / eieio / eieio-speedbar.el

;;; eieio-speedbar.el -- Classes for managing speedbar displays.

;;;
;; Copyright (C) 1999, 2000, 2001, 2002, 2005, 2007 Eric M. Ludlam
;;
;; Author: <zappo@gnu.org>
;; RCS: $Id: eieio-speedbar.el,v 1.4 2007-11-26 15:01:05 michaels Exp $
;; Keywords: oop, tools
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;
;; Please send bug reports, etc. to zappo@gnu.org

;;; Commentary:
;;  
;;  This provides some classes that can be used as a parent which
;; will automatically provide SPEEDBAR support for any list of objects
;; of that type.
;;
;; This file requires speedbar version 0.10 or later.

;;; Creating a new speedbar mode based on a pre-existing object hierarchy
;;
;; To create a new speedbar mode based on lists of objects is easier
;; than creating a whole new speedbar mode from scratch.
;;
;; 1) Objects that will have lists of items that can be expanded
;;    should also inherit from the classes:
;;  * `eieio-speedbar'                  - specify your own button behavior
;;  * `eieio-speedbar-directory-button' - objects that behave like directories
;;  * `eieio-speedbar-file-button'      - objects that behave like files
;;
;; 2) Objects that have lists of children should implement the method
;;    `eieio-speedbar-object-children' which returns a list of more
;;    objects, or a list of strings.
;;
;; 3) Objects that return a list of strings should also implement these
;;    methods:
;;  * `eieio-speedbar-child-make-tag-lines' - make tag lines for a child.
;;  * `eieio-speedbar-child-description' - describe non-object children
;;
;; 4) Objects which have expanded information should implement the method
;;    `eieio-speedbar-description' to produce more information.
;;
;; 5) Objects that are associated with a directory should implement
;;    the method `eieio-speedbar-derive-line-path' which returns a
;;    path.
;;
;; 6) Objects that have a specialized behavior when clicked should
;;    define the method `eieio-speedbar-handle-click'.
;;
;; To initialize a new eieio based speedbar display, do the following.
;;
;; 1) Create a keymap variable `foo-speedbar-key-map'.
;;    This keymap variable should be initialized in a function.
;;    If you have no special needs, use `eieio-speedbar-key-map'
;;
;; 2) Create a variable containing an easymenu definition compatible
;;    with speedbar.  if you have no special needs, use
;;    `eieio-speedbar-menu'.
;;
;; 3) Create a function which returns the top-level list of children
;;    objects to be displayed in speedbar.
;;
;; 4) Call `eieio-speedbar-create' as specified in it's documentation
;;    string.   This will automatically handle cases when speedbar is
;;    not already loaded, and specifying all overload functions.
;;
;; 5) Create an initliazer function which looks like this:
;; 
;; (defun my-speedbar-mode-initilaize ()
;;   "documentation"
;;   (interactive)
;;   (speedbar-frame-mode 1)
;;   (speedbar-change-initial-expansion-list mymodename)
;;   (speedbar-get-focus))
;; 
;; where `mymodename' is the same value as passed to `eieio-speedbar-create'
;; as the MODENAME parameter.

;;; Code:
(require 'eieio)
(require 'eieio-custom)
(require 'speedbar)

;;; Support a way of adding generic object based modes into speedbar.
;;
(defun eieio-speedbar-make-map ()
  "Make the generic object based speedbar keymap."
  (let ((map (speedbar-make-specialized-keymap)))

    ;; General viewing things
    (define-key map "\C-m" 'speedbar-edit-line)
    (define-key map "+" 'speedbar-expand-line)
    (define-key map "=" 'speedbar-expand-line)
    (define-key map "-" 'speedbar-contract-line)

    ;; Some object based things
    (define-key map "C" 'eieio-speedbar-customize-line)
    map))

(defvar eieio-speedbar-key-map (eieio-speedbar-make-map)
  "A Generic object based speedbar display keymap.")

(defvar eieio-speedbar-menu
  '([ "Edit Object/Field" speedbar-edit-line t]
    [ "Expand Object" speedbar-expand-line
      (save-excursion (beginning-of-line)
                      (looking-at "[0-9]+: *.\\+. "))]
    [ "Contract Object" speedbar-contract-line
      (save-excursion (beginning-of-line)
                      (looking-at "[0-9]+: *.-. "))]
    "---"
    [ "Customize Object" eieio-speedbar-customize-line
      (object-p (speedbar-line-token)) ]
    )
  "Menu part in easymenu format used in speedbar while browsing objects.")

;; Note to self:  Fix this silly thing!
(defalias 'eieio-speedbar-customize-line  'speedbar-edit-line)

(defun eieio-speedbar-create (map-fn map-var menu-var modename fetcher)
  "Create a speedbar mode for displaying an object hierarchy.
MAP-FN is the keymap generator function used for extra keys.
MAP-VAR is the keymap variable used.
MENU-VAR is the symbol containting an easymenu compatible menu part to use.
MODENAME is a s tring used to identify this browser mode.
FETCHER is a generic function used to fetch the base object list used when
creating the speedbar display."
  (if (not (featurep 'speedbar))
      (add-hook 'speedbar-load-hook
                (list 'lambda nil
                      (list 'eieio-speedbar-create-engine
                            map-fn map-var menu-var modename fetcher)))
    (eieio-speedbar-create-engine map-fn map-var menu-var modename fetcher)))

(defun eieio-speedbar-create-engine (map-fn map-var menu-var modename fetcher)
  "Create a speedbar mode for displaying an object hierarchy.
Called from `eieio-speedbar-create', or the speedbar load-hook.
MAP-FN, MAP-VAR, MENU-VAR, MODENAME, and FETCHER are the same as
`eieio-speedbar-create'."
  ;; make sure the keymap exists
  (funcall map-fn)
  ;; Add to the expansion list.
  (speedbar-add-expansion-list
   (list modename
         menu-var
         map-var
         (list 'lambda '(dir depth)
               (list 'eieio-speedbar-buttons 'dir 'depth
                     (list 'quote fetcher)))))
  ;; Set the special functions.
  (speedbar-add-mode-functions-list
   (list modename
         '(speedbar-item-info . eieio-speedbar-item-info)
         '(speedbar-line-directory . eieio-speedbar-line-path))))

(defun eieio-speedbar-buttons (dir-or-object depth fetcher)
  "Create buttons for the speedbar display.
Start in directory DIR-OR-OBJECT.  If it is an object, just display that
objects subelements.
Argument DEPTH specifies how far down we have already been displayed.
If it is a directory, use FETCHER to fetch all objects associated with
that path."
  (let ((objlst (cond ((object-p dir-or-object)
                       (list dir-or-object))
                      ((stringp dir-or-object)
                       (funcall fetcher dir-or-object))
                      (t dir-or-object))))
    (if (not objlst)
        (speedbar-make-tag-line nil nil nil nil "Empty display" nil nil nil
                                depth)
      ;; Dump all objects into speedbar
      (while objlst
        (eieio-speedbar-make-tag-line (car objlst) depth)
        (setq objlst (cdr objlst))))))

\f
;;; DEFAULT SUPERCLASS baseline methods
;;
;; First, define methods onto the superclass so all classes
;; will have some minor support.

(defmethod eieio-speedbar-description ((object eieio-default-superclass))
  "Return a string describing OBJECT."
  (object-name-string object))

(defmethod eieio-speedbar-derive-line-path ((object eieio-default-superclass))
  "Return the path which OBJECT has something to do with."
  nil)

(defmethod eieio-speedbar-object-buttonname ((object eieio-default-superclass))
  "Return a string to use as a speedbar button for OBJECT."
  (object-name-string object))

(defmethod eieio-speedbar-make-tag-line ((object eieio-default-superclass)
                                         depth)
  "Insert a tag line into speedbar at point for OBJECT.
By default, all objects appear as simple TAGS with no need to inherit from
the special `eieio-speedbar' classes.  Child classes should redefine this
method to create more accurate tag lines.
Argument DEPTH is the depth at which the tag line is inserted."
  (speedbar-make-tag-line nil nil nil nil
                          (eieio-speedbar-object-buttonname object)
                          'eieio-speedbar-object-click
                          object
                          'speedbar-tag-face
                          depth))

(defmethod eieio-speedbar-handle-click ((object eieio-default-superclass))
  "Handle a click action on OBJECT in speedbar.
Any object can be represented as a tag in SPEEDBAR without special
attributes.  These default objects will be pulled up in a custom
object edit buffer doing an in-place edit.

If your object represents some other item, override this method
and take the apropriate action."
  (require 'eieio-custom)
  (speedbar-with-attached-buffer
   (eieio-customize-object object))
  (speedbar-maybee-jump-to-attached-frame))

\f
;;; Class definitions
;;
;; Now define a special speedbar class with some
;; variables with :allocation class which can be attached into
;; object hierarchies.
;;
;; These more complex types are for objects which wish to display
;; lists of children buttons.

(defclass eieio-speedbar nil
  ((buttontype :initform nil
               :type symbol
               :documentation
               "The type of expansion button used for objects of this class.
Possible values are those symbols supported by the `exp-button-type' argument
to `speedbar-make-tag-line'."
               :allocation :class)
   (buttonface :initform speedbar-tag-face
               :type (or symbol face)
               :documentation
               "The face used on the textual part of the button for this class.
See `speedbar-make-tag-line' for details."
               :allocation :class)
   (expanded :initform nil
             :type boolean
             :documentation
             "State of an object being expanded in speedbar.")
   )
  "Class which provides basic speedbar support for child classes.
Add one of thie child classes to this class to the parent list of a class."
  :abstract t)

(defclass eieio-speedbar-directory-button (eieio-speedbar)
  ((buttontype :initform angle)
   (buttonface :initform speedbar-directory-face))
  "Class providing support for objects which behave like a directory."
  :abstract t)

(defclass eieio-speedbar-file-button (eieio-speedbar)
  ((buttontype :initform bracket)
   (buttonface :initform speedbar-file-face))
  "Class providing support for objects which behave like a directory."
  :abstract t)

\f
;;; Methods to eieio-speedbar-* which do not need to be overriden
;;
(defmethod eieio-speedbar-make-tag-line ((object eieio-speedbar)
                                         depth)
  "Insert a tag line into speedbar at point for OBJECT.
All objects a child of symbol `eieio-speedbar' can be created from this
method.  Override this if you need non-traditional tag lines.
Argument DEPTH is the depth at which the tag line is inserted."
  (let ((children (eieio-speedbar-object-children object))
        (exp (oref object expanded)))
    (if (not children)
        (if (eq (oref object buttontype) 'expandtag)
            (speedbar-make-tag-line 'statictag
                                    ?  nil nil
                                    (eieio-speedbar-object-buttonname object)
                                    'eieio-speedbar-object-click
                                    object
                                    (oref object buttonface)
                                    depth)
          (speedbar-make-tag-line (oref object buttontype)
                                  ?  nil nil
                                  (eieio-speedbar-object-buttonname object)
                                  'eieio-speedbar-object-click
                                  object
                                  (oref object buttonface)
                                  depth))
      (speedbar-make-tag-line (oref object buttontype)
                              (if exp ?- ?+)
                              'eieio-speedbar-object-expand
                              object
                              (eieio-speedbar-object-buttonname object)
                              'eieio-speedbar-object-click
                              object
                              (oref object buttonface)
                              depth)
      (if exp
          (eieio-speedbar-expand object (1+ depth))))))

(defmethod eieio-speedbar-child-make-tag-lines ((object eieio-speedbar) depth)
  "Base method for creating tag lines for non-object children."
  (error "You must implement `eieio-speedbar-child-make-tag-lines' for %s"
         (object-name object)))

(defmethod eieio-speedbar-expand ((object eieio-speedbar) depth)
  "Expand OBJECT at indentation DEPTH.
Inserts a list of new tag lines representing expanded elements withing
OBJECT."
  (let ((children (eieio-speedbar-object-children object)))
    (cond ((object-p (car children))
           (mapcar (lambda (car)
                     (eieio-speedbar-make-tag-line car depth))
                   children))
          (children (eieio-speedbar-child-make-tag-lines object depth)))))

\f
;;; Speedbar specific function callbacks.
;;
(defun eieio-speedbar-object-click (text token indent)
  "Handle a user click on TEXT representing object TOKEN.
The object is at indentation level INDENT."
  (eieio-speedbar-handle-click token))

(defun eieio-speedbar-object-expand (text token indent)
  "Expand object represented by TEXT.  TOKEN is the object.
INDENT is the current indentation level."
  (cond ((string-match "+" text)        ;we have to expand this file
         (speedbar-change-expand-button-char ?-)
         (oset token expanded t)
         (speedbar-with-writable
           (save-excursion
             (end-of-line) (forward-char 1)
             (eieio-speedbar-expand token (1+ indent)))))
        ((string-match "-" text)        ;we have to contract this node
         (speedbar-change-expand-button-char ?+)
         (oset token expanded nil)
         (speedbar-delete-subblock indent))
        (t (error "Ooops... not sure what to do")))
  (speedbar-center-buffer-smartly))

(defmethod eieio-speedbar-child-description ((obj eieio-speedbar))
  "Return a description for a child of OBJ which is not an object."
  (error "You must implement `eieio-speedbar-child-description' for %s"
         (object-name obj)))

(defun eieio-speedbar-item-info ()
  "Display info for the current line when in EDE display mode."
  ;; Switch across the types of the tokens.
  (let ((tok (speedbar-line-token)))
    (cond ((object-p tok)
           (message (eieio-speedbar-description tok)))
          (t
           (let ((no (eieio-speedbar-find-nearest-object)))
             (if no
                 (eieio-speedbar-child-description no)))))))

(defun eieio-speedbar-find-nearest-object (&optional depth)
  "Search backwards to the first line associated with an object.
Optional argument DEPTH is the current depth of the search."
  (save-excursion
    (if (not depth)
        (progn
          (beginning-of-line)
          (when (looking-at "^\\([0-9]+\\):")
            (setq depth (string-to-number (match-string 1))))))
    (when depth
      (while (and (not (object-p (speedbar-line-token)))
                  (> depth 0))
        (setq depth (1- depth))
        (re-search-backward (format "^%d:" depth) nil t))
      (speedbar-line-token))))

(defun eieio-speedbar-line-path (&optional depth)
  "If applicable, return the path to the file the cursor is on.
Optional DEPTH is the depth we start at."
  (save-match-data
    (if (not depth)
        (progn
          (beginning-of-line)
          (looking-at "^\\([0-9]+\\):")
          (setq depth (string-to-number (match-string 1)))))
    ;; This whole function is presently bogus.  Make it better later.
    (let ((tok (eieio-speedbar-find-nearest-object depth)))
      (if (object-p tok)
          (eieio-speedbar-derive-line-path tok)
        default-directory))))

\f
;;; Methods to the eieio-speedbar-* classes which need to be overriden.
;;
(defmethod eieio-speedbar-object-children ((object eieio-speedbar))
  "Return a list of children to be displayed in SPEEDBAR.
If the return value is a list of OBJECTs, then those objects are
queried for details.  If the return list is made of strings,
then this object will be queried for the details needed
to create a speedbar button."
  nil)

(provide 'eieio-speedbar)

;;; eieio-speedbar.el ends here