| 1 | ;;; ede/speedbar.el --- Speedbar viewing of EDE projects |
| 2 | |
| 3 | ;; Copyright (C) 1998-2001, 2003, 2005, 2007-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 |