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
   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 "[]] [^ ]"
 180                                      (save-excursion (end-of-line)
 181                                                      (point))
 182                                      t))
 183         (re-search-backward (format "^%d:" (1- depth)))
 184         (setq depth (1- depth)))
 185       (speedbar-line-token))))
 186
 187 (defmethod eieio-speedbar-derive-line-path ((obj ede-project) &optional depth)
 188   "Return the path to OBJ.
 189 Optional DEPTH is the depth we start at."
 190   (file-name-directory (oref obj file))
 191   )
 192
 193 (defmethod eieio-speedbar-derive-line-path ((obj ede-target) &optional depth)
 194   "Return the path to OBJ.
 195 Optional DEPTH is the depth we start at."
 196   (let ((proj (ede-target-parent obj)))
 197     ;; Check the type of line we are currently on.
 198     ;; If we are on a child, we need a file name too.
 199     (save-excursion
 200       (let ((lt (speedbar-line-token)))
 201         (if (or (eieio-object-p lt) (stringp lt))
 202             (eieio-speedbar-derive-line-path proj)
 203           ;; a child element is a token.  Do some work to get a filename too.
 204           (concat (eieio-speedbar-derive-line-path proj)
 205                   (ede-find-nearest-file-line)))))))
 206
 207 (defmethod eieio-speedbar-description ((obj ede-project))
 208   "Provide a speedbar description for OBJ."
 209   (ede-description obj))
 210
 211 (defmethod eieio-speedbar-description ((obj ede-target))
 212   "Provide a speedbar description for OBJ."
 213   (ede-description obj))
 214
 215 (defmethod eieio-speedbar-child-description ((obj ede-target))
 216   "Provide a speedbar description for a plain-child of OBJ.
 217 A plain child is a child element which is not an EIEIO object."
 218   (or (speedbar-item-info-file-helper)
 219       (speedbar-item-info-tag-helper)))
 220
 221 (defmethod eieio-speedbar-object-buttonname ((object ede-project))
 222   "Return a string to use as a speedbar button for OBJECT."
 223   (if (ede-parent-project object)
 224       (ede-name object)
 225     (concat (ede-name object) " " (oref object version))))
 226
 227 (defmethod eieio-speedbar-object-buttonname ((object ede-target))
 228   "Return a string to use as a speedbar button for OBJECT."
 229   (ede-name object))
 230
 231 (defmethod eieio-speedbar-object-children ((this ede-project))
 232   "Return the list of speedbar display children for THIS."
 233   (condition-case nil
 234       (with-slots (subproj targets) this
 235         (append subproj targets))
 236     (error nil)))
 237
 238 (defmethod eieio-speedbar-object-children ((this ede-target))
 239   "Return the list of speedbar display children for THIS."
 240   (oref this source))
 241
 242 (defmethod eieio-speedbar-child-make-tag-lines ((this ede-target) depth)
 243   "Create a speedbar tag line for a child of THIS.
 244 It has depth DEPTH."
 245   (with-slots (source) this
 246     (mapcar (lambda (car)
 247               (speedbar-make-tag-line 'bracket ?+
 248                                       'speedbar-tag-file
 249                                       car
 250                                       car
 251                                       'ede-file-find
 252                                       car
 253                                       'speedbar-file-face depth))
 254             source)))
 255
 256 ;;; Generic file management for TARGETS
 257 ;;
 258 (defun ede-file-find (text token indent)
 259   "Find the file TEXT at path TOKEN.
 260 INDENT is the current indentation level."
 261   (speedbar-find-file-in-frame
 262    (expand-file-name token (speedbar-line-directory indent)))
 263   (speedbar-maybee-jump-to-attached-frame))
 264
 265 (defun ede-create-tag-buttons (filename indent)
 266   "Create the tag buttons associated with FILENAME at INDENT."
 267   (let* ((lst (speedbar-fetch-dynamic-tags filename)))
 268     ;; if no list, then remove expando button
 269     (if (not lst)
 270         (speedbar-change-expand-button-char ??)
 271       (speedbar-with-writable
 272         ;; We must do 1- because indent was already incremented.
 273         (speedbar-insert-generic-list (1- indent)
 274                                       lst
 275                                       'ede-tag-expand
 276                                       'ede-tag-find)))))
 277
 278 (defun ede-tag-expand (text token indent)
 279   "Expand a tag sublist.  Imenu will return sub-lists of specialized tag types.
 280 Etags does not support this feature.  TEXT will be the button
 281 string.  TOKEN will be the list, and INDENT is the current indentation
 282 level."
 283   (cond ((string-match "+" text)        ;we have to expand this file
 284          (speedbar-change-expand-button-char ?-)
 285          (speedbar-with-writable
 286            (save-excursion
 287              (end-of-line) (forward-char 1)
 288              (speedbar-insert-generic-list indent token
 289                                            'ede-tag-expand
 290                                            'ede-tag-find))))
 291         ((string-match "-" text)        ;we have to contract this node
 292          (speedbar-change-expand-button-char ?+)
 293          (speedbar-delete-subblock indent))
 294         (t (error "Ooops...  not sure what to do")))
 295   (speedbar-center-buffer-smartly))
 296
 297 (defun ede-tag-find (text token indent)
 298   "For the tag TEXT in a file TOKEN, goto that position.
 299 INDENT is the current indentation level."
 300   (let ((file (ede-find-nearest-file-line)))
 301     (speedbar-find-file-in-frame file)
 302     (save-excursion (speedbar-stealthy-updates))
 303     ;; Reset the timer with a new timeout when cliking a file
 304     ;; in case the user was navigating directories, we can cancel
 305     ;; that other timer.
 306 ;    (speedbar-set-timer speedbar-update-speed)
 307     (goto-char token)
 308     (run-hooks 'speedbar-visiting-tag-hook)
 309     ;;(recenter)
 310     (speedbar-maybee-jump-to-attached-frame)
 311     ))
 312
 313 ;;; EDE and the speedbar FILE display
 314 ;;
 315 ;; This will add a couple keybindings and menu items into the
 316 ;; FILE display for speedbar.
 317
 318 (defvar ede-speedbar-file-menu-additions
 319   '("----"
 320     ["Create EDE Target" ede-new-target (ede-current-project) ]
 321     ["Add to project" ede-speedbar-file-add-to-project (ede-current-project) ]
 322     ["Compile project" ede-speedbar-compile-project (ede-current-project) ]
 323     ["Compile file target" ede-speedbar-compile-file-target (ede-current-project) ]
 324     ["Make distribution" ede-make-dist (ede-current-project) ]
 325     )
 326   "Set of menu items to splice into the speedbar menu.")
 327
 328 (defvar ede-speedbar-file-keymap
 329   (let ((km (make-sparse-keymap)))
 330     (define-key km "a" 'ede-speedbar-file-add-to-project)
 331     (define-key km "t" 'ede-new-target)
 332     (define-key km "s" 'ede-speedbar)
 333     (define-key km "C" 'ede-speedbar-compile-project)
 334     (define-key km "c" 'ede-speedbar-compile-file-target)
 335     (define-key km "d" 'ede-make-dist)
 336     km)
 337   "Keymap spliced into the speedbar keymap.")
 338
 339 ;;;###autoload
 340 (defun ede-speedbar-file-setup ()
 341   "Setup some keybindings in the Speedbar File display."
 342   (setq speedbar-easymenu-definition-special
 343         (append speedbar-easymenu-definition-special
 344                 ede-speedbar-file-menu-additions
 345                 ))
 346   (define-key speedbar-file-key-map "." ede-speedbar-file-keymap)
 347   ;; Finally, if the FILES mode is loaded, force a refresh
 348   ;; of the menus and such.
 349   (when (and (string= speedbar-initial-expansion-list-name "files")
 350              (buffer-live-p speedbar-buffer)
 351              )
 352     (speedbar-change-initial-expansion-list "files")))
 353
 354 (provide 'ede/speedbar)
 355
 356 ;; Local variables:
 357 ;; generated-autoload-file: "loaddefs.el"
 358 ;; generated-autoload-load-name: "ede/speedbar"
 359 ;; End:
 360
 361 ;; arch-tag: 56721fc9-8eb5-4115-8511-18cf8397ec87
 362 ;;; ede/speedbar.el ends here