tools/workspace.el

   1 ;;
   2 ;; Copyright 2001, Sony Online Entertainment, Inc.
   3 ;; All rights reserved.
   4 ;;
   5
   6 ;;; declare variables
   7 (defvar workspace-directory nil "workspace base directory")
   8 (defvar workspace-completion-obarray nil "workspace completion data")
   9 (defvar workspace-completion-hashsize 2047 "workspace completion hash entry count")
  10 (defvar workspace-headerflip-source-extension-alist '((".c") (".cpp") (".cxx") (".C") (".plsql")) "workspace headerflip source extension alist")
  11 (defvar workspace-headerflip-header-extension-alist '((".h") (".hpp") (".hxx") (".plsqlh")) "workspace headerflip header extension alist")
  12
  13 ;;; Read a file containing workspace entries.  Each line contains
  14 ;;; the short filename followed by the path to the filename.  The
  15 ;;; path listed is relative to the workspace file path.
  16
  17 (defun workspace-find-workspace (workspace-pathname)
  18   "Open a workspace file.  Replaces any existing workspace file."
  19   (interactive "fWorkspace Filename: ")
  20
  21   ;; pull directory out of the workspace pathname.  we'll need it later.
  22   (posix-string-match "\\(.*/\\).*$" workspace-pathname)
  23   (setq workspace-directory (substring workspace-pathname (match-beginning 1) (match-end 1)))
  24
  25   ;; create a temp buffer for workspace processing
  26   (with-temp-buffer
  27
  28     ;; insert-file-contents of the workspace file
  29     (insert-file-contents workspace-pathname)
  30
  31     ;; initialize completion hash
  32     (setq workspace-completion-obarray (make-vector workspace-completion-hashsize 0))
  33
  34     ;; build lookup table entry for each entry in workspace
  35     (while (posix-search-forward "^\\(.*\\):\\(.*\\)$" nil t)
  36
  37       ;; add entry to completion obarray
  38       (let
  39           (
  40            (completion-entry (intern-soft (match-string 1) workspace-completion-obarray))
  41            (completion-data (list (match-string 2)))
  42            )
  43
  44         (if completion-entry
  45             ;; entry already in array, append completion data to entry's list value
  46             (set completion-entry (append (symbol-value completion-entry) completion-data))
  47
  48           ;; entry doesn't exist, create it and set value to completion-data list
  49           (setq completion-entry (intern (match-string 1) workspace-completion-obarray))
  50           (set completion-entry completion-data)
  51           )
  52         )
  53       )
  54     )
  55   )
  56
  57 ;;; workspace-find-file function.  This works like find-file (C-x f),
  58 ;;; but allows the user to enter the short filename of a workspace
  59 ;;; file instead of the whole path.  If there is only one file with
  60 ;;; the given short filename, that file will be opened.  If multiple
  61 ;;; files exist in the workspace with the same short name, the user is
  62 ;;; prompted to differentiate which one is desired.  Standard Emacs
  63 ;;; completion is available at all stages.
  64
  65 (defun workspace-find-file ()
  66   "Find file within workspace using short filename (no path)."
  67   (interactive)
  68
  69   (let (
  70         (completion-entry-name (completing-read "Workspace Filename: " workspace-completion-obarray nil t))
  71         )
  72     (let (
  73           (completion-entry (intern completion-entry-name workspace-completion-obarray))
  74           )
  75       (let (
  76             (completion-list (symbol-value completion-entry))
  77             (completion-list-copy ())
  78             (directory nil)
  79             (path-completion-list ())
  80             ; (full-pathname (concat workspace-directory (car (symbol-value completion-entry)) completion-entry-name))
  81             )
  82
  83         ;; if there's only one completion entry, open it.  Otherwise, we need to
  84         ;; provide the user with a selection of files to open.
  85         (if (null (cdr completion-list))
  86             ;; only one entry, no selection required
  87             (find-file (concat workspace-directory (car completion-list) completion-entry-name))
  88
  89           ;; multiple entries for the short filename.  must provide a choice.
  90           ;; build short filename's path completion list.
  91           (setq completion-list-copy (copy-sequence completion-list))
  92           (while (setq directory (car completion-list-copy))
  93             ;; add directory + short filename to alist of choices.
  94             ;; note: the alist does not associate anything with the pathname in this case.
  95             (setq path-completion-list (cons (list (concat directory completion-entry-name)) path-completion-list))
  96
  97             ;; remove directory from copy list
  98             (setq completion-list-copy (cdr completion-list-copy))
  99             )
 100
 101           ;; ask user to choose workspace pathname
 102           (let (
 103                 (chosen-filename (completing-read "Choose path: " path-completion-list nil t))
 104                 )
 105             (find-file (concat workspace-directory chosen-filename))
 106             )
 107           )
 108         )
 109       )
 110     )
 111   )
 112
 113 ;;; Function used internally to find and open the first existing file
 114 ;;; that starts with a given base filename and an assoc-list of
 115 ;;; extensions.
 116
 117 (defun workspace-open-base-find-extension (pathname-base extension-alist)
 118   "Workspace internal function used to try to open a given base filename trying to append each extension in the alist."
 119
 120   ;; open the first pathname (base + ext) that exists
 121   (let (
 122         (alist-copy (copy-sequence extension-alist))
 123         (alist-entry nil)
 124         (extension nil)
 125         (try-pathname nil)
 126         )
 127     (while (setq alist-entry (car alist-copy))
 128       ;; get extension
 129       (setq extension (car alist-entry))
 130
 131       ;; build try pathname
 132       (setq try-pathname (concat pathname-base extension))
 133
 134       ;; open file if filename is exists and is readable
 135       (if (file-readable-p try-pathname)
 136           (find-file try-pathname))
 137
 138       ;; increment loop
 139       (setq alist-copy (cdr alist-copy))
 140       )
 141     )
 142   )
 143
 144 ;;; This funciton provides header-flip functionality.  If the user is
 145 ;;; in a source-code implementation file, execution of this function
 146 ;;; will open the corresponding header file (or vice versa).
 147 ;;; Implementation and header file extensions are defined in separate
 148 ;;; assoc-lists at the top of this file.
 149
 150 (defun workspace-header-flip ()
 151   "Flip between header and implementation file."
 152   (interactive)
 153
 154   ;; get pathname of current buffer
 155   (let (
 156         (pathname (buffer-file-name))
 157         (extension nil)
 158         (pathname-no-extension nil)
 159         (is-source nil)
 160         (is-header nil)
 161         )
 162
 163     ;; find extension of pathname
 164     (posix-string-match "\\(.*\\)\\(\\..*\\)$" pathname)
 165     (if (match-beginning 2)
 166         ;; we have an extension
 167         (progn
 168           ;; get the extension
 169           (setq extension (substring pathname (match-beginning 2) (match-end 2)))
 170
 171           ;; determine if we're considered a source or header
 172           (if (assoc extension workspace-headerflip-source-extension-alist)
 173               (setq is-source t))
 174           (if (assoc extension workspace-headerflip-header-extension-alist)
 175               (setq is-header t))
 176
 177           ;; only do more work if we're a source or header
 178           (if (or is-source is-header)
 179               (progn
 180                 ;; get pathname without extension
 181                 (setq pathname-no-extension (substring pathname (match-beginning 1) (match-end 1)))
 182
 183                 (if is-source
 184                     ;; if source, try to open base pathname with any header extension attached
 185                     (workspace-open-base-find-extension pathname-no-extension workspace-headerflip-header-extension-alist)
 186
 187                   ;; if source, try to open base pathname with any header extension attached
 188                   (workspace-open-base-find-extension pathname-no-extension workspace-headerflip-source-extension-alist)
 189                   )
 190                 )
 191             )
 192           )
 193
 194       ;; no extension found
 195       (prin1 (format "failed to find extension for [%s]" pathname))
 196       )
 197     )
 198   )
 199
 200 (provide 'workspace)