4 (defvar sepia-cpan-actions
5 '(("r" . sepia-cpan-readme
)
7 ("i" . sepia-cpan-install
)
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
)))
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
))
24 (sepia-call "Sepia::CPAN::readme" 'scalar-context mod
1)))
26 (pop-to-buffer (current-buffer))))
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
)))
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
)))
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
))
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
))
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
)))
57 (defvar sepia-cpan-button
)
59 (defun sepia-cpan-button (button)
60 (funcall (cdr (assoc sepia-cpan-button sepia-cpan-actions
))
61 (button-label button
)))
63 (defun sepia-cpan-button-press ()
65 (let ((sepia-cpan-button (this-command-keys)))
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
))
81 (define-button-type 'sepia-cpan
83 'action
'sepia-cpan-button
84 'help-echo
"[r]eadme, [d]ocumentation, [i]nstall"
85 'keymap sepia-cpan-mode-map
)
87 (define-derived-mode sepia-cpan-mode fundamental-mode
"CPAN"
88 "Major mode for CPAN browsing.")
90 (defun string-repeat (s n
)
94 (setq ret
(concat ret s
)))
97 (defun sepia-cpan-make-buffer (title mods fields names
)
98 (switch-to-buffer "*sepia-cpan*")
100 (setq buffer-read-only nil
)
101 (let ((inhibit-read-only t
))
105 [r]eadme, [d]ocumentation, [i]nstall,
106 [s]earch-by-name, [/][S]earch-by-description, [l]ist-for-author, [q]uit
112 (setcdr (assoc "cpan_file" mod
)
113 (replace-regexp-in-string "^.*/" ""
114 (cdr (assoc "cpan_file" mod
)))))
118 (mapcar (lambda (x) (+ 2 (length x
))) names
)
124 (length (format "%s" (cdr (assoc f x
)))))
129 (concat (mapconcat (lambda (x) (format "%%-%ds" x
)) lengths
"")
131 (insert (apply 'format fmt names
))
132 (insert (apply 'format fmt
133 (mapcar (lambda (x) (string-repeat "-" (length x
))) names
)))
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
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")))
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")))
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")))
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")))
186 (provide 'sepia-cpan
)