(require 'cl)
(require 'button)

(defvar sepia-cpan-actions
  '(("r" . sepia-cpan-readme)
    ("d" . sepia-cpan-doc)
    ("i" . sepia-cpan-install)
    ("q" . bury-buffer)))

;;;###autoload
(defun sepia-cpan-doc (mod)
  "Browse the online Perldoc for MOD."
  (interactive "sModule: ")
  (let ((buf
         (save-window-excursion
           (and
            (browse-url (concat "http://search.cpan.org/perldoc?" mod))
            (current-buffer)))))
    (when buf
      (pop-to-buffer buf))))

;;;###autoload
(defun sepia-cpan-readme (mod)
  "Display the README file for MOD."
  (interactive "sModule: ")
  (with-current-buffer (get-buffer-create "*sepia-cpan-readme*")
    (let ((inhibit-read-only t))
      (erase-buffer)
      (insert-file-contents
       (sepia-call "Sepia::CPAN::readme" 'scalar-context mod 1)))
    (view-mode 1)
    (pop-to-buffer (current-buffer))))

;;;###autoload
(defun sepia-cpan-install (mod)
  "Install MOD and its prerequisites."
  (interactive "sModule: ")
  (when (y-or-n-p (format "Install %s? " mod))
    (sepia-eval "require Sepia::CPAN")
    (sepia-call "Sepia::CPAN::install" 'void-context mod)))

(defun sepia-cpan-do-search (pattern)
  "Return a list modules whose names match PATTERN."
  (sepia-eval "require Sepia::CPAN")
  (sepia-call "Sepia::CPAN::list" 'list-context (format "/%s/" pattern)))

(defun sepia-cpan-do-desc (pattern)
  "Return a list modules whose descriptions match PATTERN."
  (sepia-eval "require Sepia::CPAN")
  (sepia-call "Sepia::CPAN::desc" 'list-context pattern))

(defun sepia-cpan-do-recommend (pattern)
  "Return a list modules whose descriptions match PATTERN."
  (sepia-eval "require Sepia::CPAN")
  (sepia-call "Sepia::CPAN::recommend" 'list-context pattern))

(defun sepia-cpan-do-list (pattern)
  "Return a list modules matching PATTERN."
  ;; (interactive "sPattern (regexp): ")
  (sepia-eval "require Sepia::CPAN")
  (sepia-call "Sepia::CPAN::ls" 'list-context (upcase pattern)))

(defvar sepia-cpan-button)

(defun sepia-cpan-button (button)
  (funcall (cdr (assoc sepia-cpan-button sepia-cpan-actions))
           (button-label button)))

(defun sepia-cpan-button-press ()
  (interactive)
  (let ((sepia-cpan-button (this-command-keys)))
    (push-button)))

(defvar sepia-cpan-mode-map
  (let ((km (make-sparse-keymap)))
    (set-keymap-parent km button-map)
    ;; (define-key km "q" 'bury-buffer)
    (define-key km "/" 'sepia-cpan-desc)
    (define-key km "S" 'sepia-cpan-desc)
    (define-key km "s" 'sepia-cpan-search)
    (define-key km "l" 'sepia-cpan-list)
    (define-key km "R" 'sepia-cpan-recommend)
    (define-key km " " 'scroll-up)
    (define-key km (kbd "DEL") 'scroll-down)
    (dolist (k (mapcar #'car sepia-cpan-actions))
      (define-key km k 'sepia-cpan-button-press))
    km))

(define-button-type 'sepia-cpan
  'follow-link nil
  'action 'sepia-cpan-button
  'help-echo "[r]eadme, [d]ocumentation, [i]nstall"
  'keymap sepia-cpan-mode-map)

(define-derived-mode sepia-cpan-mode fundamental-mode "CPAN"
  "Major mode for CPAN browsing."
  (setq buffer-read-only t
        truncate-lines t))

(defun string-repeat (s n)
  "Repeat S N times."
  (let ((ret ""))
    (dotimes (i n)
      (setq ret (concat ret s)))
    ret))

(defun sepia-cpan-make-buffer (title mods fields names)
  (switch-to-buffer "*sepia-cpan*")
  (sepia-cpan-mode)
  (setq buffer-read-only nil)
  (let ((inhibit-read-only t))
    (erase-buffer))
  (remove-overlays)
  (insert title "
    [r]eadme, [d]ocumentation, [i]nstall, [q]uit,
    [s]earch-by-name, [/][S]earch-by-description, [l]ist-for-author

")
  (when (consp mods)
    (let (lengths)
      (dolist (mod mods)
        (setcdr (assoc "cpan_file" mod)
                (replace-regexp-in-string "^.*/" ""
                                          (cdr (assoc "cpan_file" mod)))))
      (setq
       lengths
       (mapcar* #'max
                (mapcar (lambda (x) (+ 2 (length x))) names)
                (mapcar
                 (lambda (f)
                   (+ 2 (apply #'max
                               (mapcar
                                (lambda (x)
                                  (length (format "%s" (cdr (assoc f x)))))
                                mods))))
                 fields)))
          
      (setq fmt
            (concat (mapconcat (lambda (x) (format "%%-%ds" x)) lengths "")
                    "\n"))
      (insert (apply 'format fmt names))
      (insert (apply 'format fmt
                     (mapcar (lambda (x) (string-repeat "-" (length x))) names)))
      (dolist (mod mods)
        (let ((beg (point)))
          (insert
           (apply #'format fmt
                  (mapcar (lambda (x) (or (cdr (assoc x mod)) "-")) fields)))
          (make-button beg (+ beg (length (cdr (assoc "id" mod))))
                       :type 'sepia-cpan)))))
  (goto-char (point-min)))

;;;###autoload
(defun sepia-cpan-list (name)
  "List modules by author NAME."
  (interactive  "sAuthor: ")
  (sepia-cpan-make-buffer
   (concat "CPAN modules by " name)
   (sepia-cpan-do-list name)
   '("id" "inst_version" "cpan_version" "cpan_file")
   '("Module" "Inst." "CPAN" "Distribution")))

;;;###autoload
(defun sepia-cpan-search (pat)
  "List modules whose names match PAT."
  (interactive  "sPattern (regexp): ")
  (setq pat (if (string= pat "") "." pat))
  (sepia-cpan-make-buffer
   (concat "CPAN modules matching /" pat "/")
   (sepia-cpan-do-search pat)
   '("id" "fullname" "inst_version" "cpan_version" "cpan_file")
   '("Module" "Author" "Inst." "CPAN" "Distribution")))

;;;###autoload
(defun sepia-cpan-desc (pat)
  "List modules whose descriptions match PAT."
  (interactive  "sPattern (regexp): ")
  (sepia-cpan-make-buffer
   (concat "CPAN modules with descriptions matching /" pat "/")
   (sepia-cpan-do-desc pat)
   '("id" "fullname" "inst_version" "cpan_version" "cpan_file")
   '("Module" "Author" "Inst." "CPAN" "Distribution")))

;;;###autoload
(defun sepia-cpan-recommend (pat)
  "List out-of-date modules."
  (interactive  "sPattern (regexp): ")
  (setq pat (if (string= pat "") "." pat))
  (sepia-cpan-make-buffer
   (concat "Out-of-date CPAN modules matching /" pat "/")
   (sepia-cpan-do-recommend pat)
   '("id" "fullname" "inst_version" "cpan_version" "cpan_file")
   '("Module" "Author" "Inst." "CPAN" "Distribution")))

(provide 'sepia-cpan)