diff --git a/lisp/cedet/cedet-global.el b/lisp/cedet/cedet-global.el index 3773ba0..9fb46a0 100644 --- a/lisp/cedet/cedet-global.el +++ b/lisp/cedet/cedet-global.el @@ -120,6 +120,60 @@ Return a fully qualified filename." (error "No file found"))) ans)) +(defun find-file-complete-global-table (prefix) + "Do completion for file names in `find-file-complete-global'" + ;; Returned paths are relative to default-directory + (cond + ((string-match find-file-uniquify-regexp prefix) + ;; User has selected one match; return it. + (list prefix)) + + (t + (let* ((paths ;; Matching relative paths, as returned by global. + (with-current-buffer (cedet-gnu-global-call (list "--ignore-case" "-P" prefix)) + (split-string (buffer-substring (point-min) (point-max)) "\n" t))) + (dir-names + (cl-mapcar (lambda (path) (cons (file-name-directory path) (file-name-nondirectory path))) + paths)) + ) + + ;; "global -P `prefix'" matches in middle of the file name, and + ;; in the directory portion. The calling completion function + ;; rejects any completions that don't start with `prefix'. + + (find-file-uniquify dir-names) + )) + )) + +(defun find-file-complete-global (filename) + "Prompt for completion of FILENAME in a Gnu global project." + (setq filename + (completing-read + "file: " ;; prompt + (completion-table-with-cache #'find-file-complete-global-table) ;; collection + nil ;; predicate + t ;; require match + filename + )) + + (when (string-match find-file-uniquify-regexp filename) + ;; Get partial dir from conflict + (setq filename (concat (match-string 2 filename) (match-string 1 filename)))) + + ;; If there are two files like: + ;; + ;; src/keyboard.c + ;; test/etags/c-src/emacs/src/keyboard.c + ;; + ;; and the user completes to the first, the following global call + ;; will return both. The desired result is always the shortest. + (with-current-buffer (cedet-gnu-global-call (list "--ignore-case" "-Pa" filename)) + (let ((paths (split-string (buffer-substring (point-min) (point-max)) "\n" t))) + (setq paths (sort paths (lambda (a b) (< (length a) (length b))))) + (car paths))) + + ) + (defun cedet-gnu-global-show-root () "Show the root of a GNU Global area under the current buffer." (interactive) @@ -193,6 +247,19 @@ If a database already exists, then just update it." ) )) +;;; project.el integration + +(defun project-try-global (dir) + (when (cedet-gnu-global-version-check t) + (let ((root (locate-dominating-file dir "GTAGS"))) + (when root + (list 'global root))))) + +(cl-defmethod project-find-file ((prj (head global)) filename) + (let ((default-directory (file-name-as-directory (nth 1 prj)))) + (find-file (find-file-complete-global filename)))) + + (provide 'cedet-global) ;;; cedet-global.el ends here diff --git a/lisp/files.el b/lisp/files.el index c309f86..ad4fb4b 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1691,6 +1691,85 @@ killed." ;; We already ran these; don't run them again. (let (kill-buffer-query-functions kill-buffer-hook) (kill-buffer obuf)))))) + +(defconst find-file-uniquify-regexp "^\\(.*\\)<\\(.*\\)>" + "Regexp matching uniqufied file name. +Match 1 is the filename, match 2 is the relative directory.") + +(defun find-file-uniquify-conflicts (conflicts) + "Subroutine of `find-file-uniquify'." + (let ((common-root ;; shared prefix of dirs in conflicts - may be nil + (fill-common-string-prefix (car (nth 0 conflicts)) (car (nth 1 conflicts))))) + + (let ((temp (cddr conflicts)) + dir-name) + (while (and common-root + temp) + (setq dir-name (pop temp)) + (setq common-root (fill-common-string-prefix common-root (car dir-name))))) + + (when common-root + ;; Trim `common-root' back to last '/' + (let ((i (1- (length common-root)))) + (while (and (> i 0) + (not (= (aref common-root i) ?/))) + (setq i (1- i))) + (setq common-root (substring common-root 0 (1+ i))))) + + (cl-mapcar + (lambda (dir-name) + (concat (cdr dir-name) + "<" (substring (car dir-name) (length common-root)) ">")) + conflicts) + )) + +(defun find-file-uniquify (dir-names) + "Return a flat list of names from DIR-NAMES with duplicate filenames extended by directories. +DIR-NAMES is a list of (dir . name)." + (let (result + conflicts ;; list of (dir . name) where all `name' are the same. + ) + + ;; Sort dir-names so duplicates are grouped together + (setq dir-names (sort dir-names (lambda (a b) + (string< (cdr a) (cdr b))))) + + (while dir-names + (setq conflicts (list (pop dir-names))) + (while (string= (cdr (car conflicts)) (cdr (car dir-names))) + (push (pop dir-names) conflicts)) + + (if (= 1 (length conflicts)) + (push (cdr (car conflicts)) result) + (setq result (append (find-file-uniquify-conflicts conflicts) result))) + ) + (nreverse result) + )) + +(defun find-file-path-completion-table (path predicate prefix) + "Do completion for file names in `find-file-project'." + (cond + ((string-match find-file-uniquify-regexp prefix) + ;; User has selected one match; return it. + (list prefix)) + + ;; FIXME: handle prefix = "Makefile" "file1.el" "file2.el" "file3.el"))) + + ;; only one completion (after user selects first of the above) + (should (equal (find-file-path-completion-table (list dir1 dir2) nil "file1.el") + '("file1.el"))) + )) + +(ert-deftest find-file-path-completion-table-predicate () + "Test completion when there are two files with the same name in +different directories on path, and a predicate." + (let* ((root (make-temp-file "find-file-path-test" t)) + (dir1 (concat root "/dir1")) + (dir2 (concat root "/dir2")) + (regexp (dired-glob-regexp "*.elc")) + (pred (lambda (name) (not (string-match regexp name))))) + + (mkdir dir1) + (mkdir dir2) + + (with-temp-file (concat dir1 "/file1.el") + (insert "dir1/file1.el")) + (with-temp-file (concat dir1 "/file1.elc") + (insert "dir1/file1.elc")) + (with-temp-file (concat dir1 "/file2.el") + (insert "dir1/file2.el")) + (with-temp-file (concat dir1 "/file2.elc") + (insert "dir1/file2.elc")) + + (with-temp-file (concat dir2 "/file1.el") + (insert "dir2/file1.el")) + (with-temp-file (concat dir2 "/file1.elc") + (insert "dir2/file1.elc")) + (with-temp-file (concat dir2 "/file3.el") + (insert "dir2/file3.el")) + (with-temp-file (concat dir2 "/file3.elc") + (insert "dir2/file3.elc")) + + ;; multiple completions, some with same name, predicate eliminates some + (should (equal (find-file-path-completion-table (list dir1 dir2) pred "fi") + '("file1.el" "file1.el" "file2.el" "file3.el"))) + + ;; only one completion (after user selects first of the above) + (should (equal (find-file-path-completion-table (list dir1 dir2) pred "file1.el") + '("file1.el"))) + )) ;; Stop the above "Local Var..." confusing Emacs. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 735e08e..edfb045 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2421,11 +2421,13 @@ the file, which in some cases may cause a security hole. This section describes low-level subroutines for completing a file name. For higher level functions, see @ref{Reading File Names}. address@hidden file-name-all-completions partial-filename directory -This function returns a list of all possible completions for a file -whose name starts with @var{partial-filename} in directory address@hidden The order of the completions is the order of the files -in the directory, which is unpredictable and conveys no useful address@hidden file-name-all-completions partial-filename directory &optional predicate +This function returns a list of all possible completions for a file in +directory @var{directory} whose name starts with address@hidden and for which @var{predicate} (called with the +filename) returns non-nil. If @var{predicate} is nil (the default), it +is ignored. The order of the completions is the order of the files in +the directory, which is unpredictable and conveys no useful information. The argument @var{partial-filename} must be a file name containing no diff --git a/lisp/cedet/cedet-global.el b/lisp/cedet/cedet-global.el index 3773ba0..9fb46a0 100644 --- a/lisp/cedet/cedet-global.el +++ b/lisp/cedet/cedet-global.el @@ -120,6 +120,60 @@ Return a fully qualified filename." (error "No file found"))) ans)) +(defun find-file-complete-global-table (prefix) + "Do completion for file names in `find-file-complete-global'" + ;; Returned paths are relative to default-directory + (cond + ((string-match find-file-uniquify-regexp prefix) + ;; User has selected one match; return it. + (list prefix)) + + (t + (let* ((paths ;; Matching relative paths, as returned by global. + (with-current-buffer (cedet-gnu-global-call (list "--ignore-case" "-P" prefix)) + (split-string (buffer-substring (point-min) (point-max)) "\n" t))) + (dir-names + (cl-mapcar (lambda (path) (cons (file-name-directory path) (file-name-nondirectory path))) + paths)) + ) + + ;; "global -P `prefix'" matches in middle of the file name, and + ;; in the directory portion. The calling completion function + ;; rejects any completions that don't start with `prefix'. + + (find-file-uniquify dir-names) + )) + )) + +(defun find-file-complete-global (filename) + "Prompt for completion of FILENAME in a Gnu global project." + (setq filename + (completing-read + "file: " ;; prompt + (completion-table-with-cache #'find-file-complete-global-table) ;; collection + nil ;; predicate + t ;; require match + filename + )) + + (when (string-match find-file-uniquify-regexp filename) + ;; Get partial dir from conflict + (setq filename (concat (match-string 2 filename) (match-string 1 filename)))) + + ;; If there are two files like: + ;; + ;; src/keyboard.c + ;; test/etags/c-src/emacs/src/keyboard.c + ;; + ;; and the user completes to the first, the following global call + ;; will return both. The desired result is always the shortest. + (with-current-buffer (cedet-gnu-global-call (list "--ignore-case" "-Pa" filename)) + (let ((paths (split-string (buffer-substring (point-min) (point-max)) "\n" t))) + (setq paths (sort paths (lambda (a b) (< (length a) (length b))))) + (car paths))) + + ) + (defun cedet-gnu-global-show-root () "Show the root of a GNU Global area under the current buffer." (interactive) @@ -193,6 +247,19 @@ If a database already exists, then just update it." ) )) +;;; project.el integration + +(defun project-try-global (dir) + (when (cedet-gnu-global-version-check t) + (let ((root (locate-dominating-file dir "GTAGS"))) + (when root + (list 'global root))))) + +(cl-defmethod project-find-file ((prj (head global)) filename) + (let ((default-directory (file-name-as-directory (nth 1 prj)))) + (find-file (find-file-complete-global filename)))) + + (provide 'cedet-global) ;;; cedet-global.el ends here diff --git a/lisp/files.el b/lisp/files.el index c309f86..ad4fb4b 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1691,6 +1691,85 @@ killed." ;; We already ran these; don't run them again. (let (kill-buffer-query-functions kill-buffer-hook) (kill-buffer obuf)))))) + +(defconst find-file-uniquify-regexp "^\\(.*\\)<\\(.*\\)>" + "Regexp matching uniqufied file name. +Match 1 is the filename, match 2 is the relative directory.") + +(defun find-file-uniquify-conflicts (conflicts) + "Subroutine of `find-file-uniquify'." + (let ((common-root ;; shared prefix of dirs in conflicts - may be nil + (fill-common-string-prefix (car (nth 0 conflicts)) (car (nth 1 conflicts))))) + + (let ((temp (cddr conflicts)) + dir-name) + (while (and common-root + temp) + (setq dir-name (pop temp)) + (setq common-root (fill-common-string-prefix common-root (car dir-name))))) + + (when common-root + ;; Trim `common-root' back to last '/' + (let ((i (1- (length common-root)))) + (while (and (> i 0) + (not (= (aref common-root i) ?/))) + (setq i (1- i))) + (setq common-root (substring common-root 0 (1+ i))))) + + (cl-mapcar + (lambda (dir-name) + (concat (cdr dir-name) + "<" (substring (car dir-name) (length common-root)) ">")) + conflicts) + )) + +(defun find-file-uniquify (dir-names) + "Return a flat list of names from DIR-NAMES with duplicate filenames extended by directories. +DIR-NAMES is a list of (dir . name)." + (let (result + conflicts ;; list of (dir . name) where all `name' are the same. + ) + + ;; Sort dir-names so duplicates are grouped together + (setq dir-names (sort dir-names (lambda (a b) + (string< (cdr a) (cdr b))))) + + (while dir-names + (setq conflicts (list (pop dir-names))) + (while (string= (cdr (car conflicts)) (cdr (car dir-names))) + (push (pop dir-names) conflicts)) + + (if (= 1 (length conflicts)) + (push (cdr (car conflicts)) result) + (setq result (append (find-file-uniquify-conflicts conflicts) result))) + ) + (nreverse result) + )) + +(defun find-file-path-completion-table (path predicate prefix) + "Do completion for file names in `find-file-project'." + (cond + ((string-match find-file-uniquify-regexp prefix) + ;; User has selected one match; return it. + (list prefix)) + + ;; FIXME: handle prefix = "Makefile" "file1.el" "file2.el" "file3.el"))) + + ;; only one completion (after user selects first of the above) + (should (equal (find-file-path-completion-table (list dir1 dir2) nil "file1.el") + '("file1.el"))) + )) + +(ert-deftest find-file-path-completion-table-predicate () + "Test completion when there are two files with the same name in +different directories on path, and a predicate." + (let* ((root (make-temp-file "find-file-path-test" t)) + (dir1 (concat root "/dir1")) + (dir2 (concat root "/dir2")) + (regexp (dired-glob-regexp "*.elc")) + (pred (lambda (name) (not (string-match regexp name))))) + + (mkdir dir1) + (mkdir dir2) + + (with-temp-file (concat dir1 "/file1.el") + (insert "dir1/file1.el")) + (with-temp-file (concat dir1 "/file1.elc") + (insert "dir1/file1.elc")) + (with-temp-file (concat dir1 "/file2.el") + (insert "dir1/file2.el")) + (with-temp-file (concat dir1 "/file2.elc") + (insert "dir1/file2.elc")) + + (with-temp-file (concat dir2 "/file1.el") + (insert "dir2/file1.el")) + (with-temp-file (concat dir2 "/file1.elc") + (insert "dir2/file1.elc")) + (with-temp-file (concat dir2 "/file3.el") + (insert "dir2/file3.el")) + (with-temp-file (concat dir2 "/file3.elc") + (insert "dir2/file3.elc")) + + ;; multiple completions, some with same name, predicate eliminates some + (should (equal (find-file-path-completion-table (list dir1 dir2) pred "fi") + '("file1.el" "file1.el" "file2.el" "file3.el"))) + + ;; only one completion (after user selects first of the above) + (should (equal (find-file-path-completion-table (list dir1 dir2) pred "file1.el") + '("file1.el"))) + )) ;; Stop the above "Local Var..." confusing Emacs.