code.delx.au - gnu-emacs/blob - lisp/cedet/ede/speedbar.el

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