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