(eval-when-compile
  (require 'ido)
  (require 'cl))

(defun* sepia-icompleting-recursive-read (prompt dir &key
                                                 list-fn
                                                 parent-fn
                                                 chdir-fn
                                                 rootp-fn
                                                 slashp-fn)
"Like `ido-read-file-name', but without all the file-specific
bells-and-whistles.  Arguments are:
    list-fn           list current dir
    parent-fn         get parent dir
    chdir-fn          change to dir
    rootp-fn          is dir root?
    slashp-fn         does dir end in slash?
"
  (flet ((ido-make-file-list (prefix)
           (setq ido-temp-list (funcall list-fn (or prefix ""))))
         (ido-exhibit () (sepia-ido-exhibit))
         (ido-is-root-directory (&optional dir)
           (funcall rootp-fn (or dir ido-current-directory)))
         (ido-set-current-directory (dir &optional subdir foo)
           (funcall chdir-fn dir subdir foo))
         (ido-final-slash (str &rest blah)
           (funcall slashp-fn str))
         (ido-file-name-directory (x)
           (funcall parent-fn x))
         ;; And stub out these two suckers...
         (ido-is-tramp-root (&rest blah) nil)
         (ido-nonreadable-directory-p (dir) nil))
    (setq ido-current-directory dir)
    (let ((ido-saved-vc-hb nil)
          (ido-directory-nonreadable nil)
          (ido-context-switch-command 'ignore)
          (ido-directory-too-big nil))
      (sepia-ido-read-internal 'file prompt nil nil t))))

(defun sepia-rootp-fn (dir)
  (member dir '("" "::")))

(defun sepia-chdir-fn (dir sub blah)
  (setq dir
        (cond
          (sub (concat dir (car ido-matches)))
          ((member dir (list ido-current-directory "::")) dir)
          ((string-match (concat "^" dir) ido-current-directory)
           dir)
          (t (concat ido-current-directory (car ido-matches)))))
  ;; XXX what's that doing?!?
  ;; (unless ido-matches
  ;;   (error "help! dir = %s" dir))
  ;; (setq dir (concat ido-current-directory (car ido-matches)))
  (if (string-equal ido-current-directory dir)
      nil
      ;; XXX: concat?
      (setq ido-current-directory (ido-final-slash dir))
      (when (get-buffer ido-completion-buffer)
        (kill-buffer ido-completion-buffer))
      t))

(defun sepia-list-fn (str)
  (let ((listing-dir ido-current-directory))
    (when (or (not ido-current-directory)
              (string-match "^\\(?:::\\)?$" ido-current-directory))
      (setq ido-current-directory ""
            listing-dir "::"))
    (mapcar (lambda (x)
              (substring x (length listing-dir)))
            (xref-apropos (concat listing-dir str ".*") t "CODE" "STASH"))))

(defun sepia-dir-fn (str)
  (if (string-match "^\\(.*::\\)[^:]+:*$" str)
      (match-string 1 str)
      ""))

(defun sepia-slashp-fn (str)
  (cond
    ((string-match "::$" str) str)
    ((string-match ":$" str) (concat str ":"))
    (t nil)))

(defun sepia-jump-to-symbol ()
"Jump to a symbol's definition using ido-like completion."
  (interactive)
  (let ((pack (concat (sepia-buffer-package) "::"))
        ido-case-fold)
    (sepia-location
     (sepia-icompleting-recursive-read "Jump to: " pack
                                       :list-fn 'sepia-list-fn
                                       :parent-fn 'sepia-dir-fn
                                       :chdir-fn 'sepia-chdir-fn
                                       :rootp-fn 'sepia-rootp-fn
                                       :slashp-fn 'sepia-slashp-fn)
     t)))

(defun sepia-ido-exhibit ()
  "Post command hook for `sepia-icompleting-recursive-read'.
Like `ido-exhibit', but without weird file-specific bells and
whistles.  Since ido is controlled through a bunch of dynamic
variables, it's hard to figure out what can be safely cut."

  (when (= ido-use-mycompletion-depth (minibuffer-depth))
    (let ((contents (buffer-substring-no-properties (minibuffer-prompt-end)
                                                    (point-max)))
	  (buffer-undo-list t)
	  try-single-dir-match)

      (save-excursion
	(goto-char (point-max))
	;; Register the end of input, so we know where the extra stuff
	;; (match-status info) begins:
	(unless (boundp 'ido-eoinput)
	  ;; In case it got wiped out by major mode business:
	  (make-local-variable 'ido-eoinput))
	(setq ido-eoinput (point))

	;; Handle explicit directory changes
	(when (ido-final-slash contents)
          (ido-set-current-directory contents)
	  (setq ido-exit 'refresh)
	  (exit-minibuffer)
          (setq ido-text-init ""))

	;; Update the list of matches
	(setq ido-text contents)
	(ido-set-matches)

        ;; Enter something ending in a "slash"
	(when (and ido-matches
		   (null (cdr ido-matches))
		   (ido-final-slash (car ido-matches))
		   try-single-dir-match)
	  (ido-set-current-directory
	   (concat ido-current-directory (car ido-matches)))
	  (setq ido-exit 'refresh)
	  (exit-minibuffer))

	(setq ido-rescan t)

	(ido-set-common-completion)
	(let ((inf (ido-completions
		    contents
		    minibuffer-completion-table
		    minibuffer-completion-predicate
		    (not minibuffer-completion-confirm))))
	  (insert inf))))))


(defun sepia-ido-complete ()
  "Try to complete the current pattern amongst the file names."
  (interactive)
  (let (res)
    (cond

      ((not ido-matches)
       (when ido-completion-buffer
         (call-interactively (setq this-command ido-cannot-complete-command))))

      ((= 1 (length ido-matches))
       ;; only one choice, so select it.
       (if (not ido-confirm-unique-completion)
           (exit-minibuffer)
           (setq ido-rescan (not ido-enable-prefix))
           (delete-region (minibuffer-prompt-end) (point))
           (insert (car ido-matches))))

      (t ;; else there could be some completions
       (setq res ido-common-match-string)
       (if (and (not (memq res '(t nil)))
                (not (equal res ido-text)))
           ;; found something to complete, so put it in the minibuffer.
           (progn
             ;; move exact match to front if not in prefix mode
             (setq ido-rescan (not ido-enable-prefix))
             (delete-region (minibuffer-prompt-end) (point))
             (insert res))
           ;; else nothing to complete
           (call-interactively
            (setq this-command ido-cannot-complete-command)))))))

(defun sepia-ido-read-internal (item prompt history &optional
                                default require-match initial)
  "Perform the ido-read-buffer and ido-read-file-name functions.
Return the name of a buffer or file selected.
PROMPT is the prompt to give to the user.
DEFAULT if given is the default directory to start with.
If REQUIRE-MATCH is non-nil, an existing file must be selected.
If INITIAL is non-nil, it specifies the initial input string."
  (let
      ((ido-cur-item item)
       (ido-entry-buffer (current-buffer))
       (ido-process-ignore-lists t)
       (ido-process-ignore-lists-inhibit nil)
       (ido-set-default-item t)
       ido-default-item
       ido-selected
       ido-final-text
       (done nil)
       (icomplete-mode nil) ;; prevent icomplete starting up
       ;; Exported dynamic variables:
       ido-cur-list
       ido-ignored-list
       (ido-rotate-temp nil)
       (ido-keep-item-list nil)
       (ido-use-merged-list nil)
       (ido-try-merged-list t)
       (ido-pre-merge-state nil)
       (ido-case-fold ido-case-fold)
       (ido-enable-prefix ido-enable-prefix)
       (ido-enable-regexp ido-enable-regexp)
       )

    ;; (ido-define-mode-map)
    (ido-setup-completion-map)
    (setq ido-text-init initial)
    (while (not done)
      (ido-trace "\n_LOOP_" ido-text-init)
      (setq ido-exit nil)
      (setq ido-rescan t)
      (setq ido-rotate nil)
      (setq ido-text "")
      ;; XXX: set ido-default-item?

      (if ido-keep-item-list
	(setq ido-keep-item-list nil
	      ido-rescan nil)
	(setq ido-ignored-list nil
	      ido-cur-list (ido-make-file-list ido-default-item)))

      (setq ido-rotate-temp nil)

      (ido-set-matches)
      (if (and ido-matches (eq ido-try-merged-list 'auto))
	  (setq ido-try-merged-list t))
      (let
	  ((minibuffer-local-completion-map ido-completion-map)
	   (max-mini-window-height (or ido-max-window-height
				       (and (boundp 'max-mini-window-height)
                                            max-mini-window-height)))
	   (ido-completing-read t)
	   (ido-require-match require-match)
	   (ido-use-mycompletion-depth (1+ (minibuffer-depth)))
	   (show-paren-mode nil))
	;; prompt the user for the file name
	(setq ido-exit nil)
	(setq ido-final-text
	      (catch 'ido
		(completing-read
		 (ido-make-prompt item prompt)
		 '(("dummy" . 1)) nil nil ; table predicate require-match
		 (prog1 ido-text-init (setq ido-text-init nil))	;initial-contents
		 history))))

      (if (get-buffer ido-completion-buffer)
	  (kill-buffer ido-completion-buffer))

      (cond
       ((eq ido-exit 'refresh)
	(if (and (eq ido-use-merged-list 'auto)
		 (or (input-pending-p)))
	    (setq ido-use-merged-list nil
		  ido-keep-item-list t))
	nil)

       ((eq ido-exit 'done)
	(setq done t
	      ido-selected ido-text
	      ido-exit nil)

        (setq ido-text-init (read-string (concat prompt "[EDIT] ")
                                         ido-final-text)))

       ((eq ido-exit 'keep)
	(setq ido-keep-item-list t))

       ((memq ido-exit '(dired fallback findfile findbuffer))
	(setq done t))

       ((eq ido-exit 'updir)
	;; cannot go up if already at the root-dir (Unix) or at the
	;; root-dir of a certain drive (Windows or MS-DOS).
        (unless (ido-is-root-directory)
          (ido-set-current-directory (ido-file-name-directory
                                      (substring ido-current-directory 0 -2)))
          (setq ido-set-default-item t)))

       ;; Handling the require-match must be done in a better way.
       ((and require-match (not (ido-existing-item-p)))
	(error "must specify valid item"))

       (t
	(setq ido-selected
	      (if (or (eq ido-exit 'takeprompt)
		      (null ido-matches))
		  ido-final-text
		;; else take head of list
		(ido-name (car ido-matches))))

	(cond

	 ((ido-final-slash ido-selected)
	  (ido-set-current-directory ido-current-directory ido-selected)
	  (setq ido-set-default-item t))

	 (t
	  (setq done t))))))
    ido-selected))

(provide 'sepia-ido)