cgit.sxemacs.org Git - packages/blob - xemacs-packages/ede/ede-speedbar.el

   1 ;;; ede-speedbar.el --- Speedbar viewing of EDE projects
   2
   3 ;;;  Copyright (C) 1998, 1999, 2000, 2001, 2003, 2005, 2007  Eric M. Ludlam
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   6 ;; Keywords: project, make, tags
   7 ;; RCS: $Id: ede-speedbar.el,v 1.1 2007-11-26 15:22:11 michaels Exp $
   8
   9 ;; This file is NOT 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 2, or (at your option)
  14 ;; 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; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27 ;;
  28 ;; Display a project's hierarchy in speedbar.
  29 ;;
  30 ;; For speedbar support of your object, define these:
  31 ;; `ede-sb-button' - Create a button representing your object.
  32 ;; `ede-sb-expand' - Create the list of sub-buttons under your button
  33 ;;                          when it is expanded.
  34
  35 ;;; Code:
  36 (require 'speedbar)
  37 (require 'eieio-speedbar)
  38
  39 ;;; Speedbar support mode
  40 ;;
  41 (defvar ede-speedbar-key-map nil
  42   "A Generic object based speedbar display keymap.")
  43
  44 (defun ede-speedbar-make-map ()
  45   "Make the generic object based speedbar keymap."
  46   (setq ede-speedbar-key-map (speedbar-make-specialized-keymap))
  47
  48   ;; General viewing things
  49   (define-key ede-speedbar-key-map "\C-m" 'speedbar-edit-line)
  50   (define-key ede-speedbar-key-map "+" 'speedbar-expand-line)
  51   (define-key ede-speedbar-key-map "=" 'speedbar-expand-line)
  52   (define-key ede-speedbar-key-map "-" 'speedbar-contract-line)
  53   (define-key ede-speedbar-key-map " " 'speedbar-toggle-line-expansion)
  54
  55   ;; Some object based things
  56   (define-key ede-speedbar-key-map "C" 'eieio-speedbar-customize-line)
  57
  58   ;; Some project based things
  59   (define-key ede-speedbar-key-map "R" 'ede-speedbar-remove-file-from-target)
  60   (define-key ede-speedbar-key-map "b" 'ede-speedbar-compile-line)
  61   (define-key ede-speedbar-key-map "B" 'ede-speedbar-compile-project)
  62   (define-key ede-speedbar-key-map "D" 'ede-speedbar-make-distribution)
  63   (define-key ede-speedbar-key-map "E" 'ede-speedbar-edit-projectfile)
  64   )
  65
  66 (defvar ede-speedbar-menu
  67   '([ "Compile" ede-speedbar-compile-line t]
  68     [ "Compile Project" ede-speedbar-compile-project
  69       (ede-project-child-p (speedbar-line-token)) ]
  70     "---"
  71     [ "Edit File/Tag" speedbar-edit-line
  72       (not (object-p (speedbar-line-token)))]
  73     [ "Expand" speedbar-expand-line
  74       (save-excursion (beginning-of-line)
  75                       (looking-at "[0-9]+: *.\\+. "))]
  76     [ "Contract" speedbar-contract-line
  77       (save-excursion (beginning-of-line)
  78                       (looking-at "[0-9]+: *.-. "))]
  79     "---"
  80     [ "Remove File from Target" ede-speedbar-remove-file-from-target
  81       (stringp (speedbar-line-token)) ]
  82     [ "Customize Project/Target" eieio-speedbar-customize-line
  83       (object-p (speedbar-line-token)) ]
  84     [ "Edit Project File" ede-speedbar-edit-projectfile t]
  85     [ "Make Distribution" ede-speedbar-make-distribution
  86       (ede-project-child-p (speedbar-line-token)) ]
  87     )
  88   "Menu part in easymenu format used in speedbar while browsing objects.")
  89
  90 (eieio-speedbar-create 'ede-speedbar-make-map
  91                        'ede-speedbar-key-map
  92                        'ede-speedbar-menu
  93                        "Project"
  94                        'ede-speedbar-toplevel-buttons)
  95
  96
  97 (defun ede-speedbar ()
  98   "EDE development environment project browser for speedbar."
  99   (interactive)
 100   (speedbar-frame-mode 1)
 101   (speedbar-change-initial-expansion-list "Project")
 102   (speedbar-get-focus)
 103   )
 104
 105 (defun ede-speedbar-toplevel-buttons (dir)
 106   "Return a list of objects to display in speedbar.
 107 Argument DIR is the directory from which to derive the list of objects."
 108   ;(list (ede-load-project-file dir))
 109   (ede-load-project-file dir)
 110   ede-projects
 111   )
 112
 113 ;;; Some special commands useful in EDE
 114 ;;
 115 (defun ede-speedbar-remove-file-from-target ()
 116   "Remove the file at point from it's target."
 117   (interactive)
 118   (if (stringp (speedbar-line-token))
 119       (progn
 120         (speedbar-edit-line)
 121         (ede-remove-file))))
 122
 123 (defun ede-speedbar-compile-line ()
 124   "Compile/Build the project or target on this line."
 125   (interactive)
 126   (let ((obj (eieio-speedbar-find-nearest-object)))
 127     (if (not (object-p obj))
 128         nil
 129       (cond ((obj-of-class-p obj ede-project)
 130              (project-compile-project obj))
 131             ((obj-of-class-p obj ede-target)
 132              (project-compile-target obj))
 133             (t (error "Error in speedbar structure"))))))
 134
 135 (defun ede-speedbar-get-top-project-for-line ()
 136   "Return a project object for this line."
 137   (interactive)
 138   (let ((obj (eieio-speedbar-find-nearest-object)))
 139     (if (not (object-p obj))
 140         (error "Error in speedbar or ede structure")
 141       (if (obj-of-class-p obj ede-target)
 142           (setq obj (ede-target-parent obj)))
 143       (if (obj-of-class-p obj ede-project)
 144           obj
 145         (error "Error in speedbar or ede structure")))))
 146
 147 (defun ede-speedbar-compile-project ()
 148   "Compile/Build the project which owns this line."
 149   (interactive)
 150   (project-compile-project (ede-speedbar-get-top-project-for-line)))
 151
 152 (defun ede-speedbar-compile-file-project ()
 153   "Compile/Build the target which the current file belongs to."
 154   (interactive)
 155   (let* ((file (speedbar-line-file))
 156          (buf (find-file-noselect file))
 157          (bwin (get-buffer-window buf 0)))
 158     (if bwin
 159         (progn
 160           (select-window bwin)
 161           (raise-frame (window-frame bwin)))
 162       (dframe-select-attached-frame speedbar-frame)
 163       (set-buffer buf)
 164       (ede-compile-target))))
 165
 166 (defun ede-speedbar-make-distribution ()
 167   "Edit the project file based on this line."
 168   (interactive)
 169   (project-make-dist (ede-speedbar-get-top-project-for-line)))
 170
 171 (defun ede-speedbar-edit-projectfile ()
 172   "Edit the project file based on this line."
 173   (interactive)
 174   (project-edit-file-target (ede-speedbar-get-top-project-for-line)))
 175
 176 ;;; Speedbar Project Methods
 177 ;;
 178 (defun ede-find-nearest-file-line ()
 179   "Go backwards until we find a file."
 180   (save-excursion
 181     (beginning-of-line)
 182     (looking-at "^\\([0-9]+\\):")
 183     (let ((depth (string-to-number (match-string 1))))
 184       (while (not (re-search-forward "[]] [^ ]"
 185                                      (save-excursion (end-of-line)
 186                                                      (point))
 187                                      t))
 188         (re-search-backward (format "^%d:" (1- depth)))
 189         (setq depth (1- depth)))
 190       (speedbar-line-token))))
 191
 192 (defmethod eieio-speedbar-derive-line-path ((obj ede-project) &optional depth)
 193   "Return the path to OBJ.
 194 Optional DEPTH is the depth we start at."
 195   (file-name-directory (oref obj file))
 196   )
 197
 198 (defmethod eieio-speedbar-derive-line-path ((obj ede-target) &optional depth)
 199   "Return the path to OBJ.
 200 Optional DEPTH is the depth we start at."
 201   (let ((proj (ede-target-parent obj)))
 202     ;; Check the type of line we are currently on.
 203     ;; If we are on a child, we need a file name too.
 204     (save-excursion
 205       (let ((lt (speedbar-line-token)))
 206         (if (or (object-p lt) (stringp lt))
 207             (eieio-speedbar-derive-line-path proj)
 208           ;; a child element is a token.  Do some work to get a filename too.
 209           (concat (eieio-speedbar-derive-line-path proj)
 210                   (ede-find-nearest-file-line)))))))
 211
 212 (defmethod eieio-speedbar-description ((obj ede-project))
 213   "Provide a speedbar description for OBJ."
 214   (ede-description obj))
 215
 216 (defmethod eieio-speedbar-description ((obj ede-target))
 217   "Provide a speedbar description for OBJ."
 218   (ede-description obj))
 219
 220 (defmethod eieio-speedbar-child-description ((obj ede-target))
 221   "Provide a speedbar description for a plain-child of OBJ.
 222 A plain child is a child element which is not an EIEIO object."
 223   (or (speedbar-item-info-file-helper)
 224       (speedbar-item-info-tag-helper)))
 225
 226 (defmethod eieio-speedbar-object-buttonname ((object ede-project))
 227   "Return a string to use as a speedbar button for OBJECT."
 228   (if (ede-parent-project object)
 229       (ede-name object)
 230     (concat (ede-name object) " " (oref object version))))
 231
 232 (defmethod eieio-speedbar-object-buttonname ((object ede-target))
 233   "Return a string to use as a speedbar button for OBJECT."
 234   (ede-name object))
 235
 236 (defmethod eieio-speedbar-object-children ((this ede-project))
 237   "Return the list of speedbar display children for THIS."
 238   (with-slots (subproj targets) this
 239     (append subproj targets)))
 240
 241 (defmethod eieio-speedbar-object-children ((this ede-target))
 242   "Return the list of speedbar display children for THIS."
 243   (oref this source))
 244
 245 (defmethod eieio-speedbar-child-make-tag-lines ((this ede-target) depth)
 246   "Create a speedbar tag line for a child of THIS.
 247 It has depth DEPTH."
 248   (with-slots (source) this
 249     (mapcar (lambda (car)
 250               (speedbar-make-tag-line 'bracket ?+
 251                                       'speedbar-tag-file
 252                                       (concat (oref this :path) car)
 253                                       car
 254                                       'ede-file-find
 255                                       (concat (oref this :path) car)
 256                                       'speedbar-file-face depth))
 257             source)))
 258
 259 ;;; Generic file management for TARGETS
 260 ;;
 261 (defun ede-file-find (text token indent)
 262   "Find the file TEXT at path TOKEN.
 263 INDENT is the current indentation level."
 264   (speedbar-find-file-in-frame
 265    (concat (speedbar-line-directory) token))
 266   (speedbar-maybee-jump-to-attached-frame))
 267
 268 (defun ede-create-tag-buttons (filename indent)
 269   "Create the tag buttons associated with FILENAME at INDENT."
 270   (let* ((lst (speedbar-fetch-dynamic-tags filename)))
 271     ;; if no list, then remove expando button
 272     (if (not lst)
 273         (speedbar-change-expand-button-char ??)
 274       (speedbar-with-writable
 275         ;; We must do 1- because indent was already incremented.
 276         (speedbar-insert-generic-list (1- indent)
 277                                       lst
 278                                       'ede-tag-expand
 279                                       'ede-tag-find)))))
 280
 281 (defun ede-tag-expand (text token indent)
 282   "Expand a tag sublist.  Imenu will return sub-lists of specialized tag types.
 283 Etags does not support this feature.  TEXT will be the button
 284 string.  TOKEN will be the list, and INDENT is the current indentation
 285 level."
 286   (cond ((string-match "+" text)        ;we have to expand this file
 287          (speedbar-change-expand-button-char ?-)
 288          (speedbar-with-writable
 289            (save-excursion
 290              (end-of-line) (forward-char 1)
 291              (speedbar-insert-generic-list indent token
 292                                            'ede-tag-expand
 293                                            'ede-tag-find))))
 294         ((string-match "-" text)        ;we have to contract this node
 295          (speedbar-change-expand-button-char ?+)
 296          (speedbar-delete-subblock indent))
 297         (t (error "Ooops...  not sure what to do")))
 298   (speedbar-center-buffer-smartly))
 299
 300 (defun ede-tag-find (text token indent)
 301   "For the tag TEXT in a file TOKEN, goto that position.
 302 INDENT is the current indentation level."
 303   (let ((file (ede-find-nearest-file-line)))
 304     (speedbar-find-file-in-frame file)
 305     (save-excursion (speedbar-stealthy-updates))
 306     ;; Reset the timer with a new timeout when cliking a file
 307     ;; in case the user was navigating directories, we can cancel
 308     ;; that other timer.
 309 ;    (speedbar-set-timer speedbar-update-speed)
 310     (goto-char token)
 311     (run-hooks 'speedbar-visiting-tag-hook)
 312     ;;(recenter)
 313     (speedbar-maybee-jump-to-attached-frame)
 314     ))
 315
 316 ;;; EDE and the speedbar FILE display
 317 ;;
 318 ;; This will add a couple keybindings and menu items into the
 319 ;; FILE display for speedbar.
 320
 321 (defvar ede-speedbar-file-menu-additions
 322   '("----"
 323     ["Create EDE Target" ede-new-target (ede-current-project) ]
 324     ["Add to project" ede-speedbar-file-add-to-project (ede-current-project) ]
 325     ["Compile project" ede-speedbar-compile-project (ede-current-project) ]
 326     ["Compile file target" ede-speedbar-compile-file-target (ede-current-project) ]
 327     ["Make distribution" ede-make-dist (ede-current-project) ]
 328     )
 329   "Set of menu items to splice into the speedbar menu.")
 330
 331 (defvar ede-speedbar-file-keymap
 332   (let ((km (make-sparse-keymap)))
 333     (define-key km "a" 'ede-speedbar-file-add-to-project)
 334     (define-key km "t" 'ede-new-target)
 335     (define-key km "s" 'ede-speedbar)
 336     (define-key km "C" 'ede-speedbar-compile-project)
 337     (define-key km "c" 'ede-speedbar-compile-file-target)
 338     (define-key km "d" 'ede-make-dist)
 339     km)
 340   "Keymap spliced into the speedbar keymap.")
 341
 342 (defun ede-speedbar-file-setup ()
 343   "Setup some keybindings in the Speedbar File display."
 344   (setq speedbar-easymenu-definition-special
 345         (append speedbar-easymenu-definition-special
 346                 ede-speedbar-file-menu-additions
 347                 ))
 348   (define-key speedbar-file-key-map "." ede-speedbar-file-keymap)
 349   ;; Finally, if the FILES mode is loaded, force a refresh
 350   ;; of the menus and such.
 351   (if (string= speedbar-initial-expansion-list-name "files")
 352       (speedbar-change-initial-expansion-list "files")))
 353
 354 (provide 'ede-speedbar)
 355
 356 ;;; ede-speedbar.el ends here