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