[bpt/emacs.git] / lisp / emacs-lisp / eieio-speedbar.el

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

;; Copyright (C) 1999-2002, 2005, 2007-2012  Free Software Foundation, Inc.

;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: OO, tools
;; Package: eieio

;; This file is part of GNU Emacs.

;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs 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.  If not, see <http://www.gnu.org/licenses/>.

;;; 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 initializer function which looks like this:
;;
;; (defun my-speedbar-mode-initialize ()
;;   "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.

;; @todo - Can we make this ECB friendly?

;;; 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
      (eieio-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 containing an easymenu compatible menu part to use.
MODENAME is a string 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 in
`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
object's 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 ((eieio-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 with no class defined.  These will work as if
;; on the default superclass.  Specifying no class will allow these to be used
;; when no other methods are found, allowing multiple inheritance to work
;; reliably with eieio-speedbar.

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

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

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

(defmethod eieio-speedbar-make-tag-line (object 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)
  "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 appropriate 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 the child classes to this class to the parent list of a class."
  :method-invocation-order :depth-first
  :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."
  :method-invocation-order :depth-first
  :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 file."
  :method-invocation-order :depth-first
  :abstract t)

\f
;;; Methods to eieio-speedbar-* which do not need to be overridden
;;
(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 within
OBJECT."
  (let ((children (eieio-speedbar-object-children object)))
    (cond ((eieio-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 ((eieio-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 (eieio-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 (eieio-object-p tok)
	  (eieio-speedbar-derive-line-path tok)
	default-directory))))

\f
;;; Methods to the eieio-speedbar-* classes which need to be overridden.
;;
(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
Commit	Line	Data
6dd12ef2 CY	1	;;; eieio-speedbar.el -- Classes for managing speedbar displays.
6dd12ef2 CY	2
acaf905b	3	;; Copyright (C) 1999-2002, 2005, 2007-2012 Free Software Foundation, Inc.
6dd12ef2	4
9ffe3f52	5	;; Author: Eric M. Ludlam <zappo@gnu.org>
6dd12ef2	6	;; Keywords: OO, tools
bd78fa1d	7	;; Package: eieio
6dd12ef2 CY	8
	9	;; This file is part of GNU Emacs.
	10
	11	;; GNU Emacs is free software: you can redistribute it and/or modify
	12	;; it under the terms of the GNU General Public License as published by
	13	;; the Free Software Foundation, either version 3 of the License, or
	14	;; (at your option) any later version.
	15
	16	;; GNU Emacs is distributed in the hope that it will be useful,
	17	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	18	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	19	;; GNU General Public License for more details.
	20
	21	;; You should have received a copy of the GNU General Public License
	22	;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
	23
	24	;;; Commentary:
	25	;;
	26	;; This provides some classes that can be used as a parent which
	27	;; will automatically provide SPEEDBAR support for any list of objects
	28	;; of that type.
	29	;;
	30	;; This file requires speedbar version 0.10 or later.
	31
	32	;;; Creating a new speedbar mode based on a pre-existing object hierarchy
	33	;;
	34	;; To create a new speedbar mode based on lists of objects is easier
	35	;; than creating a whole new speedbar mode from scratch.
	36	;;
	37	;; 1) Objects that will have lists of items that can be expanded
	38	;; should also inherit from the classes:
	39	;; * `eieio-speedbar' - specify your own button behavior
	40	;; * `eieio-speedbar-directory-button' - objects that behave like directories
	41	;; * `eieio-speedbar-file-button' - objects that behave like files
	42	;;
	43	;; 2) Objects that have lists of children should implement the method
	44	;; `eieio-speedbar-object-children' which returns a list of more
	45	;; objects, or a list of strings.
	46	;;
	47	;; 3) Objects that return a list of strings should also implement these
	48	;; methods:
	49	;; * `eieio-speedbar-child-make-tag-lines' - make tag lines for a child.
	50	;; * `eieio-speedbar-child-description' - describe non-object children
	51	;;
	52	;; 4) Objects which have expanded information should implement the method
	53	;; `eieio-speedbar-description' to produce more information.
	54	;;
	55	;; 5) Objects that are associated with a directory should implement
	56	;; the method `eieio-speedbar-derive-line-path' which returns a
	57	;; path.
	58	;;
	59	;; 6) Objects that have a specialized behavior when clicked should
	60	;; define the method `eieio-speedbar-handle-click'.
	61	;;
	62	;; To initialize a new eieio based speedbar display, do the following.
	63	;;
	64	;; 1) Create a keymap variable `foo-speedbar-key-map'.
	65	;; This keymap variable should be initialized in a function.
	66	;; If you have no special needs, use `eieio-speedbar-key-map'
	67	;;
	68	;; 2) Create a variable containing an easymenu definition compatible
	69	;; with speedbar. if you have no special needs, use
	70	;; `eieio-speedbar-menu'.
	71	;;
72	;; 3) Create a function which returns the top-level list of children
73	;; objects to be displayed in speedbar.
74	;;
75	;; 4) Call `eieio-speedbar-create' as specified in it's documentation
76	;; string. This will automatically handle cases when speedbar is
77	;; not already loaded, and specifying all overload functions.
78	;;
9ffe3f52	79	;; 5) Create an initializer function which looks like this:
6dd12ef2	80	;;
9ffe3f52	81	;; (defun my-speedbar-mode-initialize ()
6dd12ef2 CY	82	;; "documentation"
	83	;; (interactive)
	84	;; (speedbar-frame-mode 1)
	85	;; (speedbar-change-initial-expansion-list mymodename)
	86	;; (speedbar-get-focus))
	87	;;
	88	;; where `mymodename' is the same value as passed to `eieio-speedbar-create'
	89	;; as the MODENAME parameter.
	90
	91	;; @todo - Can we make this ECB friendly?
	92
	93	;;; Code:
	94	(require 'eieio)
	95	(require 'eieio-custom)
	96	(require 'speedbar)
	97
	98	;;; Support a way of adding generic object based modes into speedbar.
	99	;;
	100	(defun eieio-speedbar-make-map ()
	101	"Make the generic object based speedbar keymap."
	102	(let ((map (speedbar-make-specialized-keymap)))
	103
	104	;; General viewing things
	105	(define-key map "\C-m" 'speedbar-edit-line)
	106	(define-key map "+" 'speedbar-expand-line)
	107	(define-key map "=" 'speedbar-expand-line)
	108	(define-key map "-" 'speedbar-contract-line)
	109
	110	;; Some object based things
	111	(define-key map "C" 'eieio-speedbar-customize-line)
	112	map))
	113
	114	(defvar eieio-speedbar-key-map (eieio-speedbar-make-map)
a8f316ca	115	"A generic object based speedbar display keymap.")
6dd12ef2 CY	116
	117	(defvar eieio-speedbar-menu
	118	'([ "Edit Object/Field" speedbar-edit-line t]
	119	[ "Expand Object" speedbar-expand-line
	120	(save-excursion (beginning-of-line)
	121	(looking-at "[0-9]+: *.\\+. "))]
	122	[ "Contract Object" speedbar-contract-line
	123	(save-excursion (beginning-of-line)
	124	(looking-at "[0-9]+: *.-. "))]
	125	"---"
	126	[ "Customize Object" eieio-speedbar-customize-line
	127	(eieio-object-p (speedbar-line-token)) ]
	128	)
	129	"Menu part in easymenu format used in speedbar while browsing objects.")
	130
	131	;; Note to self: Fix this silly thing!
	132	(defalias 'eieio-speedbar-customize-line 'speedbar-edit-line)
	133
	134	(defun eieio-speedbar-create (map-fn map-var menu-var modename fetcher)
	135	"Create a speedbar mode for displaying an object hierarchy.
	136	MAP-FN is the keymap generator function used for extra keys.
	137	MAP-VAR is the keymap variable used.
9ffe3f52 GM	138	MENU-VAR is the symbol containing an easymenu compatible menu part to use.
9ffe3f52 GM	139	MODENAME is a string used to identify this browser mode.
6dd12ef2 CY	140	FETCHER is a generic function used to fetch the base object list used when
	141	creating the speedbar display."
	142	(if (not (featurep 'speedbar))
	143	(add-hook 'speedbar-load-hook
	144	(list 'lambda nil
	145	(list 'eieio-speedbar-create-engine
	146	map-fn map-var menu-var modename fetcher)))
	147	(eieio-speedbar-create-engine map-fn map-var menu-var modename fetcher)))
	148
	149	(defun eieio-speedbar-create-engine (map-fn map-var menu-var modename fetcher)
	150	"Create a speedbar mode for displaying an object hierarchy.
	151	Called from `eieio-speedbar-create', or the speedbar load-hook.
a8f316ca	152	MAP-FN, MAP-VAR, MENU-VAR, MODENAME, and FETCHER are the same as in
6dd12ef2 CY	153	`eieio-speedbar-create'."
	154	;; make sure the keymap exists
	155	(funcall map-fn)
	156	;; Add to the expansion list.
	157	(speedbar-add-expansion-list
	158	(list modename
	159	menu-var
	160	map-var
	161	(list 'lambda '(dir depth)
	162	(list 'eieio-speedbar-buttons 'dir 'depth
	163	(list 'quote fetcher)))))
	164	;; Set the special functions.
	165	(speedbar-add-mode-functions-list
	166	(list modename
	167	'(speedbar-item-info . eieio-speedbar-item-info)
	168	'(speedbar-line-directory . eieio-speedbar-line-path))))
	169
	170	(defun eieio-speedbar-buttons (dir-or-object depth fetcher)
	171	"Create buttons for the speedbar display.
	172	Start in directory DIR-OR-OBJECT. If it is an object, just display that
a8f316ca	173	object's subelements.
6dd12ef2 CY	174	Argument DEPTH specifies how far down we have already been displayed.
	175	If it is a directory, use FETCHER to fetch all objects associated with
	176	that path."
	177	(let ((objlst (cond ((eieio-object-p dir-or-object)
	178	(list dir-or-object))
	179	((stringp dir-or-object)
	180	(funcall fetcher dir-or-object))
	181	(t dir-or-object))))
	182	(if (not objlst)
	183	(speedbar-make-tag-line nil nil nil nil "Empty display" nil nil nil
	184	depth)
	185	;; Dump all objects into speedbar
	186	(while objlst
	187	(eieio-speedbar-make-tag-line (car objlst) depth)
	188	(setq objlst (cdr objlst))))))
	189
	190	\f
	191	;;; DEFAULT SUPERCLASS baseline methods
	192	;;
62a81506 CY	193	;; First, define methods with no class defined. These will work as if
	194	;; on the default superclass. Specifying no class will allow these to be used
	195	;; when no other methods are found, allowing multiple inheritance to work
	196	;; reliably with eieio-speedbar.
6dd12ef2	197
62a81506	198	(defmethod eieio-speedbar-description (object)
6dd12ef2 CY	199	"Return a string describing OBJECT."
	200	(object-name-string object))
	201
62a81506	202	(defmethod eieio-speedbar-derive-line-path (object)
6dd12ef2 CY	203	"Return the path which OBJECT has something to do with."
	204	nil)
	205
62a81506	206	(defmethod eieio-speedbar-object-buttonname (object)
6dd12ef2 CY	207	"Return a string to use as a speedbar button for OBJECT."
	208	(object-name-string object))
	209
62a81506	210	(defmethod eieio-speedbar-make-tag-line (object depth)
6dd12ef2 CY	211	"Insert a tag line into speedbar at point for OBJECT.
	212	By default, all objects appear as simple TAGS with no need to inherit from
	213	the special `eieio-speedbar' classes. Child classes should redefine this
	214	method to create more accurate tag lines.
	215	Argument DEPTH is the depth at which the tag line is inserted."
	216	(speedbar-make-tag-line nil nil nil nil
	217	(eieio-speedbar-object-buttonname object)
	218	'eieio-speedbar-object-click
	219	object
	220	'speedbar-tag-face
	221	depth))
	222
62a81506	223	(defmethod eieio-speedbar-handle-click (object)
6dd12ef2 CY	224	"Handle a click action on OBJECT in speedbar.
	225	Any object can be represented as a tag in SPEEDBAR without special
	226	attributes. These default objects will be pulled up in a custom
	227	object edit buffer doing an in-place edit.
	228
	229	If your object represents some other item, override this method
db9e401b	230	and take the appropriate action."
6dd12ef2 CY	231	(require 'eieio-custom)
	232	(speedbar-with-attached-buffer
	233	(eieio-customize-object object))
	234	(speedbar-maybee-jump-to-attached-frame))
	235
	236	\f
	237	;;; Class definitions
	238	;;
	239	;; Now define a special speedbar class with some
	240	;; variables with :allocation class which can be attached into
	241	;; object hierarchies.
	242	;;
	243	;; These more complex types are for objects which wish to display
	244	;; lists of children buttons.
	245
	246	(defclass eieio-speedbar nil
	247	((buttontype :initform nil
	248	:type symbol
	249	:documentation
	250	"The type of expansion button used for objects of this class.
	251	Possible values are those symbols supported by the `exp-button-type' argument
	252	to `speedbar-make-tag-line'."
	253	:allocation :class)
	254	(buttonface :initform speedbar-tag-face
	255	:type (or symbol face)
	256	:documentation
	257	"The face used on the textual part of the button for this class.
	258	See `speedbar-make-tag-line' for details."
	259	:allocation :class)
	260	(expanded :initform nil
	261	:type boolean
	262	:documentation
	263	"State of an object being expanded in speedbar.")
	264	)
	265	"Class which provides basic speedbar support for child classes.
a8f316ca	266	Add one of the child classes to this class to the parent list of a class."
6dd12ef2 CY	267	:method-invocation-order :depth-first
	268	:abstract t)
	269
	270	(defclass eieio-speedbar-directory-button (eieio-speedbar)
	271	((buttontype :initform angle)
	272	(buttonface :initform speedbar-directory-face))
	273	"Class providing support for objects which behave like a directory."
	274	:method-invocation-order :depth-first
	275	:abstract t)
	276
	277	(defclass eieio-speedbar-file-button (eieio-speedbar)
	278	((buttontype :initform bracket)
	279	(buttonface :initform speedbar-file-face))
a8f316ca	280	"Class providing support for objects which behave like a file."
6dd12ef2 CY	281	:method-invocation-order :depth-first
	282	:abstract t)
	283
	284	\f
0b381c7e	285	;;; Methods to eieio-speedbar-* which do not need to be overridden
6dd12ef2 CY	286	;;
	287	(defmethod eieio-speedbar-make-tag-line ((object eieio-speedbar)
	288	depth)
	289	"Insert a tag line into speedbar at point for OBJECT.
a8f316ca JB	290	All objects a child of symbol `eieio-speedbar' can be created from
a8f316ca JB	291	this method. Override this if you need non-traditional tag lines.
6dd12ef2 CY	292	Argument DEPTH is the depth at which the tag line is inserted."
	293	(let ((children (eieio-speedbar-object-children object))
	294	(exp (oref object expanded)))
	295	(if (not children)
	296	(if (eq (oref object buttontype) 'expandtag)
	297	(speedbar-make-tag-line 'statictag
	298	? nil nil
	299	(eieio-speedbar-object-buttonname object)
	300	'eieio-speedbar-object-click
	301	object
	302	(oref object buttonface)
	303	depth)
	304	(speedbar-make-tag-line (oref object buttontype)
	305	? nil nil
	306	(eieio-speedbar-object-buttonname object)
	307	'eieio-speedbar-object-click
	308	object
	309	(oref object buttonface)
	310	depth))
	311	(speedbar-make-tag-line (oref object buttontype)
	312	(if exp ?- ?+)
	313	'eieio-speedbar-object-expand
	314	object
	315	(eieio-speedbar-object-buttonname object)
	316	'eieio-speedbar-object-click
	317	object
	318	(oref object buttonface)
	319	depth)
	320	(if exp
	321	(eieio-speedbar-expand object (1+ depth))))))
	322
	323	(defmethod eieio-speedbar-child-make-tag-lines ((object eieio-speedbar) depth)
	324	"Base method for creating tag lines for non-object children."
	325	(error "You must implement `eieio-speedbar-child-make-tag-lines' for %s"
	326	(object-name object)))
	327
	328	(defmethod eieio-speedbar-expand ((object eieio-speedbar) depth)
	329	"Expand OBJECT at indentation DEPTH.
db9e401b	330	Inserts a list of new tag lines representing expanded elements within
6dd12ef2 CY	331	OBJECT."
	332	(let ((children (eieio-speedbar-object-children object)))
	333	(cond ((eieio-object-p (car children))
	334	(mapcar (lambda (car)
	335	(eieio-speedbar-make-tag-line car depth))
	336	children))
	337	(children (eieio-speedbar-child-make-tag-lines object depth)))))
	338
	339	\f
	340	;;; Speedbar specific function callbacks.
	341	;;
	342	(defun eieio-speedbar-object-click (text token indent)
	343	"Handle a user click on TEXT representing object TOKEN.
	344	The object is at indentation level INDENT."
	345	(eieio-speedbar-handle-click token))
	346
	347	(defun eieio-speedbar-object-expand (text token indent)
a8f316ca JB	348	"Expand object represented by TEXT.
a8f316ca JB	349	TOKEN is the object. INDENT is the current indentation level."
6dd12ef2 CY	350	(cond ((string-match "+" text) ;we have to expand this file
	351	(speedbar-change-expand-button-char ?-)
	352	(oset token expanded t)
	353	(speedbar-with-writable
	354	(save-excursion
	355	(end-of-line) (forward-char 1)
	356	(eieio-speedbar-expand token (1+ indent)))))
	357	((string-match "-" text) ;we have to contract this node
	358	(speedbar-change-expand-button-char ?+)
	359	(oset token expanded nil)
	360	(speedbar-delete-subblock indent))
	361	(t (error "Ooops... not sure what to do")))
	362	(speedbar-center-buffer-smartly))
	363
	364	(defmethod eieio-speedbar-child-description ((obj eieio-speedbar))
	365	"Return a description for a child of OBJ which is not an object."
	366	(error "You must implement `eieio-speedbar-child-description' for %s"
	367	(object-name obj)))
	368
	369	(defun eieio-speedbar-item-info ()
	370	"Display info for the current line when in EDE display mode."
	371	;; Switch across the types of the tokens.
	372	(let ((tok (speedbar-line-token)))
	373	(cond ((eieio-object-p tok)
	374	(message (eieio-speedbar-description tok)))
	375	(t
	376	(let ((no (eieio-speedbar-find-nearest-object)))
	377	(if no
	378	(eieio-speedbar-child-description no)))))))
	379
	380	(defun eieio-speedbar-find-nearest-object (&optional depth)
	381	"Search backwards to the first line associated with an object.
	382	Optional argument DEPTH is the current depth of the search."
	383	(save-excursion
	384	(if (not depth)
	385	(progn
	386	(beginning-of-line)
	387	(when (looking-at "^\\([0-9]+\\):")
	388	(setq depth (string-to-number (match-string 1))))))
	389	(when depth
	390	(while (and (not (eieio-object-p (speedbar-line-token)))
	391	(> depth 0))
	392	(setq depth (1- depth))
	393	(re-search-backward (format "^%d:" depth) nil t))
	394	(speedbar-line-token))))
	395
	396	(defun eieio-speedbar-line-path (&optional depth)
	397	"If applicable, return the path to the file the cursor is on.
	398	Optional DEPTH is the depth we start at."
	399	(save-match-data
	400	(if (not depth)
	401	(progn
	402	(beginning-of-line)
	403	(looking-at "^\\([0-9]+\\):")
	404	(setq depth (string-to-number (match-string 1)))))
	405	;; This whole function is presently bogus. Make it better later.
	406	(let ((tok (eieio-speedbar-find-nearest-object depth)))
	407	(if (eieio-object-p tok)
	408	(eieio-speedbar-derive-line-path tok)
	409	default-directory))))
	410
	411	\f
0b381c7e	412	;;; Methods to the eieio-speedbar-* classes which need to be overridden.
6dd12ef2 CY	413	;;
6dd12ef2 CY	414	(defmethod eieio-speedbar-object-children ((object eieio-speedbar))
a8f316ca	415	"Return a list of children to be displayed in speedbar.
6dd12ef2 CY	416	If the return value is a list of OBJECTs, then those objects are
	417	queried for details. If the return list is made of strings,
	418	then this object will be queried for the details needed
	419	to create a speedbar button."
	420	nil)
	421
	422	(provide 'eieio-speedbar)
	423
	424	;;; eieio-speedbar.el ends here