Function: uniquify-get-proposed-name

uniquify-get-proposed-name is a byte-compiled function defined in uniquify.el.gz.

Signature

(uniquify-get-proposed-name BASE DIRNAME &optional DEPTH)

Source Code

;; Defined in /usr/src/emacs/lisp/uniquify.el.gz
(defun uniquify-get-proposed-name (base dirname &optional depth)
  (unless depth (setq depth uniquify-min-dir-content))
  (cl-assert (equal (directory-file-name dirname) dirname)) ;No trailing slash.

  (let ((extra-string nil)
	(n depth))
    (while (and (> n 0) dirname)
      (let ((file (file-name-nondirectory dirname)))
	(when (setq dirname (file-name-directory dirname))
	  (setq dirname (directory-file-name dirname)))
	(setq n (1- n))
	(push (if (zerop (length file)) ;nil or "".
		  (prog1 (or (file-remote-p dirname) "")
		    (setq dirname nil)) ;Could be `dirname' iso "".
		file)
	      extra-string)))
    (when (zerop n)
      (if (and dirname extra-string
	       (equal dirname (file-name-directory dirname)))
	  ;; We're just before the root.  Let's add the leading / already.
	  ;; With "/a/b"+"/c/d/b" this leads to "/a/b" and "d/b" but with
	  ;; "/a/b"+"/c/a/b" this leads to "/a/b" and "a/b".
	  (push "" extra-string))
      (setq uniquify-possibly-resolvable t))

    (cond
     ((null extra-string) base)
     ((string-equal base "") ;Happens for dired buffers on the root directory.
      (mapconcat #'identity extra-string "/"))
     ((eq uniquify-buffer-name-style 'reverse)
      (mapconcat #'identity
		 (cons base (nreverse extra-string))
		 (or uniquify-separator "\\")))
     ((eq uniquify-buffer-name-style 'forward)
      (mapconcat #'identity (nconc extra-string (list base))
		 "/"))
     ((eq uniquify-buffer-name-style 'post-forward)
      (concat base (or uniquify-separator "|")
	      (mapconcat #'identity extra-string "/")))
     ((eq uniquify-buffer-name-style 'post-forward-angle-brackets)
      (concat base "<" (mapconcat #'identity extra-string "/")
	      ">"))
     ((functionp uniquify-buffer-name-style)
      (funcall uniquify-buffer-name-style base extra-string))
     (t (error "Bad value for uniquify-buffer-name-style: %s"
	       uniquify-buffer-name-style)))))