emacs/nxhtml/util/ffip.el

   1 ;;; ffip.el --- Find files in project
   2 ;;
   3 ;; Authors: extracted from rinari by Phil Hagelberg and Doug Alcorn
   4 ;; Changed by Lennart Borgman
   5 ;; Created: 2008-08-14T23:46:22+0200 Thu
   6 ;; Version: 0.3
   7 ;; Last-Updated: 2008-12-28 Sun
   8 ;; URL:
   9 ;; Keywords:
  10 ;; Compatibility:
  11 ;;
  12 ;; Features that might be required by this library:
  13 ;;
  14 ;;   None
  15 ;;
  16 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  17 ;;
  18 ;;; Commentary:
  19 ;;
  20 ;;
  21 ;;
  22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23 ;;
  24 ;;; Change log:
  25 ;;
  26 ;;
  27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28 ;;
  29 ;; This program is free software; you can redistribute it and/or
  30 ;; modify it under the terms of the GNU General Public License as
  31 ;; published by the Free Software Foundation; either version 2, or
  32 ;; (at your option) any later version.
  33 ;;
  34 ;; This program is distributed in the hope that it will be useful,
  35 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  36 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  37 ;; General Public License for more details.
  38 ;;
  39 ;; You should have received a copy of the GNU General Public License
  40 ;; along with this program; see the file COPYING.  If not, write to
  41 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
  42 ;; Floor, Boston, MA 02110-1301, USA.
  43 ;;
  44 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  45 ;;
  46 ;;; Code:
  47
  48 (eval-when-compile (require 'cl))
  49
  50 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  51 ;;; Project data
  52
  53 ;; Fix-me: Change the inner structure of ffip projects
  54 (defvar ffip-project-name nil "Project name.")
  55 (defvar ffip-project-roots nil "Project directory roots.")
  56 (defvar ffip-project-type nil "Project type, `ffip-project-file-types'.")
  57 (defcustom ffip-project-file-types
  58   (list
  59     '(ruby "\\(\\.el$\\|\\.rb$\\|\\.js$\\|\\.emacs\\)")
  60     (list 'nxhtml (concat
  61                    (regexp-opt '(".html" ".htm" ".xhtml"
  62                                  ".css"
  63                                  ".js"
  64                                  ".png" ".gif"
  65                                  ))
  66                   "\\'"))
  67     )
  68   "Project types and file types.
  69 The values in this list are used to determine if a file belongs
  70 to the current ffip project. Entries have the form
  71
  72   \(TYPE FILE-REGEXP)
  73
  74 TYPE is the parameter set by `ffip-set-current-project'.  Files
  75 matching FILE-REGEXP within the project roots are members of the
  76 project."
  77   :type '(repeat (list
  78                   (symbol :tag "Type")
  79                   (regexp :tag "File regexp")))
  80   :group 'ffip)
  81
  82 (defvar ffip-project-file-matcher nil "Project file matcher.")
  83 (defvar ffip-project-files-table nil "Project file cache.")
  84
  85 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  86 ;;; Project handling
  87
  88 (defun ffip-reset-project ()
  89   "Clear project data."
  90   (remove-hook 'after-save-hook 'ffip-after-save)
  91   (setq ffip-project-name nil)
  92   (setq ffip-project-roots nil)
  93   (setq ffip-project-files-table nil)
  94   (setq ffip-project-type nil)
  95   (setq ffip-project-file-matcher nil))
  96 ;;(ffip-reset-project)
  97
  98 (defun ffip-is-current (name root type)
  99   "Return non-nil if NAME, ROOT and TYPE match current ffip project.
 100 See `ffip-set-current-project'."
 101   (and name
 102        (string= ffip-project-name name)
 103        (eq ffip-project-type type)
 104        (equal ffip-project-roots root)))
 105
 106 ;;;###autoload
 107 (defun ffip-set-current-project (name root type)
 108   "Setup ffip project NAME with top directory ROOT of type TYPE.
 109 ROOT can either be just a directory or a list of directory where
 110 the first used just for prompting purposes and the files in the
 111 rest are read into the ffip project.
 112
 113 Type is a type in `ffip-project-file-types'."
 114   (unless (ffip-is-current name root type)
 115     (ffip-reset-project)
 116     (setq ffip-project-name name)
 117     (setq ffip-project-type type)
 118     (setq ffip-project-roots root)
 119     (message "Project %s with %s files setup for find-files-in-project"
 120              name (length ffip-project-files-table))))
 121
 122 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 123 ;;; File cache handling
 124
 125 (defun ffip-cache-project-files (file-regexp)
 126   "Read files and cache their names within the ffip project."
 127   (let ((root ffip-project-roots))
 128     (message "... reading files in %s ..." root)
 129     (add-hook 'after-save-hook 'ffip-after-save)
 130     (if (not (listp root))
 131         (ffip-populate-files-table root file-regexp)
 132       (setq root (cdr root))
 133       (dolist (r root)
 134         (ffip-populate-files-table r file-regexp)))))
 135
 136 (defun ffip-file-matcher ()
 137   (when ffip-project-type
 138     (cadr (assoc ffip-project-type ffip-project-file-types))))
 139
 140 (defun ffip-project-files ()
 141   "Get a list of all files in ffip project.
 142 The members in the list has the format
 143
 144   \(SHORT-NAME . FULL-NAME)
 145
 146 where SHORT-NAME is a unique name (normally file name without
 147 directory) and FULL-NAME is the full file name."
 148   (unless ffip-project-files-table
 149     (let ((file-regexp (ffip-file-matcher)))
 150       (ffip-cache-project-files file-regexp)))
 151   ffip-project-files-table)
 152
 153 ;; Fix-me: Seems better to rewrite this to use
 154 ;; project-find-settings-file.
 155 (defun ffip-project-root (&optional dir)
 156   (setq dir (or dir
 157                 ffip-project-roots
 158                 default-directory))
 159   ;;(locate-dominating-file "." "\\`\\find-file-in-project.el\\'")
 160   (let ((root (locate-dominating-file dir
 161                                       ;;"\\`\\.emacs-project\\'"
 162                                       "\\`\\.dir-settings\\.el\\'"
 163                                       )))
 164     (if root
 165         (file-name-directory root)
 166       dir)))
 167
 168 (defun ffip-populate-files-table (file file-regexp)
 169   ;;(message "ffip-populate-files-table.file=%s" file)
 170   (if (file-directory-p file)
 171       (mapc (lambda (file)
 172               (ffip-populate-files-table file file-regexp))
 173             (directory-files (expand-file-name file) t "^[^\.]"))
 174     (let* ((file-name (file-name-nondirectory file))
 175            (existing-record (assoc file-name ffip-project-files-table))
 176            (unique-parts (ffip-get-unique-directory-names file
 177                                                      (cdr existing-record))))
 178       (when (or (not file-regexp)
 179               (string-match file-regexp file-name))
 180           (if existing-record
 181               (let ((new-key (concat file-name " - " (car unique-parts)))
 182                     (old-key (concat (car existing-record) " - "
 183                                      (cadr unique-parts))))
 184                 (setf (car existing-record) old-key)
 185                 (setq ffip-project-files-table
 186                       (acons new-key file ffip-project-files-table)))
 187             (setq ffip-project-files-table
 188                   (acons file-name file ffip-project-files-table)))))))
 189
 190 (defun ffip-get-unique-directory-names (path1 path2)
 191   (let* ((parts1 (and path1 (split-string path1 "/" t)))
 192          (parts2 (and path2 (split-string path2 "/" t)))
 193          (part1 (pop parts1))
 194          (part2 (pop parts2))
 195          (looping t))
 196     (while (and part1 part2 looping)
 197       (if (equal part1 part2)
 198           (setq part1 (pop parts1) part2 (pop parts2))
 199         (setq looping nil)))
 200     (list part1 part2)))
 201
 202 (defun ffip-file-is-in-project (file-name)
 203   "Return non-nil if file is in current ffip project."
 204   (save-match-data
 205     (let ((file-regexp (ffip-file-matcher))
 206           (roots ffip-project-roots)
 207           regexp)
 208       (if (not (listp roots))
 209           (setq roots (list roots))
 210         (setq roots (cdr roots)))
 211       (catch 'found
 212       (dolist (root roots)
 213         (setq file-regexp (concat root ".*" file-regexp))
 214         (when (string-match file-regexp file-name)
 215           (throw 'found t)))))))
 216
 217
 218 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 219 ;;; Updating on file changes
 220
 221 (defun ffip-add-file-if-in-project (file-name)
 222   "Add file to cache if it in ffip project."
 223   (when (ffip-file-is-in-project file-name)
 224     ;; We have already checked so just use nil for the matcher.
 225     (ffip-populate-files-table file-name nil)))
 226
 227 ;; For after-save-hook
 228 (defun ffip-after-save ()
 229   "Check if a file should be added to cache."
 230   (condition-case err
 231       (ffip-add-file-if-in-project buffer-file-name)
 232     (error (message "%s" (error-message-string err)))))
 233
 234
 235 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 236 ;;; Interactive functions
 237
 238 ;;;###autoload
 239 (defun ffip-find-file-in-dirtree (root)
 240   "Find files in directory tree ROOT."
 241   (interactive "DFind file in directory tree: ")
 242   ;; Setup a temporary
 243   (let ((ffip-project-name nil)
 244         (ffip-project-roots nil)
 245         (ffip-project-files-table nil)
 246         (ffip-project-type nil)
 247         (ffip-project-file-matcher nil))
 248     (ffip-set-current-project "(temporary)" root nil)
 249     (call-interactively 'ffip-find-file-in-project)))
 250
 251 (defun ffip-find-file-in-project (file)
 252   "Find files in current ffip project."
 253   (interactive
 254    (list
 255     (let* ((prompt (format "Find file in project %s: "
 256                            ffip-project-name)))
 257       (if (memq ido-mode '(file 'both))
 258           (ido-completing-read prompt
 259                                (mapcar 'car (ffip-project-files)))
 260         (let ((files (mapcar 'car (ffip-project-files))))
 261           (completing-read prompt
 262                            files
 263                            (lambda (elem) (member elem files))
 264                            t))))))
 265   (find-file (cdr (assoc file ffip-project-files-table))))
 266
 267 ;;(global-set-key (kbd "C-x C-M-f") 'find-file-in-project)
 268
 269
 270 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 271 ;;; Fix-me: This part should go somewhere else
 272 (eval-after-load 'ruby-mode
 273   '(progn
 274      (defun ffip-rails-project-files (&optional file)
 275        (let ((default-directory (or file (rails-root))))
 276          (unless (and ffip-project-roots
 277                       (string= default-directory ffip-project-roots))
 278            (ffip-set-current-project
 279             "Rails proj"
 280             root
 281             (list default-directory
 282                   (expand-file-name "app")
 283                   (expand-file-name "lib")
 284                   (expand-file-name "test"))
 285             'ruby
 286             )))
 287        (ffip-project-files))
 288
 289      (defun ffip-find-file-in-rails (file)
 290        (interactive
 291         (list (if (memq ido-mode '(file 'both))
 292                   (ido-completing-read
 293                    "Find file in project: "
 294                    (mapcar 'car (ffip-rails-project-files)))
 295                 (completing-read "Find file in project: "
 296                                  (mapcar 'car (rails-project-files))))))
 297        (find-file (cdr (assoc file ffip-project-files-table))))
 298
 299      (define-key ruby-mode-map (kbd "C-x C-M-f") 'find-file-in-rails)
 300      (eval-after-load 'nxhtml-mode
 301        '(define-key nxhtml-mode-map (kbd "C-x C-M-f") 'find-file-in-rails))))
 302
 303 (provide 'ffip)
 304 ;;; ffip.el ends here