Function: project--read-file-cpd-relative

project--read-file-cpd-relative is a byte-compiled function defined in project.el.gz.

Signature

(project--read-file-cpd-relative PROMPT ALL-FILES &optional PREDICATE HIST MB-DEFAULT)

Documentation

Read a file name, prompting with PROMPT.

ALL-FILES is a list of possible file name completions.

PREDICATE and HIST have the same meaning as in completing-read.

MB-DEFAULT is used as part of "future history", to be inserted by the user at will.

Source Code

;; Defined in /usr/src/emacs/lisp/progmodes/project.el.gz
(defun project--read-file-cpd-relative (prompt
                                        all-files &optional predicate
                                        hist mb-default)
  "Read a file name, prompting with PROMPT.
ALL-FILES is a list of possible file name completions.

PREDICATE and HIST have the same meaning as in `completing-read'.

MB-DEFAULT is used as part of \"future history\", to be inserted
by the user at will."
  (let* ((common-parent-directory
          (let ((common-prefix (try-completion "" all-files)))
            (if (> (length common-prefix) 0)
                (file-name-directory common-prefix))))
         (cpd-length (length common-parent-directory))
         (common-parent-directory (if (file-name-absolute-p (car all-files))
                                      common-parent-directory
                                    (concat default-directory common-parent-directory)))
         (prompt (if (and (zerop cpd-length)
                          all-files
                          (file-name-absolute-p (car all-files)))
                     prompt
                   (concat prompt (format " in %s" common-parent-directory))))
         (included-cpd (when (member common-parent-directory all-files)
                         (setq all-files
                               (delete common-parent-directory all-files))
                         t))
         (mb-default (mapcar (lambda (mb-default)
                               (if (and common-parent-directory
                                        mb-default
                                        (file-name-absolute-p mb-default))
                                   (file-relative-name
                                    mb-default common-parent-directory)
                                 mb-default))
                             (if (listp mb-default) mb-default (list mb-default))))
         (substrings (mapcar (lambda (s) (substring s cpd-length)) all-files))
         (_ (when included-cpd
              (setq substrings (cons "./" substrings))))
         (new-collection (project--file-completion-table substrings))
         (abs-cpd (expand-file-name common-parent-directory))
         (abs-cpd-length (length abs-cpd))
         (relname (cl-letf* ((non-essential t) ;Avoid new Tramp connections.
                             ((symbol-value hist)
                              (mapcan
                               (lambda (s)
                                 (setq s (expand-file-name s))
                                 (and (string-prefix-p abs-cpd s)
                                      (not (eq abs-cpd-length (length s)))
                                      (list (substring s abs-cpd-length))))
                               (symbol-value hist))))
                    (project--completing-read-strict prompt
                                                     new-collection
                                                     predicate
                                                     hist mb-default)))
         (absname (expand-file-name relname common-parent-directory)))
    absname))