From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Stephen Leake Newsgroups: gmane.emacs.devel Subject: find-file-project Date: Tue, 15 Sep 2015 15:23:57 -0500 Message-ID: <86pp1j4ejm.fsf@stephe-leake.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1442348692 27702 80.91.229.3 (15 Sep 2015 20:24:52 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 15 Sep 2015 20:24:52 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Sep 15 22:24:42 2015 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1ZbwmN-0007eA-SL for ged-emacs-devel@m.gmane.org; Tue, 15 Sep 2015 22:24:40 +0200 Original-Received: from localhost ([::1]:45769 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZbwmN-0003Io-1s for ged-emacs-devel@m.gmane.org; Tue, 15 Sep 2015 16:24:39 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:45883) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZbwmF-0003IG-Pm for emacs-devel@gnu.org; Tue, 15 Sep 2015 16:24:35 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ZbwmB-0001OA-EN for emacs-devel@gnu.org; Tue, 15 Sep 2015 16:24:31 -0400 Original-Received: from gproxy10-pub.mail.unifiedlayer.com ([69.89.20.226]:41650) by eggs.gnu.org with smtp (Exim 4.71) (envelope-from ) id 1ZbwmB-0001Ns-1u for emacs-devel@gnu.org; Tue, 15 Sep 2015 16:24:27 -0400 Original-Received: (qmail 30528 invoked by uid 0); 15 Sep 2015 20:24:21 -0000 Original-Received: from unknown (HELO cmgw4) (10.0.90.85) by gproxy10.mail.unifiedlayer.com with SMTP; 15 Sep 2015 20:24:21 -0000 Original-Received: from host114.hostmonster.com ([74.220.207.114]) by cmgw4 with id HYQG1r00W2UdiVW01YQKPk; Tue, 15 Sep 2015 14:24:21 -0600 X-Authority-Analysis: v=2.1 cv=QdD14Krv c=1 sm=1 tr=0 a=CQdxDb2CKd3SRg4I0/XZPQ==:117 a=CQdxDb2CKd3SRg4I0/XZPQ==:17 a=DsvgjBjRAAAA:8 a=f5113yIGAAAA:8 a=9i_RQKNPAAAA:8 a=hEr_IkYJT6EA:10 a=x_XPkuGwIRMA:10 a=ff-B7xzCdYMA:10 a=VyjxiUwDQzZikiVNqi0A:9 a=InNGobqYSJdzWzgpfBkA:9 a=bLFeGVFjiK6rhQw6:21 a=WxU6vXJkj8nfQ5D2:21 a=1T31WVv9Che2EhS9:21 Original-Received: from [76.218.37.33] (port=64400 helo=TAKVER2) by host114.hostmonster.com with esmtpa (Exim 4.84) (envelope-from ) id 1Zbwlz-0001eP-Hv for emacs-devel@gnu.org; Tue, 15 Sep 2015 14:24:16 -0600 User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.5 (windows-nt) X-Identified-User: {2442:host114.hostmonster.com:stephele:stephe-leake.org} {sentby:smtp auth 76.218.37.33 authed with stephen_leake@stephe-leake.org} X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 69.89.20.226 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:189988 Archived-At: --=-=-= Content-Type: text/plain Attached is a patch that implements find-file-project, with completion of file-name on the project search path. It handles duplicate filenames by uniquifying them witht trailing directory names. The patch also adds small projects for elisp and global, to show that this approach works for multiple backends. Comments? I can break this into smaller commits on master, if that seems like a good idea. I didn't add a NEWS entry. I don't think we are putting project related changes in NEWS yet, since it is all new in Emacs 25. But the file-name-all-completion change needs a NEWS entry. -- -- Stephe --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=find-file-project.diff 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}. -@defun 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 -@var{directory}. The order of the completions is the order of the files -in the directory, which is unpredictable and conveys no useful +@defun 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 +@var{partial-filename} 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. --=-=-=--