extensions/iproject.el

   1 ;;; iproject.el --- Interactive Project Mode
   2 ;;
   3 ;; Author:      Cedric Lallain <kandjar76@hotmail.com>
   4 ;; Version:     1.0
   5 ;; Keywords:    interactive project buffer makefile filesystem management
   6 ;; Description: Interactive Project Extension For Project-Buffer-Mode
   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 ;; iproject stands for Interactive Project; based on the
  32 ;; project-buffer-mode; it provides an interactive way to create
  33 ;; projects.
  34 ;;
  35 ;; Simply creates a new project using `iproject-new' (C-x p n); then
  36 ;; add new projects using `iproject-add-project' (C-c n).
  37 ;;
  38 ;; Once the project is created it is possible to add extra files to
  39 ;; the current project using `iproject-add-files-to-current-project'
  40 ;; (C-c +).
  41 ;;
  42 ;; iproject will ask the user for command lines (with default values
  43 ;; based on the selected project type) to run each user action which
  44 ;; are: build/clean/run/debug and update.  These command lines will be
  45 ;; stored in the project but also saved with the project.
  46 ;;
  47 ;; HOW TO INSTALL IT:
  48 ;;
  49 ;; Just add to your .emacs:
  50 ;;   (require 'iproject)
  51 ;;   (iproject-key-binding)
  52 ;;
  53 ;; KEY BINDINGS IN THE IPROJECT BUFFER:
  54 ;;
  55 ;; C-c n   to add new project
  56 ;; C-c +   to add file to an existing project
  57 ;; C-c C-r to revert the project
  58 ;; C-x C-w to write the project
  59 ;; C-x C-s to save the project
  60 ;;
  61 ;; as well as all standard project-buffer-mode key-bindings.
  62 ;;
  63 ;; GLOBAL KEY BINDINGS:
  64 ;;
  65 ;; C-x p n to create a new iproject
  66 ;; C-x p f to load a project file
  67 ;;
  68
  69
  70 ;;; History:
  71 ;;
  72 ;; v1.0: First official release.
  73 ;;
  74
  75
  76 (require 'project-buffer-mode)
  77
  78
  79 ;;; Code:
  80
  81
  82 ;;
  83 ;;  Global configuration variable:
  84 ;;
  85
  86 (defvar iproject-filters
  87   '((c++       ("\\.[cChH][pPxX+][pPxX+]$" "\\.[cChH]$" "\\.[iI][nN][lL]$" "\\.[cC][cC]$"))
  88     (c         ("\\.[cChH]$" "\\.[iI][nN][lL]$" "\\.[cC][cC]$"))
  89     (elisp     ("\\.el$"))
  90     (perl      ("\\.pl$"))
  91     (ruby      ("\\.rb$"))
  92     (sharp     ("\\.[cjf]s$"))
  93     (python    ("\\.py$"))
  94     (smalltalk ("\\.st$"))
  95     (haskell   ("\\.hs$"))
  96     (ocaml     ("\\.ml$"))
  97     (lisp      ("\\.cl$"))
  98     (awk       ("\\.awk$"))
  99     (java      ("\\.java$" "\\.js$"))
 100     (cg        ("\\.cg\\(?:fx\\)?$"))
 101     (web       ("\\.htm\\(?:l\\)?$" "\\.xml" "\\.php$" "\\.js$" "\\.css$"))
 102     (custom    (nil)))
 103   "List of the different file filters."
 104 )
 105
 106 (defvar iproject-project-type
 107   '((makefile ("\\.mak$" "Makefile$")
 108               ((build . "make -C {root} CONFIG={build}")
 109                (clean . "make -C {root} clean CONFIG={build}")))
 110     (cmake    ("CMakeLists.txt")
 111               ((build . "make -C {root} CONFIG={build}")
 112                (clean . "make -C {root} clean CONFIG={build}")))
 113     (jam      ("Jamfile\\(?:s\\)?$" "Jamrules$" "Jambase$" "Jamroot$")
 114               ((build . "jam -a {project}")
 115                (clean . "jam clean -a {project}")))
 116     (scons    ("SConstruct$" "Sconscript$")
 117               ((build . "scons")
 118                (clean . "scons --clean")))
 119     (dmconfig ("build.dmc$")
 120               ((build . "make {platform}.{project}-{build}.build")
 121                (clean . "make {platform}.{project}-{build}.clean")
 122                (run . "make {platform}.{project}-{build}.run")
 123                (debug . "make {platform}.{project}-{build}.debug")))
 124     (cabal    ("\\.cabal$")
 125               ((build . "cabal build")
 126                (clean . "cabal clean")))
 127     (any      (".*$")
 128               ((build . "")))
 129     (blank    nil
 130               ((build . ""))))
 131   "List of the different project type.
 132
 133 Each project type is a list of the following format:
 134   (symbol matching-regexp (action-string-list)) where
 135   action-string-list is a set of 4 strings representing the default
 136   command to 'build' 'clean' 'run' and 'debug'.
 137   the following wild cards can be use in each action string:
 138    {build}    the current selected build version
 139    {platform} the current selected platform
 140    {project}  name of the project
 141    {projfile} path of the project's main file
 142    {root}     root folder of the project"
 143 )
 144
 145 (defvar iproject-ignore-folder
 146   '(".git" ".svn" "bzr" ".hg" "CVS" ".CVS" "build" "lib" "Debug" "Release")
 147   "List of folder to ignore during the recursive search.")
 148
 149
 150 ;;
 151 ;; History:
 152 ;;
 153
 154
 155 (defvar iproject-project-type-history nil)
 156 (defvar iproject-file-filter-history nil)
 157 (defvar iproject-file-filter-query-history nil)
 158 (defvar iproject-file-filter-regexp-history nil)
 159 (defvar iproject-file-filter-extension-list-history nil)
 160 (defvar iproject-project-name-history nil)
 161 (defvar iproject-platforms-history nil)
 162 (defvar iproject-build-configurations-history nil)
 163 (defvar iproject-action-commands-history nil)
 164 (defvar iproject-last-base-directory-history nil)
 165
 166
 167 ;;
 168 ;;  Local variables:
 169 ;;
 170
 171 (defvar iproject-last-project-type-choosen "makefile")
 172 (defvar iproject-last-filter-type-choosen "c++")
 173 (defvar iproject-last-file-filter-query-mode-choosen "regexp")
 174 (defvar iproject-last-file-filter-regexp-choosen nil)
 175 (defvar iproject-last-file-extension-list-choosen nil)
 176 (defvar iproject-platform-list nil)
 177 (defvar iproject-build-configuration-list nil)
 178 (defvar iproject-last-base-directory-choosen nil)
 179
 180
 181 ;;
 182 ;;  Functions:
 183 ;;
 184
 185 (defun iproject-choose-project-type()
 186   "Request and return the selected project type"
 187   (let* ((project-type-string (completing-read (format "Project Type [default %s]: " iproject-last-project-type-choosen)
 188                                                iproject-project-type nil t nil 'iproject-project-type-history iproject-last-project-type-choosen))
 189          (project-type (intern project-type-string)))
 190     (setq iproject-last-project-type-choosen project-type-string)
 191     (assoc project-type iproject-project-type)))
 192
 193 (defun iproject-shorten-string(str max-lgt)
 194   "If the length of STR is greater than MAX-LGT; shorten the string adding '...' at the end."
 195   (if (> (length str) max-lgt)
 196       (concat (substring str 0 (- max-lgt 3)) "...")
 197       str))
 198
 199 (defun iproject-choose-file-filter()
 200   "Read the file filter."
 201   (let* ((filter-type-string (completing-read (format "Filter Type [default %s]: " iproject-last-filter-type-choosen)
 202                                                iproject-filters nil t nil 'iproject-file-filter-history iproject-last-filter-type-choosen))
 203          (filter-type (intern filter-type-string)))
 204     (setq iproject-last-filter-type-choosen filter-type-string)
 205     (if (not (eq filter-type 'custom))
 206         ;; If not custom: return the selected file-filter:
 207         (assoc filter-type iproject-filters)
 208         ;; In case of custom file filter:
 209         ;; Let's first ask how to specify the filter:
 210         (let* ((query-mode-string (completing-read (format "Enter the file system query mode (regexp, file-extension) [default %s]: " iproject-last-file-filter-query-mode-choosen)
 211                                                    '("regexp" "file-extension") nil t nil 'iproject-file-filter-query-history iproject-last-file-filter-query-mode-choosen))
 212                (query-mode (intern query-mode-string)))
 213           (setq iproject-last-file-filter-query-mode-choosen query-mode-string)
 214           (cond ((eq query-mode 'regexp)
 215                  ;; A regexp:
 216                  (let* ((def-string (if iproject-last-file-filter-regexp-choosen
 217                                         (concat " [default " (iproject-shorten-string iproject-last-file-filter-regexp-choosen 9) "]")
 218                                         ""))
 219                         (file-filter-regexp (read-from-minibuffer (format "Enter the file filter regexp%s: " def-string)
 220                                                                   nil nil nil 'iproject-file-filter-regexp-history)))
 221                    (if (= (length file-filter-regexp) 0)
 222                        (setq file-filter-regexp iproject-last-file-filter-regexp-choosen)
 223                        (setq iproject-last-file-filter-regexp-choosen file-filter-regexp))
 224                    (list 'custom (list file-filter-regexp))))
 225                 ((eq query-mode 'file-extension)
 226                  ;; A list of file extension:
 227                  (let* ((def-string (if iproject-last-file-extension-list-choosen
 228                                         (concat " [default " (iproject-shorten-string iproject-last-file-extension-list-choosen 9) "]")
 229                                         ""))
 230                         (file-extension-list (read-from-minibuffer (format "Enter the list of extension separated by spaces%s: " def-string)
 231                                                                    nil nil nil 'iproject-file-filter-extension-list-history)))
 232                    (if (= (length file-extension-list) 0)
 233                        (setq file-extension-list iproject-last-file-extension-list-choosen)
 234                        (setq iproject-last-file-extension-list-choosen file-extension-list))
 235                    (list 'custom (list (concat "\\." (regexp-opt (split-string file-extension-list)) "$")))))
 236                 (t (error "Unknown Query Mode")))))))
 237
 238
 239 (defun iproject-collect-files(root-folder file-filter-list &optional ignore-folders)
 240   "Parse ROOT-FOLDER and its sub-folder and create a list of full path filename matching one of the regexp of FILE-FILTER-LIST.
 241 The folder defined inside in IGNORE-FOLDERS will be skipped."
 242   (let ((dir-list (directory-files-and-attributes root-folder t))
 243         (ign-reg  (concat (regexp-opt ignore-folders) "$"))
 244         file-list)
 245     (while dir-list
 246       (let* ((cur-node (pop dir-list))
 247              (fullpath (car cur-node))
 248              (is-dir   (eq (car (cdr cur-node)) t))
 249              (is-file  (not (car (cdr cur-node))))
 250              (basename (file-name-nondirectory fullpath)))
 251         (cond
 252          ;; if the current node is a directory different from "." or "..", all it's file gets added to the list
 253          ((and is-dir
 254                (not (string-equal basename "."))
 255                (not (string-equal basename ".."))
 256                (or (not ignore-folders)
 257                    (not (string-match ign-reg basename))))
 258                (setq dir-list (append dir-list (directory-files-and-attributes fullpath t))))
 259          ;; if the current node is a file
 260          (is-file
 261           ;; check against the file filter, if it succeed: add the file to the file-list
 262           (when (some '(lambda (item) (string-match item basename)) file-filter-list)
 263             (setq file-list (cons fullpath file-list)))
 264           ))))
 265     file-list))
 266
 267
 268 (defun iproject-generate-user-data(action-string-list
 269                                      project-name
 270                                      project-main-file
 271                                      project-root-folder)
 272   "Generate the project's user data based from ACTION-STRING-LIST.
 273 ACTION-STRING-LIST is a list of string; each of them corresponding to the project actions.
 274 This function returns a assoc-list of assoc-list such as:
 275   (cdr (assoc buildconfig (cdr (assoc platform data)))) should returns a list of user actions.
 276
 277 In each action string list may contain the following wildcard
 278 which will be replaced by their respective value:
 279    {build}    the current selected build version
 280    {platform} the current selected platform
 281    {project}  name of the project
 282    {projfile} path of the project's main file
 283    {root}     root folder of the project"
 284
 285   (let ((platform-list iproject-platform-list)
 286         user-data)
 287     (while platform-list
 288       (let ((current-platform (pop platform-list))
 289             (build-config-list iproject-build-configuration-list)
 290             bc-list)
 291         (setq user-data (cons (cons current-platform
 292                                     (progn (while build-config-list
 293                                              (let ((current-build-config (pop build-config-list)))
 294                                                (setq bc-list (cons (cons current-build-config
 295                                                                          (mapcar (lambda (action-node)
 296                                                                                    (let* ((action-string (cdr action-node))
 297                                                                                           (repl1 (replace-regexp-in-string "{build}"    current-build-config  action-string))
 298                                                                                           (repl2 (replace-regexp-in-string "{platform}" current-platform      repl1))
 299                                                                                           (repl3 (replace-regexp-in-string "{project}"  project-name          repl2))
 300                                                                                           (repl4 (replace-regexp-in-string "{projfile}" project-main-file     repl3))
 301                                                                                           (repl5 (replace-regexp-in-string "{root}"     project-root-folder   repl4)))
 302                                                                                      (cons (car action-node) repl5)))
 303                                                                                  action-string-list))
 304                                                                    bc-list))
 305                                                ))
 306                                            bc-list)
 307                                       )
 308                               user-data))))
 309     user-data))
 310
 311
 312 (defun iproject-action-handler(action project-name project-path platform configuration)
 313   (let* ((user-data (project-buffer-get-project-user-data project-name))
 314          (query-string (concat "[" project-name "] " (upcase-initials (format "%s" action)) " command: "))
 315          user-command)
 316     ;; user data's format is: '((platform1 (config1 . ((action1 . "cmd") (action2 . "cmd"))) (config2 ...)) (platform2...))
 317     ;; platform-data:         '(curplat (config1 . ((act...))) (config2 ...))
 318     ;; config-data:           '(config1 (act1 ...) (act2...))
 319     ;; action-data:           '(action . "cmd")
 320     (if user-data
 321       (let ((platform-data (assoc platform user-data)))
 322         (if platform-data
 323             (let ((config-data (assoc configuration (cdr platform-data))))
 324               (if config-data
 325                   (let ((action-data (assoc action (cdr config-data))))
 326                     (if action-data
 327                         (progn (setq user-command (read-from-minibuffer query-string (cdr action-data) nil nil 'iproject-action-commands-history))
 328                                (setcdr action-data user-command))
 329                         (progn (setq user-command (read-from-minibuffer query-string nil nil nil 'iproject-action-commands-history))
 330                                (setcdr config-data (acons action user-command (cdr config-data))))))
 331                   (progn (setq user-command (read-from-minibuffer query-string nil nil nil 'iproject-action-commands-history))
 332                          (setcdr platform-data (acons configuration (acons action user-command nil) (cdr platform-data))))))
 333             (progn (setq user-command (read-from-minibuffer query-string nil nil nil 'iproject-action-commands-history))
 334                    (setcdr user-data (copy-alist user-data))
 335                    (setcar user-data (cons platform (acons configuration (acons action user-command nil) nil))))))
 336       (progn (setq user-command (read-from-minibuffer query-string nil nil nil 'iproject-action-commands-history))
 337              (project-buffer-set-project-user-data project-name (acons platform (acons configuration (acons action user-command nil) nil) nil))))
 338     (compile user-command)))
 339
 340
 341 ;;
 342 ;;  User command:
 343 ;;
 344
 345
 346 (defun iproject-add-project(&optional project-type project-main-file project-root-folder project-name file-filter)
 347   "Select a FOLDER, a MAIN-FILE and a FILE-FILTER, then add all
 348 files under the current folder and sub-folder matching the
 349 FILE-FILTER will be added to the project."
 350   (interactive)
 351   (unless project-buffer-status (error "Not in project-buffer buffer"))
 352   (when (interactive-p)
 353     ;; Read the project-type
 354     (unless project-type
 355       (setq project-type (iproject-choose-project-type)))
 356     ;; Read the project-main-file (if the project's type is 'blank' there is no root filename)
 357     (unless project-main-file
 358       (when (nth 1 project-type)
 359         (let* ((project-filter (nth 1 project-type))
 360                (project-predicate (lambda (filename)
 361                                     (and (not (string-equal filename "./"))
 362                                          (not (string-equal filename "../"))
 363                                          (or (file-directory-p filename)
 364                                              (some '(lambda (item) (string-match item filename)) project-filter))))))
 365           (while (or (not project-main-file)
 366                      (file-directory-p project-main-file)
 367                      (not (funcall project-predicate project-main-file)))
 368             (let ((def-dir (and project-main-file (file-directory-p project-main-file) project-main-file)))
 369               (setq project-main-file (read-file-name "Project Main File: " def-dir nil t nil project-predicate))
 370               )))))
 371     ;; Read the project-root-folder:
 372     (unless project-root-folder
 373       (let ((def-dir (if project-main-file
 374                          (file-name-directory project-main-file)
 375                          default-directory)))
 376         (while (or (not project-root-folder)
 377                    (= (length project-root-folder) 0))
 378           (setq project-root-folder (read-directory-name "File Search - Root Folder: " def-dir def-dir t)))
 379         (unless (string-equal (substring project-root-folder -1) "/")
 380           (setq project-root-folder (concat project-root-folder "/")))
 381         ))
 382     ;; Read the project name:
 383     (unless project-name
 384       (while (not project-name)
 385         (setq project-name (read-from-minibuffer "Project Name: "
 386                                                  (file-name-nondirectory (substring project-root-folder 0 -1))
 387                                                  nil nil 'iproject-project-name-history))
 388         (when (project-buffer-project-exists-p project-name)
 389           (message "Project %s already exists!" project-name)
 390           (sit-for 2)
 391           (setq project-name nil))
 392         ))
 393     ;; Read the file-filter:
 394     (unless file-filter
 395       (setq file-filter (iproject-choose-file-filter)))
 396     )
 397
 398   (let (file-list user-data project-settings)
 399     ;;
 400     ;; Collect the project's file
 401     ;;
 402     (setq file-list (iproject-collect-files project-root-folder (nth 1 file-filter) iproject-ignore-folder))
 403
 404     ;;
 405     ;; Populate the project-buffer-mode:
 406     ;;
 407
 408     ;; Generate the project node's user-data:
 409     (setq user-data (iproject-generate-user-data (nth 2 project-type)
 410                                                    project-name
 411                                                    project-main-file
 412                                                    project-root-folder))
 413
 414     ;; Create the initial project settings:
 415     ;; project settings is a list of lists, each sub list should follow the following format:
 416     ;;   (root-project-folder root-file-folder file-filter-list ignore-folder-list)
 417     (setq project-settings (list (list "" project-root-folder (nth 1 file-filter) iproject-ignore-folder)))
 418
 419     ;; Add the project node
 420     (project-buffer-insert project-name 'project project-main-file project-name)
 421     (project-buffer-set-project-build-configurations project-name iproject-build-configuration-list)
 422     (project-buffer-set-project-platforms            project-name iproject-platform-list)
 423     (project-buffer-set-project-user-data            project-name user-data)
 424     (project-buffer-set-project-settings-data        project-name  project-settings)
 425
 426     ;; Add each individual files to the project:
 427     (mapcar (lambda (name)
 428               (let* ((relative-path (file-relative-name name))
 429                      (full-path     (abbreviate-file-name name))
 430                      (file-name     (if (> (length relative-path) (length full-path)) full-path relative-path))
 431                      (proj-name     (substring name (length (expand-file-name project-root-folder)) (length name))))
 432                 (project-buffer-insert proj-name 'file  file-name project-name)))
 433             file-list)
 434     ;; Add the project's main file to the project:
 435     (when project-main-file
 436       (project-buffer-insert (file-name-nondirectory project-main-file) 'file  project-main-file project-name))
 437   ))
 438
 439
 440 (defun iproject-uniquify-name(file-name file-path project)
 441   "Returns a uniq name based on FILE-NAME to be inserted inside PROJECT.
 442 Returns nil if the FILE-NAME is already in PROJECT."
 443   (let (cur-name)
 444     ;; Check: if file-name ends with " (N)" but not file-path; we'll remove it.
 445     (let ((ndx (string-match " ([0-9]+)$" file-name)))
 446       (if (and ndx (not (string-match " ([0-9]+)$" file-path))) ;; I'm ignoring the fact the number may be different :)
 447           (setq cur-name (substring file-name 0 ndx))
 448           (setq cur-name file-name)))
 449     ;; Check name conflict:
 450     (let ((exists        (project-buffer-exists-p cur-name project))
 451           (existing-path (project-buffer-get-file-path cur-name project))
 452           (count 2))
 453       (when exists
 454         (if (and existing-path (string-equal file-path existing-path))
 455             (setq cur-name nil) ; if the file is already present, skip it (note: the search is very basic; it is possible to trick the system and add a file twice...)
 456             (setq cur-name (concat cur-name " (1)"))))
 457       (while (and exists cur-name)
 458         (setq exists        (project-buffer-exists-p cur-name project))
 459         (setq existing-path (project-buffer-get-file-path cur-name project))
 460         (when exists
 461           (if (and existing-path (string-equal file-path existing-path))
 462               (setq cur-name nil) ; if the file is already present, skip it
 463               (setq cur-name (concat (substring proj-name 0 -2) (format "%i)" count))
 464                     count (1+ count)))))
 465       cur-name)))
 466
 467
 468 (defun iproject-add-file-list-to-current-project(current-project base-virtual-folder root-folder file-list)
 469   "Add files contained in FILE-LIST in the CURRENT-PROJECT
 470 prefixing the project's filename with BASE-VIRTUAL-FOLDER."
 471   (mapcar (lambda (name)
 472             (let* ((relative-path (file-relative-name name))
 473                    (full-path     (abbreviate-file-name name))
 474                    (file-name     (if (> (length relative-path) (length full-path)) full-path relative-path))
 475                    (proj-name     (iproject-uniquify-name (concat base-virtual-folder (substring name (length (expand-file-name root-folder)) (length name)))
 476                                                           file-name current-project)))
 477                   (when proj-name
 478                     (project-buffer-insert proj-name 'file  file-name current-project))))
 479               file-list))
 480
 481
 482 (defun iproject-add-files-to-current-project(&optional root-folder file-filter base-virtual-folder)
 483   "Add extra files to the current project."
 484   (interactive)
 485   (unless project-buffer-status (error "Not in project-buffer buffer"))
 486   (let ((current-project (project-buffer-get-current-project-name)))
 487     (unless current-project (error "No current project found"))
 488     (when (interactive-p)
 489       ;; Read the root-folder:
 490       (unless root-folder
 491         (while (or (not root-folder)
 492                    (= (length root-folder) 0))
 493             (setq root-folder (read-directory-name "File Search - Root Folder: " nil nil t)))
 494         (unless (string-equal (substring root-folder -1) "/")
 495           (setq root-folder (concat root-folder "/"))))
 496       ;; Read the file-filter:
 497       (unless file-filter
 498         (setq file-filter (iproject-choose-file-filter)))
 499       ;; Read the base-virtual-path:
 500       (unless base-virtual-folder
 501         (let* ((def-string (if iproject-last-base-directory-choosen
 502                                (concat " [default " (iproject-shorten-string iproject-last-base-directory-choosen 9) "]")
 503                                "")))
 504           (setq base-virtual-folder (read-from-minibuffer (format "Enter the base directory in the project%s: " def-string)
 505                                                           nil nil nil 'iproject-last-base-directory-history))))
 506       )
 507
 508     (let (file-list user-data project-settings)
 509       ;; Collect the project's file
 510       (setq file-list (iproject-collect-files root-folder (nth 1 file-filter) iproject-ignore-folder))
 511
 512       ;; Make sure the base-virtual-folder doesn't start with a '/' and end with one:
 513       (when (and (> (length base-virtual-folder) 0)
 514                  (string-equal (substring base-virtual-folder 0 1) "/"))
 515         (setq base-virtual-folder (substring base-virtual-folder 1)))
 516       (unless (or (= (length base-virtual-folder) 0)
 517                   (string-equal (substring base-virtual-folder -1) "/"))
 518         (setq base-virtual-folder (concat base-virtual-folder "/")))
 519
 520       ;; Update the project settings:
 521       (setq project-settings (cons (list base-virtual-folder root-folder (nth 1 file-filter) iproject-ignore-folder)
 522                                    (project-buffer-get-project-settings-data current-project)))
 523       (project-buffer-set-project-settings-data current-project project-settings)
 524
 525       ;; Add each individual files to the project:
 526       (iproject-add-file-list-to-current-project current-project base-virtual-folder root-folder file-list)
 527       )))
 528
 529
 530 (defun iproject-move-files-within-project(file-list folder-name)
 531   "Move the file present in FILE-LIST into the folder FOLDER-NAME.
 532 FILE-LIST should be a list of list '(file-name file-path project)."
 533   (let ((virtual-folder folder-name))
 534     ;; Make sure the folder name doesn't start with a '/' but ends with one.
 535     (when (and (> (length virtual-folder) 0)
 536                (string-equal (substring virtual-folder 0 1) "/"))
 537       (setq virtual-folder (substring virtual-folder 1)))
 538     (unless (or (= (length virtual-folder) 0)
 539                 (string-equal (substring virtual-folder -1) "/"))
 540       (setq virtual-folder (concat virtual-folder "/")))
 541     ;; Let's delete all files from the project:
 542     (mapcar (lambda (file-node)
 543                 (project-buffer-delete-file (car file-node) (nth 2 file-node) t))
 544             file-list)
 545     ;; Re-add each node making sure they are uniq:
 546     (mapcar (lambda (file-node)
 547               (let ((file-name (nth 0 file-node))
 548                     (file-path (nth 1 file-node))
 549                     (project   (nth 2 file-node)))
 550                 (setq file-name (iproject-uniquify-name (concat virtual-folder (file-name-nondirectory file-name))
 551                                                         file-path project))
 552                 (when file-name
 553                   (project-buffer-insert file-name 'file file-path project))))
 554             file-list)))
 555
 556
 557 (defun iproject-move-marked-files-or-current-file-within-project(&optional folder-name)
 558   "Move the marked files into an specified project's folder."
 559   (interactive)
 560   (let* ((node-list    (project-buffer-get-marked-node-list))
 561          (current-node (unless node-list (project-buffer-get-current-file-data))))
 562     (unless (or node-list current-node) (error "No marked files / No current file found"))
 563     (unless folder-name
 564       (let ((def-string (if iproject-last-base-directory-choosen
 565                             (concat " [default " (iproject-shorten-string iproject-last-base-directory-choosen 9) "]")
 566                             ""))
 567             (file-str (if node-list (if (> (length node-list) 1) "marked files" "marked file") "current file")))
 568         (setq folder-name (read-from-minibuffer (format "Enter the base directory to move the %s into%s: " file-str def-string)
 569                                                 nil nil nil 'iproject-last-base-directory-history))))
 570     (unless node-list
 571       (setq node-list (list current-node)))
 572     (iproject-move-files-within-project node-list folder-name)))
 573
 574
 575 (defun iproject-refresh-project(project)
 576   "Reparse the directories associated to PROJECT, add the new files to it."
 577   (let ((settings (project-buffer-get-project-settings-data project)))
 578     (while settings
 579       (let ((current (pop settings))
 580             file-list)
 581         (when (file-directory-p (nth 1 current))
 582           ;; currest is a list (root-project-folder root-file-folder file-filter-list ignore-folder-list)
 583           (setq file-list (iproject-collect-files (nth 1 current) (nth 2 current) (nth 3 current)))
 584           ;; Add each individual files to the project:
 585           (iproject-add-file-list-to-current-project project (nth 0 current) (nth 1 current) file-list)
 586           )))))
 587
 588
 589 (defun iproject-refresh-handler(project-list content)
 590   "Refresh all projects, check if there are new files to be added.
 591 PROJECT-LIST is a list containing the project's names"
 592   (when (and project-list
 593              (funcall project-buffer-confirm-function
 594                       (if (cdr project-list) "Reparse the projects' directoriess "
 595                           (format "Reparse %s's directories " (car project-list)))))
 596     (while project-list
 597       (iproject-refresh-project (pop project-list)))))
 598
 599
 600 (defun iproject-setup-local-key()
 601   "Define a local key-bindings."
 602   (local-set-key [(control ?c) ?n] 'iproject-add-project)
 603   (local-set-key [(control ?c) ?+] 'iproject-add-files-to-current-project)
 604   (local-set-key [(control ?c) ?m] 'iproject-move-marked-files-or-current-file-within-project)
 605
 606   (local-set-key [(control ?c) (control ?r)] 'project-buffer-revert)
 607   (local-set-key [(control ?x) (control ?s)] 'project-buffer-save-file)
 608   (local-set-key [(control ?x) (control ?w)] 'project-buffer-write-file))
 609
 610
 611 ;;
 612 ;;  User commands:
 613 ;;
 614
 615
 616 ;;;###autoload
 617 (defun iproject-new (name root-folder)
 618   "Create a iproject buffer named NAME with a `default-directory' set to ROOT-FOLDER."
 619   (interactive "sProject Buffer Name: \nDRoot Folder: ")
 620   (let ((buffer (generate-new-buffer (concat "ipb:" name))))
 621     (switch-to-buffer buffer)
 622     (with-current-buffer buffer
 623       (cd root-folder)
 624       (project-buffer-mode)
 625       ;; local variables:
 626       (make-local-variable 'iproject-last-project-type-choosen)
 627       (make-local-variable 'iproject-last-filter-type-choosen)
 628       (make-local-variable 'iproject-last-file-filter-query-mode-choosen)
 629       (make-local-variable 'iproject-last-file-filter-regexp-choosen)
 630       (make-local-variable 'iproject-last-file-extension-list-choosen)
 631       (make-local-variable 'iproject-platform-list)
 632       (make-local-variable 'iproject-build-configuration-list)
 633       ;; register the local variable to be saved:
 634       (add-to-list 'project-buffer-locals-to-save 'iproject-last-project-type-choosen)
 635       (add-to-list 'project-buffer-locals-to-save 'iproject-last-filter-type-choosen)
 636       (add-to-list 'project-buffer-locals-to-save 'iproject-last-file-filter-query-mode-choosen)
 637       (add-to-list 'project-buffer-locals-to-save 'iproject-last-file-filter-regexp-choosen)
 638       (add-to-list 'project-buffer-locals-to-save 'iproject-last-file-extension-list-choosen)
 639       (add-to-list 'project-buffer-locals-to-save 'iproject-platform-list)
 640       (add-to-list 'project-buffer-locals-to-save 'iproject-build-configuration-list)
 641       ;; ask for the platform list:
 642       (setq iproject-platform-list            (split-string (read-from-minibuffer "Enter the list of platforms separated by spaces: "
 643                                                                                   (if iproject-platforms-history (car iproject-platforms-history) (format "%s" system-type))
 644                                                                                   nil nil 'iproject-platforms-history)))
 645       (setq iproject-build-configuration-list (split-string (read-from-minibuffer "Enter the list of build configurations separated by spaces: "
 646                                                                                   (if iproject-build-configurations-history (car iproject-build-configurations-history) "release debug")
 647                                                                                   nil nil 'iproject-build-configurations-history)))
 648       ;;
 649       (iproject-setup-local-key)
 650       (add-hook 'project-buffer-post-load-hook 'iproject-setup-local-key nil t)
 651       (add-hook 'project-buffer-action-hook    'iproject-action-handler  nil t)
 652       (add-hook 'project-buffer-refresh-hook   'iproject-refresh-handler nil t)
 653       )))
 654
 655
 656 ;;;###autoload
 657 (defun iproject-key-binding ()
 658   "Setup some global key-bindings."
 659   (define-key global-map [(control x) (?p) (?n)] 'iproject-new)
 660   (define-key global-map [(control x) (?p) (?f)] 'project-buffer-find-file))
 661
 662
 663 ;;
 664
 665 (provide 'iproject)
 666
 667 ;;; iproject.el ends here