bth/um-mode
Watch
1
Fork
You've already forked um-mode
 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

embark-dwim ffap recurse into current project : manually call find -type d

Browse source
This commit is contained in:
bth 2024-08-21 16:30:48 -07:00
commit b5caec4543
1 changed files with 25 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

46
elisp/um.el
View file

@ -107,22 +107,22 @@
;; `embark-target-finders', since I'd have to remove the file finder and put my ;; `embark-target-finders', since I'd have to remove the file finder and put my
;; function in the same place in the list anyway. ;; function in the same place in the list anyway.
(defalias 'project-find-file-future-enter (kmacro "C-x p f M-n RET")) ;; HACK: taken from project-find-file-in and project--files-in-directory.
(defun find-directories-only (dir)
(let* ((default-directory dir)
(vc-dirs-ignores (mapcar
(lambda (d)
(concat d "/"))
vc-directory-exclusion-list))
(command (format "%s -H . $s -type d"
find-program
(xref--find-ignores-arguments vc-dirs-ignores "./")
))
(outstr (shell-command-to-string command)))
(defun find-file-in-project (&optional dir) (mapcar (lambda (path)
;; (interactive) (expand-file-name path dir)) (split-string outstr "\n"))
(when-let* ((project (project-current nil dir)) ))
(default-directory (project-root project)))
(project-find-file-in nil nil project)))
(defun project-search-nointeractive ()
(fileloop-initialize-search
(thing-at-point 'filename t)
;; XXX: See the comment in project-query-replace-regexp.
(cl-delete-if-not #'file-regular-p (project-files (project-current)))
'default)
(fileloop-continue)
)
;;;###autoload ;;;###autoload
(defun um-file-at-point-advice (origfunc) (defun um-file-at-point-advice (origfunc)
@ -139,18 +139,20 @@ TODO: Use a special directory name for potentials/ or the like, in case it's not
in the root dir. in the root dir.
" "
(or (or
;; current project ;; current project
(funcall origfunc) (funcall origfunc)
;; TODO: Trying to recurse down into current project directories. ;; NOTE: Recurse down into current project directories.
;; project-find-file does it fine, just don't want interactive ;; project-find-file does it fine, just don't want interactive
;; completing-read call. ;; completing-read call.
(let ((result) (start-dir (project-root (project-current))))
;; none of these work: (cl-loop for path in
;; (find-file-in-project) (find-directories-only start-dir)
;; (project-search-nointeractive) do (let ((default-directory path))
;; (project-find-file-future-enter) (setq result (funcall origfunc)))
if result
return result
))
;; all other projects ;; all other projects
(let ((result)) (let ((result))