| blob | 08f4e9991931003bf140b971efc0765c25da38b4 |
1 ;;; project-buffer-mode.el --- Generic mode to browse project file
2 ;;
3 ;; Author: Cedric Lallain <kandjar76@hotmail.com>
4 ;; Version: 1.22
5 ;; Keywords: project mode buffer viewer generic
6 ;; Description: Generic mode to handle projects.
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 ;;
26 ;;; Summary:
27 ;;
29 ;; project-buffer-mode is a generic mode to handle projects. It
30 ;; provides an easy and intuitive way to interact with the multiple
31 ;; projects with in one buffer.
32 ;;
33 ;;
34 ;; Three project implementation uses this mode:
35 ;; - fsproject - which creates a project based on the file system
36 ;; - sln-mode - which parses a sln files and create a project representing it
37 ;; - iproject - which stands for Interactive Project allowing the user to easily add/remove projects.
38 ;;
39 ;; Two generic extensions are also available:
40 ;; - project-buffer-mode+ - which allow to run user actions such as build/clean.. commands from the project files
41 ;; - project-buffer-occur - which provides a function to search in project files and list all occurrences
42 ;;
43 ;; Key features:
44 ;; - find files based on regular expression
45 ;; - four different view modes
46 ;; - advanced 'search in files' system
47 ;; - notion of master project to launch build/clean/run/debug and update.
48 ;; - intuitive key bindings (at least I hope)
49 ;; - full save/load of a project including hooks and local configuration.
50 ;; - mouse support to expand/collapse a folder or open a file
53 ;;; Commentary:
54 ;;
56 ;; project-buffer-mode provides a generic way to handle multiple
57 ;; projects in a buffer.
58 ;;
59 ;; A Project is defined by:
60 ;; - its name
61 ;; - its main file (Makefile, Jam, Scons...)
62 ;; - a build configuration list (Debug, Release, ...)
63 ;; - a platform list (Win32, PocketPC, Linux...)
64 ;; - and obviously a list of files.
65 ;;
66 ;;
67 ;; QUICK FIND FILE USING REGEXP:
68 ;;
69 ;; Through a hierarchical view, the project-buffer mode provides an
70 ;; very easy and intuitive way to search for a particular files (key:
71 ;; '/', then 'n' or 'p' to go to the next or previous matching
72 ;; result). Note: press 'q' to cancel the research.
73 ;;
74 ;; Opening the current is a simple as pressing <enter> or
75 ;; 'o' to open it in another window.
76 ;; Press 'f' if you want to open all marked files.
77 ;;
78 ;;
79 ;; FOUR DIFFERENT VIEW-MODE:
80 ;;
81 ;; Four different view-modes are currently supported:
82 ;; - folder-view (<default>)
83 ;; - flat-view
84 ;; - folder-hidden-view
85 ;; - marked-view
86 ;;
87 ;; It's possible to switch between them using 'c v'.
88 ;;
89 ;; The first three modes show the project with their associated files:
90 ;; - folder-view shows a tree-view of files.
91 ;; - flat-view shows the list of the files prefixed by their folder
92 ;; - folder-hidden-view shows the list of just the file names, next
93 ;; to it, it displays the real path for each of them.
94 ;;
95 ;; The final view mode named marked-view shows only the list of marked
96 ;; files, prefixed by their project and folders.
97 ;;
98 ;;
99 ;; MARKING FILE MATCHING A REGEXP:
100 ;;
101 ;; Files can be marked/unmarked individually, but you can also easily
102 ;; mark all files whose names are matching a regular expression ('/'
103 ;; then 'm').
104 ;; Note: using the mark/unmark command in front of a folder of a
105 ;; project results in marking every files which belong to this folder
106 ;; or this project.
107 ;;
108 ;;
109 ;; ADVANCED SEARCH IN FILES SYSTEM:
110 ;;
111 ;; The search in files functionality comes with three different behaviors:
112 ;; - Narrow the marked files (<default>)
113 ;; - All files
114 ;; - Current project
115 ;;
116 ;; Before talking about the "Narrow the marked files" behavior which
117 ;; is the default one; let's quickly go throught the others two:
118 ;;
119 ;; - If the search behavior is set to "All files", the search-in-files
120 ;; command ('s') will do a search-regexp in files for each unmarked
121 ;; files (all projects) and mark the ones which contain the regexp.
122 ;;
123 ;; - If the search behavior is set to "Current Project" the
124 ;; search-in-files will do search-regexp in files for each unmarked
125 ;; file contained in the current project. The current project being
126 ;; defined by the position of the cursor. Again, each matching files
127 ;; will be marked.
128 ;;
129 ;; Note: it is possible to have the search-regexp in file unmarking
130 ;; the files instead by using the prefix argument (C-u).
131 ;;
132 ;; Finally in case the search behavior is set to "Narrow the marked
133 ;; files": if no files are actually marked, it will behave the same
134 ;; way as the "All files" behavior. In case some files are marked, it
135 ;; will only perform the "search-regexp in files" in the marked files,
136 ;; unmarking the ones which don't contain the regular expression.
137 ;;
138 ;; This provide an easy way to narrow/refine some research.
139 ;;
140 ;; The search behavior can be either customized or locally change
141 ;; (pressing 'c s')
142 ;;
143 ;; Note: in case a search-in-files mark or unmark some files; the view
144 ;; mode will automatically be switched to marked-view. This behavior
145 ;; can be disabled.
146 ;;
147 ;;
148 ;; MASTER PROJECT / BUILD CONFIGURATION / PLATFORM:
149 ;;
150 ;; The master project, build configuration and platform can be easily
151 ;; changed using respectively: 'c t' 'c b' 'c p' Using the capital
152 ;; letter ('c T' 'c B' and 'c P') will prompt the user for the new
153 ;; value.
154 ;;
155 ;; This value allows to take quick actions for the master project:
156 ;; build/clean/run/debug/update (keys: 'B' 'C' 'R' 'D' 'G')
157 ;;
158 ;;
159 ;; KEY BINDINGS:
160 ;;
161 ;; Shortkey in the project-buffer-mode:
162 ;; + -> collapse/expand folder/project (cursor has to be on a folder/project)
163 ;; m -> mark the 'matching regexp' filename or the current file
164 ;; u -> unmark file
165 ;; t -> toggle marked files
166 ;; M -> mark all
167 ;; U -> unmark all
168 ;; f -> open marked files
169 ;; q -> cancel file search or bury project-buffer
170 ;; g -> refresh the display / the projects (C-u g: refresh the current project only)
171 ;; ? -> show brief help!!
172 ;; / -> search file name matching regexp
173 ;; n -> next file matching regexp
174 ;; p -> prev file matching regexp
175 ;; v -> view current file in view-mode
176 ;; o -> find file at current pos in other window
177 ;; s -> (un)mark files containing regexp...
178 ;; <TAB> -> collapse/expand folder/project (work if the cursor is on a file)
179 ;; <RET> -> open file at cursor pos
180 ;; <DEL> -> Delete the current node or the marked files
181 ;; <BCK> -> go to parent
182 ;; <SPC> -> next line
183 ;; S-<SPC> -> prev line
184 ;; C-<DWN> -> move to the next folder/project
185 ;; C-<UP> -> move to the previous folder/project
186 ;; C-<LFT> -> expand if collapsed move to the first folder; move inside if expanded
187 ;; C-<RGT> -> move up if folded collapsed; collapse if in front of folder ; move to the folded if in front of a file
188 ;; c s -> Toggle search mode
189 ;; c v -> Toggle view mode (flat / flat with the folder hidden / folder / marked files view)
190 ;; c b -> switch to the next build configuration
191 ;; c m -> switch the master project to be the current project
192 ;; c p -> switch to the next platform
193 ;; c B -> prompt to change build configuration
194 ;; c M -> prompt for the master project (project to build)
195 ;; c P -> prompt to change platform
196 ;; B -> launch build
197 ;; C -> launch clean
198 ;; D -> launch run/with debugger
199 ;; R -> launch run/without debugger
200 ;; G -> launch the update command (useful to regenerate some makefile/vcproj... from cmake for example); can also be consider a user command.
201 ;; 1 -> Switch to folder-view mode
202 ;; 2 -> Switch to flat-view mode
203 ;; 3 -> Switch to folder-hidden-view mode
204 ;; 4 -> Switch to marked-view mode
205 ;;
206 ;;
207 ;; Future improvement:
208 ;; T -> touch marked files (need a variable to make sure touch is always available)
209 ;; h -> find corresponding header/source (need regexps to match one and the other such as: source/header = ( "\.c\(pp\)?" . "\.h\(pp\)?" ) )
210 ;; d -> show/hide project dependencies
211 ;; b -> compile/buils marked files
212 ;;
213 ;;
217 ;;; Raw mode:
218 ;;
220 ;; As it was mentioned earlier, project-buffer-mode is just an abstract
221 ;; project manager. Even if some extensions already exist, you may
222 ;; want to be able to handle you own project system.
223 ;;
224 ;; Here is a sample code which shows how to create a new project:
225 ;;
226 ;; (defun test-projbuff()
227 ;; (interactive)
228 ;; (let ((buffer (generate-new-buffer "test-project-buffer"))) ; Creation of a buffer for the project
229 ;; (display-buffer buffer) ; We want to switch to this buffer right away.
230 ;; (with-current-buffer buffer
231 ;; (cd "~/temp") ; It's always better to set the root directory if it's known.
232 ;; (project-buffer-mode) ; Initialize the project buffer mode
233 ;;
234 ;; (project-buffer-insert "test1" 'project "test1/Makefile" "test1") ; Create an insert a project node called 'test1' (note: it's recommended to have project and node being the same)
235 ;; (project-buffer-insert "src/gfr.cpp" 'file "~/temp/test1/gfr.cpp" "test1") ; Add "~/tenp/gfr.cpp" to the project 'test1' it's project path will be: "src/gfr.cpp"
236 ;; (project-buffer-insert "src/abc.cpp" 'file "~/temp/test1/abc.cpp" "test1") ; Add "~/tenp/abc.cpp" to the project 'test1' it's project path will be: "src/abc.cpp"
237 ;;
238 ;; (project-buffer-insert "test2" 'project "test2/Makefile" "test2") ; Creation of a second project namded "test2"
239 ;; (project-buffer-insert "header/yyy.h" 'file "~/temp/test2/zzz.h" "test2") ; Add some file to this project; note that the project path and the physical file name can be completely different
240 ;; (project-buffer-insert "src/roo.c" 'file "~/temp/test2/roo.c" "test2") ; the file name research will be based on the project-path and not on the physical file name
241 ;; (project-buffer-insert "script.awk" 'file "~/temp/test2/script.awk" "test2") ;
242 ;; )))
243 ;;
244 ;;
245 ;; List of user functions available to handle your own project:
246 ;; - `project-buffer-mode' which initialize the project-buffer mode
247 ;; - `project-buffer-insert' to insert a file or project to the view
248 ;; - `project-buffer-delete-file' to remove a file
249 ;; - `project-buffer-delete-folder' to remove a folder and all its files
250 ;; - `project-buffer-delete-project' to remove a project and all its files
251 ;; - `project-buffer-set-project-platforms' to set the platform configuration for a particular project
252 ;; - `project-buffer-set-build-configurations' to set the build configurations for a particular project
253 ;; - `project-buffer-raw-save' to save a project into a file
254 ;; - `project-buffer-raw-load' to load a project from a file
255 ;; - `project-buffer-set-project-user-data' to set user data to a project node
256 ;; - `project-buffer-get-project-user-data' to get user data from a project node
257 ;; - `project-buffer-set-file-user-data' to set user data to a file node
258 ;; - `project-buffer-get-file-user-data' to get user data from a file node
259 ;; - `project-buffer-get-current-project-name' to get the nane of the current project the cursor is on
260 ;; - `project-buffer-get-current-file-data' to get data about the current file the cursor is on; nil if it's on a folder or a project
261 ;; - `project-buffer-exists-p' to check if a node exists (file or folder) inside a project
262 ;; - `project-buffer-project-exists-p' to check if a project exists
263 ;; - `project-buffer-get-project-path' to get a project's path
264 ;; - `project-buffer-get-file-path' to get the path of a file of the project
265 ;; - `project-buffer-get-current-node-type' to get the type of the current node (including folder)
266 ;; - `project-buffer-get-current-node-name' to get the name of the current node (including folder)
267 ;; - `project-buffer-get-marked-node-list' to get the list of marked files
268 ;; - `project-buffer-set-project-settings-data' to set user project settings data
269 ;; - `project-buffer-get-project-settings-data' to retrive the user project settings data
270 ;; - `project-buffer-apply-to-each-file' to perform a function call on every file node
271 ;; - `project-buffer-apply-to-marked-files' to perform a function call on eveyr marked files; the function returns nil if no marked files were found
272 ;; - `project-buffer-apply-to-project-files' to perform a function call on every files belonging to a specified project
273 ;;
274 ;; If you need to have some local variables to be saved; register them in `project-buffer-locals-to-save'.
275 ;; The same way, if there is need to save extra hooks: register them in `project-buffer-hooks-to-save'.
278 ;;; Todo:
279 ;;
281 ;; - show project dependencies
282 ;; e.g: [+] ProjName1 <deps: ProjName3, ProjName2>
283 ;; - add collapsed all / expand all commands
284 ;; - provide a touch marked files command
285 ;; - provide a compile/build marked files command
286 ;; - add a command to easily find the corresponding header/source for the current file (or specified file)
287 ;; - disable project which doesn't have the current selected platform/build-configuration in their list ???
292 ;;; History:
293 ;;
295 ;; v1.00: First public release.
296 ;; v1.10: Added mouse support and save/load.
297 ;; - Enable click on folder/project to expand/collapse them.
298 ;; - Enable click on filename to open them.
299 ;; - Added global command to load/save/write/revert a project buffer.
300 ;; - Added new hook: `project-buffer-post-find-file-hook'.
301 ;; - Added possibilty to attach user data to each nodes.
302 ;; v1.11: Bugs fixed
303 ;; - project-buffer-find-node-up was return nil in view-mode other than folder-view
304 ;; - file-exist-p has been renamed to file-exists-p
305 ;; - minor visibility bug when a files get added to the project if the view-mode is different from folder-view
306 ;; v1.12: New action added
307 ;; - 'update' to allow some project generation from cmake or other build system
308 ;; v1.20: Add new commands:
309 ;; - Delete current node
310 ;; - Delete marked files
311 ;; - Delete current node or marked file if in front of one (bound to <DEL>
312 ;; Add the following user functions:
313 ;; - `project-buffer-get-current-project-name' to get the project name the cursor is on
314 ;; - `project-buffer-get-current-file-data' to get data about the file the cursor is on
315 ;; - `project-buffer-get-file-path' to get the file path
316 ;; - `project-buffer-get-current-node-type' to get the type of the current node (including folder)
317 ;; - `project-buffer-get-current-node-name' to get the name of the current node (including folder)
318 ;; - `project-buffer-delete-folder' to remove a folder and all its files
319 ;; - `project-buffer-exists-p' to check if a node exists (file or folder) inside a project
320 ;; - `project-buffer-project-exists-p' to check if a project exists
321 ;; v1.21: Remap the update action to G; to remove the key conflict with the 'unmark all' command.
322 ;; Added the following user function:
323 ;; - `project-buffer-get-marked-node-list' to get the list of marked files
324 ;; Fix bug when deleting the cached folder.
325 ;; Added the refresh command bound to 'g'.
326 ;; The non-existing files are now 'grayed' out (can be disabled
327 ;; setting `project-buffer-check-file-existence' to nil)
328 ;; v1.22: Added the following user functions:
329 ;; - `project-buffer-set-project-settings-data' to set user project settings data
330 ;; - `project-buffer-get-project-settings-data' to retrieve the user project settings data
331 ;; - `project-buffer-apply-to-each-file' to perform a function call on every file node
332 ;; - `project-buffer-apply-to-marked-files' to perform a function call on eveyr marked files; the function returns nil if no marked files were found
333 ;; - `project-buffer-apply-to-project-files' to perform a function call on every files belonging to a specified project
334 ;; - `project-buffer-get-project-path' to get a project's path
335 ;; Refresh hooks now receive the current project or the project list as argument.
336 ;; It is now possible to refresh the current project only using the prefix argument
343 ;;; Code:
347 ;;
348 ;; Group definition:
349 ;;
353 "A special mode to manage projects."
354 )
357 ;;
358 ;; Constants:
359 ;;
365 ;;
366 ;; Customizable variables:
367 ;;
371 "Newly added project will be collapsed by default."
377 "Variable defining the current search-in-files mode.
378 The different search mode set to 'narrow-marked-files it will
379 search in the selected marked files, removing the one failing the
380 research, set to 'all-files it will launch the search on all
381 files in the projects, 'current-project will only search with the
382 current project Note: if no files are marked while using
383 narrow-marked-files, the search will occur in all files in the
384 project."
392 "If set to t, the view-mode will automatically be switched to
393 the marked-view mode after performing a search-in-files (unless
394 no files got marked/unmarked)."
400 "Confirmation function called before clean and node deletion."
407 "When set, deleting the last file of a project will result in
408 deleting the project itself."
414 "When set, the displayed files will be displayed with
415 'project-buffer-file-doesnt-exist' font if the file doesn't
416 exists."
422 ;;
423 ;; Font
424 ;;
430 "Project buffer mode face used to highlight project nodes."
435 "Master project buffer mode face used to highlight project nodes."
441 "Project buffer mode face used to highlight folder nodes."
447 "Project buffer mode face used to highlight file nodes."
453 "Project buffer mode face used highligh [ and ] in front of the project name."
459 "Project buffer mode face used to highlight indent characters."
465 "Project buffer mode face used highligh marks."
471 "Project buffer mode face used highligh file names."
476 "Project buffer mode face used matching file."
483 "Project buffer mode face used to highlight non-existing file nodes."
488 ;;
489 ;; User hook:
490 ;;
494 "Post `project-buffer-mode' initialization hook."
500 "Hook to perform the actions (build, clean, run...)
502 The function should follow the prototype:
503 (lambda (action project-name project-path platform configuration)
504 Where ACTION represents the action to apply to the project,
505 it may be: 'build 'clean 'run 'debug 'update,
506 PROJECT-NAME is the name of the master project,
507 PROJECT-PATH is the file path of the project
508 PLATFORM is the name of the selected platform,
509 and CONFIGURATION correspond to the selected build configuration."
515 "Hook to run after performing `project-buffer-raw-load'.
521 "Hook to run after performing `project-buffer-find-file' or
522 `project-buffer-find-file-other-window'.
524 The function should follow the prototype:
525 (lambda (project-buffer file-buffer))
526 Where PROJECT-BUFFER is the buffer of the project, and
531 "Hook to run before refreshing every node..
533 The function should follow the prototype:
534 (lambda (project-list content))
535 Where PROJECT-LIST is a list of project names (can be nil),
536 and CONTENT can either be 'current or 'all.
538 This is the place to add functions which reload the project file,
542 ;;
543 ;; Buffer local variables:
544 ;;
563 ;;
564 ;; History:
565 ;;
573 ;;
574 ;; Data type:
575 ;;
578 ;; Structure to store data attached to each ewoc-node.
579 ;; Each node represents either a file or a project or a folder indide the project"
584 name ;; string displayed to represent the file (usually the file.ext)
585 type ;; project? file? folder?
587 marked ;; is the file marked?
588 hidden ;; hidden files (currently: = project/folder close)
589 collapsed ;; is the folder/project collapsed or not?
590 project-collapsed ;; t if the project the file belong to is collapsed
592 matched ;; the file matches the regexp search
594 filename ;; path to the filename
595 project ;; name of the project the file belongs to
596 parent ;; parent node (parent folder or project or nil)
598 platform-list ;; list of the platform available for the project (valid in project node only)
599 build-configurations-list ;; list of build configuration avalailable for the project (valid in project node only)
601 user-data ;; user data could be set (mainly useful to store something per project)
602 project-settings ;; user data field used to store the project settings
603 )
607 ;;
608 ;; Key Bindings:
609 ;;
612 ;; Define the key mapping for the spu mode:
639 (define-key project-buffer-mode-map [?\ ] 'project-buffer-next-file)
640 (define-key project-buffer-mode-map [(shift ?\ )] 'project-buffer-prev-file)
641 (define-key project-buffer-mode-map [return] 'project-buffer-node-find-file)
642 (define-key project-buffer-mode-map [mouse-1] 'project-buffer-mouse-find-file)
643 (define-key project-buffer-mode-map [?o] 'project-buffer-node-find-file-other-window)
644 (define-key project-buffer-mode-map [(control left)] 'project-buffer-goto-dir-up-or-collapsed)
646 (define-key project-buffer-mode-map [(control right)] 'project-buffer-next-file-or-expand)
647 (define-key project-buffer-mode-map [(control up)] 'project-buffer-go-to-previous-folder-or-project)
648 (define-key project-buffer-mode-map [(control down)] 'project-buffer-go-to-next-folder-or-project)
649 (define-key project-buffer-mode-map [??] 'project-buffer-help)
650 (define-key project-buffer-mode-map [?q] 'project-buffer-quit)
651 (define-key project-buffer-mode-map [?g] 'project-buffer-refresh)
653 (define-key project-buffer-mode-map [?B] 'project-buffer-perform-build-action)
654 (define-key project-buffer-mode-map [?C] 'project-buffer-perform-clean-action)
655 (define-key project-buffer-mode-map [?R] 'project-buffer-perform-run-action)
656 (define-key project-buffer-mode-map [?D] 'project-buffer-perform-debug-action)
657 (define-key project-buffer-mode-map [?G] 'project-buffer-perform-update-action)
658 (define-key project-buffer-mode-map [?s] 'project-buffer-mark-files-containing-regexp)
660 (define-key project-buffer-mode-map [?1] 'project-buffer-set-folder-view-mode)
661 (define-key project-buffer-mode-map [?2] 'project-buffer-set-flat-view-mode)
662 (define-key project-buffer-mode-map [?3] 'project-buffer-set-folder-hidden-view-mode)
663 (define-key project-buffer-mode-map [?4] 'project-buffer-set-marked-view-mode)
665 (define-key project-buffer-mode-map [delete] 'project-buffer-delete-current-node-or-marked-files)
667 project-buffer-mode-map))
670 ;;
671 ;; Internal Utility Functions:
672 ;;
675 (defun project-buffer-erase-all(status)
676 "Erase all nodes from the buffer."
677 (let ((node (ewoc-nth status 0)))
678 (while node
679 (project-buffer-delete-project-node status (project-buffer-node->name (ewoc-data node)) node)
680 (setq node (ewoc-nth status 0)))
681 (setq project-buffer-cache-project nil)
682 (setq project-buffer-cache-subdirectory nil)
683 (setq project-buffer-projects-list nil)
684 (setq project-buffer-master-project nil)
685 (setq project-buffer-platforms-list nil)
686 (setq project-buffer-current-platform nil)
687 (setq project-buffer-build-configurations-list nil)
688 (setq project-buffer-current-build-configuration nil)
689 (project-buffer-refresh-ewoc-hf status)
690 ))
693 (defun project-buffer-mark-matching-file(status regexp)
694 "Check each file name and mark the files matching the regular expression REGEXP"
695 (let ((node (ewoc-nth status 0)))
696 (while node
697 (let* ((node-data (ewoc-data node))
698 (node-type (project-buffer-node->type node-data))
699 (node-name (project-buffer-node->name node-data))
700 (file (file-name-nondirectory node-name)))
701 (when (string-match regexp file)
702 (let ((parent (project-buffer-find-node-up status node)))
703 (while (and parent
704 (not (eq (project-buffer-node->type (ewoc-data parent)) 'project))
705 (not (project-buffer-node->matched (ewoc-data parent))))
706 (setf (project-buffer-node->matched (ewoc-data parent)) t)
707 (ewoc-invalidate status parent)
708 (setq parent (project-buffer-find-node-up status parent))
709 ))
710 (setf (project-buffer-node->matched node-data) t)
711 (ewoc-invalidate status node)
712 ))
713 (setq node (ewoc-next status node)))))
716 (defun project-buffer-read-regexp(prompt)
717 "Read a regular expression from the minibuffer."
718 (read-from-minibuffer prompt nil nil nil 'project-buffer-regexp-history))
721 (defun project-buffer-clear-matched-mark(status)
722 "Clear 'matched' flag"
723 (let (result)
724 (ewoc-map (lambda (node)
725 (when (project-buffer-node->matched node)
726 (setf (project-buffer-node->matched node) nil)
727 (setq result t)))
728 status)
729 result))
732 (defun project-buffer-get-marked-nodes(status)
733 "Return the list of marked node or the current node if none are marked"
734 (or (ewoc-collect status (lambda (node) (project-buffer-node->marked node)))
735 (list (ewoc-data (ewoc-locate status)))))
738 (defun project-buffer-convert-name-for-display(node-data)
739 "Convert the node name into the displayed string depending on the project-buffer-view-mode."
740 (let* ((node-name (project-buffer-node->name node-data))
741 (file-color (if (project-buffer-node->matched node-data)
742 'project-buffer-matching-file-face
743 (if (and project-buffer-check-file-existence
744 (eq (project-buffer-node->type node-data) 'file)
745 (not (file-exists-p (project-buffer-node->filename node-data))))
746 'project-buffer-file-doesnt-exist
747 'project-buffer-file-face)))
748 (node-color (if (eq (project-buffer-node->type node-data) 'file) file-color 'project-buffer-folder-face))
749 (file-help (concat "mouse-1: find file other window: " (project-buffer-node->filename node-data)))
750 (folder-help (concat "mouse-1: "
751 (if (project-buffer-node->collapsed node-data) "expand" "collapse")
752 " folder " node-name ".")))
753 (cond ((eq project-buffer-view-mode 'flat-view)
754 (concat (propertize " `- " 'face 'project-buffer-indent-face)
755 (and (file-name-directory node-name)
756 (propertize (file-name-directory node-name) 'face 'project-buffer-folder-face))
757 (propertize (file-name-nondirectory node-name)
758 'face file-color
759 'mouse-face 'highlight
760 'help-echo file-help)))
761 ((eq project-buffer-view-mode 'folder-hidden-view)
762 (concat (propertize " `- " 'face 'project-buffer-indent-face)
763 (propertize (file-name-nondirectory node-name)
764 'face file-color
765 'mouse-face 'highlight
766 'help-echo file-help)))
767 ((eq project-buffer-view-mode 'folder-view)
768 (let ((dir-list (split-string node-name "/"))
769 (str (if (eq (project-buffer-node->type node-data) 'file)
770 " `- "
771 (concat " `"
772 (propertize (if (project-buffer-node->collapsed node-data) "+" "-")
773 'mouse-face 'highlight
774 'help-echo folder-help)
775 " ")))
776 (cur 1))
777 (while (< cur (length dir-list))
778 (setq str (concat " | " str)
779 cur (1+ cur)))
780 (concat (propertize str 'face 'project-buffer-indent-face)
781 (if (eq (project-buffer-node->type node-data) 'file)
782 (propertize (file-name-nondirectory node-name)
783 'face node-color
784 'mouse-face 'highlight
785 'help-echo file-help)
786 (propertize (file-name-nondirectory node-name)
787 'face node-color
788 'mouse-face 'highlight
789 'help-echo folder-help))
790 )))
791 ((eq project-buffer-view-mode 'marked-view)
792 (concat (propertize " - " 'face 'project-buffer-indent-face)
793 (and (file-name-directory node-name)
794 (propertize (file-name-directory node-name) 'face 'project-buffer-folder-face))
795 (propertize (file-name-nondirectory node-name)
796 'face file-color
797 'mouse-face 'highlight
798 'help-echo file-help
799 )))
800 (t (format "Unknown view mode: %S" project-buffer-view-mode) ))))
803 (defun project-buffer-prettyprint(node)
804 "Pretty-printer function"
805 (let ((node-collapsed (project-buffer-node->collapsed node))
806 (node-name (project-buffer-node->name node))
807 (node-marked (project-buffer-node->marked node))
808 (node-type (project-buffer-node->type node))
809 (node-hidden (project-buffer-node->hidden node))
810 (node-matching (project-buffer-node->matched node))
811 (node-prjcol (project-buffer-node->project-collapsed node))
812 (node-project (project-buffer-node->project node))
813 (project-help (concat "mouse-1: "
814 (if (project-buffer-node->collapsed node) "expand" "collapse")
815 " project "
816 (project-buffer-node->name node))))
817 (if (eq project-buffer-view-mode 'marked-view)
818 (when (and (eq node-type 'file)
819 (or node-marked node-matching))
820 (insert (concat " "
821 (if node-marked (propertize "*" 'face 'project-buffer-mark-face) " ")
822 " "
823 (propertize (if (> (length node-project) 16)
824 (substring node-project 0 16)
825 node-project)
826 'face 'project-buffer-project-face)))
827 (indent-to-column 19)
828 (insert (concat (project-buffer-convert-name-for-display node)
830 (when (or (and (eq project-buffer-view-mode 'folder-view)
831 (or (not node-hidden)
832 node-matching))
833 (and (not (eq project-buffer-view-mode 'folder-view))
834 (not (eq node-type 'folder))
835 (or (not node-prjcol)
836 node-matching))
837 (eq node-type 'project))
838 (insert (concat " "
839 (if node-marked (propertize "*" 'face 'project-buffer-mark-face)" ")
840 " "
841 (cond ((not (eq node-type 'project)) " ")
842 (node-collapsed (propertize "[+]"
843 'face 'project-buffer-project-button-face
844 'mouse-face 'highlight
845 'help-echo project-help))
846 (t (propertize "[-]"
847 'face 'project-buffer-project-button-face
848 'mouse-face 'highlight
849 'help-echo project-help)))
850 " "
851 (or (and (eq node-type 'project)
852 (propertize node-name
853 'face (or (and project-buffer-master-project
854 (string= node-name (car project-buffer-master-project))
855 'project-buffer-master-project-face)
856 'project-buffer-project-face)
857 'mouse-face 'highlight
858 'help-echo project-help))
859 (project-buffer-convert-name-for-display node))))
860 (when (and (eq project-buffer-view-mode 'folder-hidden-view)
861 (project-buffer-node->filename node)
862 (eq (project-buffer-node->type node) 'file))
863 (indent-to-column 40)
864 (insert (concat " " (propertize (project-buffer-node->filename node)
865 'face 'project-buffer-filename-face))))
867 )))
870 (defun project-buffer-refresh-ewoc-hf(status)
871 "Refresh ewoc header/footer"
872 (ewoc-set-hf status
880 (defun project-buffer-extract-folder(name type)
881 "Return the folder associated to the node's NAME of the type TYPE.
882 Return nil if TYPE is project."
883 (cond ((eq type 'folder) name)
884 ((eq type 'project) nil)
885 (t (let ((dirname (file-name-directory name)))
886 (and dirname (substring dirname 0 -1))))))
889 (defun project-buffer-directory-lessp(dir1 dir2 type2)
890 "Return t if DIR1 is less than (DIR2,TYPE2)."
891 (let* ((list1 (and dir1 (split-string dir1 "/")))
892 (list2 (and dir2 (split-string dir2 "/")))
893 (cnt 0))
894 (if (and list1 list2)
895 (progn (while (and (< cnt (length list1))
896 (< cnt (length list2))
897 (string= (nth cnt list1) (nth cnt list2)))
898 (setq cnt (1+ cnt)))
899 (if (and (< cnt (length list1))
900 (< cnt (length list2)))
901 (string-lessp (nth cnt list1) (nth cnt list2))
902 (and (eq type2 'file)
903 (< cnt (length list1)))
904 ))
905 (null list2))))
908 (defun project-buffer-parent-of-p(child parent)
909 "Check if CHILD is a child of the directory PARENT."
910 (let* ((clist (and child (split-string child "/")))
911 (plist (and parent (split-string parent "/")))
912 (cont t)
913 res)
914 (while (and clist plist cont)
915 (let ((cname (pop clist))
916 (pname (pop plist)))
917 (setq cont (string-equal cname pname))))
918 (and cont (null plist))))
921 (defun project-buffer-find-node-up(status node)
922 "Return the directory or project in which the node belong.
923 This may change depending on the view mode."
924 (if (eq project-buffer-view-mode 'folder-view)
925 (project-buffer-node->parent (ewoc-data node))
926 (let ((parent (project-buffer-node->parent (ewoc-data node))))
927 (when parent
928 (while (not (eq (project-buffer-node->type (ewoc-data parent)) 'project))
929 (setq parent (project-buffer-node->parent (ewoc-data parent))))
930 parent))))
933 (defun project-buffer-search-project-node(status project-name)
934 "Return the node of the project node named PROJECT-NAME or nil if absent"
935 (if (string-equal (car project-buffer-cache-project) project-name)
936 (cdr project-buffer-cache-project)
937 (let ((node (ewoc-nth status 0)))
938 (while (and node
939 (or (not (eq (project-buffer-node->type (ewoc-data node)) 'project))
940 (not (string-equal (project-buffer-node->name (ewoc-data node)) project-name))))
941 (setq node (ewoc-next status node)))
942 node)))
945 (defun project-buffer-set-project-platforms-data(status project platform-list)
946 "Attached the list of platform contained in PLATFORM-LIST to the project named PROJECT."
947 (let ((node (project-buffer-search-project-node status project)))
948 ;; Now, if the project has been found:
949 (when node
950 (setf (project-buffer-node->platform-list (ewoc-data node)) platform-list)
951 ;; also:
952 (while platform-list
953 (add-to-list 'project-buffer-platforms-list (pop platform-list) t))
954 (unless project-buffer-current-platform
955 (setq project-buffer-current-platform (car project-buffer-platforms-list)))))
956 (project-buffer-refresh-ewoc-hf status))
959 (defun project-buffer-set-project-build-configurations-data(status project build-configuration-list)
960 "Attached the list build configurations in BUILD-CONFIGURATION-LIST to the project named PROJECT."
961 (let ((node (project-buffer-search-project-node status project)))
962 ;; Now, if the project has been found:
963 (when node
964 (setf (project-buffer-node->build-configurations-list (ewoc-data node)) build-configuration-list)
965 ;; also:
966 (while build-configuration-list
967 (add-to-list 'project-buffer-build-configurations-list (pop build-configuration-list) t))
968 (unless project-buffer-current-build-configuration
969 (setq project-buffer-current-build-configuration (car project-buffer-build-configurations-list)))))
970 (project-buffer-refresh-ewoc-hf status))
973 (defun project-buffer-insert-node(status data)
974 "Insert a file in alphabetic order in it's project/directory."
975 (let ((node (ewoc-nth status 0))
976 (folder-data (project-buffer-extract-folder (project-buffer-node->name data) (project-buffer-node->type data)))
977 (name-data (file-name-nondirectory (project-buffer-node->name data)))
978 (type-data (project-buffer-node->type data))
979 (proj-data (project-buffer-node->project data))
980 (node-data nil)
981 (here nil)
982 (proj-found nil)
983 (folder nil)
984 (hidden-flag nil)
985 (skip nil)
986 (proj-root-node nil)
987 (folder-node nil)
988 (parent-node nil)
989 )
990 (when (eq type-data 'folder)
991 (error "Not supported -- in particular project-buffer-directory-lessp may returns a incorrect value"))
994 ;; Cache check:
995 (when project-buffer-cache-project
996 (cond
997 ;; cache-project < current-project -> we can start the search from here (at least).
998 ((string-lessp (car project-buffer-cache-project) proj-data)
999 (setq node (cdr project-buffer-cache-project)
1000 project-buffer-cache-subdirectory nil))
1002 ;; cache-project == current-project -> check the folders...
1003 ((string-equal (car project-buffer-cache-project) proj-data)
1004 ;; cache-subdir < current-subdir -> we can start from here.
1005 ;; cache-subdir = current-subdir -> good starting point
1006 (if (and project-buffer-cache-subdirectory
1007 folder-data
1008 (or (string-equal (car project-buffer-cache-subdirectory) folder-data)
1009 (project-buffer-directory-lessp (car project-buffer-cache-subdirectory) folder-data 'folder)))
1010 (setq node (cdr project-buffer-cache-subdirectory)
1011 proj-root-node (cdr project-buffer-cache-project)
1012 proj-found t)
1013 (setq node (cdr project-buffer-cache-project)
1014 project-buffer-cache-subdirectory nil)))
1015 ;; other wise: cache miss...
1016 (t
1017 (setq project-buffer-cache-project nil
1018 project-buffer-cache-subdirectory nil))))
1020 ;; Search where to insert the node:
1021 (while (and node (not here) (not skip))
1022 (setq node-data (ewoc-data node))
1024 (cond
1025 ;; data.project < node.project -> insert here...
1026 ((string-lessp proj-data (project-buffer-node->project node-data))
1027 (if (eq (project-buffer-node->type data) 'project)
1028 (setq here node)
1029 (setq here (and proj-found node)
1030 skip (not proj-found))))
1032 ;; node.project == data.project -> check folder/file name
1033 ((string-equal proj-data (project-buffer-node->project node-data))
1034 (if (eq (project-buffer-node->type data) 'project)
1035 ;; If we're trying to add the project when the project already exist... we'll skip it.
1036 (setq skip t)
1037 ;; Otherwise:
1038 (let* ((folder-db (project-buffer-extract-folder (project-buffer-node->name node-data) (project-buffer-node->type node-data)))
1039 (name-db (file-name-nondirectory (project-buffer-node->name node-data)))
1040 (type-db (project-buffer-node->type node-data)))
1041 ;; Are we're on the project line???
1042 (if (eq type-db 'project)
1043 (setq proj-root-node node)
1044 (if (and folder-db folder-data)
1045 ;; Both the current node and the new one have a directory
1046 (progn (when (and (eq type-db 'folder)
1047 (project-buffer-parent-of-p (project-buffer-node->name data) folder-db))
1048 (setq folder-node node))
1049 (cond ((project-buffer-directory-lessp folder-data folder-db type-db)
1050 (setq here node))
1052 ((string-equal folder-data folder-db)
1053 (when (eq type-db 'folder)
1054 (setq folder-node node))
1055 (setq folder folder-data)
1056 (if (eq type-data 'folder)
1057 (setq skip t)
1058 (unless (eq type-db 'folder)
1059 (when (string-lessp name-data name-db)
1060 (setq here node)))))
1062 (t (setq folder folder-db))))
1063 ;; Either:
1064 ;; - the current node has no folder, meaning:
1065 ;; -> either the new node has a directory in which case we'll add it here.
1066 ;; -> or we'll search for the right place to add it.
1067 ;; - the current node has a folder, meaning:
1068 ;; -> the new one has no folder, therefore, we need to carry on until we reach the no-folder area.
1069 (unless folder-db
1070 (if folder-data
1071 (setq here node)
1072 (when (string-lessp name-data name-db)
1073 (setq here node)))))))
1074 (setq proj-found t))
1075 ))
1077 ;; Carry on...
1078 (setq node (ewoc-next status node)))
1080 ;; Insert before here...
1081 (when (not skip)
1083 ;; Here we can set the parent folder:
1084 (if folder-node
1085 (setf (project-buffer-node->parent data) folder-node)
1086 (setf (project-buffer-node->parent data) proj-root-node))
1088 ;; Once the node added we will need to check if it should be hidden or not.
1089 ;; At first, if it's a file, it will be hidden to not have any glitch in the displayed buffer
1090 (if (eq type-data 'project)
1091 (progn (setf (project-buffer-node->project-collapsed data) project-buffer-new-project-collapsed)
1092 (setf (project-buffer-node->collapsed data) project-buffer-new-project-collapsed)
1093 (add-to-list 'project-buffer-projects-list name-data)
1094 (unless project-buffer-master-project
1095 (setq project-buffer-master-project (cons name-data nil)))) ; to prevent blinking
1096 (progn (setf (project-buffer-node->hidden data) t)
1097 (setf (project-buffer-node->project-collapsed data) (project-buffer-node->project-collapsed (ewoc-data (project-buffer-node->parent data))))
1098 (unless proj-root-node
1099 (error "Project '%s' not found" proj-data))))
1101 (if here
1102 (setq node (ewoc-enter-before status here data))
1103 (setq node (ewoc-enter-last status data)))
1105 (when (eq type-data 'project)
1106 (unless (cdr project-buffer-master-project)
1107 (setq project-buffer-master-project (cons name-data node)))
1108 (setq proj-root-node node))
1110 ;;
1112 ;; If it's not a project type, search up in all possible parent to see if the node is supposed to be visible or not
1113 (unless (eq type-data 'project)
1114 (let* ((shown t)
1115 (parent (project-buffer-find-node-up status node)))
1116 (setf (project-buffer-node->project-collapsed data) (project-buffer-node->project-collapsed (ewoc-data parent)))
1117 (setq shown (not (and parent (project-buffer-node->collapsed (ewoc-data parent)))))
1118 (while (and parent
1119 shown
1120 (not (eq (project-buffer-node->type (ewoc-data parent)) 'project)))
1121 (setq parent (project-buffer-find-node-up status parent))
1122 (setq shown (not (and parent (project-buffer-node->collapsed (ewoc-data parent)))))
1123 )
1124 (setq hidden-flag (not shown)))
1125 (unless hidden-flag
1126 (setf (project-buffer-node->hidden data) nil)
1127 (ewoc-invalidate status node)))
1129 ;; In case some folder needed to be created:
1130 (when folder-data
1131 (let* ((db-list (and folder (split-string folder "/")))
1132 (curr-list (split-string folder-data "/"))
1133 (cnt 0))
1134 (while (and (< cnt (length curr-list))
1135 (< cnt (length db-list))
1136 (string= (nth cnt db-list) (nth cnt curr-list)))
1137 (setq cnt (1+ cnt)))
1138 ;; Add the extra folder:
1139 (if (< cnt (length curr-list))
1140 (let ((ndx 0)
1141 (str nil))
1142 (while (< ndx cnt)
1143 (setq str (or (and str (concat str "/" (nth ndx curr-list)))
1144 (nth ndx curr-list)))
1145 (setq ndx (1+ ndx)))
1146 (while (< ndx (length curr-list))
1147 (setq str (or (and str (concat str "/" (nth ndx curr-list)))
1148 (nth ndx curr-list)))
1150 (setq parent-node (or folder-node proj-root-node))
1151 (let ((new-data (project-buffer-create-node str 'folder folder proj-data hidden-flag)))
1152 (setf (project-buffer-node->project-collapsed new-data) (project-buffer-node->project-collapsed data))
1153 (setq folder-node (ewoc-enter-before status node new-data)))
1154 (setf (project-buffer-node->parent (ewoc-data folder-node)) parent-node)
1156 (setf (project-buffer-node->parent data) folder-node)
1157 (setq ndx (1+ ndx)))))
1158 ))
1159 )
1161 ;; Save the project root node:
1162 ;; - to speed up the next insert (we stop looking for the project if it's the same one)
1163 (setq project-buffer-cache-project (cons proj-data proj-root-node))
1164 (setq project-buffer-cache-subdirectory (and folder-node
1165 (cons folder-data folder-node)))
1166 ))
1169 (defun project-buffer-delete-node(status node &optional dont-delete-project)
1170 "Delete a specific node.
1171 Also cleanup with empty folder/project resulting of the deletion."
1172 (let ((parent-node (project-buffer-node->parent (ewoc-data node)))
1173 (project (project-buffer-node->project (ewoc-data node)))
1174 (inhibit-read-only t))
1175 ;; Delete the found node:
1176 (when (and project-buffer-cache-subdirectory
1177 (eq node (cdr project-buffer-cache-subdirectory)))
1178 (setq project-buffer-cache-subdirectory nil))
1179 (ewoc-delete status node)
1181 ;; Now it's time to check the parent node the file belong to:
1182 (while parent-node
1183 (let ((next-node (ewoc-next status parent-node))
1184 (parent-data (ewoc-data parent-node)))
1185 (if (and next-node
1186 (eq (project-buffer-node->parent (ewoc-data next-node)) parent-node))
1187 (setq parent-node nil)
1188 (let ((new-parent-node (and (not (eq (project-buffer-node->type parent-data) 'project))
1189 (project-buffer-node->parent parent-data))))
1190 (if (not new-parent-node)
1191 (unless dont-delete-project
1192 (project-buffer-delete-project-node status project parent-node))
1193 (progn (when (and project-buffer-cache-subdirectory
1194 (eq parent-node (cdr project-buffer-cache-subdirectory)))
1195 (setq project-buffer-cache-subdirectory nil))
1196 (ewoc-delete status parent-node)))
1197 (setq parent-node new-parent-node))
1198 )))
1199 ))
1202 (defun project-buffer-delete-file-node(status name project &optional dont-delete-project)
1203 "Delete the node named NAME which belongs to PROJECT.
1204 Empty folder node will also be cleared up."
1205 (let* ((node (project-buffer-search-node status name project)))
1206 (when node
1207 (project-buffer-delete-node status node dont-delete-project))
1208 ))
1211 (defun project-buffer-delete-folder-node(status folder-node &optional dont-delete-project)
1212 "Delete the folder FOLDER-NODE and all it's files.
1213 Empty parent folder node will also be cleared up."
1214 (let* ((folder (and folder-node (project-buffer-node->name (ewoc-data folder-node)))))
1215 (when folder
1216 ;; First, let delete the content of the folder:
1217 (let ((inhibit-read-only t))
1218 (save-excursion
1219 (let* ((node (ewoc-next status folder-node))
1220 (node-data (and node (ewoc-data node)))
1221 next-node)
1222 (while (and node
1223 (not (eq (project-buffer-node->type node-data) 'project))
1224 (project-buffer-parent-of-p (project-buffer-node->name node-data) folder))
1225 (setq next-node (ewoc-next status node))
1226 (when (and project-buffer-cache-subdirectory (eq node (cdr project-buffer-cache-subdirectory)))
1227 (setq project-buffer-cache-subdirectory nil))
1228 (ewoc-delete status node)
1229 (setq node next-node
1230 node-data (and node (ewoc-data node)))))))
1231 ;; Now let's delete the node:
1232 (project-buffer-delete-node status folder-node dont-delete-project)
1233 )))
1236 (defun project-buffer-delete-project-node(status proj-name proj-node)
1237 "Delete the project node PROJ-NODE.
1238 Each files/folder under the project will also be deleted."
1239 (when proj-node
1240 (let ((proj-data (ewoc-data proj-node))
1241 (prev-node (ewoc-prev status proj-node))
1242 (curr-node proj-node))
1243 ;; Let's start by removing the project from the project list:
1244 (setq project-buffer-projects-list (remove proj-name project-buffer-projects-list))
1246 ;; Check the cache:
1247 (when (string-equal (car project-buffer-cache-project) proj-name)
1248 (setq project-buffer-cache-project nil)
1249 (setq project-buffer-cache-subdirectory nil))
1251 ;; Delete the nodes:
1252 (let ((inhibit-read-only t))
1253 (while (and curr-node
1254 (string-equal (project-buffer-node->project (ewoc-data curr-node)) proj-name))
1255 (let ((next-node (ewoc-next status curr-node)))
1256 (ewoc-delete status curr-node)
1257 (setq curr-node next-node)
1258 )))
1260 ;; Now: the master project may need to be readjusted
1261 (when (string-equal proj-name (car project-buffer-master-project))
1262 (if curr-node
1263 ;; By default the next project become the new master one:
1264 (progn (setq project-buffer-master-project (cons (project-buffer-node->project (ewoc-data curr-node)) curr-node))
1265 (ewoc-invalidate status curr-node))
1266 ;; Otherwise: if the previous node is invalid, it's project will become the new master one:
1267 (if prev-node
1268 (let ((prev-parent (project-buffer-node->parent (ewoc-data prev-node))))
1269 (while (not (eq (project-buffer-node->type (ewoc-data prev-parent)) 'project))
1270 (setq prev-parent (project-buffer-node->parent (ewoc-data prev-parent))))
1271 (setq project-buffer-master-project (cons (project-buffer-node->project (ewoc-data prev-parent)) prev-parent))
1272 (ewoc-invalidate status prev-parent))
1273 (setq project-buffer-master-project nil))))
1274 )))
1277 (defun project-buffer-refresh-all-items(status)
1278 "Refresh all ewoc item from the buffer."
1279 (ewoc-map (lambda (info) t) status)) ; (ewoc-refresh status) doesn't work properly.
1282 (defun project-buffer-perform-action-hook(action)
1283 "Call the user hook to perform ACTION."
1284 (run-hook-with-args 'project-buffer-action-hook
1285 action
1286 (car project-buffer-master-project)
1287 (project-buffer-node->filename (ewoc-data (cdr project-buffer-master-project)))
1288 project-buffer-current-platform
1289 project-buffer-current-build-configuration))
1292 (defun project-buffer-search-and-mark-files(status regexp project marked-flag)
1293 "Search REGEXP in with all files if PROJECT is nil or in each file of the specified PROJECT.
1294 If REGEXP is found, the marked-flag field associated to the file get set to MARKED-FLAG
1295 The function returns the number of files whose marked-flag field changed"
1296 (let ((count 0))
1297 (ewoc-map (lambda (node)
1298 (when (and (eq (project-buffer-node->type node) 'file) ; check only files
1299 (or (not project) ; ( if a project is specified,
1300 (string-equal (project-buffer-node->project node) project)) ; make sure it matches the node's project )
1301 (not (eq (project-buffer-node->marked node) marked-flag))) ; which aren't already (un)marked (based on request)
1302 ;; Check if the file contain the regexp:
1303 (let ((filename (project-buffer-node->filename node)))
1304 (when (and filename
1305 (file-readable-p filename)
1306 (let ((fbuf (get-file-buffer filename)))
1307 (message "Project '%s' -- Searching in '%s'" (project-buffer-node->project node) (project-buffer-node->name node))
1308 (if fbuf
1309 (with-current-buffer fbuf
1310 (save-excursion
1311 (goto-char (point-min))
1312 (re-search-forward regexp nil t)))
1313 (with-temp-buffer
1314 (insert-file-contents filename)
1315 (goto-char (point-min))
1316 (re-search-forward regexp nil t)))))
1317 (setf (project-buffer-node->marked node) marked-flag)
1318 (setq count (1+ count))
1319 t )))) ; to force the update of the display.
1320 status)
1321 count))
1324 (defun project-buffer-refine-mark-files(status regexp marked-flag)
1325 "Search REGEXP in with all marked files.
1326 If REGEXP is found, the marked-flag field associated to the file get set to MARKED-FLAG
1327 The function returns the number of files whose marked-flag field changed
1328 Note: if no files are marked, the search will occur in all existing files of the project"
1329 (let ((count 0)
1330 marked-file-found)
1331 (ewoc-map (lambda (node)
1332 (when (and (eq (project-buffer-node->type node) 'file) ; check only files
1333 (project-buffer-node->marked node)) ; which are already marked
1334 (setq marked-file-found t)
1335 ;; Check if the file contain the regexp:
1336 (let ((filename (project-buffer-node->filename node)))
1337 (when (and filename
1338 (file-readable-p filename)
1339 (let ((found (let ((fbuf (get-file-buffer filename)))
1340 (message "Project '%s' -- Searching in '%s'" (project-buffer-node->project node) (project-buffer-node->name node))
1341 (if fbuf
1342 (with-current-buffer fbuf
1343 (save-excursion
1344 (goto-char (point-min))
1345 (re-search-forward regexp nil t)))
1346 (with-temp-buffer
1347 (insert-file-contents filename)
1348 (goto-char (point-min))
1349 (re-search-forward regexp nil t))))))
1350 (or (and found (not marked-flag))
1351 (and (not found) marked-flag))))
1352 (setf (project-buffer-node->marked node) nil)
1353 (setq count (1+ count))
1354 t )))) ; to force the update of the display.
1355 status)
1356 (if marked-file-found
1357 count
1358 ( - 0 (project-buffer-search-and-mark-files status regexp nil marked-flag)))))
1361 (defun project-buffer-set-master-project(status project-name)
1362 "Set PROJECT-NAME to be the new master project."
1363 (let ((old-node (cdr project-buffer-master-project))
1364 (cur-node (project-buffer-search-project-node status project-name)))
1365 (when cur-node
1366 ;; Let's replace the old node by the new one
1367 (setq project-buffer-master-project (cons (project-buffer-node->name (ewoc-data cur-node)) cur-node))
1368 ;; Force the refresh:
1369 (ewoc-invalidate status old-node)
1370 (ewoc-invalidate status cur-node)
1371 (ewoc-goto-node status cur-node))))
1375 (defun project-buffer-raw-print-hooks(hook-symbol hook-list)
1376 "Print a hooks block in the current buffer."
1377 (print (list 'begin 'hook hook-symbol) (current-buffer))
1378 (while hook-list
1379 (let ((hook-item (pop hook-list)))
1380 (print (cond ((booleanp hook-item)
1381 (list 'value hook-item))
1382 ((symbolp hook-item)
1383 (list 'symbol hook-item (abbreviate-file-name (symbol-file hook-item))))
1384 ((functionp hook-item)
1385 (list 'value hook-item))
1386 (t (error "Unknown type found in the hook list")))
1387 (current-buffer))))
1388 (print (list 'end 'hook hook-symbol) (current-buffer)))
1391 (defun project-buffer-raw-print-locals(local-list)
1392 "Print a local block in the current-buffer."
1393 (print (list 'begin 'locals) (current-buffer))
1394 (while local-list
1395 (print (pop local-list) (current-buffer)))
1396 (print (list 'end 'locals) (current-buffer)))
1399 (defun project-buffer-read-header(status data-buffer &optional set-buffer-name set-current-directory)
1400 "Read the header of the saved file from the DATA-BUFFER."
1401 (let ((header-data (read data-buffer)))
1402 (unless (and header-data
1403 (listp header-data)
1404 (eq (car header-data) 'project-buffer-mode))
1405 (error "Not in project-buffer save file"))
1406 ;; The header list is: '(project-buffer-mode version buffer-name directory)
1407 (when set-buffer-name
1408 (rename-buffer (nth 2 header-data) t))
1409 (when set-current-directory
1410 (cd (nth 3 header-data)))
1411 ;; Finally, let's return the version:
1412 (nth 1 header-data)))
1415 (defun project-buffer-read-block-hook(status data-buffer block-header run-mode-hooks)
1416 "Read a project-buffer-hook block; set the local hook and
1417 attempt to load the definition file if a hook function isnt't bound."
1418 ;; block-header should be: '(begin hook hook-symbol)
1419 (unless (and (listp block-header)
1420 (eq (car block-header) 'begin)
1421 (eq (nth 1 block-header) 'hook)
1422 (= (length block-header) 3))
1423 (error "Invalid block-header"))
1424 (let ((hook-symbol (nth 2 block-header)))
1425 (unless (symbolp hook-symbol)
1426 (error "Invalid block-header"))
1427 (if (and (boundp hook-symbol)
1428 (listp (eval hook-symbol)))
1429 ;; If the hook variable exists:
1430 (let ((block-line (read data-buffer)))
1431 (add-to-list 'project-buffer-hooks-to-save hook-symbol)
1432 (while (and block-line
1433 (not (and (listp block-line)
1434 (eq (car block-line) 'end)
1435 (eq (nth 1 block-line) 'hook)
1436 (eq (nth 2 block-line) hook-symbol))))
1437 (if (listp block-line)
1438 (cond ((eq (car block-line) 'symbol)
1439 (let ((func (nth 1 block-line))
1440 (file (nth 2 block-line)))
1441 (add-hook hook-symbol func nil t)
1442 (when (and (not (fboundp func))
1443 (file-exists-p file)
1444 (file-readable-p file))
1445 (load-file file))))
1446 ((eq (car block-line) 'value)
1447 (add-hook hook-symbol (nth 1 block-line) nil t))
1448 (t (error "Unknown hook type: %s!" (car block-line))))
1449 (error "Unknown hook line: %s" block-line))
1450 (setq block-line (read data-buffer)))
1451 ;; Check if it's the mode-hook:
1452 (when (and run-mode-hooks
1453 (eq hook-symbol 'project-buffer-mode-hook))
1454 (run-hooks 'project-buffer-mode-hook))
1455 )
1456 ;; If the hook variable doesn't exist, we just skip the block:
1457 (project-buffer-skip-block status data-buffer block-header))))
1460 (defun project-buffer-read-block-node-list(status data-buffer block-header)
1461 "Read a project-buffer-node-list block; add each node to the
1462 project-buffer context."
1463 ;; block-header should be: '(begin node-list)
1464 (unless (and (listp block-header)
1465 (eq (car block-header) 'begin)
1466 (eq (nth 1 block-header) 'node-list))
1467 (error "Invalid block-header"))
1468 (let ((block-line (read data-buffer)))
1469 (while (and block-line
1470 (not (and (listp block-line)
1471 (eq (car block-line) 'end)
1472 (eq (nth 1 block-line) 'node-list))))
1473 (if (and (listp block-line)
1474 (> (length block-line) 5))
1475 (let ((name (nth 0 block-line))
1476 (type (nth 1 block-line))
1477 (filename (nth 2 block-line))
1478 (project (nth 3 block-line))
1479 (platform-list (nth 4 block-line))
1480 (build-configurations-list (nth 5 block-line))
1481 (user-data (and (> (length block-line) 6) (nth 6 block-line)))
1482 (project-settings (and (> (length block-line) 7) (nth 7 block-line))))
1483 (let ((data (project-buffer-create-node name type filename project)))
1484 (project-buffer-insert-node status data)
1485 (when platform-list
1486 (project-buffer-set-project-platforms-data status project platform-list))
1487 (when build-configurations-list
1488 (project-buffer-set-project-build-configurations-data status project build-configurations-list))
1489 (when user-data
1490 (setf (project-buffer-node->user-data data) user-data))
1491 (when project-settings
1492 (setf (project-buffer-node->project-settings data) project-settings))
1493 ))
1494 (error "Unknown node-list line: %s" block-line))
1495 (setq block-line (read data-buffer)))))
1498 (defun project-buffer-read-block-locals(status data-buffer block-header)
1499 "Read a project-buffer-locals block; set the local variable of
1500 the buffer with their specified values. Skip non local
1501 variable."
1502 ;; block-header should be: '(begin locals)
1503 (unless (and (listp block-header)
1504 (eq (car block-header) 'begin)
1505 (eq (nth 1 block-header) 'locals))
1506 (error "Invalid block-header"))
1507 (let ((block-line (read data-buffer)))
1508 (while (and block-line
1509 (not (and (listp block-line)
1510 (eq (car block-line) 'end)
1511 (eq (nth 1 block-line) 'locals))))
1512 (if (and (listp block-line)
1513 (symbolp (car block-line)))
1514 (progn (unless (local-variable-p (car block-line))
1515 (make-local-variable (car block-line)))
1516 (set (car block-line) (cdr block-line))
1517 (add-to-list 'project-buffer-locals-to-save (car block-line)))
1518 (error "Unknown local line: %s" block-line))
1519 (setq block-line (read data-buffer)))))
1523 (defun project-buffer-skip-block(status data-buffer block-header)
1524 "Skip project-buffer block."
1525 (unless (and (listp block-header)
1526 (eq (car block-header) 'begin))
1527 (error "Invalid block-header"))
1528 (let ((block-line (read data-buffer))
1529 (block-type (nth 1 block-header)))
1530 (while (and block-line
1531 (not (and (listp block-line)
1532 (eq (car block-line) 'end)
1533 (eq (nth 1 block-line) block-type))))
1534 (setq block-line (read data-buffer)))))
1537 (defun project-buffer-read-line-master-project(status block-header)
1538 "Read the project-buffer-master-project line."
1539 (unless (and (listp block-header)
1540 (eq (car block-header) 'one-line)
1541 (eq (nth 1 block-header) 'master-project))
1542 (error "Invalid block-header"))
1543 (project-buffer-set-master-project status (nth 2 block-header)))
1546 (defun project-buffer-read-block(status data-buffer run-mode-hooks)
1547 "Read and parse the next block from the DATA-BUFFER."
1548 (let ((block-header (read data-buffer))
1549 (goon t))
1550 (if (listp block-header)
1551 (cond ((eq (car block-header) 'begin)
1552 (cond ((eq (nth 1 block-header) 'hook)
1553 (project-buffer-read-block-hook status data-buffer block-header run-mode-hooks))
1554 ((eq (nth 1 block-header) 'node-list)
1555 (project-buffer-read-block-node-list status data-buffer block-header))
1556 ((eq (nth 1 block-header) 'locals)
1557 (project-buffer-read-block-locals status data-buffer block-header))
1558 (t
1559 (project-buffer-skip-block status data-buffer block-header))))
1560 ((eq (car block-header) 'one-line)
1561 (cond ((eq (nth 1 block-header) 'master-project)
1562 (project-buffer-read-line-master-project status block-header)))))
1563 (setq goon (not (and (symbolp block-header) (eq block-header 'eof))))
1564 )
1565 goon) ;; carry on
1566 )
1569 (defun project-buffer-set-view-mode(status view-mode)
1570 "Set the view mode to VIEW-MODE."
1571 (unless (eq project-buffer-view-mode view-mode)
1572 (let ((node (ewoc-locate project-buffer-status)))
1573 (setq project-buffer-view-mode view-mode)
1574 (message "View mode set to: %s" project-buffer-view-mode)
1575 (project-buffer-refresh-all-items status)
1576 (project-buffer-refresh-ewoc-hf status)
1577 (ewoc-goto-node status node))))
1580 (defun project-buffer-search-node(status name project)
1581 "Search a node named NAME which belongs to PROJECT."
1582 (let ((node (ewoc-nth status 0))
1583 (folder-data (project-buffer-extract-folder name 'file))
1584 (proj-data project)
1585 (found nil)
1586 (folder-found nil)
1587 (node-data nil))
1589 ;; Before checking the cache; let's check the current node:
1590 (let* ((cur-node (ewoc-locate status))
1591 (cur-data (and cur-node (ewoc-data cur-node))))
1592 (setq found (and cur-node
1593 (string-equal (project-buffer-node->project cur-data) project)
1594 (string-equal (project-buffer-node->name cur-data) name)
1595 cur-node)))
1597 ;; Cache check: <no cache update>
1598 (when (and (not found) project-buffer-cache-project)
1599 (cond
1600 ;; cache-project < current-project -> we can start the search from here (at least).
1601 ((string-lessp (car project-buffer-cache-project) proj-data)
1602 (setq node (cdr project-buffer-cache-project)))
1604 ;; cache-project == current-project -> check the folders...
1605 ((string-equal (car project-buffer-cache-project) proj-data)
1606 ;; cache-subdir < current-subdir -> we can start from here.
1607 ;; cache-subdir = current-subdir -> good starting point
1608 (if (and project-buffer-cache-subdirectory
1609 folder-data
1610 (or (string-equal (car project-buffer-cache-subdirectory) folder-data)
1611 (project-buffer-directory-lessp (car project-buffer-cache-subdirectory) folder-data 'folder)))
1612 (setq node (cdr project-buffer-cache-subdirectory))
1613 (setq node (cdr project-buffer-cache-project))))
1614 ;; other wise: cache miss...
1615 ))
1617 ;; Search the node:
1618 (while (and node (not found))
1619 (setq node-data (ewoc-data node))
1621 (cond
1622 ;; data.project < node.project -> not found...
1623 ((string-lessp proj-data (project-buffer-node->project node-data))
1624 (setq node nil))
1626 ;; node.project == data.project -> check folder/file name
1627 ((string-equal proj-data (project-buffer-node->project node-data))
1628 (let* ((folder-db (project-buffer-extract-folder (project-buffer-node->name node-data) (project-buffer-node->type node-data)))
1629 (type-db (project-buffer-node->type node-data)))
1630 ;; Make sure it's not the project line:
1631 (unless (eq type-db 'project)
1632 (setq found (and (string-equal (project-buffer-node->name node-data) name) node))))))
1634 ;; next node:
1635 (setq node (and node (ewoc-next status node))))
1637 ;; Final result:
1638 found
1639 ))
1642 ;;
1643 ;; External functions:
1644 ;;
1647 (defun project-buffer-mode (&optional skip-mode-hooks)
1648 "Major mode to view project.
1650 Commands:
1652 (kill-all-local-variables)
1653 (buffer-disable-undo)
1654 (setq mode-name "project-buffer"
1655 major-mode 'project-buffer-mode
1656 buffer-read-only t)
1657 (use-local-map project-buffer-mode-map)
1658 (let ((buffer-read-only nil))
1659 (erase-buffer)
1660 (let ((status (ewoc-create 'project-buffer-prettyprint "" "" t)))
1661 (make-local-variable 'project-buffer-status)
1662 (make-local-variable 'project-buffer-view-mode)
1663 (make-local-variable 'project-buffer-cache-project)
1664 (make-local-variable 'project-buffer-cache-subdirectory)
1665 (make-local-variable 'project-buffer-platforms-list)
1666 (make-local-variable 'project-buffer-current-platform)
1667 (make-local-variable 'project-buffer-build-configurations-list)
1668 (make-local-variable 'project-buffer-current-build-configuration)
1669 (make-local-variable 'project-buffer-master-project)
1670 (make-local-variable 'project-buffer-projects-list)
1671 (make-local-variable 'project-buffer-file-name)
1672 (make-local-variable 'project-buffer-locals-to-save)
1673 (make-local-variable 'project-buffer-hooks-to-save)
1675 (setq project-buffer-status status)
1676 (setq project-buffer-view-mode 'folder-view)
1677 (setq project-buffer-cache-project nil)
1678 (setq project-buffer-cache-subdirectory nil)
1679 (setq project-buffer-platforms-list nil)
1680 (setq project-buffer-current-platform nil)
1681 (setq project-buffer-build-configurations-list nil)
1682 (setq project-buffer-current-build-configuration nil)
1683 (setq project-buffer-master-project nil)
1684 (setq project-buffer-projects-list nil)
1685 (setq project-buffer-file-name nil)
1686 (setq project-buffer-locals-to-save '(project-buffer-view-mode project-buffer-current-platform project-buffer-current-build-configuration))
1687 (setq project-buffer-hooks-to-save '(project-buffer-mode-hook project-buffer-action-hook project-buffer-post-load-hook project-buffer-post-find-file-hook project-buffer-refresh-hook))
1689 (project-buffer-refresh-ewoc-hf status)
1691 (unless skip-mode-hooks
1692 (run-hooks 'project-buffer-mode-hook))
1693 )))
1696 (defun project-buffer-insert (name type filename project)
1697 "Insert a file in alphabetic order in it's project/directory.
1699 NAME is the name of the file in the project with it's virtual project directory,
1700 both name and directory may be virtual
1701 TYPE type of the node in the project: should be either 'project or 'file
1702 FILENAME should be either a full path to the project's file or a relative path based
1703 on the current directory of the buffer
1704 PROJECT is the name of the project in which to insert the node
1705 note: regarding the project node, it's recommended to have NAME = PROJECT"
1706 (unless project-buffer-status (error "Not in project-buffer buffer"))
1707 (project-buffer-insert-node project-buffer-status
1708 (project-buffer-create-node name type filename project)))
1710 (defun project-buffer-delete-file (name project &optional dont-delete-project)
1711 "Delete the node named NAME which belongs to PROJECT.
1712 Empty folder node will also be cleared up. If no more file
1713 remain in the project; the project will also be deleted unless
1714 DONT-DELETE-PROJECT is set."
1715 (unless project-buffer-status (error "Not in project-buffer buffer"))
1716 (project-buffer-delete-file-node project-buffer-status name project dont-delete-project))
1719 (defun project-buffer-delete-folder (name project &optional dont-delete-project)
1720 "Delete the node named NAME which belongs to PROJECT."
1721 (unless project-buffer-status (error "Not in project-buffer buffer"))
1722 (project-buffer-delete-folder-node project-buffer-status
1723 (project-buffer-search-node project-buffer-status name project)
1724 dont-delete-project))
1727 (defun project-buffer-delete-project (project)
1728 "Delete the project PROJECT.
1729 Each files/folder under the project will also be deleted."
1730 (unless project-buffer-status (error "Not in project-buffer buffer"))
1731 (project-buffer-delete-project-node project-buffer-status
1732 project
1733 (project-buffer-search-project-node project-buffer-status project)))
1736 (defun project-buffer-set-project-platforms (project platform-list)
1737 "Attached the list of platform contained in PLATFORM-LIST to the project named PROJECT."
1738 (unless project-buffer-status (error "Not in project-buffer buffer"))
1739 (project-buffer-set-project-platforms-data project-buffer-status
1740 project
1741 platform-list))
1743 (defun project-buffer-set-project-build-configurations (project build-configuration-list)
1744 "Attached the list build configurations in BUILD-CONFIGURATION-LIST to the project named PROJECT."
1745 (unless project-buffer-status (error "Not in project-buffer buffer"))
1746 (project-buffer-set-project-build-configurations-data project-buffer-status
1747 project
1748 build-configuration-list))
1751 (defun project-buffer-raw-save (filename)
1752 "Save the project data in FILENAME; the project can later be
1753 reloaded through `project-buffer-raw-load' function."
1754 (unless project-buffer-status (error "Not in project-buffer buffer"))
1755 (let* ((status project-buffer-status)
1756 (node (ewoc-nth status 0))
1757 (buf-name (buffer-name))
1758 (buf-dir default-directory)
1759 (project-buffer (current-buffer))
1760 (hooks-list (mapcar (lambda (item) (cons item (and (local-variable-p item) (eval item))))
1761 project-buffer-hooks-to-save))
1762 (locals-list (remove nil
1763 (mapcar (lambda (item) (and (local-variable-p item) (cons item (eval item))))
1764 project-buffer-locals-to-save))))
1765 (with-temp-buffer
1766 ;; First, let's write a quick header:
1767 (print (list 'project-buffer-mode
1768 project-buffer-mode-version
1769 buf-name
1770 buf-dir) (current-buffer))
1771 ;; Save the hooks:
1772 (mapcar (lambda (item) (when (cdr item) (project-buffer-raw-print-hooks (car item) (cdr item))))
1773 hooks-list)
1774 ;; Save the locals:
1775 (project-buffer-raw-print-locals locals-list)
1776 ;; Save each nodes:
1777 (print (list 'begin 'node-list) (current-buffer))
1778 (while node
1779 (let ((data (ewoc-data node)))
1780 (unless (eq (project-buffer-node->type data) 'folder)
1781 (print (list (project-buffer-node->name data)
1782 (project-buffer-node->type data)
1783 (project-buffer-node->filename data)
1784 (project-buffer-node->project data)
1785 (project-buffer-node->platform-list data)
1786 (project-buffer-node->build-configurations-list data)
1787 (project-buffer-node->user-data data)
1788 (project-buffer-node->project-settings data))
1789 (current-buffer))))
1790 (setq node (ewoc-next status node)))
1791 (print (list 'end 'node-list) (current-buffer))
1792 ;; Save the master project:
1793 (print (list 'one-line 'master-project (car (buffer-local-value 'project-buffer-master-project project-buffer)))
1794 (current-buffer))
1795 ;; End of file:
1796 (print 'eof (current-buffer))
1797 ;; Finally: write the file.
1798 (write-file filename))))
1801 (defun project-buffer-raw-load (filename &optional set-buffer-name run-mode-hooks)
1802 "Load a project saved by `project-buffer-raw-data'.
1803 This function does not restore the mode and assume the
1804 project-buffer-mode to be set. It doesn't clear the existing
1805 nodes either."
1806 (unless project-buffer-status (error "Not in project-buffer buffer"))
1807 (let ((project-buffer (current-buffer))
1808 (status project-buffer-status))
1809 (with-temp-buffer
1810 (insert-file filename)
1811 (goto-char (point-min))
1812 (let ((data-buffer (current-buffer))
1813 data-version
1814 block-header)
1815 (with-current-buffer project-buffer
1816 (setq data-version (project-buffer-read-header status data-buffer set-buffer-name t))
1817 ;; The rest of the file is defined by blocks:
1818 (while (project-buffer-read-block status data-buffer run-mode-hooks))
1819 )))
1820 (run-hooks 'project-buffer-post-load-hook)
1821 ))
1824 (defun project-buffer-set-file-user-data (name project user-data)
1825 "Attach user data to a node named NAME in the project PROJECT."
1826 (unless project-buffer-status (error "Not in project-buffer buffer"))
1827 (let ((node (project-buffer-search-node project-buffer-status name project)))
1828 (when node
1829 (setf (project-buffer-node->user-data (ewoc-data node)) user-data))))
1832 (defun project-buffer-set-project-user-data (project user-data)
1833 "Attach user data to the project node named PROJECT."
1834 (unless project-buffer-status (error "Not in project-buffer buffer"))
1835 (let ((node (project-buffer-search-project-node project-buffer-status project)))
1836 (when node
1837 (setf (project-buffer-node->user-data (ewoc-data node)) user-data))))
1840 (defun project-buffer-get-file-user-data (name project)
1841 "Retrieve user data to a node named NAME in the project PROJECT."
1842 (unless project-buffer-status (error "Not in project-buffer buffer"))
1843 (let ((node (project-buffer-search-node project-buffer-status name project)))
1844 (when node
1845 (project-buffer-node->user-data (ewoc-data node)))))
1848 (defun project-buffer-get-project-user-data (project)
1849 "Retrieve user data to the project node named PROJECT."
1850 (unless project-buffer-status (error "Not in project-buffer buffer"))
1851 (let ((node (project-buffer-search-project-node project-buffer-status project)))
1852 (when node
1853 (project-buffer-node->user-data (ewoc-data node)))))
1856 (defun project-buffer-get-current-project-name ()
1857 "Retrieve the name of the project the cursor is on."
1858 (unless project-buffer-status (error "Not in project-buffer buffer"))
1859 (let ((node (ewoc-locate project-buffer-status)))
1860 (when node
1861 (project-buffer-node->project (ewoc-data node)))))
1864 (defun project-buffer-get-current-file-data ()
1865 "Retrieve data about the current file the cursor is on.
1866 Return nil if the cursor is not on a file.
1867 If non-nil the return value is a list containing:
1868 '(project-file-name file-path project-name)"
1869 (unless project-buffer-status (error "Not in project-buffer buffer"))
1870 (let* ((node (ewoc-locate project-buffer-status))
1871 (data (and node (ewoc-data node))))
1872 (when (and data (eq (project-buffer-node->type data) 'file))
1873 (list (project-buffer-node->name data)
1874 (project-buffer-node->filename data)
1875 (project-buffer-node->project data)))))
1878 (defun project-buffer-set-project-settings-data (project settings-data)
1879 "Attach SETTINGS-DATA to the project node named PROJECT."
1880 (unless project-buffer-status (error "Not in project-buffer buffer"))
1881 (let ((node (project-buffer-search-project-node project-buffer-status project)))
1882 (when node
1883 (setf (project-buffer-node->project-settings (ewoc-data node)) settings-data))))
1886 (defun project-buffer-get-project-settings-data (project)
1887 "Retrieve the project settings from PROJECT."
1888 (unless project-buffer-status (error "Not in project-buffer buffer"))
1889 (let ((node (project-buffer-search-project-node project-buffer-status project)))
1890 (when node
1891 (project-buffer-node->project-settings (ewoc-data node)))))
1894 (defun project-buffer-exists-p (name project)
1895 "Return true if a node NAME exists in PROJECT."
1896 (unless project-buffer-status (error "Not in project-buffer buffer"))
1897 (let ((node (project-buffer-search-node project-buffer-status name project)))
1898 (and node t)))
1901 (defun project-buffer-project-exists-p (project)
1902 "Return true if the project PROJECT exists."
1903 (unless project-buffer-status (error "Not in project-buffer buffer"))
1904 (let ((node (project-buffer-search-project-node project-buffer-status project)))
1905 (and node t)))
1908 (defun project-buffer-get-project-path (project)
1909 "Return the path/file attached to the project PROJECT."
1910 (unless project-buffer-status (error "Not in project-buffer buffer"))
1911 (let ((node (project-buffer-search-project-node project-buffer-status project)))
1912 (and node (project-buffer-node->filename (ewoc-data node)))))
1915 (defun project-buffer-get-file-path (name project)
1916 "Retrieve the path of the file NAME in PROJECT."
1917 (unless project-buffer-status (error "Not in project-buffer buffer"))
1918 (let ((node (project-buffer-search-node project-buffer-status name project)))
1919 (when node
1920 (project-buffer-node->filename (ewoc-data node)))))
1923 (defun project-buffer-get-current-node-type ()
1924 "Retrieve the type of the current node."
1925 (unless project-buffer-status (error "Not in project-buffer buffer"))
1926 (let ((node (ewoc-locate project-buffer-status)))
1927 (when node
1928 (project-buffer-node->type (ewoc-data node)))))
1931 (defun project-buffer-get-current-node-name ()
1932 "Retrieve the type of the current node."
1933 (unless project-buffer-status (error "Not in project-buffer buffer"))
1934 (let ((node (ewoc-locate project-buffer-status)))
1935 (when node
1936 (project-buffer-node->name (ewoc-data node)))))
1939 (defun project-buffer-get-marked-node-list ()
1940 "Retrieve the list of marked files.
1941 Each node of the returned list are also list as:
1942 '(project-file-name file-path project-name)"
1943 (unless project-buffer-status (error "Not in project-buffer buffer"))
1944 (let* ((status project-buffer-status)
1945 (node (ewoc-nth status 0))
1946 marked-node-list)
1947 (while node
1948 (let ((node-data (ewoc-data node)))
1949 (when (and (eq (project-buffer-node->type node-data) 'file)
1950 (project-buffer-node->marked node-data))
1951 (setq marked-node-list (cons (list (project-buffer-node->name node-data)
1952 (project-buffer-node->filename node-data)
1953 (project-buffer-node->project node-data))
1954 marked-node-list))))
1955 (setq node (ewoc-next status node)))
1956 (reverse marked-node-list)
1957 ))
1960 (defun project-buffer-apply-to-each-file(func &rest args)
1961 "Call FUNC for each existing file nodes.
1962 FUNC's prototype must be:
1963 (lambda (project-file-name file-path project-name &rest ARGS) ...)"
1964 (unless project-buffer-status (error "Not in project-buffer buffer"))
1965 (let* ((status project-buffer-status)
1966 (node (ewoc-nth status 0)))
1967 (while node
1968 (let ((node-data (ewoc-data node)))
1969 (when (eq (project-buffer-node->type node-data) 'file)
1970 (apply func
1971 (project-buffer-node->name node-data)
1972 (project-buffer-node->filename node-data)
1973 (project-buffer-node->project node-data)
1974 args))
1975 (setq node (ewoc-next status node))))))
1978 (defun project-buffer-apply-to-marked-files(func &rest args)
1979 "Call FUNC for each marked file nodes.
1980 FUNC's prototype must be:
1981 (lambda (project-file-name file-path project-name &rest ARGS) ...)"
1982 (unless project-buffer-status (error "Not in project-buffer buffer"))
1983 (let* ((status project-buffer-status)
1984 (node (ewoc-nth status 0))
1985 found-marked-files)
1986 (while node
1987 (let ((node-data (ewoc-data node)))
1988 (when (and (eq (project-buffer-node->type node-data) 'file)
1989 (project-buffer-node->marked node-data))
1990 (setq found-marked-files t)
1991 (apply func
1992 (project-buffer-node->name node-data)
1993 (project-buffer-node->filename node-data)
1994 (project-buffer-node->project node-data)
1995 args))
1996 (setq node (ewoc-next status node))))
1997 found-marked-files))
2000 (defun project-buffer-apply-to-project-files(project func &rest args)
2001 "Call FUNC for each file nodes in PROJECT.
2002 FUNC's prototype must be:
2003 (lambda (project-file-name file-path project-name &rest ARGS) ...)"
2004 (unless project-buffer-status (error "Not in project-buffer buffer"))
2005 (let* ((status project-buffer-status)
2006 (node (project-buffer-search-project-node status project)))
2007 (while (and node
2008 (string= (project-buffer-node->project (ewoc-data node)) project))
2009 (let ((node-data (ewoc-data node)))
2010 (when (eq (project-buffer-node->type node-data) 'file)
2011 (apply func
2012 (project-buffer-node->name node-data)
2013 (project-buffer-node->filename node-data)
2014 (project-buffer-node->project node-data)
2015 args))
2016 (setq node (ewoc-next status node))))))
2020 ;;
2021 ;; Interactive commands:
2022 ;;
2025 (defun project-buffer-goto-dir-up ()
2026 "Go to the project/folder containing the current file/folder."
2027 (interactive)
2028 (unless project-buffer-status (error "Not in project-buffer buffer"))
2029 (let* ((status project-buffer-status)
2030 (node (ewoc-locate status)))
2031 (setq node (and node (project-buffer-find-node-up status node)))
2032 (when node
2033 (ewoc-goto-node status node))))
2036 (defun project-buffer-goto-dir-up-or-collapsed ()
2037 "Go to the project/folder containing the current file/folder unless the cursor is on a expanded folder/project in which case, it will collapse it."
2038 (interactive)
2039 (unless project-buffer-status (error "Not in project-buffer buffer"))
2040 (let* ((status project-buffer-status)
2041 (node (ewoc-locate status))
2042 (node-data (and node (ewoc-data node))))
2043 (when node
2044 (if (or (eq (project-buffer-node->type node-data) 'file)
2045 (project-buffer-node->collapsed node-data))
2046 (progn (setq node (and node (project-buffer-find-node-up status node)))
2047 (when node (ewoc-goto-node status node)))
2048 (project-buffer-toggle-expand-collapse)
2049 ))))
2052 (defun project-buffer-search-forward-regexp (regexp)
2053 "Search file matching REGEXP."
2054 (interactive "sSearch forward (regexp): ")
2055 (unless project-buffer-status (error "Not in project-buffer buffer"))
2056 (project-buffer-clear-matched-mark project-buffer-status)
2057 (when (and regexp
2058 (> (length regexp) 0))
2059 (let* ((status project-buffer-status)
2060 (node (ewoc-locate status)))
2061 (project-buffer-mark-matching-file project-buffer-status regexp)
2062 ;; goto first match
2063 (while (and node
2064 (or (not (eq (project-buffer-node->type (ewoc-data node)) 'file))
2065 (not (project-buffer-node->matched (ewoc-data node)))))
2066 (setq node (ewoc-next status node)))
2067 ;; if failed: go to the last search instead
2068 (unless node
2069 (setq node (ewoc-locate status))
2070 (while (and node
2071 (or (not (eq (project-buffer-node->type (ewoc-data node)) 'file))
2072 (not (project-buffer-node->matched (ewoc-data node)))))
2073 (setq node (ewoc-prev status node))))
2074 (if node
2075 (ewoc-goto-node status node)
2076 (message "Search failed: %s." regexp)))))
2079 (defun project-buffer-goto-next-match ()
2080 "Go to the next matching."
2081 (interactive)
2082 (unless project-buffer-status (error "Not in project-buffer buffer"))
2083 (let* ((status project-buffer-status)
2084 (node (ewoc-locate status)))
2085 (if node (setq node (ewoc-next status node)))
2086 ;; goto first match
2087 (while (and node
2088 (or (not (eq (project-buffer-node->type (ewoc-data node)) 'file))
2089 (not (project-buffer-node->matched (ewoc-data node)))))
2090 (setq node (ewoc-next status node)))
2091 (if node
2092 (ewoc-goto-node status node)
2093 (message "Failing forward search."))))
2096 (defun project-buffer-goto-prev-match ()
2097 "Go to the previous matching."
2098 (interactive)
2099 (unless project-buffer-status (error "Not in project-buffer buffer"))
2100 (let* ((status project-buffer-status)
2101 (node (ewoc-locate status)))
2102 (if node (setq node (ewoc-prev status node)))
2103 ;; goto first match
2104 (while (and node
2105 (or (not (eq (project-buffer-node->type (ewoc-data node)) 'file))
2106 (not (project-buffer-node->matched (ewoc-data node)))))
2107 (setq node (ewoc-prev status node)))
2108 (if node
2109 (ewoc-goto-node status node)
2110 (message "Failing backward search."))))
2113 (defun project-buffer-quit ()
2114 "Burry project-buffer mode or cancel the research."
2115 (interactive)
2116 (unless project-buffer-status (error "Not in project-buffer buffer"))
2117 (unless (project-buffer-clear-matched-mark project-buffer-status)
2118 (bury-buffer)))
2121 (defun project-buffer-help ()
2122 "Display help for project-buffer mode."
2123 (interactive)
2124 (describe-function 'project-buffer-mode))
2127 (defun project-buffer-next-file (&optional n)
2128 "Move the cursor down N files."
2129 (interactive "p")
2130 (unless project-buffer-status (error "Not in project-buffer buffer"))
2131 (ewoc-goto-next project-buffer-status n))
2134 (defun project-buffer-next-file-or-expand ()
2135 "Go to the project/folder containing the current file/folder unless the cursor is on a expanded folder/project in which case, it will collapse it."
2136 (interactive)
2137 (unless project-buffer-status (error "Not in project-buffer buffer"))
2138 (let* ((status project-buffer-status)
2139 (node (ewoc-locate status))
2140 (node-data (and node (ewoc-data node))))
2141 (when node
2142 (if (or (eq (project-buffer-node->type node-data) 'file)
2143 (not (project-buffer-node->collapsed node-data)))
2144 (ewoc-goto-next status 1)
2145 (project-buffer-toggle-expand-collapse)
2146 ))))
2149 (defun project-buffer-prev-file (&optional n)
2150 "Move the cursor up N files."
2151 (interactive "p")
2152 (unless project-buffer-status (error "Not in project-buffer buffer"))
2153 (ewoc-goto-prev project-buffer-status n))
2156 (defun project-buffer-find-marked-files ()
2157 "Run find-files on the marked files."
2158 (interactive)
2159 (unless project-buffer-status (error "Not in project-buffer buffer"))
2160 (let* ((file-list (project-buffer-get-marked-nodes project-buffer-status))
2161 (cnt 0)
2162 buffer)
2163 (project-buffer-clear-matched-mark project-buffer-status)
2164 (while file-list
2165 (let ((node (pop file-list)))
2166 (when (eq (project-buffer-node->type node) 'file)
2167 (setq buffer (find-file-noselect (project-buffer-node->filename node))
2168 cnt (1+ cnt)))))
2169 (cond ((> cnt 1) (message "Find %i files." cnt))
2170 ((= cnt 1) (display-buffer buffer))
2171 (t (message "No files selected")))))
2174 (defun project-buffer-go-to-previous-project ()
2175 "Go to previous project line."
2176 (interactive)
2177 (unless project-buffer-status (error "Not in project-buffer buffer"))
2178 (let* ((status project-buffer-status)
2179 (node (ewoc-locate project-buffer-status))
2180 (search (ewoc-prev status node)))
2181 (while (and search
2182 (not (eq (project-buffer-node->type (ewoc-data search)) 'project)))
2183 (setq search (ewoc-prev status search)))
2184 (when search
2185 (ewoc-goto-node status search))))
2188 (defun project-buffer-go-to-previous-folder-or-project ()
2189 "If the cursor is on a file, go up to the previous project/folder.
2190 If the cursor is on a folder, search up for the previous project/folder.
2191 If the cursor is on a project, go to previous project."
2192 (interactive)
2193 (unless project-buffer-status (error "Not in project-buffer buffer"))
2194 (let* ((status project-buffer-status)
2195 (node (ewoc-locate project-buffer-status))
2196 (node-data (and node (ewoc-data node))))
2197 (cond ((eq (project-buffer-node->type node-data) 'file)
2198 (project-buffer-goto-dir-up))
2199 ((eq (project-buffer-node->type node-data) 'folder)
2200 (let ((search (ewoc-prev status node)))
2201 (while (and search
2202 (eq (project-buffer-node->type (ewoc-data search)) 'file))
2203 (setq search (ewoc-prev status search)))
2204 (when search
2205 (ewoc-goto-node status search))))
2206 ((eq (project-buffer-node->type node-data) 'project)
2207 (let ((search (ewoc-prev status node)))
2208 (while (and search
2209 (not (eq (project-buffer-node->type (ewoc-data search)) 'project)))
2210 (setq search (ewoc-prev status search)))
2211 (when search
2212 (ewoc-goto-node status search))))
2213 (t (error "Unknown node type! (%S)" (project-buffer-node->type node-data))))))
2216 (defun project-buffer-go-to-next-project ()
2217 "Go to next project line."
2218 (interactive)
2219 (unless project-buffer-status (error "Not in project-buffer buffer"))
2220 (let* ((status project-buffer-status)
2221 (node (ewoc-locate project-buffer-status))
2222 (search (ewoc-next status node)))
2223 (while (and search
2224 (not (eq (project-buffer-node->type (ewoc-data search)) 'project)))
2225 (setq search (ewoc-next status search)))
2226 (when search
2227 (ewoc-goto-node status search))))
2230 (defun project-buffer-go-to-next-folder-or-project ()
2231 "If the cursor is on a file, go down to the next project/folder.
2232 If the cursor is on a folder, search down for the next project/folder.
2233 If the cursor is on a project, go to next project."
2234 (interactive)
2235 (unless project-buffer-status (error "Not in project-buffer buffer"))
2236 (let* ((status project-buffer-status)
2237 (node (ewoc-locate project-buffer-status))
2238 (node-data (and node (ewoc-data node)))
2239 (fold-ok (and node
2240 (not (eq (project-buffer-node->type node-data) 'project))
2241 (eq project-buffer-view-mode 'folder-view)))
2242 (search (and node (ewoc-next status node))))
2244 (while (and search
2245 (not (eq (project-buffer-node->type (ewoc-data search)) 'project))
2246 (not (and fold-ok
2247 (eq (project-buffer-node->type (ewoc-data search)) 'folder))))
2248 (setq search (ewoc-next status search)))
2249 (when search
2250 (ewoc-goto-node status search))))
2253 (defun project-buffer-node-find-file ()
2254 "Find the file the cursor is on."
2255 (interactive)
2256 (unless project-buffer-status (error "Not in project-buffer buffer"))
2257 (let* ((node (ewoc-locate project-buffer-status))
2258 (node-data (ewoc-data node))
2259 (project-buffer (current-buffer)))
2260 (project-buffer-clear-matched-mark project-buffer-status)
2261 (if (eq (project-buffer-node->type node-data) 'file)
2262 (let ((file-buffer (find-file (project-buffer-node->filename node-data))))
2263 (run-hook-with-args 'project-buffer-post-find-file-hook project-buffer file-buffer))
2264 (project-buffer-toggle-expand-collapse))))
2267 (defun project-buffer-mouse-find-file(event)
2268 "Find the file you click on."
2269 (interactive "e")
2270 (save-excursion
2271 (set-buffer (window-buffer (posn-window (event-end event))))
2272 (save-excursion
2273 (goto-char (posn-point (event-end event)))
2274 (if (get-text-property (point) 'mouse-face)
2275 (project-buffer-node-find-file-other-window)))))
2278 (defun project-buffer-node-find-file-other-window ()
2279 "Find the file the cursor is on in another window."
2280 (interactive)
2281 (unless project-buffer-status (error "Not in project-buffer buffer"))
2282 (let* ((node (ewoc-locate project-buffer-status))
2283 (node-data (ewoc-data node))
2284 (project-buffer (current-buffer)))
2285 (project-buffer-clear-matched-mark project-buffer-status)
2286 (if (eq (project-buffer-node->type node-data) 'file)
2287 (let ((file-buffer (find-file-other-window (project-buffer-node->filename node-data))))
2288 (run-hook-with-args 'project-buffer-post-find-file-hook project-buffer file-buffer))
2289 (project-buffer-toggle-expand-collapse))))
2292 (defun project-buffer-mark-file ()
2293 "Mark the file that the cursor is on and move to the next one."
2294 (interactive)
2295 (unless project-buffer-status (error "Not in project-buffer buffer"))
2296 (let* ((node (ewoc-locate project-buffer-status))
2297 (node-data (ewoc-data node))
2298 (status project-buffer-status))
2299 (cond
2300 ;; Mark the current file:
2301 ((eq (project-buffer-node->type node-data) 'file)
2302 (setf (project-buffer-node->marked node-data) t)
2303 (ewoc-invalidate status node)
2304 (ewoc-goto-next status 1))
2305 ;; Or all files which belong to the project:
2306 ((eq (project-buffer-node->type node-data) 'project)
2307 (let ((prj-name (project-buffer-node->name node-data)))
2308 (save-excursion
2309 (setq node (ewoc-next status node)
2310 node-data (and node (ewoc-data node)))
2311 (while (and node (string-equal (project-buffer-node->project node-data) prj-name))
2312 (when (eq (project-buffer-node->type node-data) 'file)
2313 (setf (project-buffer-node->marked node-data) t)
2314 (ewoc-invalidate status node))
2315 (setq node (ewoc-next status node)
2316 node-data (and node (ewoc-data node)))))))
2317 ;; Or finally, all files which are under the current folder:
2318 ((eq (project-buffer-node->type node-data) 'folder)
2319 (let ((folder (project-buffer-node->name node-data)))
2320 (save-excursion
2321 (setq node (ewoc-next status node)
2322 node-data (and node (ewoc-data node)))
2323 (while (and node
2324 (not (eq (project-buffer-node->type node-data) 'project))
2325 (project-buffer-parent-of-p (project-buffer-node->name node-data) folder))
2326 (when (eq (project-buffer-node->type node-data) 'file)
2327 (setf (project-buffer-node->marked node-data) t)
2328 (ewoc-invalidate status node))
2329 (setq node (ewoc-next status node)
2330 node-data (and node (ewoc-data node)))))))
2331 )))
2334 (defun project-buffer-unmark-file ()
2335 "Unmark the file that the cursor is on and move to the next one."
2336 (interactive)
2337 (unless project-buffer-status (error "Not in project-buffer buffer"))
2338 (let* ((node (ewoc-locate project-buffer-status))
2339 (node-data (ewoc-data node))
2340 (status project-buffer-status))
2341 (cond
2342 ;; Mark the current file:
2343 ((eq (project-buffer-node->type node-data) 'file)
2344 (setf (project-buffer-node->marked node-data) nil)
2345 (ewoc-invalidate project-buffer-status node)
2346 (when (eq node (ewoc-locate project-buffer-status))
2347 (ewoc-goto-next project-buffer-status 1)))
2348 ;; Or all files which belong to the project:
2349 ((eq (project-buffer-node->type node-data) 'project)
2350 (let ((prj-name (project-buffer-node->name node-data)))
2351 (save-excursion
2352 (setq node (ewoc-next status node)
2353 node-data (and node (ewoc-data node)))
2354 (while (and node (string-equal (project-buffer-node->project node-data) prj-name))
2355 (when (eq (project-buffer-node->type node-data) 'file)
2356 (setf (project-buffer-node->marked node-data) nil)
2357 (ewoc-invalidate status node))
2358 (setq node (ewoc-next status node)
2359 node-data (and node (ewoc-data node)))))))
2360 ;; Or finally, all files which are under the current folder:
2361 ((eq (project-buffer-node->type node-data) 'folder)
2362 (let ((folder (project-buffer-node->name node-data)))
2363 (save-excursion
2364 (setq node (ewoc-next status node)
2365 node-data (and node (ewoc-data node)))
2366 (while (and node
2367 (not (eq (project-buffer-node->type node-data) 'project))
2368 (project-buffer-parent-of-p (project-buffer-node->name node-data) folder))
2369 (when (eq (project-buffer-node->type node-data) 'file)
2370 (setf (project-buffer-node->marked node-data) nil)
2371 (ewoc-invalidate status node))
2372 (setq node (ewoc-next status node)
2373 node-data (and node (ewoc-data node)))))))
2374 )))
2377 (defun project-buffer-mark-all ()
2378 "Mark all files."
2379 (interactive)
2380 (unless project-buffer-status (error "Not in project-buffer buffer"))
2381 (ewoc-map (lambda (node) (when (and (eq (project-buffer-node->type node) 'file)
2382 (not (project-buffer-node->marked node)))
2383 (setf (project-buffer-node->marked node) t)))
2384 project-buffer-status))
2387 (defun project-buffer-unmark-all ()
2388 "Unmark all files."
2389 (interactive)
2390 (unless project-buffer-status (error "Not in project-buffer buffer"))
2391 (ewoc-map (lambda (node) (when (and (eq (project-buffer-node->type node) 'file)
2392 (project-buffer-node->marked node))
2393 (setf (project-buffer-node->marked node) nil) t))
2394 project-buffer-status))
2397 (defun project-buffer-toggle-all-marks ()
2398 "Toggle all file mark."
2399 (interactive)
2400 (unless project-buffer-status (error "Not in project-buffer buffer"))
2401 (ewoc-map (lambda (node) (when (eq (project-buffer-node->type node) 'file)
2402 (setf (project-buffer-node->marked node) (not (project-buffer-node->marked node))) t))
2403 project-buffer-status))
2406 (defun project-buffer-toggle-expand-collapse-even-on-file ()
2407 "Expand / Collapse project and folder that the cursor is on.
2408 If the cursor is on a file - search up for the nearest folder and collapse it."
2409 (interactive)
2410 (unless project-buffer-status (error "Not in project-buffer buffer"))
2411 (let* ((node (ewoc-locate project-buffer-status))
2412 (node-data (ewoc-data node))
2413 (status project-buffer-status))
2414 (project-buffer-clear-matched-mark status)
2415 (when (eq (project-buffer-node->type node-data) 'file)
2416 (setq node (and node (project-buffer-find-node-up status node)))
2417 (when node (ewoc-goto-node status node)))
2418 (when node
2419 (project-buffer-toggle-expand-collapse))))
2422 (defun project-buffer-toggle-expand-collapse ()
2423 "Expand / Collapse project and folder that the cursor is on.
2424 If the cursor is on a file - nothing will be done."
2425 (interactive)
2426 (unless project-buffer-status (error "Not in project-buffer buffer"))
2427 (let* ((node (ewoc-locate project-buffer-status))
2428 (node-data (ewoc-data node))
2429 (status project-buffer-status)
2430 prj-sel
2431 hidden-flag
2432 project
2433 skip-under
2434 folder)
2435 (project-buffer-clear-matched-mark status)
2436 (unless (eq (project-buffer-node->type node-data) 'file)
2437 (when (eq (project-buffer-node->type node-data) 'folder)
2438 (setq folder (project-buffer-node->name node-data)))
2439 (setf (project-buffer-node->collapsed node-data) (not (project-buffer-node->collapsed node-data)))
2440 (setq hidden-flag (project-buffer-node->collapsed node-data))
2441 (setq prj-sel (eq (project-buffer-node->type node-data) 'project))
2442 (when prj-sel
2443 (setf (project-buffer-node->project-collapsed node-data) hidden-flag))
2444 (ewoc-invalidate status node)
2445 (setq project (project-buffer-node->project node-data)
2446 node (ewoc-next status node))
2447 (while node
2448 (setq node-data (ewoc-data node))
2449 (when skip-under
2450 (unless (project-buffer-parent-of-p (project-buffer-node->name node-data) skip-under)
2451 (setq skip-under nil)))
2452 (if (and (string-equal (project-buffer-node->project node-data) project)
2453 (or (not folder)
2454 (project-buffer-parent-of-p (project-buffer-node->name node-data) folder)))
2455 (progn
2456 (when prj-sel
2457 (setf (project-buffer-node->project-collapsed node-data) hidden-flag)
2458 (ewoc-invalidate status node))
2459 (unless skip-under
2460 (setf (project-buffer-node->hidden node-data) hidden-flag)
2461 (ewoc-invalidate status node)
2462 (if (and (eq (project-buffer-node->type node-data) 'folder)
2463 (project-buffer-node->collapsed node-data)
2464 (not hidden-flag))
2465 (setq skip-under (project-buffer-node->name node-data))))
2466 (setq node (ewoc-next status node)))
2467 (setq node nil))))))
2470 (defun project-buffer-set-folder-view-mode()
2471 "Set the view mode to folder-view."
2472 (interactive)
2473 (unless project-buffer-status (error "Not in project-buffer buffer"))
2474 (project-buffer-set-view-mode project-buffer-status 'folder-view))
2476 (defun project-buffer-set-flat-view-mode()
2477 "Set the view mode to flat-view."
2478 (interactive)
2479 (unless project-buffer-status (error "Not in project-buffer buffer"))
2480 (project-buffer-set-view-mode project-buffer-status 'flat-view))
2482 (defun project-buffer-set-folder-hidden-view-mode()
2483 "Set the view mode to folder-hidden-view."
2484 (interactive)
2485 (unless project-buffer-status (error "Not in project-buffer buffer"))
2486 (project-buffer-set-view-mode project-buffer-status 'folder-hidden-view))
2489 (defun project-buffer-set-marked-view-mode()
2490 "Set the view mode to marked-view."
2491 (interactive)
2492 (unless project-buffer-status (error "Not in project-buffer buffer"))
2493 (project-buffer-set-view-mode project-buffer-status 'marked-view))
2496 (defun project-buffer-toggle-view-mode ()
2497 "Toggle between the different view mode (folder-view / flat-view / folder-hidden-view)."
2498 (interactive)
2499 (unless project-buffer-status (error "Not in project-buffer buffer"))
2500 (let ((node (ewoc-locate project-buffer-status)))
2501 (setq project-buffer-view-mode
2502 (cond ((eq project-buffer-view-mode 'folder-view) 'flat-view)
2503 ((eq project-buffer-view-mode 'flat-view) 'folder-hidden-view)
2504 ((eq project-buffer-view-mode 'folder-hidden-view) 'marked-view)
2505 ((eq project-buffer-view-mode 'marked-view) 'folder-view)
2506 ))
2507 (let ((status project-buffer-status))
2508 (message "View mode set to: %s" project-buffer-view-mode)
2509 (project-buffer-refresh-all-items status)
2510 (project-buffer-refresh-ewoc-hf status)
2511 (ewoc-goto-node status node)
2512 )))
2515 (defun project-buffer-toggle-search-mode()
2516 "Toggle between the different search-in-files mode (narrow-marked-files / all-files / current-project)."
2517 (interactive)
2518 (unless project-buffer-status (error "Not in project-buffer buffer"))
2519 (let ((node (ewoc-locate project-buffer-status)))
2520 (setq project-buffer-search-in-files-mode
2521 (cond ((eq project-buffer-search-in-files-mode 'narrow-marked-files) 'all-files)
2522 ((eq project-buffer-search-in-files-mode 'all-files) 'current-project)
2523 ((eq project-buffer-search-in-files-mode 'current-project) 'narrow-marked-files)))
2524 (let ((status project-buffer-status))
2525 (message "Search mode set to: %s" project-buffer-search-in-files-mode)
2526 (project-buffer-refresh-ewoc-hf status)
2527 (ewoc-goto-node status node)
2528 )))
2531 (defun project-buffer-choose-build-configuration()
2532 "Ask the user for the build configuration using a completion list"
2533 (interactive)
2534 (unless project-buffer-status (error "Not in project-buffer buffer"))
2535 (unless project-buffer-build-configurations-list (error "No build configuration available"))
2536 (if (cdr project-buffer-build-configurations-list)
2537 (let ((new-build-configuration (completing-read "Build-Configuration: " project-buffer-build-configurations-list nil t)))
2538 (when (and new-build-configuration (> (length new-build-configuration) 0))
2539 (setq project-buffer-current-build-configuration new-build-configuration)))
2540 (message "This is the only one build configuration available."))
2541 (project-buffer-refresh-ewoc-hf project-buffer-status))
2544 (defun project-buffer-next-build-configuration ()
2545 "Select next build configuration (rotate through them)."
2546 (interactive)
2547 (unless project-buffer-status (error "Not in project-buffer buffer"))
2548 (unless project-buffer-build-configurations-list (error "No build configuration available"))
2549 (if (cdr project-buffer-build-configurations-list)
2550 (let ((current (member project-buffer-current-build-configuration project-buffer-build-configurations-list)))
2551 (unless current (error "The current build configuration is invalid"))
2552 (setq project-buffer-current-build-configuration (or (and (cdr current) (cadr current))
2553 (car project-buffer-build-configurations-list)))
2554 (message "Build configuration set to: %s" project-buffer-current-build-configuration))
2555 (message "This is the only one build configuration available."))
2556 (project-buffer-refresh-ewoc-hf project-buffer-status))
2559 (defun project-buffer-choose-platform ()
2560 "Ask the user for the platform using a completion list."
2561 (interactive)
2562 (unless project-buffer-status (error "Not in project-buffer buffer"))
2563 (unless project-buffer-platforms-list (error "No build configuration available"))
2564 (if (cdr project-buffer-platforms-list)
2565 (let ((new-platform (completing-read "Platform: " project-buffer-platforms-list nil t)))
2566 (when (and new-platform (> (length new-platform) 0))
2567 (setq project-buffer-current-platform new-platform)))
2568 (message "This is the only one platform available."))
2569 (project-buffer-refresh-ewoc-hf project-buffer-status))
2572 (defun project-buffer-next-platform ()
2573 "Select next platform (rotate through them)."
2574 (interactive)
2575 (unless project-buffer-status (error "Not in project-buffer buffer"))
2576 (unless project-buffer-platforms-list (error "No build configuration available"))
2577 (if (cdr project-buffer-platforms-list)
2578 (let ((current (member project-buffer-current-platform project-buffer-platforms-list)))
2579 (unless current (error "The current build configuration is invalid"))
2580 (setq project-buffer-current-platform (or (and (cdr current) (cadr current))
2581 (car project-buffer-platforms-list)))
2582 (message "Platform set to: %s" project-buffer-current-platform))
2583 (message "This is the only one platform available."))
2584 (project-buffer-refresh-ewoc-hf project-buffer-status))
2587 (defun project-buffer-choose-master-project ()
2588 "Prompt the user for the master project."
2589 (interactive)
2590 (unless project-buffer-status (error "Not in project-buffer buffer"))
2591 (let ((status project-buffer-status)
2592 (proj-name (completing-read "Enter the master project: " project-buffer-projects-list nil t)))
2593 (when (and proj-name
2594 (> (length proj-name) 0))
2595 (project-buffer-set-master-project status proj-name))))
2598 (defun project-buffer-select-current-as-master-project ()
2599 "Make the current project the new master project."
2600 (interactive)
2601 (unless project-buffer-status (error "Not in project-buffer buffer"))
2602 (let ((status project-buffer-status)
2603 (old-node (cdr project-buffer-master-project))
2604 (cur-node (ewoc-locate project-buffer-status)))
2605 ;; Search for the project node:
2606 (while (and cur-node
2607 (not (eq (project-buffer-node->type (ewoc-data cur-node)) 'project)))
2608 (setq cur-node (project-buffer-find-node-up status cur-node)))
2609 ;; Let's replace the old node by the new one
2610 (setq project-buffer-master-project (cons (project-buffer-node->name (ewoc-data cur-node))
2611 cur-node))
2612 ;; Force the refresh:
2613 (ewoc-invalidate status old-node)
2614 (ewoc-invalidate status cur-node)
2615 (ewoc-goto-node status cur-node)))
2618 (defun project-buffer-perform-build-action ()
2619 "Run the user hook to perform the build action."
2620 (interactive)
2621 (unless project-buffer-status (error "Not in project-buffer buffer"))
2622 (project-buffer-perform-action-hook 'build))
2625 (defun project-buffer-perform-clean-action ()
2626 "Run the user hook to perform the build action."
2627 (interactive)
2628 (unless project-buffer-status (error "Not in project-buffer buffer"))
2629 (project-buffer-perform-action-hook 'clean))
2632 (defun project-buffer-perform-run-action ()
2633 "Run the user hook to perform the build action."
2634 (interactive)
2635 (unless project-buffer-status (error "Not in project-buffer buffer"))
2636 (project-buffer-perform-action-hook 'run))
2639 (defun project-buffer-perform-debug-action ()
2640 "Run the user hook to perform the build action."
2641 (interactive)
2642 (unless project-buffer-status (error "Not in project-buffer buffer"))
2643 (project-buffer-perform-action-hook 'debug))
2645 (defun project-buffer-perform-update-action ()
2646 "Run the user hook to perform the build action."
2647 (interactive)
2648 (unless project-buffer-status (error "Not in project-buffer buffer"))
2649 (project-buffer-perform-action-hook 'update))
2652 (defun project-buffer-mark-files-containing-regexp (regexp &optional unmark)
2653 "Mark all files containing REGEXP -- A prefix argument means to UNMARK the files containing the REGEXP instead."
2654 (interactive
2655 (list (project-buffer-read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
2656 " files containing (regexp): "))
2657 current-prefix-arg))
2658 (unless project-buffer-status (error "Not in project-buffer buffer"))
2659 (let* ((node (ewoc-locate project-buffer-status))
2660 (node-data (ewoc-data node))
2661 (current-project (project-buffer-node->project node-data))
2662 (count (cond ((eq project-buffer-search-in-files-mode 'narrow-marked-files)
2663 (project-buffer-refine-mark-files project-buffer-status regexp (not unmark)))
2664 ((eq project-buffer-search-in-files-mode 'all-files)
2665 (project-buffer-search-and-mark-files project-buffer-status regexp nil (not unmark)))
2666 ((eq project-buffer-search-in-files-mode 'current-project)
2667 (project-buffer-search-and-mark-files project-buffer-status regexp current-project (not unmark))))))
2668 (if (< count 0)
2669 (message "%i files marked." (- 0 count))
2670 (message "%i files %s."
2671 count
2672 (if (or unmark
2673 (eq project-buffer-search-in-files-mode 'narrow-marked-files))
2674 "unmarked" "marked")))
2675 (when project-buffer-autoswitch-marked-view-mode
2676 (unless (= count 0)
2677 (setq project-buffer-view-mode 'marked-view)
2678 (let ((status project-buffer-status))
2679 (project-buffer-refresh-all-items status)
2680 (project-buffer-refresh-ewoc-hf status)
2681 (ewoc-goto-node status node))))
2682 ))
2685 (defun project-buffer-mark-matched-files-or-current-file(force-marked-current)
2686 "Mark the matched files or the current file if no filename research are in progress or if FORCE-MARKED-CURRENT is set."
2687 (interactive "P")
2688 (unless project-buffer-status (error "Not in project-buffer buffer"))
2689 (let (result)
2690 (unless (or force-marked-current
2691 (not (project-buffer-node->matched (ewoc-data (ewoc-locate project-buffer-status)))))
2692 (ewoc-map (lambda (node-data)
2693 (when (and (eq (project-buffer-node->type node-data) 'file)
2694 (project-buffer-node->matched node-data))
2695 (setf (project-buffer-node->marked node-data) t)
2696 (setq result t)))
2697 project-buffer-status))
2698 (unless result
2699 (project-buffer-mark-file))))
2702 (defun project-buffer-unmark-matched-files-or-current-file(force-unmarked-current)
2703 "Unmark the matched files or the current file if no filename research are in progress or if FORCE-UNMARKED-CURRENT is set."
2704 (interactive "P")
2705 (unless project-buffer-status (error "Not in project-buffer buffer"))
2706 (let (result)
2707 (unless (or force-unmarked-current
2708 (not (project-buffer-node->matched (ewoc-data (ewoc-locate project-buffer-status)))))
2709 (ewoc-map (lambda (node-data)
2710 (when (and (eq (project-buffer-node->type node-data) 'file)
2711 (project-buffer-node->matched node-data))
2712 (setf (project-buffer-node->marked node-data) nil)
2713 (setq result t)))
2714 project-buffer-status))
2715 (unless result
2716 (project-buffer-unmark-file))))
2719 (defun project-buffer-view-file ()
2720 "Examine the current file using the view mode."
2721 (interactive)
2722 (unless project-buffer-status (error "Not in project-buffer buffer"))
2723 (let* ((node (ewoc-locate project-buffer-status))
2724 (node-data (ewoc-data node)))
2725 (when (eq (project-buffer-node->type node-data) 'file)
2726 (view-file (project-buffer-node->filename node-data)))))
2729 (defun project-buffer-delete-current-node()
2730 "Delete the current node."
2731 (interactive)
2732 (unless project-buffer-status (error "Not in project-buffer buffer"))
2733 (let ((status project-buffer-status)
2734 (node (ewoc-locate project-buffer-status)))
2735 (when node
2736 (let* ((node-data (ewoc-data node))
2737 (type (project-buffer-node->type node-data))
2738 (name (project-buffer-node->name node-data)))
2739 (when (funcall project-buffer-confirm-function
2740 (concat (format "Delete %s%s " name (if (eq type 'file) "" " and its content"))))
2741 (message "Deleting %s..." name)
2742 (cond ((eq type 'file)
2743 (project-buffer-delete-node status node (not project-buffer-cleanup-empty-projects)))
2744 ((eq type 'folder)
2745 (project-buffer-delete-folder-node status node (not project-buffer-cleanup-empty-projects)))
2746 ((eq type 'project)
2747 (project-buffer-delete-project-node project-buffer-status name node))
2748 (t (error "Unknown data type"))))))))
2751 (defun project-buffer-delete-marked-files()
2752 "Delete the marked files from the buffer."
2753 (interactive)
2754 (unless project-buffer-status (error "Not in project-buffer buffer"))
2755 (let ((status project-buffer-status)
2756 node-list)
2757 (let ((node (ewoc-nth status 0))
2758 node-data)
2759 (while node
2760 (setq node-data (ewoc-data node))
2761 (when (and (eq (project-buffer-node->type node-data) 'file)
2762 (project-buffer-node->marked node-data))
2763 (setq node-list (cons node node-list)))
2764 (setq node (ewoc-next status node))))
2766 (when node-list
2767 (let* ((lgt (length node-list))
2768 (confirm-str (if (> lgt 1)
2769 (format "Delete marked files [%i files] " lgt)
2770 (format "Delete %s " (project-buffer-node->name (ewoc-data (car node-list))))))
2771 (result-str (format "%i deletion%s done" lgt (if (> lgt 1) "s" ""))))
2772 (when (funcall project-buffer-confirm-function confirm-str)
2773 (while node-list
2774 (project-buffer-delete-node status (pop node-list) (not project-buffer-cleanup-empty-projects)))
2775 (message result-str))))))
2778 (defun project-buffer-delete-current-node-or-marked-files()
2779 "Delete either the current node or the marked files.
2780 The decision is based on the current node: if the current node is
2781 marked, the deletion will attempt to delete all marked files;
2782 otherwise only the current node (and potentially it's content)
2783 will get deleted."
2784 (interactive)
2785 (unless project-buffer-status (error "Not in project-buffer buffer"))
2786 (let ((node (ewoc-locate project-buffer-status)))
2787 (when node
2788 (if (and (eq (project-buffer-node->type (ewoc-data node)) 'file)
2789 (project-buffer-node->marked (ewoc-data node)))
2790 (project-buffer-delete-marked-files)
2791 (project-buffer-delete-current-node)))))
2794 (defun project-buffer-refresh(current-project-only)
2795 "Call the `project-buffer-refresh-hook' then redisplay every nodes."
2796 (interactive "P")
2797 (unless project-buffer-status (error "Not in project-buffer buffer"))
2798 (save-excursion
2799 (if current-project-only
2800 (run-hook-with-args 'project-buffer-refresh-hook (list (project-buffer-get-current-project-name)) 'current)
2801 (run-hook-with-args 'project-buffer-refresh-hook project-buffer-projects-list 'all))
2802 (project-buffer-refresh-all-items project-buffer-status)
2803 (project-buffer-refresh-ewoc-hf project-buffer-status)))
2806 ;;
2807 ;; Global command:
2808 ;;
2811 (defun project-buffer-write-file (filename)
2812 "Save the content of `project-buffer-mode' buffer to FILENAME."
2813 (interactive "FSave project to file: ")
2814 (unless project-buffer-status (error "Not in project-buffer buffer"))
2815 (project-buffer-raw-save filename)
2816 (setq project-buffer-file-name filename))
2819 ;;;###autoload
2820 (defun project-buffer-find-file (filename)
2821 "Create a `project-buffer-mode' buffer based on the content of FILENAME."
2822 (interactive "fFind project: ")
2823 (let ((new-buffer (generate-new-buffer "*project-temp*")))
2824 (with-current-buffer new-buffer
2825 (project-buffer-mode t)
2826 (project-buffer-raw-load filename t t)
2827 (setq project-buffer-file-name filename))
2828 (switch-to-buffer new-buffer)))
2831 (defun project-buffer-save-file ()
2832 "Save the content of the project-buffer-mode buffer into
2833 `project-buffer-file-name'. If `project-buffer-file-name' is
2834 nil; the command will request a file name."
2835 (interactive)
2836 (unless project-buffer-status (error "Not in project-buffer buffer"))
2837 (if project-buffer-file-name
2838 (project-buffer-raw-save project-buffer-file-name)
2839 (call-interactively 'project-buffer-write-file)))
2842 (defun project-buffer-revert ()
2843 "Revert the prvoject-buffer-mode buffer to match the content
2844 from `project-buffer-file-name'."
2845 (interactive)
2846 (unless project-buffer-status (error "Not in project-buffer buffer"))
2847 (unless project-buffer-file-name (error "No file-name attached to this project-buffer"))
2848 (project-buffer-erase-all project-buffer-status)
2849 (project-buffer-raw-load project-buffer-file-name))
2853 ;;
2855 (provide 'project-buffer-mode)
2857 ;;; project-buffer-mode.el ends here