Mercurial > emacs
view lisp/emacs-lisp/eieio-speedbar.el @ 111672:7c6e6f2b3351
gnus-art.el (gnus-url-mailto): Do not downcase args.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Mon, 22 Nov 2010 11:33:06 +0000 |
parents | 280c8ae2476d |
children | 417b1e4d63cd |
line wrap: on
line source
;;; eieio-speedbar.el -- Classes for managing speedbar displays. ;; Copyright (C) 1999, 2000, 2001, 2002, 2005, 2007, 2008, 2009, 2010 ;; Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Version: 0.2 ;; 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)))))) ;;; 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 appropriate action." (require 'eieio-custom) (speedbar-with-attached-buffer (eieio-customize-object object)) (speedbar-maybee-jump-to-attached-frame)) ;;; 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) ;;; 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 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))))) ;;; 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)))) ;;; 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) ;; arch-tag: eaac1283-10b0-4419-a929-982b87e83234 ;;; eieio-speedbar.el ends here