sepia-cpan.el

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