Delay loading some rarely-used stuff. Startup is already fast, but
[sepia.git] / sepia-cpan.el
blob0cfc20bcf23b7d3333815702b6242a838acf45d2
1 (require 'cl)
2 (require 'button)
4 (defvar sepia-cpan-actions
5 '(("r" . sepia-cpan-readme)
6 ("d" . sepia-cpan-doc)
7 ("i" . sepia-cpan-install)
8 ("q" . bury-buffer)))
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))))
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))))
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)))
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)))
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))
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))
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)))
63 (defvar sepia-cpan-button)
65 (defun sepia-cpan-button (button)
66 (funcall (cdr (assoc sepia-cpan-button sepia-cpan-actions))
67 (button-label button)))
69 (defun sepia-cpan-button-press ()
70 (interactive)
71 (let ((sepia-cpan-button (this-command-keys)))
72 (push-button)))
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))
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)
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))
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))
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
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)))
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)))
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")))
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")))
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")))
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")))
195 (provide 'sepia-cpan)