sepia-cpan.el

   1 (require 'cl)
   2 (require 'button)
   3
   4 (defvar sepia-cpan-actions
   5   '(("r" . sepia-cpan-readme)
   6     ("d" . sepia-cpan-doc)
   7     ("i" . sepia-cpan-install)
   8     ("q" . bury-buffer)))
   9
  10 ;;;###autoload
  11 (defun sepia-cpan-doc (mod)
  12   "Browse the online Perldoc for MOD."
  13   (interactive "sModule: ")
  14   (let ((buf
  15          (save-window-excursion
  16            (and
  17             (browse-url (concat "http://search.cpan.org/perldoc?" mod))
  18             (current-buffer)))))
  19     (when buf
  20       (pop-to-buffer buf))))
  21
  22 ;;;###autoload
  23 (defun sepia-cpan-readme (mod)
  24   "Display the README file for MOD."
  25   (interactive "sModule: ")
  26   (with-current-buffer (get-buffer-create "*sepia-cpan-readme*")
  27     (let ((inhibit-read-only t))
  28       (erase-buffer)
  29       (insert-file-contents
  30        (sepia-call "Sepia::CPAN::readme" 'scalar-context mod 1)))
  31     (view-mode 1)
  32     (pop-to-buffer (current-buffer))))
  33
  34 ;;;###autoload
  35 (defun sepia-cpan-install (mod)
  36   "Install MOD and its prerequisites."
  37   (interactive "sModule: ")
  38   (when (y-or-n-p (format "Install %s? " mod))
  39     (sepia-eval "require Sepia::CPAN")
  40     (sepia-call "Sepia::CPAN::install" 'void-context mod)))
  41
  42 (defun sepia-cpan-do-search (pattern)
  43   "Return a list modules whose names match PATTERN."
  44   (sepia-eval "require Sepia::CPAN")
  45   (sepia-call "Sepia::CPAN::list" 'list-context (format "/%s/" pattern)))
  46
  47 (defun sepia-cpan-do-desc (pattern)
  48   "Return a list modules whose descriptions match PATTERN."
  49   (sepia-eval "require Sepia::CPAN")
  50   (sepia-call "Sepia::CPAN::desc" 'list-context pattern))
  51
  52 (defun sepia-cpan-do-recommend (pattern)
  53   "Return a list modules whose descriptions match PATTERN."
  54   (sepia-eval "require Sepia::CPAN")
  55   (sepia-call "Sepia::CPAN::recommend" 'list-context pattern))
  56
  57 (defun sepia-cpan-do-list (pattern)
  58   "Return a list modules matching PATTERN."
  59   ;; (interactive "sPattern (regexp): ")
  60   (sepia-eval "require Sepia::CPAN")
  61   (sepia-call "Sepia::CPAN::ls" 'list-context (upcase pattern)))
  62
  63 (defvar sepia-cpan-button)
  64
  65 (defun sepia-cpan-button (button)
  66   (funcall (cdr (assoc sepia-cpan-button sepia-cpan-actions))
  67            (button-label button)))
  68
  69 (defun sepia-cpan-button-press ()
  70   (interactive)
  71   (let ((sepia-cpan-button (this-command-keys)))
  72     (push-button)))
  73
  74 (defvar sepia-cpan-mode-map
  75   (let ((km (make-sparse-keymap)))
  76     (set-keymap-parent km button-map)
  77     ;; (define-key km "q" 'bury-buffer)
  78     (define-key km "/" 'sepia-cpan-desc)
  79     (define-key km "S" 'sepia-cpan-desc)
  80     (define-key km "s" 'sepia-cpan-search)
  81     (define-key km "l" 'sepia-cpan-list)
  82     (define-key km "R" 'sepia-cpan-recommend)
  83     (define-key km " " 'scroll-up)
  84     (define-key km (kbd "DEL") 'scroll-down)
  85     (dolist (k (mapcar #'car sepia-cpan-actions))
  86       (define-key km k 'sepia-cpan-button-press))
  87     km))
  88
  89 (define-button-type 'sepia-cpan
  90   'follow-link nil
  91   'action 'sepia-cpan-button
  92   'help-echo "[r]eadme, [d]ocumentation, [i]nstall"
  93   'keymap sepia-cpan-mode-map)
  94
  95 (define-derived-mode sepia-cpan-mode fundamental-mode "CPAN"
  96   "Major mode for CPAN browsing."
  97   (setq buffer-read-only t
  98         truncate-lines t))
  99
 100 (defun string-repeat (s n)
 101   "Repeat S N times."
 102   (let ((ret ""))
 103     (dotimes (i n)
 104       (setq ret (concat ret s)))
 105     ret))
 106
 107 (defun sepia-cpan-make-buffer (title mods fields names)
 108   (switch-to-buffer "*sepia-cpan*")
 109   (sepia-cpan-mode)
 110   (setq buffer-read-only nil)
 111   (let ((inhibit-read-only t))
 112     (erase-buffer))
 113   (remove-overlays)
 114   (insert title "
 115     [r]eadme, [d]ocumentation, [i]nstall, [q]uit,
 116     [s]earch-by-name, [/][S]earch-by-description, [l]ist-for-author
 117
 118 ")
 119   (when (consp mods)
 120     (let (lengths)
 121       (dolist (mod mods)
 122         (setcdr (assoc "cpan_file" mod)
 123                 (replace-regexp-in-string "^.*/" ""
 124                                           (cdr (assoc "cpan_file" mod)))))
 125       (setq
 126        lengths
 127        (mapcar* #'max
 128                 (mapcar (lambda (x) (+ 2 (length x))) names)
 129                 (mapcar
 130                  (lambda (f)
 131                    (+ 2 (apply #'max
 132                                (mapcar
 133                                 (lambda (x)
 134                                   (length (format "%s" (cdr (assoc f x)))))
 135                                 mods))))
 136                  fields)))
 137
 138       (setq fmt
 139             (concat (mapconcat (lambda (x) (format "%%-%ds" x)) lengths "")
 140                     "\n"))
 141       (insert (apply 'format fmt names))
 142       (insert (apply 'format fmt
 143                      (mapcar (lambda (x) (string-repeat "-" (length x))) names)))
 144       (dolist (mod mods)
 145         (let ((beg (point)))
 146           (insert
 147            (apply #'format fmt
 148                   (mapcar (lambda (x) (or (cdr (assoc x mod)) "-")) fields)))
 149           (make-button beg (+ beg (length (cdr (assoc "id" mod))))
 150                        :type 'sepia-cpan)))))
 151   (goto-char (point-min)))
 152
 153 ;;;###autoload
 154 (defun sepia-cpan-list (name)
 155   "List modules by author NAME."
 156   (interactive  "sAuthor: ")
 157   (sepia-cpan-make-buffer
 158    (concat "CPAN modules by " name)
 159    (sepia-cpan-do-list name)
 160    '("id" "inst_version" "cpan_version" "cpan_file")
 161    '("Module" "Inst." "CPAN" "Distribution")))
 162
 163 ;;;###autoload
 164 (defun sepia-cpan-search (pat)
 165   "List modules whose names match PAT."
 166   (interactive  "sPattern (regexp): ")
 167   (setq pat (if (string= pat "") "." pat))
 168   (sepia-cpan-make-buffer
 169    (concat "CPAN modules matching /" pat "/")
 170    (sepia-cpan-do-search pat)
 171    '("id" "fullname" "inst_version" "cpan_version" "cpan_file")
 172    '("Module" "Author" "Inst." "CPAN" "Distribution")))
 173
 174 ;;;###autoload
 175 (defun sepia-cpan-desc (pat)
 176   "List modules whose descriptions match PAT."
 177   (interactive  "sPattern (regexp): ")
 178   (sepia-cpan-make-buffer
 179    (concat "CPAN modules with descriptions matching /" pat "/")
 180    (sepia-cpan-do-desc pat)
 181    '("id" "fullname" "inst_version" "cpan_version" "cpan_file")
 182    '("Module" "Author" "Inst." "CPAN" "Distribution")))
 183
 184 ;;;###autoload
 185 (defun sepia-cpan-recommend (pat)
 186   "List out-of-date modules."
 187   (interactive  "sPattern (regexp): ")
 188   (setq pat (if (string= pat "") "." pat))
 189   (sepia-cpan-make-buffer
 190    (concat "Out-of-date CPAN modules matching /" pat "/")
 191    (sepia-cpan-do-recommend pat)
 192    '("id" "fullname" "inst_version" "cpan_version" "cpan_file")
 193    '("Module" "Author" "Inst." "CPAN" "Distribution")))
 194
 195 (provide 'sepia-cpan)