Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
  • 18 commits
  • 4 files changed
  • 0 commit comments
  • 1 contributor
Commits on Sep 30, 2012
rakete remove some unused stuff 6c7a2dc
rakete fix project-index not working correctly with project name as argument a42327e
rakete fix basedir config value not having trailing slash sometimes
- use file-name-as-directory to automatically append trailing slash if
  neccessary
f52736c
rakete only visit recent sourcemarkers from project, not from global db 345447e
Commits on Oct 19, 2012
rakete define project when todo keyword set to any project todo keyword
- checks if org headline at point is a topic in a project and if it is
  and the todo the user changed to is any of the ones defined in
  mk-org-todo-keywords then it defines a project from the headline
4fb3cd2
rakete (org-mode-p) is gone, use (eq major-mode 'org-mode) instead 317e955
rakete check recentf-files list for org files with projects in them c3a330f
rakete don't use project-def in mk-org-entry-define-project
- project-def goes into infinite loop, put project-alist into
  mk-proj-list manually instead
54f1a27
rakete remove useless conditional 413d636
rakete remove sourcemarker restoring hooks before loading project files, add
them again after loading the project
c4c7523
rakete check in with-project-db if project has sourcemarker-db config values e2b4d04
Commits on Nov 05, 2012
rakete fix friend name not correctly expanded in mk-project-helm 1637e56
rakete made project inheriting the default behaviour
- inherit parameter t by default, need to specify nil to explicitly
  prevent inheritance
- fix issue in mk-proj-buffer-p where src-patterns were not matched
  correctly against a buffers filename, prevent correct testing if a
  buffer belongs to a project
- fix for mk-proj-find-projects-owning-buffer returning projects with
  non-matching src-patterns
ebc4896
rakete better tags support, cscope
- automatically add tags from multiple friends when loading a project,
  support generating tags for friends
- detect project languages, generate ack-args accordingly
bba3e63
rakete replaced leftover org-mode-p with (eq major-mode 'org-mode) 95b329a
rakete find basedir by trying to match buffers directory to project basedirs 2e5444b
rakete defun project-insert, insert config into current buffer 27958ae
rakete add scheme to src-patterns table 47d904a
5 mk-project-helm.el
View
@@ -125,7 +125,7 @@
`((name . "Mk-Project friendly files")
(init . (lambda ()
(with-current-buffer (helm-candidate-buffer 'global)
- (dolist (friend (mk-proj-get-config-val 'friends))
+ (dolist (friend (mk-proj-get-config-val 'friends nil t))
(if (file-exists-p (expand-file-name friend))
(insert (concat (expand-file-name friend) "\n"))
(unless (get-buffer (mk-proj-fib-name friend))
@@ -136,7 +136,8 @@
(file-name-absolute-p (buffer-substring (point-at-bol) (point-at-eol)))))
(insert-buffer (mk-proj-fib-name friend))
(mapc (lambda (line)
- (insert (concat line "\n"))) (mk-proj-fib-friend-matches nil friend))))))))
+ (insert (concat (expand-file-name line (mk-proj-get-config-val 'basedir friend t)) "\n")))
+ (mk-proj-fib-matches nil friend))))))))
(candidates-in-buffer)
(candidate-number-limit . 300)
(candidate-transformer helm-c-shorten-home-path)
76 mk-project-orgmode.el
View
@@ -72,6 +72,19 @@ a single org file is stored in the projects basedir.")
(beginning-of-line)
(when (some (lambda (x) (string-equal (org-get-todo-state) x)) org-done-keywords)
(mk-org-clock-from-parent-to-todo))))
+ (add-hook 'org-after-todo-state-change-hook (lambda ()
+ (beginning-of-line)
+ (when (and (some (lambda (x) (string-equal (org-get-todo-state) x)) mk-org-todo-keywords)
+ (mk-org-entry-is-in-project-p))
+ (mk-org-entry-define-project))))
+ (add-hook 'org-after-todo-state-change-hook (lambda ()
+ (beginning-of-line)
+ (let ((proj-name (mk-org-entry-name)))
+ (when (and proj-name
+ (some (lambda (x) (string-equal (org-get-todo-state) x)) mk-org-todo-keywords)
+ (mk-org-entry-is-in-project-p)
+ (not (file-exists-p (mk-proj-get-config-val 'sourcemarker-db-path proj-name))))
+ (mk-proj-with-current-project proj-name (mk-sourcemarker-save-all))))))
(mk-proj-define-backend 'org-mode
:buffer-fun 'mk-org-config-buffer
@@ -86,23 +99,56 @@ a single org file is stored in the projects basedir.")
(add-hook 'mk-proj-before-unload-hook (lambda ()
(when (mk-proj-get-config-val 'org-file)
(project-clock-out))))
- ;;(add-hook 'mk-proj-after-unload-hook 'mk-org-kill-project-buffer)
+ ;; (add-hook 'after-load-functions (lambda (filename)
+ ;; (when filename
+ ;; (with-current-buffer (find-buffer-visiting filename)
+ ;; (when (eq major-mode 'org-mode)
+ ;; (mk-org-map-entries
+ ;; :file filename
+ ;; :scope 'project-tree
+ ;; :close-files nil
+ ;; :function (lambda ()
+ ;; (when (and (not (mk-org-entry-is-link-p))
+ ;; (or (and (org-get-todo-state)
+ ;; (and (some (lambda (x) (string-equal (org-get-todo-state) x)) mk-org-todo-keywords)
+ ;; (not (some (lambda (x) (string-equal (org-get-todo-state) x)) mk-org-ignore-todos))))
+ ;; (and (or (mk-org-entry-last-clock-position)
+ ;; (some (lambda (prop-tuple)
+ ;; (some (lambda (sym) (string-equal (mk-org-symbol-table sym) (cdr prop-tuple)))
+ ;; (append mk-proj-required-vars mk-proj-optional-vars)))
+ ;; (org-entry-properties))
+ ;; (org-entry-get (point) org-effort-property))
+ ;; (and (org-get-todo-state)
+ ;; (and (some (lambda (x) (string-equal (org-get-todo-state) x)) mk-org-todo-keywords)
+ ;; (not (some (lambda (x) (string-equal (org-get-todo-state) x)) mk-org-ignore-todos)))))
+ ;; (and (mk-org-entry-is-project-p)
+ ;; (or (not (org-get-todo-state))
+ ;; (and (org-get-todo-state)
+ ;; (some (lambda (x) (string-equal (org-get-todo-state) x)) mk-org-todo-keywords)
+ ;; (not (some (lambda (x) (string-equal (org-get-todo-state) x)) mk-org-ignore-todos)))))))
+ ;; (mk-org-entry-define-project)
+ ;; (unless (eq (last buffer-with-projects) (current-buffer))
+ ;; (add-to-list 'buffer-with-projects (current-buffer)))))))))))
))
-
-
-
-
(defun mk-org-files-containing-projects ()
"Searches all defined projects and returns a list of all .org files
in which projects have been defined as well as the files specified by
-`mk-org-project-search-files'"
+`mk-org-project-search-files'.
+Also tries to find org files with projects in files from `recentf-list'."
(let ((org-files '()))
(maphash (lambda (k p)
(when (cdr (assoc 'org-file p))
- (setq org-files (append (cdr (assoc 'org-file p)) org-files))))
+ (add-to-list 'org-files (cadr (assoc 'org-file p)))))
mk-proj-list)
+ (when (boundp 'recentf-list)
+ (dolist (recent-file recentf-list)
+ (when (and (file-exists-p recent-file)
+ (string-match ".*\\.org" recent-file)
+ (= (call-process "bash" nil nil nil "-c" (concat "grep \"MKP_NAME\" \"" recent-file "\"")) 0))
+ (print recent-file)
+ (add-to-list 'org-files recent-file 'string-equal))))
(remove-if (lambda (x)
(or (not (file-exists-p x))
(eq x nil)))
@@ -578,7 +624,7 @@ will be used internally. You can specify a MATCH to be used in that case with:
(save-excursion
(org-back-to-heading t)
(beginning-of-line)
- (unless (and (org-mode-p)
+ (unless (and (eq major-mode 'org-mode)
(looking-at org-complex-heading-regexp))
(error "mk-org: buffer is not in org-mode or point is not a org heading"))
(let* ((entry-properties (org-entry-properties))
@@ -602,8 +648,12 @@ will be used internally. You can specify a MATCH to be used in that case with:
entry-config)))))
(defun mk-org-entry-define-project (&optional marker)
- (project-def (mk-org-entry-name marker)
- (mk-org-entry-alist marker)))
+ (let* ((proj-name (mk-org-entry-name marker))
+ (alist (mk-proj-eval-alist proj-name (mk-org-entry-alist marker))))
+ (when alist
+ (puthash proj-name alist mk-proj-list)
+ (message "Defined: %s" proj-name)
+ alist)))
(defun mk-org-entry-undefine-project (&optional marker)
(interactive)
@@ -611,7 +661,7 @@ will be used internally. You can specify a MATCH to be used in that case with:
(save-excursion
(org-back-to-heading t)
(beginning-of-line)
- (unless (and (org-mode-p)
+ (unless (and (eq major-mode 'org-mode)
(looking-at org-complex-heading-regexp))
(error "mk-org: buffer is not in org-mode or point is not a org heading"))
(project-undef (mk-org-entry-name)))))
@@ -925,7 +975,7 @@ See also `mk-org-entry-nearest-active'."
(defun mk-org-config-insert (proj-name config-alist &optional insert-undefined insert-internal headline)
(interactive)
- (unless (org-mode-p)
+ (unless (eq major-mode 'org-mode)
(error "mk-org: current buffer not in org-mode"))
(unless proj-name
(setq proj-name (or (cadr (assoc 'name config-alist) headline) "NewProject")))
@@ -976,7 +1026,7 @@ See also `mk-org-entry-nearest-active'."
((looking-at org-complex-heading-regexp)
(org-end-of-subtree)
(mk-org-config-insert proj-name config-alist nil nil headline))
- ((org-mode-p)
+ ((eq major-mode 'org-mode)
(mk-org-config-insert proj-name config-alist nil nil headline))))))
(save-buffer)
(set-buffer-modified-p mod)
19 mk-project-sourcemarker.el
View
@@ -54,6 +54,7 @@
(run-with-idle-timer 120 t 'mk-sourcemarker-write-project-db)
(add-hook 'mk-proj-before-files-load-hook (lambda ()
+ (remove-hook 'find-file-hook 'mk-sourcemarker-restore)
(dolist (proj-name (append (list mk-proj-name) (mk-proj-get-config-val 'friends)))
(dolist (buf (append (mk-proj-file-buffers proj-name)))
(when buf
@@ -63,6 +64,7 @@
))
(add-hook 'mk-proj-after-load-hook (lambda ()
(mk-sourcemarker-restore-all)
+ (add-hook 'find-file-hook 'mk-sourcemarker-restore)
(mk-sourcemarker-display-most-recent-buffer)))
(add-hook 'mk-proj-before-files-unload-hook (lambda ()
@@ -73,16 +75,17 @@
))
(defmacro mk-sourcemarker-with-project-db (&rest body)
- `(if mk-sourcemarker-per-project-db
+ `(if (and mk-sourcemarker-per-project-db
+ (mk-proj-get-config-val 'sourcemarker-db-path)
+ (mk-proj-get-config-val 'sourcemarker-db-symbol))
(let ((global-db-symbol continue-db-symbol)
(global-db-path continue-db-path)
(continue-db-path (mk-proj-get-config-val 'sourcemarker-db-path))
(continue-db-symbol (mk-proj-get-config-val 'sourcemarker-db-symbol)))
(condition-case nil
(symbol-value (intern continue-db-symbol))
- (error (progn
- (setf (symbol-value (intern continue-db-symbol))
- (make-hash-table :test 'equal)))))
+ (error (setf (symbol-value (intern continue-db-symbol))
+ (make-hash-table :test 'equal))))
,@body)
,@body))
@@ -141,11 +144,7 @@
(mk-sourcemarker-save))
(mk-sourcemarker-with-project-db
(let* ((filename (buffer-file-name buf))
- (sm (if (mk-sourcemarker-with-project-db
- (gethash filename (symbol-value (intern continue-db-symbol))))
- (mk-sourcemarker-with-project-db
- (gethash filename (symbol-value (intern-soft continue-db-symbol)) nil))
- (gethash filename (symbol-value (intern-soft continue-db-symbol)) nil)))
+ (sm (gethash filename (symbol-value (intern-soft continue-db-symbol)) nil))
(timestamp (and sm (read (cdr (assoc :timestamp sm))))))
(if timestamp
(add-to-list 'results `(,timestamp . ,buf))
@@ -166,7 +165,7 @@
(mk-proj-friendly-buffer-p (find-buffer-visiting filename))))
(not (mk-sourcemarker-with-project-db
(gethash filename (symbol-value (intern continue-db-symbol))))))
- (gethash filename (symbol-value (intern-soft global-db-symbol)) nil)
+ nil ;;(gethash filename (symbol-value (intern-soft global-db-symbol)) nil)
(gethash filename (symbol-value (intern-soft continue-db-symbol)) nil)))
(timestamp (and sm (read (cdr (assoc :timestamp sm))))))
(when timestamp
542 mk-project.el
View
@@ -36,6 +36,7 @@
(require 'grep)
(require 'thingatpt)
(require 'cl)
+(require 'xcscope)
(defvar mk-proj-version "1.6.0")
@@ -84,11 +85,11 @@ value is not used if a custom find command is set in
See also `mk-proj-optional-vars' `mk-proj-var-before-get-functions'")
(defvar mk-proj-optional-vars '(parent ;; parent needs to come first!
+ languages
src-patterns
ignore-patterns
ack-args
vcs
- tags-file
compile-cmd
install-cmd
run-cmd
@@ -99,7 +100,10 @@ See also `mk-proj-optional-vars' `mk-proj-var-before-get-functions'")
src-find-cmd
grep-find-cmd
index-find-cmd
+ tags-file
etags-cmd
+ cscope-namefile
+ cscope-cmd
patterns-are-regex
friends
open-friends-cache)
@@ -114,26 +118,40 @@ See also `mk-proj-required-vars' `mk-proj-var-before-get-functions'")
(when (stringp val)
(expand-file-name val)))
+(defun mk-proj-basedir-expand (var val &optional proj-name config-alist)
+ (when (stringp val)
+ (file-name-as-directory (expand-file-name val))))
+
(defun mk-proj-var-get-tags-file (var val &optional proj-name config-alist)
(if val
(expand-file-name val)
- (mk-proj-get-cache-path var proj-name 'copy)))
+ (mk-proj-get-cache-path var proj-name t)))
(defun mk-proj-var-get-open-file-cache (var val &optional proj-name config-alist)
(if val
(expand-file-name val)
- (mk-proj-get-cache-path var proj-name)))
+ (mk-proj-get-cache-path var proj-name nil)))
(defun mk-proj-var-get-file-list-cache (var val &optional proj-name config-alist)
(if val
(expand-file-name val)
(mk-proj-get-cache-path var proj-name t)))
-(defvar mk-proj-var-before-get-functions '((basedir . mk-proj-var-expand)
+(defun mk-proj-var-guess-languages (var val &optional proj-name config-alist)
+ (or val (mk-proj-src-pattern-languages (mk-proj-get-config-val 'src-patterns proj-name))))
+
+(defvar mk-proj-var-before-get-functions '((basedir . mk-proj-basedir-expand)
(tags-file . mk-proj-var-get-tags-file)
+ (cscope-namefile . mk-proj-var-get-tags-file)
(file-list-cache . mk-proj-var-get-file-list-cache)
(open-files-cache . mk-proj-var-get-open-file-cache)
- (open-friends-cache . mk-proj-var-get-open-file-cache))
+ (open-friends-cache . mk-proj-var-get-open-file-cache)
+ (languages . mk-proj-var-guess-languages)
+ (patterns-are-regex . (lambda (var val &optional proj-name config-alist)
+ (if (and config-alist
+ (not (assoc 'patterns-are-regex config-alist)))
+ t
+ val))))
"Config vars from `mk-proj-required-vars' and `mk-proj-optional-vars' (except 'name')
can be associated with a function in this association list, which will be
applied to the value of the var right after it is taken from the config-alist.
@@ -231,20 +249,31 @@ incubator root could be guessed as basedir.")
help guessing a projects basedir. Matching directory names will be ignored
and their parent directory used as basedir.")
-(defvar mk-proj-src-pattern-table '(("h" ".*\\.c" ".*\\.cpp" ".*\\.cc")
- ("hpp" ".*\\.c" ".*\\.cpp" ".*\\.cc")
- ("hh" ".*\\.c" ".*\\.cpp" ".*\\.cc")
- ("c" ".*\\.h")
- ("cpp" ".*\\.h" ".*\\.hpp" ".*\\.hh")
- ("cc" ".*\\.h" ".*\\.hpp" ".*\\.hh")
- ("hs" ".*\\.lhs" ".*\\.cabal")
- ("php" ".*\\.html")
- ("js" ".*\\.html")
- ("el")
- ("lisp")
- ("clojure" ".*\\.clj")
- ("clj" ".*\\.clojure")
- )
+(defvar mk-proj-src-pattern-table '(("h" . (c ".*\\.c" ".*\\.cpp" ".*\\.cc" ".*\\.h"))
+ ("hpp" . (cpp ".*\\.cpp" ".*\\.c" ".*\\.h" ".*\\.hpp"))
+ ("hh" . (cpp ".*\\.cc" ".*\\.c" ".*\\.h" ".*\\.hh"))
+ ("c" . (c ".*\\.c" ".*\\.h"))
+ ("cpp" . (cpp ".*\\.cpp" ".*\\.c" ".*\\.h" ".*\\.hpp"))
+ ("cc" . (cpp ".*\\.cc" ".*\\.c" ".*\\.h" ".*\\.hh"))
+ ("hs" . (haskell ".*\\.hs" ".*\\.lhs" ".*\\.cabal"))
+ ("lhs" . (haskell ".*\\.hs" ".*\\.lhs" ".*\\.cabal"))
+ ("cabal" . (haskell ".*\\.hs" ".*\\.lhs" ".*\\.cabal"))
+ ("php" . (php ".*\\.php" ".*\\.html"))
+ ("js" . (javascript ".*\\.js" ".*\\.html"))
+ ("el" . (elisp ".*\\.el"))
+ ("lisp" . (lisp ".*\\.lisp" ".*\\.lsp"))
+ ("lsp" . (lisp ".*\\.lisp" ".*\\.lsp"))
+ ("scm" . (scheme ".*\\.scm"))
+ ("lua" . (lua ".*\\.lua"))
+ ("clojure" . (clojure ".*\\.clj" ".*\\.clojure"))
+ ("clj" . (clojure ".*\\.clojure" ".*\\.clj"))
+ ("java" . (java ".*\\.java"))
+ ("pl" . (perl ".*\\.pl" ".*\\.pm" ".*\\.pod" ".*\\.t"))
+ ("pm" . (perl ".*\\.pl" ".*\\.pm" ".*\\.pod" ".*\\.t"))
+ ("pod" . (perl ".*\\.pl" ".*\\.pm" ".*\\.pod" ".*\\.t"))
+ ("t" . (perl ".*\\.pl" ".*\\.pm" ".*\\.pod" ".*\\.t"))
+ ("py" . (python ".*\\.py"))
+ ("sh" . (shell . ".*\\.sh")))
"Maps file suffixes to regexps used as source-patterns when guessing a
project config from the currently opened file in the active buffer.")
@@ -261,6 +290,24 @@ can find it, if not it creates it at the end of the file).
See also `mk-proj-config-save-location'")
+(defvar mk-proj-language-source-tagging '((c . (etags cscope gtags semantic))
+ (cpp . (etags cscope gtags semantic))
+ (csharp . (etags semantic))
+ (elisp . (etags semantic))
+ (erlang . (etags semantic))
+ (lisp . (etags semantic))
+ (scheme . (etags semantic))
+ (lua . (etags))
+ (haskell . (htags))
+ (ocaml . (etags))
+ (perl . (etags))
+ (python . (etags semantic))
+ (php . (etags gtags semantic))
+ (shell . (etags))
+ (ruby . (etags))
+ (java . (etags gtags semantic))
+ (javascript . (etags semantic))))
+
;; ---------------------------------------------------------------------
;; Customization
@@ -359,8 +406,8 @@ load time. See also `project-menu-remove'."
(unless proj-name
(mk-proj-assert-proj)
(setq proj-name mk-proj-name))
- (if (or (mk-proj-get-config-val 'vcs) (mk-proj-get-config-val 'vcs proj-name t))
- (cdr (assoc (or (mk-proj-get-config-val 'vcs) (mk-proj-get-config-val 'vcs proj-name t)) mk-proj-vcs-path))
+ (if (mk-proj-get-config-val 'vcs proj-name)
+ (cdr (assoc (mk-proj-get-config-val 'vcs proj-name) mk-proj-vcs-path))
nil))
(defun mk-proj-has-univ-arg ()
@@ -379,9 +426,9 @@ load time. See also `project-menu-remove'."
(mk-proj-assert-proj)
(setq proj-name mk-proj-name))
(let ((cmd (ecase context
- ('src (mk-proj-get-config-val 'src-find-cmd proj-name))
- ('grep (mk-proj-get-config-val 'grep-find-cmd proj-name))
- ('index (mk-proj-get-config-val 'index-find-cmd proj-name)))))
+ ('src (mk-proj-get-config-val 'src-find-cmd proj-name t))
+ ('grep (mk-proj-get-config-val 'grep-find-cmd proj-name t))
+ ('index (mk-proj-get-config-val 'index-find-cmd proj-name t)))))
(if cmd
(cond ((stringp cmd) cmd)
((functionp cmd) (funcall cmd context))
@@ -574,7 +621,7 @@ Examples:
(defvar mk-proj-list (make-hash-table :test 'equal))
-(defun mk-proj-find-config (&optional proj-name inherit)
+(defun* mk-proj-find-config (&optional proj-name (inherit t))
"Get a projects config-alist from the global projects hashmap."
(unless proj-name
(mk-proj-assert-proj)
@@ -587,7 +634,7 @@ Examples:
alist (append alist (remove-if (lambda (x) (some (lambda (y) (eq (first x) (first y))) alist)) child))))
alist))
-(defun mk-proj-get-config-val (key &optional proj-name inherit)
+(defun* mk-proj-get-config-val (key &optional proj-name (inherit t))
"Finds the value associated with KEY. A project PROJ
can optionally be specified.
If the third argument INHERIT is non-nil, all parents will queried
@@ -595,7 +642,7 @@ for the KEY and the first value that is found is returned."
(unless proj-name
(mk-proj-assert-proj)
(setq proj-name mk-proj-name))
- (let* ((proj-alist (mk-proj-find-config proj-name))
+ (let* ((proj-alist (mk-proj-find-config proj-name nil))
(fn (cdr (assoc key mk-proj-var-before-get-functions)))
(val (or (when fn
(funcall fn key (cadr (assoc key proj-alist)) proj-name proj-alist))
@@ -616,7 +663,7 @@ for the KEY and the first value that is found is returned."
(unless proj-name
(mk-proj-assert-proj)
(setq proj-name mk-proj-name))
- (let* ((current-alist (mk-proj-find-config proj-name))
+ (let* ((current-alist (mk-proj-find-config proj-name nil))
(new-alist current-alist))
(when current-alist
(add-to-list 'new-alist `(,key ,value))
@@ -646,8 +693,9 @@ for the KEY and the first value that is found is returned."
(add-to-list 'evaluated-config-alist `(,key ,value)))))))
(when (cadr (assoc 'parent result-alist))
(message "%s inherits from %s" proj-name (cadr (assoc 'parent result-alist)))
- (setq result-alist (mk-proj-alist-union (gethash (cadr (assoc 'parent result-alist)) mk-proj-list)
- result-alist)))
+ ;; (setq result-alist (mk-proj-alist-union (gethash (cadr (assoc 'parent result-alist)) mk-proj-list)
+ ;; result-alist))
+ )
(when (gethash proj-name mk-proj-list)
(message "union with %s" proj-name)
(setq result-alist (mk-proj-alist-union (gethash proj-name mk-proj-list) result-alist)))
@@ -772,7 +820,7 @@ find command will be used and the `mk-proj-ignore-patterns' and
(message "Defined: %s" proj-name)
alist)))
((and (functionp 'mk-org-entry-define-project)
- (org-mode-p)
+ (eq major-mode 'org-mode)
(looking-at org-complex-heading-regexp)
(mk-org-entry-define-project)))))
@@ -829,8 +877,9 @@ find command will be used and the `mk-proj-ignore-patterns' and
(let ((projects nil))
(maphash (lambda (k v)
(when (and (buffer-file-name buf)
- (mk-proj-get-config-val 'basedir k)
- (mk-proj-path-equal (buffer-file-name buf) (mk-proj-get-config-val 'basedir k)))
+ (mk-proj-get-config-val 'basedir k t)
+ (mk-proj-path-equal (buffer-file-name buf) (mk-proj-get-config-val 'basedir k t))
+ (some (lambda (re) (string-match re (buffer-file-name buf))) (mk-proj-get-config-val 'src-patterns k t)))
(add-to-list 'projects k)))
(or (and name-list
(let ((temp-hash (make-hash-table :test 'equal)))
@@ -936,6 +985,17 @@ find command will be used and the `mk-proj-ignore-patterns' and
;; (mk-proj-guess-buffers (current-buffer) mk-proj-incubator-paths)
+(defun mk-proj-src-pattern-languages (src-patterns)
+ (let ((lang nil)
+ (languages nil))
+ (loop for pattern in src-patterns
+ do (setq lang (cadr (assoc (car (last (split-string pattern "\\." t))) mk-proj-src-pattern-table)))
+ if (not (eq lang nil))
+ do (add-to-list 'languages lang))
+ languages))
+
+;;(mk-proj-src-pattern-languages (mk-proj-get-config-val 'src-patterns))
+
(defvar mk-proj-guess-functions '((buffer . ((()
`(1 . ,(current-buffer)))))
(mode . (((buffer)
@@ -985,7 +1045,22 @@ find command will be used and the `mk-proj-ignore-patterns' and
(lambda (a b) (> (length a) (length b))))))
(when (car found-paths)
`(300 . ,(car found-paths)))))))
- ))
+ ;; find basedir by trying to match buffers directory to project basedirs
+ ((buffer)
+ (let ((basedirs '()))
+ (dolist (proj-name (mk-proj-find-projects-owning-buffer buffer))
+ (let ((basedir (file-name-as-directory (mk-proj-get-config-val 'basedir proj-name t))))
+ (unless (some (apply-partially 'string-equal basedir) basedirs)
+ (add-to-list 'basedirs basedir))))
+ (if (eq (length basedirs) 1)
+ `(400 . ,(car basedirs))
+ (let ((basedirs-without-incubators (remove-if (lambda (dir)
+ (some (lambda (incubator)
+ (string-equal dir (file-name-as-directory incubator)))
+ mk-proj-incubator-paths))
+ basedirs)))
+ (when (eq (length basedirs-without-incubators) 1)
+ `(150 . ,(car basedirs-without-incubators)))))))))
(name . (((buffer)
(progn
(unless buffer
@@ -1028,10 +1103,10 @@ find command will be used and the `mk-proj-ignore-patterns' and
(and (last splits)
(> (length splits) 1)))
do (let ((file-ending (car (last (split-string f "\\." t)))))
- (add-to-list 'patterns (concat ".*\\." (regexp-quote file-ending)))
+ ;;(add-to-list 'patterns (concat ".*\\." (regexp-quote file-ending)))
(mapc (lambda (s)
(add-to-list 'patterns s))
- (cdr (assoc file-ending mk-proj-src-pattern-table))))
+ (cddr (assoc file-ending mk-proj-src-pattern-table))))
else
do (add-to-list 'patterns (regexp-quote f))))
(when files
@@ -1042,7 +1117,7 @@ find command will be used and the `mk-proj-ignore-patterns' and
`(100 . ,patterns))))))
(patterns-are-regex . ((nil
'(10 . t))))
- (compile-cmd . ((()
+ (compile-cmd . ((nil
(when (and (boundp 'compile-command)
compile-command)
`(50 . ,compile-command)))
@@ -1065,8 +1140,39 @@ find command will be used and the `mk-proj-ignore-patterns' and
(vcs . (((basedir)
(let ((r nil))
(loop for f in (directory-files basedir)
- until (some (lambda (y) (string-equal (cdr y) f)) mk-proj-vcs-path)
- finally return `(10 . ,f))))))))
+ if (some (lambda (y)
+ (string-equal (cdr y) f)) mk-proj-vcs-path)
+ return `(10 . ,(car (rassoc f mk-proj-vcs-path))))))))
+ (etags-cmd . ((nil
+ '(10 . "etags --extra=fq --fields=+afiklmnsSzt --C++-kinds=+p --C-kinds=+p -o"))))
+ (languages . (((src-patterns)
+ (let ((languages (mk-proj-src-pattern-languages src-patterns)))
+ (when languages
+ `(10 . ,languages))))))
+ (ack-args . (((languages)
+ (let ((args nil))
+ (dolist (lang languages)
+ (cond ((eq lang 'c)
+ (add-to-list 'args "--cc"))
+ ((eq lang 'cpp)
+ (add-to-list 'args "--cpp"))
+ ((eq lang 'elisp)
+ (add-to-list 'args "--el"))
+ ((eq lang 'perl)
+ (add-to-list 'args "--perl"))
+ ((eq lang 'python)
+ (add-to-list 'args "--python"))
+ ((eq lang 'lisp)
+ (add-to-list 'args "--lisp"))
+ ((eq lang 'scheme)
+ (add-to-list 'args "--scheme"))
+ ((eq lang 'shell)
+ (add-to-list 'args "--shell"))
+ ((eq lang 'haskell)
+ (add-to-list 'args "--haskell"))))
+ (when args
+ `(10 . ,(reduce (lambda (a b) (concat a " " b))
+ args)))))))))
(defun* mk-proj-guess-alist (&optional ask-basedir ask-name)
;; go through mk-proj-guess-functions and collect all symbols that are used
@@ -1253,7 +1359,8 @@ See also `mk-proj-config-save-section', `mk-proj-config-save-section'"
(or (not (some (lambda (j) (eq k j)) mk-proj-internal-vars))
insert-internal)
(or (not (cdr (assoc k mk-proj-var-before-get-functions)))
- (not (string-equal (funcall (cdr (assoc k mk-proj-var-before-get-functions)) k nil) (mk-proj-get-config-val k proj-name)))
+ (not (string-equal (prin1-to-string (funcall (cdr (assoc k mk-proj-var-before-get-functions)) k nil))
+ (prin1-to-string (mk-proj-get-config-val k proj-name))))
insert-internal))
do (when (or insert-undefined
(assoc k config-alist))
@@ -1314,7 +1421,7 @@ See also `mk-proj-config-save-section', `mk-proj-config-save-section'"
(set-window-start window (marker-position marker))
(lisp-interaction-mode)
(goto-char (marker-position marker))
- (mk-proj-config-save mk-proj-name (mk-proj-find-config mk-proj-name))
+ (mk-proj-config-save mk-proj-name (mk-proj-find-config mk-proj-name nil))
(set-window-dedicated-p window t)
(mk-proj-backend-edit-project-mode 'elisp)
(buffer-enable-undo)))
@@ -1385,7 +1492,18 @@ See also `mk-proj-config-save-section', `mk-proj-config-save-section'"
(interactive)
(mk-proj-assert-proj)
(mk-proj-backend-funcall (mk-proj-detect-backend)
- 'save mk-proj-name (mk-proj-find-config)))
+ 'save mk-proj-name (mk-proj-find-config nil nil)))
+
+(defun project-insert ()
+ (interactive)
+ (mk-proj-assert-proj)
+ (cond ((or (eq major-mode 'emacs-lisp-mode)
+ (eq major-mode 'lisp-interaction-mode))
+ (mk-proj-backend-funcall 'elisp
+ 'insert mk-proj-name (mk-proj-find-config nil nil)))
+ ((or (eq major-mode 'org-mode))
+ (mk-proj-backend-funcall 'orgmode
+ 'insert mk-proj-name (mk-proj-find-config nil nil)))))
(defun* project-create ()
(interactive)
@@ -1481,12 +1599,12 @@ See also `mk-proj-config-save-section', `mk-proj-config-save-section'"
(unless (mk-proj-get-config-val v proj-name t)
(throw 'mk-proj-check-required-vars v)))))
-(defun mk-proj-get-cache-path (symbol &optional proj-name inherit)
+(defun* mk-proj-get-cache-path (symbol &optional proj-name (inherit t))
(unless proj-name
(mk-proj-assert-proj)
(setq proj-name mk-proj-name))
(let ((directory (concat mk-global-cache-root
- (cond ((mk-proj-get-config-val 'parent proj-name)
+ (cond ((mk-proj-get-config-val 'parent proj-name nil)
(let ((a (concat "/" (mk-proj-join "/" (mk-proj-ancestry proj-name)))))
(concat a "/")))
(t
@@ -1496,19 +1614,19 @@ See also `mk-proj-config-save-section', `mk-proj-config-save-section'"
(let ((r (concat directory file)))
(cond ((file-exists-p r)
r)
- ((and (mk-proj-get-config-val 'parent proj-name)
- (file-exists-p (or (mk-proj-get-config-val symbol (mk-proj-get-config-val 'parent proj-name))
- (mk-proj-get-cache-path symbol (mk-proj-get-config-val 'parent proj-name))))
- (or (eq inherit 'copy)))
+ ((and (mk-proj-get-config-val 'parent proj-name nil)
+ (file-exists-p (or (mk-proj-get-config-val symbol (mk-proj-get-config-val 'parent proj-name nil) nil)
+ (mk-proj-get-cache-path symbol (mk-proj-get-config-val 'parent proj-name nil) t)))
+ (eq inherit 'copy))
(progn
- (copy-file (mk-proj-get-cache-path symbol (mk-proj-get-config-val 'parent proj-name) t) r)
+ (copy-file (or (mk-proj-get-config-val symbol (mk-proj-get-config-val 'parent proj-name nil) nil)
+ (mk-proj-get-cache-path symbol (mk-proj-get-config-val 'parent proj-name nil) t)) r)
r))
- ((and (mk-proj-get-config-val 'parent proj-name)
- (file-exists-p (or (mk-proj-get-config-val symbol (mk-proj-get-config-val 'parent proj-name))
- (mk-proj-get-cache-path symbol (mk-proj-get-config-val 'parent proj-name))))
+ ((and (mk-proj-get-config-val 'parent proj-name nil)
+ (eq (mk-proj-get-config-val 'basedir proj-name nil) nil)
(eq inherit t))
- (or (mk-proj-get-config-val symbol (mk-proj-get-config-val 'parent proj-name))
- (mk-proj-get-cache-path symbol (mk-proj-get-config-val 'parent proj-name))))
+ (or (mk-proj-get-config-val symbol (mk-proj-get-config-val 'parent proj-name nil) nil)
+ (mk-proj-get-cache-path symbol (mk-proj-get-config-val 'parent proj-name nil) t)))
(t r)))))
;;(mk-proj-get-cache-path 'file-list-cache mk-proj-name t)
@@ -1527,13 +1645,13 @@ See also `mk-proj-config-save-section', `mk-proj-config-save-section'"
(defun mk-proj-load (proj-name)
(interactive)
(let* ((oldname mk-proj-name)
- (proj-alist (mk-proj-find-config proj-name))
+ (proj-alist (mk-proj-find-config proj-name nil))
(quiet (and (cadr (assoc 'parent proj-alist))
(or (string-equal (cadr (assoc 'parent proj-alist))
mk-proj-name)
(and (not (condition-case nil (mk-proj-assert-proj) (error t)))
(string-equal (cadr (assoc 'parent proj-alist))
- (mk-proj-get-config-val 'parent)))))))
+ (mk-proj-get-config-val 'parent nil nil)))))))
(unless proj-name
(error "mk-proj-load: proj-name is nil"))
(run-hooks 'mk-proj-before-load-hook)
@@ -1550,8 +1668,13 @@ See also `mk-proj-config-save-section', `mk-proj-config-save-section'"
(when (and (mk-proj-get-config-val 'vcs) (not (mk-proj-get-vcs-path)))
(error "Invalid VCS setting!"))
(message "Loading project %s ..." proj-name)
- (cd (mk-proj-get-config-val 'basedir))
- (mk-proj-tags-load)
+ (cd (file-name-as-directory (mk-proj-get-config-val 'basedir)))
+ (mk-proj-etags-load mk-proj-name)
+ (dolist (friend (mk-proj-get-config-val 'friends))
+ (mk-proj-etags-load mk-proj-name friend))
+ (mk-proj-cscope-load mk-proj-name)
+ (dolist (friend (mk-proj-get-config-val 'friends))
+ (mk-proj-cscope-load mk-proj-name friend))
(mk-proj-fib-init)
(add-hook 'kill-emacs-hook 'mk-proj-kill-emacs-hook)
(when (mk-proj-get-config-val 'startup-hook)
@@ -1579,9 +1702,9 @@ See also `mk-proj-config-save-section', `mk-proj-config-save-section'"
(completing-read "Project Name: " names)))))
(when (and (cadr (assoc 'name guessed-alist))
(string-equal name (cadr (assoc 'name guessed-alist)))
- (not (mk-proj-find-config name)))
+ (not (mk-proj-find-config name nil)))
(project-def name guessed-alist))
- (when (not (mk-proj-find-config name))
+ (when (not (mk-proj-find-config name nil))
(add-to-list 'guessed-alist `(name ,name))
(project-def name guessed-alist))
(mk-proj-load name)))
@@ -1605,7 +1728,8 @@ See also `mk-proj-config-save-section', `mk-proj-config-save-section'"
(progn
(message "Unloading project %s" mk-proj-name)
(run-hooks 'mk-proj-before-unload-hook)
- (mk-proj-tags-clear)
+ (mk-proj-etags-clear)
+ (mk-proj-cscope-clear)
(mk-proj-maybe-kill-buffer (mk-proj-fib-name))
(mk-proj-save-open-file-info)
(mk-proj-save-open-friends-info)
@@ -1628,6 +1752,7 @@ See also `mk-proj-config-save-section', `mk-proj-config-save-section'"
(file-exists-p (buffer-file-name (current-buffer))))
(cd (mk-proj-dirname (buffer-file-name (current-buffer)))))
(modify-frame-parameters (selected-frame) (list (cons 'name "Emacs")))
+ (setq compile-command nil)
(message "Project settings have been cleared"))
(defun project-close-files ()
@@ -1636,7 +1761,6 @@ See also `mk-proj-config-save-section', `mk-proj-config-save-section'"
(mk-proj-assert-proj)
(let ((closed nil)
(dirty nil)
- (basedir-len (length (mk-proj-get-config-val 'basedir)))
(zeitgeist-prevent-send t))
(dolist (b (append (mk-proj-file-buffers) (mk-proj-dired-buffers)))
(cond
@@ -1667,9 +1791,11 @@ See also `mk-proj-config-save-section', `mk-proj-config-save-section'"
(if (and file-name
(file-exists-p file-name)
(mk-proj-get-config-val 'basedir proj-name t)
- (string-match (concat "^" (regexp-quote (mk-proj-get-config-val 'basedir proj-name t))) file-name)
+ (string-match (concat "^" (regexp-quote (file-name-as-directory (mk-proj-get-config-val 'basedir proj-name t)))) file-name)
(loop for pattern in (mk-proj-get-config-val 'src-patterns proj-name t)
- until (string-match (regexp-quote pattern) file-name)
+ if (string-match (if (mk-proj-get-config-val 'patterns-are-regex proj-name t)
+ pattern
+ (regexp-quote pattern)) file-name)
return t
finally return nil))
t
@@ -1726,7 +1852,7 @@ See also `mk-proj-config-save-section', `mk-proj-config-save-section'"
(unless proj-name
(mk-proj-assert-proj)
(setq proj-name mk-proj-name))
- (if (mk-proj-get-config-val 'basedir proj-name)
+ (if (mk-proj-get-config-val 'basedir proj-name t)
(let ((b (get-buffer-create "*mk-proj: project-status*")))
(with-current-buffer b
(kill-region (point-min) (point-max))
@@ -1778,65 +1904,181 @@ See also `mk-proj-config-save-section', `mk-proj-config-save-section'"
;; Etags
;; ---------------------------------------------------------------------
-(defun mk-proj-tags-load ()
+(defun mk-proj-etags-load (&optional proj-name tags-proj)
"Load TAGS file (if tags-file set)"
- (mk-proj-tags-clear)
- (setq tags-file-name (mk-proj-get-config-val 'tags-file)
- tags-table-list nil)
- (when (and (mk-proj-get-config-val 'tags-file)
- (file-readable-p (mk-proj-get-config-val 'tags-file)))
+ (unless proj-name
+ (mk-proj-assert-proj)
+ (setq proj-name mk-proj-name))
+ (let ((zeitgeist-prevent-send t)
+ (tags-add-tables t))
+ (when (and (mk-proj-get-config-val 'tags-file proj-name t)
+ (file-readable-p (mk-proj-get-config-val 'tags-file proj-name t)))
+ (visit-tags-table (mk-proj-get-config-val 'tags-file proj-name t)))
+ (when (and (boundp 'etags-table-alist)
+ tags-proj
+ (mk-proj-get-config-val 'tags-file tags-proj t)
+ (file-readable-p (mk-proj-get-config-val 'tags-file tags-proj t)))
+ (let* ((proj-name-entry-key (concat (regexp-quote (file-name-as-directory (mk-proj-get-config-val 'basedir proj-name t))) ".*"))
+ (proj-name-entry-value (cdr (assoc proj-name-entry-key etags-table-alist)))
+ (tags-proj-entry-key (concat (regexp-quote (file-name-as-directory (mk-proj-get-config-val 'basedir tags-proj t))) ".*")))
+ ;; main entry proj-name -> tags-file from proj-name, and from tags-proj, and all other that were already present in the list
+ (add-to-list 'proj-name-entry-value (mk-proj-get-config-val 'tags-file tags-proj t) nil)
+ (unless (string-equal proj-name tags-proj)
+ (add-to-list 'proj-name-entry-value (mk-proj-get-config-val 'tags-file proj-name t) t))
+ (setq etags-table-alist (remove-if (lambda (xs) (string-equal (car xs) proj-name-entry-key)) etags-table-alist))
+ (add-to-list 'etags-table-alist (append (list proj-name-entry-key) proj-name-entry-value))
+ ;; another entry for tags-proj
+ (setq etags-table-alist (remove-if (lambda (xs) (string-equal (car xs) tags-proj-entry-key)) etags-table-alist))
+ (add-to-list 'etags-table-alist (append (list tags-proj-entry-key) proj-name-entry-value))
+ ))))
+
+(defun mk-proj-cscope-load (&optional proj-name tags-proj)
+ (unless proj-name
+ (mk-proj-assert-proj)
+ (setq proj-name mk-proj-name))
+ (unless cscope-initial-directory
+ (setq cscope-initial-directory (file-name-directory (mk-proj-get-config-val 'basedir proj-name t))))
+ (let* ((db-key (regexp-quote (file-name-as-directory (mk-proj-get-config-val 'basedir proj-name))))
+ (current-db-list (or (assoc db-key cscope-database-regexps)
+ (list (file-name-directory (mk-proj-get-config-val 'basedir proj-name t)))))
+ (proj-entry (list (file-name-directory (mk-proj-get-config-val 'cscope-namefile proj-name t))
+ (list "-s" (mk-proj-get-config-val 'basedir proj-name))))
+ (tags-proj-entry (when tags-proj
+ (list (file-name-directory (mk-proj-get-config-val 'cscope-namefile tags-proj t))
+ (list "-s" (mk-proj-get-config-val 'basedir tags-proj))))))
+ (add-to-list 'current-db-list proj-entry 'eq)
+ (when tags-proj
+ (add-to-list 'current-db-list tags-proj-entry 'eq))
+ (setq cscope-database-regexps (remove-if (lambda (xs)
+ (string-equal (car xs) (car current-db-list)))
+ cscope-database-regexps))
+ (add-to-list 'cscope-database-regexps current-db-list 'eq)))
+
+(defun mk-proj-etags-clear ()
+ "Clear the TAGS file (if tags-file set)"
+ (dolist (proj-name (append (list mk-proj-name) (mk-proj-get-config-val 'friends mk-proj-name t)))
(let ((zeitgeist-prevent-send t))
- (visit-tags-table (mk-proj-get-config-val 'tags-file)))))
+ (when (and (mk-proj-get-config-val 'tags-file proj-name t)
+ (get-file-buffer (mk-proj-get-config-val 'tags-file proj-name t)))
+ (mk-proj-maybe-kill-buffer (get-file-buffer (mk-proj-get-config-val 'tags-file proj-name t))))))
+ (setq tags-file-name nil
+ tags-table-list nil)
+ (when (boundp 'etags-table-alist)
+ (setq etags-table-alist nil)))
-(defun mk-proj-tags-clear ()
- "Clear the TAGS file (if tags-file set)"
- (let ((zeitgeist-prevent-send t))
- (when (and (mk-proj-get-config-val 'tags-file)
- (get-file-buffer (mk-proj-get-config-val 'tags-file)))
- (mk-proj-maybe-kill-buffer (get-file-buffer (mk-proj-get-config-val 'tags-file))))
- (setq tags-file-name nil
- tags-table-list nil)))
+(defun mk-proj-cscope-clear ()
+ (setq cscope-initial-directory nil
+ cscope-database-regexps nil))
-(defun mk-proj-etags-cb (process event)
+(defun mk-proj-etags-cb (process event &optional proj-name)
"Visit tags table when the etags process finishes."
(message "Etags process %s received event %s" process event)
- (kill-buffer (get-buffer "*etags*"))
+ (kill-buffer (get-buffer (concat "*etags " proj-name "*")))
(cond
((string= event "finished\n")
- (mk-proj-tags-load)
- (message "Refreshing TAGS file %s...done" (mk-proj-get-config-val 'tags-file)))
- (t (message "Refreshing TAGS file %s...failed" (mk-proj-get-config-val 'tags-file)))))
+ (mk-proj-etags-load mk-proj-name proj-name)
+ (message "Refreshing TAGS file %s...done" (mk-proj-get-config-val 'tags-file proj-name t)))
+ (t (message "Refreshing TAGS file %s...failed" (mk-proj-get-config-val 'tags-file proj-name t)))))
-(defun project-tags ()
- "Regenerate the project's TAG file. Runs in the background."
- (interactive)
- (mk-proj-assert-proj)
- (if (mk-proj-get-config-val 'tags-file)
- (let* ((tags-file-name (file-name-nondirectory (mk-proj-get-config-val 'tags-file)))
+(defun mk-proj-cscope-cb (process event &optional proj-name)
+ (message "Cscope process %s received event %s" process event)
+ (kill-buffer (get-buffer (concat "*cscope " proj-name "*")))
+ (cond
+ ((string= event "finished\n")
+ (mk-proj-cscope-load mk-proj-name proj-name)
+ (message "Refreshing CSCOPE files in %s...done" (file-name-directory (mk-proj-get-config-val 'cscope-namefile proj-name t))))
+ (t (message "Refreshing CSCOPE files in %s...failed" (file-name-directory (mk-proj-get-config-val 'cscope-namefile proj-name t))))))
+
+(defun mk-proj-cscope (&optional proj-name)
+ (unless proj-name
+ (mk-proj-assert-proj)
+ (setq proj-name mk-proj-name))
+ (if (mk-proj-get-config-val 'cscope-namefile proj-name t)
+ (let* ((cscope-files (mk-proj-get-config-val 'cscope-namefile proj-name t))
+ (default-directory (mk-proj-get-config-val 'basedir proj-name))
+ (default-find-cmd (concat "find '" (mk-proj-get-config-val 'basedir proj-name t)
+ "' -type f "
+ (mk-proj-find-cmd-src-args (mk-proj-get-config-val 'src-patterns proj-name t) proj-name)
+ (mk-proj-find-cmd-ignore-args (mk-proj-get-config-val 'ignore-patterns proj-name t) proj-name)
+ ))
+ (cscope-find-cmd (concat default-find-cmd " > " cscope-files))
+ (cscope-shell-cmd (if (mk-proj-get-config-val 'cscope-cmd proj-name t)
+ (mk-proj-get-config-val 'cscope-cmd proj-name t)
+ (concat "cscope -b -q -k -i " cscope-files)))
+ (cscope-cmd (concat cscope-find-cmd "; " cscope-shell-cmd))
+ (cscope-proc-name (concat proj-name "-cscope-process")))
+ (message "project-cscope default-dir %s" default-directory)
+ (message "project-cscope cscope-cmd \"%s\"" cscope-cmd)
+ (message "Refreshing CSCOPE files in %s..." (file-name-directory cscope-files))
+ (start-process-shell-command cscope-proc-name (concat "*cscope " proj-name "*") cscope-cmd)
+ (set-process-sentinel (get-process cscope-proc-name) `(lambda (p e) (mk-proj-cscope-cb p e ,proj-name)))
+ )))
+
+(defun mk-proj-etags (&optional proj-name)
+ (unless proj-name
+ (mk-proj-assert-proj)
+ (setq proj-name mk-proj-name))
+ (if (mk-proj-get-config-val 'tags-file proj-name t)
+ (let* ((tags-file-name (file-name-nondirectory (mk-proj-get-config-val 'tags-file proj-name t)))
;; If the TAGS file is in the basedir, we can generate
;; relative filenames which will allow the TAGS file to
;; be relocatable if moved with the source. Otherwise,
;; run the command from the TAGS file's directory and
;; generate absolute filenames.
- (relative-tags (string= (file-name-as-directory (mk-proj-get-config-val 'basedir))
- (file-name-directory (mk-proj-get-config-val 'tags-file))))
- (default-directory (file-name-as-directory
- (file-name-directory (mk-proj-get-config-val 'tags-file))))
- (default-find-cmd (concat "find '" (if relative-tags "." (mk-proj-get-config-val 'basedir))
+ (relative-tags (string= (file-name-as-directory (mk-proj-get-config-val 'basedir proj-name t))
+ (file-name-directory (mk-proj-get-config-val 'tags-file proj-name t))))
+ (default-directory (file-name-as-directory (file-name-directory (mk-proj-get-config-val 'tags-file proj-name t))))
+ (default-find-cmd (concat "find '" (if relative-tags "." (file-name-as-directory (mk-proj-get-config-val 'basedir proj-name t)))
"' -type f "
- (mk-proj-find-cmd-src-args (mk-proj-get-config-val 'src-patterns))))
- (etags-shell-cmd (if (mk-proj-get-config-val 'etags-cmd)
- (mk-proj-get-config-val 'etags-cmd)
- "etags -o"))
- (etags-cmd (concat (or (mk-proj-find-cmd-val 'src) default-find-cmd)
- " | " etags-shell-cmd " '" tags-file-name "' - "))
- (proc-name "etags-process"))
+ (mk-proj-find-cmd-src-args (mk-proj-get-config-val 'src-patterns proj-name t) proj-name)
+ (mk-proj-find-cmd-ignore-args (mk-proj-get-config-val 'ignore-patterns proj-name t) proj-name)
+ ))
+ (etags-shell-cmd (if (mk-proj-get-config-val 'etags-cmd proj-name t)
+ (mk-proj-get-config-val 'etags-cmd proj-name t)
+ "etags --extra=fq --fields=+afiklmnsSzt --C++-kinds=+p --C-kinds=+p -o"))
+ (etags-cmd (concat (or (mk-proj-find-cmd-val 'src proj-name) default-find-cmd)
+ " | " etags-shell-cmd " '" tags-file-name "' -L - "))
+ (etags-proc-name (concat proj-name "-etags-process")))
(message "project-tags default-dir %s" default-directory)
- (message "project-tags cmd \"%s\"" etags-cmd)
- (message "Refreshing TAGS file %s..." (mk-proj-get-config-val 'tags-file))
- (start-process-shell-command proc-name "*etags*" etags-cmd)
- (set-process-sentinel (get-process proc-name) 'mk-proj-etags-cb))
- (message "mk-proj-tags-file is not set")))
+ (message "project-tags etags-cmd \"%s\"" etags-cmd)
+ (message "Refreshing TAGS file %s..." (mk-proj-get-config-val 'tags-file proj-name t))
+ (start-process-shell-command etags-proc-name (concat "*etags " proj-name "*") etags-cmd)
+ (set-process-sentinel (get-process etags-proc-name) `(lambda (p e) (mk-proj-etags-cb p e ,proj-name)))
+ )))
+
+(defun project-tags ()
+ "Regenerate the project's TAG file. Runs in the background."
+ (interactive)
+ (mk-proj-assert-proj)
+ (if (mk-proj-has-univ-arg)
+ (project-tags-with-friends)
+ (dolist (tagging (remove-duplicates (apply 'append (mapcar (lambda (l) (assoc l mk-proj-language-source-tagging))
+ (mk-proj-src-pattern-languages (mk-proj-get-config-val 'src-patterns))))))
+ (cond ((eq tagging 'etags)
+ (mk-proj-etags-clear)
+ (mk-proj-etags))
+ ((eq tagging 'cscope)
+ (mk-proj-cscope-clear)
+ (mk-proj-cscope))))))
+
+(defun project-tags-with-friends ()
+ (interactive)
+ (mk-proj-assert-proj)
+ (dolist (tagging (remove-duplicates (apply 'append (mapcar (lambda (l) (assoc l mk-proj-language-source-tagging))
+ (mk-proj-src-pattern-languages (mk-proj-get-config-val 'src-patterns))))))
+ (cond ((eq tagging 'etags)
+ (mk-proj-etags-clear)
+ (mk-proj-etags mk-proj-name))
+ ((eq tagging 'cscope)
+ (mk-proj-cscope-clear)
+ (mk-proj-cscope mk-proj-name))))
+ (dolist (friend (mk-proj-get-config-val 'friends mk-proj-name t))
+ (dolist (tagging (remove-duplicates (apply 'append (mapcar (lambda (l) (assoc l mk-proj-language-source-tagging))
+ (mk-proj-src-pattern-languages (mk-proj-get-config-val 'src-patterns friend))))))
+ (cond ((eq tagging 'etags)
+ (mk-proj-etags friend))
+ ((eq tagging 'cscope)
+ (mk-proj-cscope friend))))))
(defun mk-proj-find-cmd-src-args (src-patterns &optional proj-name)
"Generate the ( -name <pat1> -o -name <pat2> ...) pattern for find cmd"
@@ -1845,7 +2087,7 @@ See also `mk-proj-config-save-section', `mk-proj-config-save-section'"
(setq proj-name mk-proj-name))
(if src-patterns
(let ((name-expr " \\(")
- (regex-or-name-arg (if (mk-proj-get-config-val 'patterns-are-regex proj-name)
+ (regex-or-name-arg (if (mk-proj-get-config-val 'patterns-are-regex proj-name t)
"-regex"
"-name")))
(dolist (pat src-patterns)
@@ -1904,7 +2146,7 @@ C-u prefix, start from the current directory."
(define-compilation-mode ack-mode "Ack" "Ack compilation mode." nil)
-(defvar mk-proj-ack-default-args "--nocolor --nogroup")
+(defvar mk-proj-ack-default-args "--nocolor --nogroup --column")
(defun mk-proj-ack-cmd (regex)
"Generate the ack command string given a regex to search for."
@@ -1925,11 +2167,11 @@ With C-u prefix act as `project-ack-with-friends'."
(regex (or phrase
(if wap (read-string (concat "Ack project for (default \"" wap "\"): ") nil nil wap)
(read-string "Ack project for: "))))
- (path (mk-proj-get-config-val 'basedir mk-proj-name t))
+ (path (file-name-as-directory (mk-proj-get-config-val 'basedir)))
(whole-cmd (concat (mk-proj-ack-cmd regex) " " path))
(confirmed-cmd (read-string "Ack command: " whole-cmd nil whole-cmd))
- (default-directory (file-name-as-directory (mk-proj-get-config-val 'basedir mk-proj-name t))))
- (compilation-start confirmed-cmd 'ack-mode))))
+ (default-directory (file-name-as-directory (mk-proj-get-config-val 'basedir))))
+ (compilation-start confirmed-cmd 'ack-and-a-half-mode))))
;; ---------------------------------------------------------------------
;; Compile
@@ -1946,8 +2188,8 @@ With C-u prefix act as `project-ack-with-friends'."
(setq result-compile-command compile-command
compile-command saved-compile-command)
result-compile-command)))
- (let ((cmd (mk-proj-get-config-val 'compile-cmd mk-proj-name t)))
- (mk-proj-with-directory (mk-proj-get-config-val 'basedir mk-proj-name t)
+ (let ((cmd (mk-proj-get-config-val 'compile-cmd)))
+ (mk-proj-with-directory (mk-proj-get-config-val 'basedir)
(cond ((stringp cmd)
(let ((new-cmd (internal-compile cmd)))
(unless (string-equal cmd new-cmd)
@@ -1968,7 +2210,7 @@ With C-u prefix act as `project-ack-with-friends'."
"Open dired in the project's basedir (or jump to the existing dired buffer)"
(interactive)
(mk-proj-assert-proj t)
- (dired (mk-proj-get-config-val 'basedir t)))
+ (dired (mk-proj-get-config-val 'basedir)))
;; ---------------------------------------------------------------------
;; Find-file
@@ -2027,17 +2269,17 @@ With C-u prefix act as `project-ack-with-friends'."
(setq proj-name mk-proj-name))
(when (mk-proj-get-config-val 'file-list-cache proj-name t)
(mk-proj-fib-clear proj-name)
- (cd (mk-proj-get-config-val 'basedir proj-name t))
+ (cd (file-name-as-directory (mk-proj-get-config-val 'basedir proj-name t)))
(let* ((default-directory (file-name-as-directory (mk-proj-get-config-val 'basedir proj-name t)))
(start-dir (if mk-proj-file-index-relative-paths
"."
- (mk-proj-get-config-val 'basedir proj-name t)))
+ (file-name-as-directory (mk-proj-get-config-val 'basedir proj-name t))))
(find-cmd (concat "find '" start-dir "' -type f "
- (mk-proj-find-cmd-src-args (mk-proj-get-config-val 'src-patterns) proj-name)
- (mk-proj-find-cmd-ignore-args (mk-proj-get-config-val 'ignore-patterns) proj-name)))
+ (mk-proj-find-cmd-src-args (mk-proj-get-config-val 'src-patterns proj-name t) proj-name)
+ (mk-proj-find-cmd-ignore-args (mk-proj-get-config-val 'ignore-patterns proj-name t) proj-name)))
(proc-name "index-process"))
- (when (mk-proj-get-vcs-path)
- (setq find-cmd (concat find-cmd " -not -path " (concat "'*/" (mk-proj-get-vcs-path) "/*'"))))
+ (when (mk-proj-get-vcs-path proj-name)
+ (setq find-cmd (concat find-cmd " -not -path " (concat "'*/" (mk-proj-get-vcs-path proj-name) "/*'"))))
(setq find-cmd (or (mk-proj-find-cmd-val 'index proj-name) find-cmd))
(with-current-buffer (get-buffer-create (mk-proj-fib-name proj-name))
(buffer-disable-undo) ;; this is a large change we don't need to undo
@@ -2057,27 +2299,28 @@ If it is nil, return all files.
Returned file paths are relative to the project's basedir."
(unless (get-buffer (mk-proj-fib-name proj-name))
(mk-proj-fib-init proj-name))
- (with-current-buffer (mk-proj-fib-name proj-name)
- (let ((basedir (mk-proj-get-config-val 'basedir proj-name))
- (current-filename nil))
- (sort (loop for line in (split-string (buffer-string) "\n" t)
- if (> (length line) 0)
- do (setq current-filename (if (file-name-absolute-p line)
- (file-relative-name line (mk-proj-get-config-val 'basedir proj-name))
- line))
- if (or (not regex)
- (and (stringp regex)
- (string-match regex current-filename))
- (and (listp regex)
- (some (lambda (re) (string-match re current-filename)) regex)))
- collect current-filename)
- #'string-lessp))))
+ (when (gethash proj-name mk-proj-list nil)
+ (with-current-buffer (mk-proj-fib-name proj-name)
+ (let ((basedir (file-name-as-directory (mk-proj-get-config-val 'basedir proj-name t)))
+ (current-filename nil))
+ (sort (loop for line in (split-string (buffer-string) "\n" t)
+ if (> (length line) 0)
+ do (setq current-filename (if (file-name-absolute-p line)
+ (file-relative-name line basedir)
+ line))
+ if (or (not regex)
+ (and (stringp regex)
+ (string-match regex current-filename))
+ (and (listp regex)
+ (some (lambda (re) (string-match re current-filename)) regex)))
+ collect current-filename)
+ #'string-lessp)))))
(defun mk-proj-files (&optional proj-name)
(unless proj-name
(mk-proj-assert-proj)
(setq proj-name mk-proj-name))
- (mapcar (lambda (f) (expand-file-name (concat (mk-proj-get-config-val 'basedir proj-name t) f)))
+ (mapcar (lambda (f) (expand-file-name (concat (file-name-as-directory (mk-proj-get-config-val 'basedir proj-name t)) f)))
(mk-proj-fib-matches nil proj-name)))
(defun mk-proj-friendly-files (&optional proj-name friends-only)
@@ -2085,11 +2328,11 @@ Returned file paths are relative to the project's basedir."
(mk-proj-assert-proj)
(setq proj-name mk-proj-name))
(let ((friendly-files (mapcan (lambda (friend)
- (if (file-exists-p (mk-proj-with-directory (mk-proj-get-config-val 'basedir proj-name)
+ (if (file-exists-p (mk-proj-with-directory (mk-proj-get-config-val 'basedir proj-name t)
(expand-file-name friend)))
(list friend)
(mk-proj-files friend)))
- (mk-proj-get-config-val 'friends proj-name))))
+ (mk-proj-get-config-val 'friends proj-name t))))
friendly-files))
(defun mk-proj-normalize-drive-letter (file)
@@ -2136,7 +2379,7 @@ See also: `project-index', `project-find-file-ido'."
(ido-completing-read "Select match (ido): " matches)
(completing-read "Select match: " matches))))
(when file
- (find-file (concat (file-name-as-directory (mk-proj-get-config-val 'basedir)) file))))))))
+ (find-file (concat (file-name-as-directory (mk-proj-get-config-val 'basedir mk-proj-name t)) file))))))))
(defun* project-find-file-ido ()
"Find file in the current project using 'ido'.
@@ -2153,7 +2396,7 @@ selection of the file. See also: `project-index',
(let ((file (ido-completing-read "Find file in project matching (ido): "
(mk-proj-fib-matches))))
(when file
- (find-file (concat (file-name-as-directory (mk-proj-get-config-val 'basedir)) file)))))
+ (find-file (concat (file-name-as-directory (mk-proj-get-config-val 'basedir mk-proj-name t)) file)))))
(defun project-multi-occur (regex)
"Search all open project files for 'regex' using `multi-occur'.
@@ -2239,15 +2482,15 @@ project is not loaded."
(mk-proj-assert-proj)
(setq proj-name mk-proj-name))
(let ((resulting-matches '()))
- (dolist (friend (mk-proj-get-config-val 'friends proj-name) resulting-matches)
- (if (file-exists-p (mk-proj-with-directory (mk-proj-get-config-val 'basedir proj-name)
+ (dolist (friend (mk-proj-get-config-val 'friends proj-name t) resulting-matches)
+ (if (file-exists-p (mk-proj-with-directory (mk-proj-get-config-val 'basedir proj-name t)
(expand-file-name friend)))
(if regex
(when (string-match regex friend) (add-to-list 'resulting-matches (expand-file-name friend)))
(add-to-list 'resulting-matches (expand-file-name friend)))
(setq resulting-matches (append resulting-matches
(mapcar (lambda (f)
- (expand-file-name (concat (mk-proj-get-config-val 'basedir friend) "/" f)))
+ (expand-file-name (concat (file-name-as-directory (mk-proj-get-config-val 'basedir friend t)) f)))
(mk-proj-fib-matches regex friend))))))
;;(remove-duplicates resulting-matches :test #'string-equal)
))
@@ -2262,7 +2505,7 @@ project is not loaded."
(if (file-exists-p (expand-file-name f))
(when (string-equal f file-name)
(return-from "friend-loop" t))
- (when (mk-proj-find-config f)
+ (when (mk-proj-find-config f t)
(let* ((friend-config (mk-proj-find-config f t))
(basedir (expand-file-name (car (cdr (assoc 'basedir friend-config)))))
(friend-basedir (if (string-equal (substring basedir -1) "/")
@@ -2356,7 +2599,6 @@ project is not loaded."
(mk-proj-assert-proj)
(let ((closed nil)
(dirty nil)
- (basedir-len (length (mk-proj-get-config-val 'basedir)))
(zeitgeist-prevent-send t))
(dolist (b (append (mk-proj-friendly-buffers) (mk-proj-friendly-dired-buffers)))
(cond
@@ -2392,13 +2634,13 @@ project is not loaded."
(let* ((wap (word-at-point))
(regex (if wap (read-string (concat "Ack project for (default \"" wap "\"): ") nil nil wap)
(read-string "Ack project for: ")))
- (paths (mk-proj-find-unique-paths (append (list (mk-proj-get-config-val 'basedir mk-proj-name t)) (mk-proj-friend-basedirs))))
+ (paths (mk-proj-find-unique-paths (append (list (mk-proj-get-config-val 'basedir)) (mk-proj-friend-basedirs))))
(whole-cmd (concat (let ((s ""))
(dolist (d paths s)
(setq s (concat s (mk-proj-ack-cmd regex) " " d "; "))))))
(confirmed-cmd (read-string "Ack command: " whole-cmd nil whole-cmd))
- (default-directory (file-name-as-directory (mk-proj-get-config-val 'basedir mk-proj-name t))))
- (compilation-start confirmed-cmd 'ack-mode)))
+ (default-directory (file-name-as-directory (mk-proj-get-config-val 'basedir))))
+ (compilation-start confirmed-cmd 'ack-and-a-half-mode)))
;;(defun mk-proj-find-projects-owning-file (file))

No commit comments for this range

Something went wrong with that request. Please try again.