extensions/fsproject.el

   1 ;;; fsproject.el --- File System Project Viewer
   2 ;;
   3 ;; Author:      Cedric Lallain <kandjar76@hotmail.com>
   4 ;; Version:     1.0
   5 ;; Keywords:    project buffer makefile filesystem management
   6 ;; Description: File System Project Viewer
   7 ;; Tested with: GNU Emacs 22.x and GNU Emacs 23.x
   8 ;;
   9 ;; This file is *NOT* part of GNU Emacs.
  10 ;;
  11 ;;    This program 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 2 of the License, or
  14 ;;    (at your option) any later version.
  15 ;;
  16 ;;    This program 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 this program; if not, write to the Free Software
  23 ;;    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  24 ;;
  25
  26 ;;; Commentary:
  27 ;;
  28
  29 ;; This is an add-on library for project-buffer-mode.
  30 ;;
  31 ;; This library provides a function to create a project-buffer based
  32 ;; on a root directory and it's sub folders.  It detects the project
  33 ;; root using a regular expression, and accept filter to create base
  34 ;; path.
  35 ;;
  36 ;; Note: this library doesn't provide any user commands!
  37 ;;
  38 ;; In order to use it, you can either create your own command, or call
  39 ;;   fsproject-create-project from your init.el.
  40 ;;
  41 ;; I haven't found a satisfied way to create a uniform command for this
  42 ;; file, that's why there is none.
  43 ;;
  44 ;;
  45 ;; Here is an example of a command with an implementation of an action
  46 ;; handler:
  47 ;;
  48 ;; (defun my-action-handler(action project-name project-path platform configuration)
  49 ;;   "project action handler."
  50 ;;   (let ((make-cmd (cond ((eq action 'build) "")
  51 ;;                         ((eq action 'clean) "clean")
  52 ;;                         ((eq action 'run)   "run")
  53 ;;                         ((eq action 'debug) "debug"))))
  54 ;;     (compile
  55 ;;      (concat "make -j16 -C " (file-name-directory project-path)
  56 ;;                       " -f " (file-name-nondirectory project-path)
  57 ;;                          " " make-cmd))))
  58 ;;
  59 ;; (autoload 'fsproject-create-project "fsproject")
  60 ;; (defun fsproject-new(root-folder)
  61 ;;   (interactive "sRoot folder: ")
  62 ;;   (let ((regexp-project-name  "[Mm]akefile")
  63 ;;         (regexp-file-filter   '("\\.cpp$" "\\.h$" "\\.inl$" "\\.mak$" "Makefile"))
  64 ;;         (ignore-folders       '("build" "docs" "bin"))
  65 ;;         (pattern-modifier     nil)
  66 ;;         (build-configurations '("debug" "release"))
  67 ;;         (platforms            '("Linux")))
  68 ;;     (fsproject-create-project root-folder
  69 ;;                            regexp-project-name
  70 ;;                            regexp-file-filter
  71 ;;                            'my-action-handler
  72 ;;                            ignore-folders
  73 ;;                            pattern-modifier
  74 ;;                            build-configurations
  75 ;;                            platforms)))
  76 ;;
  77 ;; And if you want to have only have a source and include folder inside each projects:
  78 ;;
  79 ;; (autoload 'fsproject-create-project "fsproject")
  80 ;; (defun fsproject-new(root-folder)
  81 ;;   (interactive "sRoot folder: ")
  82 ;;   (let ((regexp-project-name  "[Mm]akefile")
  83 ;;         (regexp-file-filter   '("\\.cpp$" "\\.h$" "\\.inl$" "\\.mak$" "Makefile"))
  84 ;;         (ignore-folders       '("build" "docs" "bin"))
  85 ;;         (pattern-modifier     '(("^\\(?:.*/\\)?\\([a-zA-Z0-9_]*\\.cpp\\)$" . "source/\\1")
  86 ;;                                 ("^\\(?:.*/\\)?\\([a-zA-Z0-9_]*\\.\\(?:h\\|inl\\)\\)$" . "include/\\1")))
  87 ;;         (build-configurations '("debug" "release"))
  88 ;;         (platforms            '("Linux")))
  89 ;;     (fsproject-create-project root-folder
  90 ;;                               regexp-project-name
  91 ;;                               regexp-file-filter
  92 ;;                               'my-action-handler
  93 ;;                               ignore-folders
  94 ;;                               pattern-modifier
  95 ;;                               build-configurations
  96 ;;                               platforms)))
  97 ;;
  98
  99
 100 ;;; History:
 101 ;;
 102 ;; v1.0: First official release.
 103 ;;
 104
 105
 106 ;;; Todo:
 107 ;;
 108 ;; - Create the reload project function, map it to 'g
 109
 110
 111
 112 (require 'cl)
 113 (require 'project-buffer-mode)
 114
 115
 116
 117 ;;; Code:
 118
 119
 120 (defun fsproject-collect-files(root project-regexp file-filter &optional ignore-folders)
 121   "Parse the ROOT folder and all of it's sub-folder, and create a file list.
 122 FILE-FILTER is a list of regexp which are used to filter the file list.
 123 PROJECT-REGEXP should represent a regular expression which will help finding the project folders
 124 If IGNORE-FOLDERS is non nil, it should specify a list of folder name to ignore.
 125
 126 The return is a list of two lists: ((project...) (files...))
 127 Note: the project list is sorted in descending alphabetic order."
 128   (let ((dir-list (directory-files-and-attributes root t))
 129         (ign-reg  (regexp-opt ignore-folders))
 130         file-list proj-list)
 131     (while dir-list
 132       (let* ((cur-node (pop dir-list))
 133              (fullpath (car cur-node))
 134              (is-dir   (eq (car (cdr cur-node)) t))
 135              (is-file  (not (car (cdr cur-node))))
 136              (basename (file-name-nondirectory fullpath)))
 137         (cond
 138          ;; if the current node is a directory different from "." or "..", all it's file gets added to the list
 139          ((and is-dir
 140                (not (string-equal basename "."))
 141                (not (string-equal basename ".."))
 142                (or (not ignore-folders)
 143                    (not (string-match ign-reg basename))))
 144                (setq dir-list (append dir-list (directory-files-and-attributes fullpath t))))
 145          ;; if the current node is a file
 146          (is-file
 147           ;; check against the file filter, if it succeed: add the file to the file-list
 148           (when (some '(lambda (item) (string-match item basename)) file-filter)
 149             (setq file-list (cons fullpath file-list)))
 150           ;; check also against the project-regexp: if succeed, we had the base directory of the project of the project list
 151           ;; (including the final '/')
 152           (let ((pos (string-match project-regexp fullpath)))
 153             (when pos
 154               (setq proj-list (cons (cons (file-name-directory (substring fullpath 0 pos)) fullpath) proj-list)))
 155           )))))
 156     (cons (sort proj-list '(lambda (a b) (string-lessp (car a) (car b)))) file-list)))
 157
 158
 159 (defun fsproject-extract-project-file-list(current-project file-list)
 160   "Extract the file which belongs to CURRENT-PROJECT from FILE-LIST.
 161 Return a list of two lists: ((current project file list..) (remaining files...)."
 162   (let (project-file-list
 163         remaining-files
 164         (lgt (length current-project)))
 165     (while file-list
 166       (let ((current-file (pop file-list)))
 167         (if (and (> (length current-file) lgt)
 168                  (string-equal (substring current-file 0 lgt) current-project))
 169             (setq project-file-list (cons current-file project-file-list))
 170             (setq remaining-files (cons current-file remaining-files)))))
 171     (cons project-file-list remaining-files)))
 172
 173
 174 (defun fsproject-parent-of-p(child parent)
 175   "Check if CHILD is a child of the directory PARENT.
 176 CHILD and PARENT are two string representing directories."
 177   (let* ((clist (and child  (split-string child "/")))
 178          (plist (and parent (split-string parent "/")))
 179          (cont t)
 180          res)
 181     (while (and clist plist cont)
 182       (let ((cname (pop clist))
 183             (pname (pop plist)))
 184         (setq cont (string-equal cname pname))))
 185     (and cont (and (null plist)
 186                    (not (null clist))))))
 187
 188
 189 (defun fsproject-resolve-conflict(conflict-list)
 190   "Solve the CONFLICT-LIST and return the list of final names.
 191 The code assume that no folders will be named with a '(n)' suffix."
 192   (let* ((name-check (make-hash-table :test 'equal))
 193          (name-list  (mapcar (lambda (node) (let* ((prj  (file-name-nondirectory (car node)))
 194                                                    (sub  (cdr node))
 195                                                    (name (if sub (concat sub "/" prj) prj))
 196                                                    (cnt  (gethash name name-check)))
 197                                               (if cnt
 198                                                   (setq cnt (1+ cnt))
 199                                                   (setq cnt 1))
 200                                               (puthash name cnt name-check)
 201                                               (format "%s (%i)" name cnt)))
 202                              conflict-list)))
 203     (mapcar (lambda (name) (if (string-match " (1)$" name)
 204                                (let ((subname (substring name 0 (- (length name) 4))))
 205                                  (if (= (gethash subname name-check) 1)
 206                                      subname
 207                                      name))
 208                                name))
 209             name-list)))
 210
 211 (defun fsproject-generate-project-names(project-list)
 212   "Return a list of project names based on the project paths contained in PROJECT-LIST.
 213 Making sure each name is uniq. This function will also detect subproject and add the master project name as prefix.
 214 PROJECT-LIST should be a list of couple: (project-path . project-file-name)"
 215   (let ((project-base-list (mapcar (lambda (path) (substring (car path) 0 -1)) project-list))
 216         (project-name-list (mapcar (lambda (path) (file-name-nondirectory (substring (car path) 0 -1))) project-list))
 217         (project-ht (make-hash-table :test 'equal))
 218         subproject-list)
 219
 220     ;; Extract the subproject list:
 221     (let ((path-list project-base-list)
 222           subprojects
 223           sub-list)
 224       (while path-list
 225         (let ((current (pop path-list))
 226               subproj)
 227           (while (and (not subproj) subprojects)
 228             (if (fsproject-parent-of-p current (cdr (car subprojects)))
 229                 (setq subproj     (car (car subprojects))
 230                       subprojects (cons (cons (concat (car (car subprojects)) "/" (file-name-nondirectory current))
 231                                               current)
 232                                         subprojects))
 233                 (setq subprojects (cdr subprojects))))
 234           (when (not subprojects)
 235             (setq subprojects (list (cons (file-name-nondirectory current) current))))
 236           (setq sub-list (cons subproj sub-list))))
 237       ;;
 238       (setq subproject-list (reverse sub-list)))
 239
 240     ;;
 241
 242     ;; Build the hash table:
 243     ;; each node of the hash table will be initially be a list of : '("basepath" "subproj")
 244     ;; Note: subproj can be nil.
 245
 246     ;; First path: initialization of the hash table throught the list:
 247     (let ((name-list project-name-list)
 248           (base-list project-base-list)
 249           (sub-list  subproject-list))
 250       (while base-list
 251         (let ((cur-name (pop name-list))
 252               (cur-base (pop base-list))
 253               (cur-subp (pop sub-list)))
 254           (puthash cur-name
 255                    (cons (cons cur-base cur-subp)
 256                          (gethash cur-name project-ht))
 257                    project-ht))))
 258
 259     ;; The second path will solve the conflicts and patch theses values.
 260     ;; Each node is a list of '("basepath" "subproj") and will be converted
 261     ;; into a list a string corresponding to the final name for each project
 262     ;; Note: the initial list has been build in reverse order
 263     (let ((name-list project-name-list))
 264       (while name-list
 265         (let* ((cur-name (pop name-list))
 266                (cur-node (gethash cur-name project-ht)))
 267           (when (listp (car cur-node))
 268             (puthash cur-name (fsproject-resolve-conflict cur-node) project-ht)))))
 269
 270     ;; The third will retrieve the conflict-less name
 271     (let ((name-list project-name-list)
 272           reversed-list)
 273       (while name-list
 274         (let* ((cur-name (pop name-list))
 275                (cur-node (gethash cur-name project-ht)))
 276           (setq reversed-list (cons (pop cur-node) reversed-list))
 277           (puthash cur-name cur-node project-ht)))
 278       (reverse reversed-list))))
 279
 280
 281 (defun fsproject-extract-file-names(current-project file-list modifier)
 282   "Return the CURRENT-PROJECT's converted FILE-LIST."
 283   (let ((prj-lgt (length current-project)))
 284     (mapcar (lambda (name)
 285               (let ((sub-name (substring name prj-lgt (length name))))
 286                 (if modifier
 287                     (reduce (lambda (str node) (replace-regexp-in-string (car node) (cdr node) str t))
 288                             modifier
 289                             :initial-value sub-name)
 290                     sub-name)))
 291             file-list )))
 292
 293
 294 ;;
 295
 296
 297 (defun fsproject-create-project-nodes-list(root project-regexp file-filter &optional ignore-folders pattern-modifier)
 298   "Parse the ROOT folder and sub-folders, and create a node list to add them into a project-buffer.
 299 FILE-FILTER is a list of regexp which are used to filter the file list.
 300 PROJECT-REGEXP should represent a regular expression which will help finding the project folders
 301 If IGNORE-FOLDERS is non nil, it should specify a list of folder name to ignore.
 302 If PATTERN-MODIFIER is non nil, it should specify a list of couple string (regexp . replace) which are going to get apply
 303 to the final project file name.
 304
 305 The return value is a list of nodes, each node will also be a list as described:
 306   '(proj-name proj-file-path (file-list) (file-full-path-list)"
 307   (let* ((collected-list (fsproject-collect-files root project-regexp file-filter ignore-folders))
 308          (file-list (cdr collected-list))
 309          (project-name-list (reverse (fsproject-generate-project-names (car collected-list))))
 310          (project-list (reverse (car collected-list)))
 311          project-node-list)
 312     (while project-list
 313       (let* ((current-project      (pop project-list))
 314              (current-project-name (pop project-name-list))
 315              (extracted-data       (fsproject-extract-project-file-list (car current-project) file-list))
 316              node)
 317         (setq file-list (cdr extracted-data))
 318         (setq node (list current-project-name
 319                          (cdr current-project)
 320                          (fsproject-extract-file-names (car current-project) (car extracted-data) pattern-modifier)
 321                          (car extracted-data)))
 322         (setq project-node-list (cons node project-node-list))))
 323     project-node-list))
 324
 325
 326
 327 (defun fsproject-populate-project-buffer(buffer node-list &optional project-configuration project-platforms)
 328   "Add each file / node to the project-buffer.
 329 BUFFER is the buffer of the project
 330 NODE-LIST is a list of (proj-name proj-file-path (file-list) (file-full-path-list))
 331 If PROJECT-CONFIGURATION isn't nil, it should be a list of string representing the different build configuration
 332 If PROJECT-PLATFORMS isn't nil, it should also be a list of string representing the different platforms available."
 333   (with-current-buffer buffer
 334     (save-excursion
 335       (while node-list
 336         (let* ((current-node  (pop node-list))
 337                (project-name  (car current-node))
 338                (project-file  (car (cdr current-node)))
 339                (file-list     (car (cdr (cdr current-node))))
 340                (fullpath-list (car (cdr (cdr (cdr current-node))))))
 341           ;; Add the project node:
 342           (project-buffer-insert project-name 'project project-file project-name)
 343           (when project-configuration (project-buffer-set-project-build-configurations project-name project-configuration))
 344           (when project-platforms     (project-buffer-set-project-platforms            project-name project-platforms))
 345
 346           ;; Add each individual files to the project:
 347           (mapcar* (lambda (&rest args)
 348                      (let* ((cur-name (car (cdr args)))
 349                             (relative-path (file-relative-name cur-name))
 350                             (full-path     (abbreviate-file-name cur-name))
 351                             (file-name     (if (> (length relative-path) (length full-path)) full-path relative-path)))
 352                        (project-buffer-insert (car args) 'file  file-name project-name)))
 353                    file-list
 354                    fullpath-list))))))
 355
 356
 357 ;;
 358 ;;  User function:
 359 ;;
 360
 361 ;; Note: the build command has yet to be set and used!
 362 (defun fsproject-create-project (root-folder regexp-project-name regexp-file-filter &optional action-handler ignore-folders pattern-modifier build-configurations platforms)
 363   "Create a project-buffer parsing the file-system to get projects and files.
 364
 365 ROOT-FOLDER is a string representing a folder as a starting point
 366 for the research, the last subfolder will also be used to name
 367 the project-buffer.
 368
 369 REGEXP-PROJECT-NAME is a regular expression used to search the
 370 different project's root folder; it may contains '/' in it and
 371 can also match just a part of the name.
 372
 373 REGEXP-FILE-FILTER is a list of regular expressions used to
 374 filter the list of file contained in the projects.
 375 Note: the filter is only applied to the basenames.
 376
 377 ACTION-HANDLER is function which is going to get call to perform
 378 the following action: Build, Clean, Run and Debug.
 379 The prototype of this function should be:
 380   lambda (action project-name project-path platform configuration)
 381   Where ACTION represents the action to apply to the project,
 382   it may be: 'build 'clean 'run 'debug,
 383   PROJECT-NAME is the name of the master project,
 384   PROJECT-PATH is the file path of the project
 385   PLATFORM is the name of the selected platform,
 386   and CONFIGURATION correspond to the selected build
 387   configuration.
 388
 389 IGNORE-FOLDERS is a list of folder name to ignore during the
 390 creation of the file list.
 391
 392 PATTERN-MODIFIER is a list of cons (\"regexp\" . \"repl-str\"),
 393 each couple regexp/repl-str will be applied successively to
 394 project's path of each project's file
 395
 396 BUILD-CONFIGURATIONS is a list of string representing the
 397 different build configuration available for the projects
 398 PLATFORMS is a list of string representing each available
 399 platform
 400
 401 e.g:
 402
 403  (fsproject-create-project  \"~/work\"
 404                             \"[Mm]akefile$\"
 405                             '(\"\\.cpp$\" \"\\.[hc]$\" \"[Mm]akefile$\")
 406                             '(\"build\")
 407                             '((\"^\\(?:.*/\\)?\\([a-zA-Z0-9_]*\\.cpp\\)$\" . \"source/\\1\")
 408                               (\"^\\(?:.*/\\)?\\([a-zA-Z0-9_]*\\.\\(?:h\\|inl\\)\\)$\" . \"include/\\1\"))
 409                             '(\"Debug\" \"Release\")
 410                             '(\"Win32\"))"
 411   (let ((buffer    (generate-new-buffer (concat "fs:" (file-name-nondirectory root-folder))))
 412         (node-list (fsproject-create-project-nodes-list root-folder regexp-project-name regexp-file-filter ignore-folders pattern-modifier)))
 413     (switch-to-buffer buffer)
 414     (with-current-buffer buffer
 415       ;; Make sure the buffer path match the project's path
 416       (cd root-folder)
 417       (project-buffer-mode)
 418       (when action-handler
 419         (add-hook 'project-buffer-action-hook action-handler nil t))
 420       (fsproject-populate-project-buffer buffer node-list build-configurations platforms))))
 421
 422
 423 ;;
 424
 425 (provide 'fsproject)
 426
 427 ;;; fsproject.el ends here