lisp/cedet/ede/speedbar.el

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