sepia-cpan.el

   1 (require 'button)
   2
   3 (define-button-type 'sepia-cpan
   4   'follow-link nil
   5   'action 'sepia-cpan-button
   6   'help-echo "[r]eadme, [d]ocumentation, [i]nstall, [b]rowse"
   7   'keymap sepia-cpan-mode-map)
   8
   9 (defvar sepia-cpan-actions
  10   '(("r" . sepia-cpan-readme)
  11     ("d" . sepia-cpan-doc)
  12     ("i" . sepia-cpan-install)
  13     ("b" . sepia-cpan-browse)
  14     ("?" . sepia-cpan-readme)))
  15
  16 (defun sepia-cpan-doc (mod)
  17   "Browse the online Perldoc for MOD."
  18   (interactive "sModule: ")
  19   (browse-url (concat "http://search.cpan.org/perldoc?" mod)))
  20
  21 (defun sepia-cpan-readme (mod)
  22   "Display the README file for MOD."
  23   (interactive "sModule: ")
  24   (with-current-buffer (get-buffer-create "*sepia-cpan-readme*")
  25     (insert (sepia-call "Sepia::CPAN::readme" 'list-context mod))
  26     (pop-to-buffer (current-buffer))))
  27
  28 (defun sepia-cpan-install (mod)
  29   "Install MOD and its prerequisites."
  30   (interactive "sModule: ")
  31   (when (y-or-n-p (format "Install %s? " mod))
  32     (sepia-call "Sepia::CPAN::install" 'void-context mod)))
  33
  34 (defun sepia-cpan-list (pattern)
  35   "Return a list modules matching PATTERN."
  36   ;; (interactive "sPattern (regexp): ")
  37   (sepia-eval (format "map { Sepia::CPAN::interesting_parts $_ } Sepia::CPAN::list('/%s/')" pattern)
  38               'list-context))
  39
  40 (defun sepia-cpan-button (button)
  41   (funcall (cdr (assoc sepia-cpan-button sepia-cpan-actions))
  42            (button-label button)))
  43
  44 (defvar sepia-cpan-button)
  45
  46 (defun sepia-cpan-button-press ()
  47   (interactive)
  48   (let ((sepia-cpan-button (this-command-keys)))
  49     (push-button)))
  50
  51 (defvar sepia-cpan-mode-map
  52   (let ((km (make-sparse-keymap)))
  53     (set-keymap-parent km button-map)
  54     ;; (define-key km "q" 'bury-buffer)
  55     (define-key km "/" 'sepia-cpan-search)
  56     (define-key km "s" 'sepia-cpan-search)
  57     (dolist (k (mapcar #'car sepia-cpan-actions))
  58       (define-key km k 'sepia-cpan-button-press))
  59     km))
  60
  61 (define-derived-mode sepia-cpan-mode view-mode "CPAN"
  62   "Major mode for CPAN browsing.")
  63
  64 (defun sepia-cpan-search (pat)
  65   (interactive  "sPattern (regexp): ")
  66   (switch-to-buffer "*sepia-cpan*")
  67   (sepia-cpan-mode)
  68   (setq buffer-read-only nil)
  69   (let ((inhibit-read-only t))
  70     (erase-buffer))
  71   (remove-overlays)
  72   (insert (format "\
  73 CPAN modules matching /%s/
  74     [r]eadme, [d]ocumentation, [i]nstall, [b]rowse
  75
  76 " pat))
  77   (let ((mods (sepia-cpan-list pat))
  78         (fields
  79          '("id" "fullname" "inst_version" "cpan_version" "cpan_file"))
  80         lengths fmt)
  81     (when mods
  82       (dolist (mod mods)
  83         (setcdr (assoc "cpan_file" mod)
  84                 (replace-regexp-in-string "^.*/" ""
  85                                           (cdr (assoc "cpan_file" mod)))))
  86       (setq lengths
  87             (mapcar
  88              (lambda (f)
  89                (+ 2 (apply #'max (mapcar
  90                                   (lambda (x)
  91                                     (length (format "%s" (cdr (assoc f x)))))
  92                                   mods))))
  93              fields))
  94       (setq fmt
  95             (concat (mapconcat (lambda (x) (format "%%-%ds" x)) lengths "")
  96                     "\n"))
  97       (insert (format fmt "Module" "Author" "Inst." "CPAN" "Distribution"))
  98       (dolist (mod mods)
  99         (let ((beg (point)))
 100           (insert
 101            (apply #'format fmt
 102                   (mapcar (lambda (x) (cdr (assoc x mod))) fields)))
 103           (make-button beg (+ beg (length (cdr (assoc "id" mod))))
 104                        :type 'sepia-cpan)))))
 105   (setq buffer-read-only t
 106         truncate-lines t))
 107
 108 (provide 'sepia-cpan)