|
428
|
1 ;;; package-ui.el ---
|
|
|
2
|
|
|
3 ;; Copyright (C) 1998 by Darryl Okahata
|
|
|
4
|
|
|
5 ;; Author: Darryl Okahata <darrylo@sr.hp.com>
|
|
|
6 ;; Keywords: internal
|
|
|
7
|
|
|
8 ;; This file is part of XEmacs.
|
|
|
9
|
|
|
10 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
11 ;; under the terms of the GNU General Public License as published by
|
|
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
13 ;; any later version.
|
|
|
14
|
|
|
15 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
18 ;; General Public License for more details.
|
|
|
19
|
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
|
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
|
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
|
|
23 ;; 02111-1307, USA.
|
|
|
24
|
|
|
25 ;;; Synched up with: Not in FSF
|
|
|
26
|
|
|
27 (require 'package-get) ;; which, in turn, requires 'package-admin
|
|
|
28
|
|
|
29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
30 ;; User-changeable variables:
|
|
|
31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
32
|
|
|
33 (defgroup pui nil
|
|
442
|
34 "Convenient interface to the package system."
|
|
428
|
35 :group 'package-tools
|
|
|
36 :tag "Package User interface"
|
|
|
37 :prefix "pui-")
|
|
|
38
|
|
|
39 (defcustom pui-package-install-dest-dir nil
|
|
|
40 "*If non-nil (Automatic) path to package tree to install packages in.
|
|
|
41 Otherwise, use old path for installed packages and make a guess for
|
|
|
42 new ones."
|
|
|
43 :group 'pui
|
|
|
44 :tag "Install Location"
|
|
|
45 :type '(choice (const :tag "Automatic" nil)
|
|
|
46 (directory)))
|
|
|
47
|
|
|
48 (defcustom pui-list-verbose t
|
|
|
49 "*If non-nil, display verbose info in the package list buffer."
|
|
|
50 :group 'pui
|
|
|
51 :tag "Verbose Listing"
|
|
|
52 :type 'boolean)
|
|
|
53
|
|
|
54 (defcustom pui-up-to-date-package-face nil
|
|
|
55 "*The face to use for packages that are up-to-date."
|
|
|
56 :group 'pui
|
|
|
57 :type 'face)
|
|
|
58
|
|
|
59 (defcustom pui-selected-package-face 'bold
|
|
|
60 "*The face to use for selected packages.
|
|
|
61 Set this to `nil' to use the `default' face."
|
|
|
62 :group 'pui
|
|
|
63 :type 'face)
|
|
|
64
|
|
|
65 (defcustom pui-deleted-package-face 'blue
|
|
|
66 "*The face to use for packages marked for removal.
|
|
|
67 Set this to `nil' to use the `default' face."
|
|
|
68 :group 'pui
|
|
|
69 :type 'face)
|
|
|
70
|
|
|
71 (defcustom pui-outdated-package-face 'red
|
|
|
72 "*The face to use for outdated packages.
|
|
|
73 Set this to `nil' to use the `default' face."
|
|
|
74 :group 'pui
|
|
|
75 :type 'face)
|
|
|
76
|
|
|
77 (defcustom pui-uninstalled-package-face 'italic
|
|
|
78 "*The face to use for uninstalled packages.
|
|
|
79 Set this to `nil' to use the `default' face."
|
|
|
80 :group 'pui
|
|
|
81 :type 'face)
|
|
|
82
|
|
1365
|
83 (defcustom pui-info-buffer "*Packages*"
|
|
|
84 "*Buffer to use for displaying package information."
|
|
|
85 :group 'pui
|
|
|
86 :type 'string)
|
|
428
|
87
|
|
|
88 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
89 ;; End of user-changeable variables.
|
|
|
90 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
91
|
|
|
92 (defvar pui-selected-packages nil
|
|
|
93 "The list of user-selected packages to install.")
|
|
|
94
|
|
|
95 (defvar pui-deleted-packages nil
|
|
|
96 "The list of user-selected packages to remove.")
|
|
|
97
|
|
|
98 (defvar pui-actual-package "")
|
|
|
99
|
|
|
100 (defvar pui-display-keymap
|
|
|
101 (let ((m (make-keymap)))
|
|
|
102 (suppress-keymap m)
|
|
|
103 (set-keymap-name m 'pui-display-keymap)
|
|
|
104 (define-key m "q" 'pui-quit)
|
|
|
105 (define-key m "g" 'pui-list-packages)
|
|
|
106 (define-key m "i" 'pui-display-info)
|
|
1742
|
107 (define-key m "m" 'pui-display-maintainer)
|
|
428
|
108 (define-key m "?" 'describe-mode)
|
|
|
109 (define-key m "v" 'pui-toggle-verbosity-redisplay)
|
|
|
110 (define-key m "d" 'pui-toggle-package-delete-key)
|
|
|
111 (define-key m "D" 'pui-toggle-package-delete-key)
|
|
|
112 (define-key m [return] 'pui-toggle-package-key)
|
|
|
113 (define-key m "x" 'pui-install-selected-packages)
|
|
|
114 (define-key m "I" 'pui-install-selected-packages)
|
|
|
115 (define-key m "r" 'pui-add-required-packages)
|
|
|
116 (define-key m "n" 'next-line)
|
|
|
117 (define-key m "+" 'pui-toggle-package-key)
|
|
|
118 (define-key m "p" 'previous-line)
|
|
|
119 (define-key m " " 'scroll-up-command)
|
|
|
120 (define-key m [delete] 'scroll-down-command)
|
|
|
121 m)
|
|
|
122 "Keymap to use in the `pui-info-buffer' buffer")
|
|
|
123
|
|
|
124 (defvar pui-package-keymap
|
|
|
125 (let ((m (make-sparse-keymap)))
|
|
|
126 (set-keymap-name m 'pui-package-keymap)
|
|
|
127 (define-key m 'button2 'pui-toggle-package-event)
|
|
|
128 ;; We use a popup menu
|
|
|
129 (define-key m 'button3 'pui-popup-context-sensitive)
|
|
|
130 m)
|
|
|
131 "Keymap to use over package names/descriptions.")
|
|
|
132
|
|
|
133 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
134 ;; End of variables
|
|
|
135
|
|
|
136
|
|
|
137 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
138 ;; Configuration routines
|
|
|
139
|
|
|
140 ;;;###autoload
|
|
|
141 (defun package-ui-add-site (site)
|
|
|
142 "Add site to package-get-remote and possibly offer to update package list."
|
|
|
143 (let ((had-none (null package-get-remote)))
|
|
1365
|
144 (setq package-get-remote site)
|
|
428
|
145 (when (and had-none package-get-was-current
|
|
|
146 (y-or-n-p "Update Package list?"))
|
|
|
147 (setq package-get-was-current nil)
|
|
|
148 (package-get-require-base t)
|
|
|
149 (if (get-buffer pui-info-buffer)
|
|
|
150 (save-window-excursion
|
|
|
151 (pui-list-packages))))
|
|
|
152 (set-menubar-dirty-flag)))
|
|
1365
|
153
|
|
|
154 ;;;###autoload
|
|
|
155 (defun package-ui-download-menu ()
|
|
|
156 "Build the `Add Download Site' menu."
|
|
|
157 (mapcar (lambda (site)
|
|
|
158 (vector (car site)
|
|
|
159 `(if (equal package-get-remote (quote ,(cdr site)))
|
|
|
160 (setq package-get-remote nil)
|
|
|
161 (package-ui-add-site (quote ,(cdr site))))
|
|
|
162 ;; I've used radio buttons so that only a single
|
|
|
163 ;; site can be selected, but they are in fact
|
|
|
164 ;; toggles. SY.
|
|
|
165 :style 'radio
|
|
|
166 :selected `(equal package-get-remote (quote ,(cdr site)))))
|
|
|
167 package-get-download-sites))
|
|
428
|
168
|
|
|
169 ;;;###autoload
|
|
1365
|
170 (defun package-ui-pre-release-download-menu ()
|
|
|
171 "Build the 'Pre-Release Download Sites' menu."
|
|
|
172 (mapcar (lambda (site)
|
|
|
173 (vector (car site)
|
|
|
174 `(if (equal package-get-remote (quote ,(cdr site)))
|
|
|
175 (setq package-get-remote nil)
|
|
|
176 (package-ui-add-site (quote ,(cdr site))))
|
|
|
177 ;; I've used radio buttons so that only a single
|
|
|
178 ;; site can be selected, but they are in fact
|
|
|
179 ;; toggles. SY.
|
|
|
180 :style 'radio
|
|
|
181 :selected `(equal package-get-remote (quote ,(cdr site)))))
|
|
|
182 package-get-pre-release-download-sites))
|
|
|
183
|
|
|
184 ;;;###autoload
|
|
1374
|
185 (defun package-ui-site-release-download-menu ()
|
|
|
186 "Build the 'Site Release Download Sites' menu."
|
|
|
187 (mapcar (lambda (site)
|
|
|
188 (vector (car site)
|
|
|
189 `(if (equal package-get-remote (quote ,(cdr site)))
|
|
|
190 (setq package-get-remote nil)
|
|
|
191 (package-ui-add-site (quote ,(cdr site))))
|
|
|
192 ;; I've used radio buttons so that only a single
|
|
|
193 ;; site can be selected, but they are in fact
|
|
|
194 ;; toggles. SY.
|
|
|
195 :style 'radio
|
|
|
196 :selected `(equal package-get-remote (quote ,(cdr site)))))
|
|
|
197 package-get-site-release-download-sites))
|
|
|
198
|
|
|
199 ;;;###autoload
|
|
1647
|
200 (defun pui-set-local-package-get-directory ()
|
|
1365
|
201 "Set a new package binary directory in `package-get-remote'.
|
|
428
|
202 Note that no provision is made for saving any changes made by this function.
|
|
|
203 It exists mainly as a convenience for one-time package installations from
|
|
|
204 disk."
|
|
1365
|
205 (interactive)
|
|
|
206 (let ((dir (read-directory-name
|
|
|
207 "New package binary directory to add? "
|
|
|
208 nil nil t)))
|
|
|
209 (setq package-get-remote (list nil dir))
|
|
|
210 (message "Package directory \"%s\" added." dir)))
|
|
428
|
211
|
|
|
212 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
213 ;; Package list/installer routines
|
|
|
214
|
|
|
215 (defun pui-quit ()
|
|
|
216 (interactive)
|
|
|
217 (kill-buffer nil))
|
|
|
218
|
|
|
219 (defun pui-package-symbol-char (pkg-sym version)
|
|
|
220 (progn
|
|
|
221 (if (package-get-info-find-package packages-package-list pkg-sym)
|
|
|
222 (let ((installed (package-get-key pkg-sym :version)))
|
|
|
223 (if (>= (if (stringp installed)
|
|
|
224 (string-to-number installed)
|
|
|
225 installed)
|
|
|
226 (if (stringp version)
|
|
|
227 (string-to-number version)
|
|
|
228 version))
|
|
|
229 (list " " pui-up-to-date-package-face)
|
|
|
230 (list "*" pui-outdated-package-face)))
|
|
1365
|
231 (list "-" pui-uninstalled-package-face))))
|
|
428
|
232
|
|
|
233 (defun pui-update-package-display (extent &optional pkg-sym version)
|
|
|
234 "Update the package status for EXTENT.
|
|
|
235 If PKG-SYM or VERSION are not given, they are read from the extent.
|
|
|
236 These are used to determine whether or not the package is installed,
|
|
|
237 and whether or not it is up-to-date."
|
|
|
238 (let (buffer-read-only disp sym-char)
|
|
|
239 (if (not pkg-sym)
|
|
|
240 (setq pkg-sym (extent-property extent 'pui-package)))
|
|
|
241 (if (not version)
|
|
|
242 (setq version (package-get-info-prop (extent-property extent 'pui-info)
|
|
|
243 'version)))
|
|
|
244 (cond ((member pkg-sym pui-selected-packages)
|
|
|
245 (if pui-selected-package-face
|
|
|
246 (set-extent-face extent (get-face pui-selected-package-face))
|
|
|
247 (set-extent-face extent (get-face 'default)))
|
|
|
248 (setq sym-char "+"))
|
|
|
249 ((member pkg-sym pui-deleted-packages)
|
|
|
250 (if pui-deleted-package-face
|
|
|
251 (set-extent-face extent (get-face pui-deleted-package-face))
|
|
|
252 (set-extent-face extent (get-face 'default)))
|
|
|
253 (setq sym-char "D"))
|
|
|
254 (t
|
|
|
255 (setq disp (pui-package-symbol-char pkg-sym version))
|
|
|
256 (setq sym-char (car disp))
|
|
|
257 (if (car (cdr disp))
|
|
|
258 (set-extent-face extent (get-face (car (cdr disp))))
|
|
|
259 (set-extent-face extent (get-face 'default)))))
|
|
|
260 (save-excursion
|
|
|
261 (goto-char (extent-start-position extent))
|
|
|
262 (delete-char 1)
|
|
|
263 (insert sym-char)
|
|
1365
|
264 (set-buffer-modified-p nil))))
|
|
428
|
265
|
|
|
266 (defun pui-toggle-package (extent)
|
|
|
267 (let (pkg-sym)
|
|
|
268 (setq pkg-sym (extent-property extent 'pui-package))
|
|
|
269 (if (member pkg-sym pui-selected-packages)
|
|
|
270 (setq pui-selected-packages
|
|
|
271 (delete pkg-sym pui-selected-packages))
|
|
|
272 (setq pui-selected-packages
|
|
|
273 (cons pkg-sym pui-selected-packages))
|
|
|
274 (setq pui-deleted-packages
|
|
|
275 (delete pkg-sym pui-deleted-packages)))
|
|
1365
|
276 (pui-update-package-display extent pkg-sym)))
|
|
428
|
277
|
|
|
278 (defun pui-toggle-package-key ()
|
|
|
279 "Select/unselect package for installation, using the keyboard."
|
|
|
280 (interactive)
|
|
|
281 (let (extent)
|
|
|
282 (if (setq extent (extent-at (point) (current-buffer) 'pui))
|
|
|
283 (progn
|
|
|
284 (pui-toggle-package extent)
|
|
1365
|
285 (forward-line 1))
|
|
1410
|
286 (error 'invalid-operation
|
|
|
287 "No package under cursor!"))))
|
|
428
|
288
|
|
|
289 (defun pui-toggle-package-delete (extent)
|
|
|
290 (let (pkg-sym)
|
|
|
291 (setq pkg-sym (extent-property extent 'pui-package))
|
|
|
292 (if (member pkg-sym pui-deleted-packages)
|
|
|
293 (setq pui-deleted-packages
|
|
|
294 (delete pkg-sym pui-deleted-packages))
|
|
|
295 (setq pui-deleted-packages
|
|
|
296 (cons pkg-sym pui-deleted-packages))
|
|
442
|
297 (setq pui-selected-packages
|
|
428
|
298 (delete pkg-sym pui-selected-packages)))
|
|
1365
|
299 (pui-update-package-display extent pkg-sym)))
|
|
428
|
300
|
|
|
301
|
|
|
302 (defun pui-toggle-package-delete-key ()
|
|
|
303 "Select/unselect package for removal, using the keyboard."
|
|
|
304 (interactive)
|
|
|
305 (let (extent)
|
|
|
306 (if (setq extent (extent-at (point) (current-buffer) 'pui))
|
|
|
307 (progn
|
|
|
308 (pui-toggle-package-delete extent)
|
|
1365
|
309 (forward-line 1))
|
|
1410
|
310 (error 'invalid-operation
|
|
|
311 "No package under cursor!"))))
|
|
428
|
312
|
|
|
313 (defun pui-current-package ()
|
|
|
314 (let ((extent (extent-at (point) (current-buffer) 'pui)))
|
|
|
315 (if extent
|
|
|
316 (extent-property extent 'pui-package))))
|
|
|
317
|
|
|
318 (defun pui-toggle-package-event (event)
|
|
|
319 "Select/unselect package for installation, using the mouse."
|
|
|
320 (interactive "e")
|
|
1365
|
321 (let* ((ep (event-point event))
|
|
|
322 (buffer (window-buffer (event-window event)))
|
|
|
323 (extent (extent-at ep buffer 'pui-package)))
|
|
|
324 (pui-toggle-package extent)))
|
|
428
|
325
|
|
|
326 (defun pui-toggle-verbosity-redisplay ()
|
|
|
327 "Toggle verbose package info."
|
|
|
328 (interactive)
|
|
|
329 (progn
|
|
|
330 (setq pui-list-verbose (not pui-list-verbose))
|
|
1365
|
331 (pui-list-packages)))
|
|
428
|
332
|
|
|
333 (defun pui-install-selected-packages ()
|
|
|
334 "Install selected packages."
|
|
|
335 (interactive)
|
|
1365
|
336 (let ((tmpbuf "*Packages-To-Remove*")
|
|
|
337 do-delete)
|
|
428
|
338 (when pui-deleted-packages
|
|
|
339 (save-window-excursion
|
|
|
340 (with-output-to-temp-buffer tmpbuf
|
|
|
341 (display-completion-list (sort
|
|
442
|
342 (mapcar #'symbol-name pui-deleted-packages)
|
|
|
343 #'string<)
|
|
428
|
344 :activate-callback nil
|
|
|
345 :help-string "Packages selected for removal:\n"
|
|
1365
|
346 :completion-string t))
|
|
428
|
347 (setq tmpbuf (get-buffer-create tmpbuf))
|
|
|
348 (display-buffer tmpbuf)
|
|
|
349 (setq do-delete (yes-or-no-p "Remove these packages? "))
|
|
|
350 (kill-buffer tmpbuf))
|
|
|
351 (when do-delete
|
|
|
352 (message "Deleting selected packages ...") (sit-for 0)
|
|
|
353 (mapcar (lambda (pkg)
|
|
|
354 (package-admin-delete-binary-package
|
|
1378
|
355 pkg (package-admin-get-install-dir pkg)))
|
|
624
|
356 (nreverse pui-deleted-packages))
|
|
428
|
357 (message "Packages deleted"))))
|
|
|
358
|
|
1365
|
359 (let ((tmpbuf "*Packages-To-Install*")
|
|
|
360 do-install)
|
|
428
|
361 (if pui-selected-packages
|
|
|
362 (progn
|
|
|
363 ;; Don't change window config when asking the user if he really
|
|
|
364 ;; wants to install the packages. We do this to avoid messing up
|
|
|
365 ;; the window configuration if errors occur (we don't want to
|
|
|
366 ;; display random buffers in addition to the error buffer, if
|
|
|
367 ;; errors occur, which would normally be caused by display-buffer).
|
|
|
368 (save-window-excursion
|
|
|
369 (with-output-to-temp-buffer tmpbuf
|
|
442
|
370 (display-completion-list
|
|
|
371 (sort (mapcar #'symbol-name pui-selected-packages) #'string<)
|
|
|
372 :activate-callback nil
|
|
|
373 :help-string "Packages selected for installation:\n"
|
|
1365
|
374 :completion-string t))
|
|
428
|
375 (setq tmpbuf (get-buffer-create tmpbuf))
|
|
|
376 (display-buffer tmpbuf)
|
|
|
377 (setq do-install (y-or-n-p "Install these packages? "))
|
|
1365
|
378 (kill-buffer tmpbuf))
|
|
428
|
379 (if do-install
|
|
|
380 (progn
|
|
|
381 (save-excursion
|
|
|
382 ;; Clear old temp buffer history
|
|
|
383 (set-buffer (get-buffer-create package-admin-temp-buffer))
|
|
|
384 (buffer-disable-undo package-admin-temp-buffer)
|
|
1365
|
385 (erase-buffer package-admin-temp-buffer))
|
|
428
|
386 (message "Installing selected packages ...") (sit-for 0)
|
|
|
387 (if (catch 'done
|
|
|
388 (mapcar (lambda (pkg)
|
|
|
389 (if (not (package-get pkg nil nil
|
|
|
390 pui-package-install-dest-dir))
|
|
|
391 (throw 'done nil)))
|
|
624
|
392 (nreverse pui-selected-packages))
|
|
428
|
393 t)
|
|
|
394 (progn
|
|
|
395 (pui-list-packages)
|
|
1365
|
396 (message "Packages installed"))))
|
|
|
397 (clear-message)))
|
|
428
|
398 (if pui-deleted-packages
|
|
|
399 (pui-list-packages)
|
|
1410
|
400 (error 'invalid-operation
|
|
|
401 "No packages have been selected!")))
|
|
454
|
402 ;; sync with windows type systems
|
|
1365
|
403 (package-net-update-installed-db)))
|
|
428
|
404
|
|
|
405 (defun pui-add-required-packages ()
|
|
|
406 "Select packages required by those already selected for installation."
|
|
|
407 (interactive)
|
|
|
408 (let ((tmpbuf "*Required-Packages*") do-select)
|
|
|
409 (if pui-selected-packages
|
|
|
410 (let ((dependencies
|
|
|
411 (delq nil (mapcar
|
|
|
412 (lambda (pkg)
|
|
|
413 (let ((installed
|
|
|
414 (package-get-key pkg :version))
|
|
|
415 (current
|
|
|
416 (package-get-info-prop
|
|
|
417 (package-get-info-version
|
|
|
418 (package-get-info-find-package
|
|
|
419 package-get-base pkg) nil)
|
|
|
420 'version)))
|
|
|
421 (if (or (null installed)
|
|
|
422 (< (if (stringp installed)
|
|
|
423 (string-to-number installed)
|
|
|
424 installed)
|
|
|
425 (if (stringp current)
|
|
|
426 (string-to-number current)
|
|
|
427 current)))
|
|
|
428 pkg
|
|
|
429 nil)))
|
|
|
430 (package-get-dependencies pui-selected-packages)))))
|
|
|
431 ;; Don't change window config when asking the user if he really
|
|
|
432 ;; wants to add the packages. We do this to avoid messing up
|
|
|
433 ;; the window configuration if errors occur (we don't want to
|
|
|
434 ;; display random buffers in addition to the error buffer, if
|
|
|
435 ;; errors occur, which would normally be caused by display-buffer).
|
|
|
436 (save-window-excursion
|
|
|
437 (with-output-to-temp-buffer tmpbuf
|
|
|
438 (display-completion-list (sort
|
|
|
439 (mapcar #'(lambda (pkg)
|
|
|
440 (symbol-name pkg))
|
|
|
441 dependencies)
|
|
|
442 'string<)
|
|
|
443 :activate-callback nil
|
|
|
444 :help-string "Required packages:\n"
|
|
|
445 :completion-string t))
|
|
|
446 (setq tmpbuf (get-buffer-create tmpbuf))
|
|
|
447 (display-buffer tmpbuf)
|
|
|
448 (setq do-select (y-or-n-p "Select these packages? "))
|
|
|
449 (kill-buffer tmpbuf))
|
|
|
450 (if do-select
|
|
|
451 (progn
|
|
|
452 (setq pui-selected-packages
|
|
|
453 (union pui-selected-packages dependencies))
|
|
|
454 (map-extents #'(lambda (extent maparg)
|
|
|
455 (pui-update-package-display extent))
|
|
|
456 nil nil nil nil nil 'pui)
|
|
|
457 (message "added dependencies"))
|
|
|
458 (clear-message)))
|
|
1410
|
459 (error 'invalid-operation
|
|
|
460 "No packages have been selected!"))))
|
|
428
|
461
|
|
|
462 (defun pui-help-echo (extent &optional force-update)
|
|
|
463 "Display additional package info in the modeline.
|
|
|
464 EXTENT determines the package to display (the package information is
|
|
|
465 attached to the extent as properties)."
|
|
1742
|
466 (let (pkg-sym info inst-ver inst-auth-ver auth-ver date maintainer balloon req)
|
|
428
|
467 (if (or force-update (not (current-message))
|
|
1365
|
468 (string-match ".*: .*: " (current-message)))
|
|
428
|
469 (progn
|
|
|
470 (setq pkg-sym (extent-property extent 'pui-package)
|
|
|
471 info (extent-property extent 'pui-info)
|
|
|
472 inst-ver (package-get-key pkg-sym :version)
|
|
1742
|
473 inst-auth-ver (package-get-key pkg-sym :author-version)
|
|
428
|
474 auth-ver (package-get-info-prop info 'author-version)
|
|
|
475 date (package-get-info-prop info 'date)
|
|
852
|
476 maintainer (package-get-info-prop info 'maintainer)
|
|
|
477 req (package-get-info-prop info 'requires))
|
|
428
|
478 (if (not inst-ver)
|
|
852
|
479 (setq inst-ver 0))
|
|
|
480 (if (featurep 'balloon-help)
|
|
|
481 (progn
|
|
|
482 (setq balloon (format "
|
|
2146
|
483 Package Information: [For package: \"%s\"]\n================
|
|
1742
|
484 Installed Upstream Ver: %s Available Upstream Ver: %s
|
|
852
|
485 Maintainer : %s
|
|
|
486 Released : %s
|
|
|
487 Required Packages : %s\n\n"
|
|
1742
|
488 pkg-sym inst-auth-ver auth-ver maintainer
|
|
852
|
489 date req))
|
|
|
490 (set-extent-property extent 'balloon-help balloon)))
|
|
1742
|
491 (format
|
|
|
492 "Installed upstream ver: %s Available upstream ver: %s"
|
|
|
493 inst-auth-ver auth-ver)))))
|
|
428
|
494
|
|
|
495 (defun pui-display-info (&optional no-error event)
|
|
|
496 "Display additional package info in the modeline.
|
|
|
497 Designed to be called interactively (from a keypress)."
|
|
|
498 (interactive)
|
|
|
499 (let (extent)
|
|
|
500 (save-excursion
|
|
|
501 (beginning-of-line)
|
|
|
502 (if (setq extent (extent-at (point) (current-buffer) 'pui))
|
|
|
503 (message (pui-help-echo extent t))
|
|
|
504 (if no-error
|
|
|
505 (clear-message nil)
|
|
1410
|
506 (error 'invalid-operation
|
|
|
507 "No package under cursor!"))))))
|
|
428
|
508
|
|
1742
|
509 (defun pui-display-maintainer (&optional no-error event)
|
|
|
510 "Display a package's maintainer in the minibuffer."
|
|
|
511 (interactive)
|
|
|
512 (let (extent pkg-sym info maintainer)
|
|
|
513 (save-excursion
|
|
|
514 (beginning-of-line)
|
|
|
515 (if (setq extent (extent-at (point) (current-buffer) 'pui))
|
|
|
516 (progn
|
|
|
517 (setq pkg-sym (extent-property extent 'pui-package)
|
|
|
518 info (extent-property extent 'pui-info)
|
|
|
519 maintainer (package-get-info-prop info 'maintainer))
|
|
|
520 (message (format "Maintainer: %s" maintainer)))
|
|
|
521 (if no-error
|
|
|
522 (clear-message nil)
|
|
|
523 (error 'invalid-operation
|
|
|
524 "No package under cursor!"))))))
|
|
|
525
|
|
428
|
526 (defvar pui-menu
|
|
|
527 '("Packages"
|
|
|
528 ["Toggle install " pui-toggle-package-key :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))]
|
|
|
529 ["Toggle delete " pui-toggle-package-delete-key :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))]
|
|
|
530 ["Info on" pui-display-info :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))]
|
|
|
531 "---"
|
|
|
532 ["Add Required" pui-add-required-packages t]
|
|
|
533 ["Install/Remove Selected" pui-install-selected-packages t]
|
|
|
534 "---"
|
|
|
535 ["Verbose" pui-toggle-verbosity-redisplay
|
|
|
536 :active t :style toggle :selected pui-list-verbose]
|
|
|
537 ["Refresh" pui-list-packages t]
|
|
|
538 ["Help" pui-help t]
|
|
|
539 ["Quit" pui-quit t]))
|
|
|
540
|
|
442
|
541 ;;; "Why is there no standard function to do this?"
|
|
|
542 (defun pui-popup-context-sensitive (event)
|
|
|
543 (interactive "e")
|
|
|
544 (save-excursion
|
|
|
545 (set-buffer (event-buffer event))
|
|
|
546 (goto-char (event-point event))
|
|
|
547 (popup-menu pui-menu event)
|
|
|
548 ;; I agree with dired.el - this is seriously bogus.
|
|
|
549 (while (popup-up-p)
|
|
|
550 (dispatch-event (next-event)))))
|
|
428
|
551
|
|
|
552 (defun list-packages-mode ()
|
|
|
553 "Symbols in the leftmost column:
|
|
|
554
|
|
|
555 + The package is marked for installation.
|
|
|
556 - The package has not been installed.
|
|
|
557 D The package has been marked for deletion.
|
|
|
558 * The currently installed package is old, and a newer version is
|
|
|
559 available.
|
|
|
560
|
|
|
561 Useful keys:
|
|
|
562
|
|
|
563 `\\[pui-toggle-package-key]' to select/unselect the current package for installation.
|
|
|
564 `\\[pui-toggle-package-delete-key]' to select/unselect the current package for removal.
|
|
|
565 `\\[pui-add-required-packages]' to add any packages required by those selected.
|
|
|
566 `\\[pui-install-selected-packages]' to install/delete selected packages.
|
|
1742
|
567 `\\[pui-display-info]' to display additional information about the package in the minibuffer.
|
|
|
568 `\\[pui-display-maintainer]' to display the package's maintainer in the minibuffer
|
|
428
|
569 `\\[pui-list-packages]' to refresh the package list.
|
|
|
570 `\\[pui-toggle-verbosity-redisplay]' to toggle between a verbose and non-verbose display.
|
|
|
571 `\\[pui-quit]' to kill this buffer.
|
|
|
572 "
|
|
1410
|
573 (error 'invalid-operation
|
|
|
574 "You cannot enter this mode directly. Use `pui-list-packages'"))
|
|
428
|
575
|
|
|
576 (put 'list-packages-mode 'mode-class 'special)
|
|
|
577
|
|
|
578 ;;;###autoload
|
|
|
579 (defun pui-list-packages ()
|
|
|
580 "List all packages and package information.
|
|
|
581 The package name, version, and description are displayed. From the displayed
|
|
|
582 buffer, the user can see which packages are installed, which are not, and
|
|
|
583 which are out-of-date (a newer version is available). The user can then
|
|
|
584 select packages for installation via the keyboard or mouse."
|
|
|
585 (interactive)
|
|
|
586 (package-get-require-base t)
|
|
1365
|
587 (let ((outbuf (get-buffer-create pui-info-buffer))
|
|
|
588 (sep-string "===============================================================================\n")
|
|
|
589 start)
|
|
428
|
590 (message "Creating package list ...") (sit-for 0)
|
|
|
591 (set-buffer outbuf)
|
|
|
592 (setq buffer-read-only nil)
|
|
|
593 (buffer-disable-undo outbuf)
|
|
|
594 (erase-buffer outbuf)
|
|
|
595 (kill-all-local-variables)
|
|
|
596 (use-local-map pui-display-keymap)
|
|
|
597 (setq major-mode 'list-packages-mode)
|
|
|
598 (setq mode-name "Packages")
|
|
|
599 (setq truncate-lines t)
|
|
|
600
|
|
|
601 (unless package-get-remote
|
|
|
602 (insert "
|
|
|
603 Warning: No download sites specified. Package index may be out of date.
|
|
|
604 If you intend to install packages, specify download sites first.
|
|
|
605
|
|
|
606 "))
|
|
|
607
|
|
|
608 (if pui-list-verbose
|
|
|
609 (insert " Latest Installed
|
|
|
610 Package name Vers. Vers. Description
|
|
|
611 ")
|
|
|
612 (insert " Latest
|
|
|
613 Package name Vers. Description
|
|
|
614 "))
|
|
|
615 (insert sep-string)
|
|
|
616 (setq start (point))
|
|
442
|
617 (mapcar
|
|
|
618 #'(lambda (pkg)
|
|
|
619 (let (pkg-sym info version desc
|
|
|
620 b e extent current-vers disp)
|
|
|
621 (setq pkg-sym (car pkg)
|
|
|
622 info (package-get-info-version (cdr pkg) nil))
|
|
|
623 (setq version (package-get-info-prop info 'version)
|
|
|
624 desc (package-get-info-prop info 'description))
|
|
428
|
625
|
|
442
|
626 (setq disp (pui-package-symbol-char pkg-sym
|
|
|
627 version))
|
|
|
628 (setq b (point))
|
|
|
629 (if pui-list-verbose
|
|
|
630 (progn
|
|
|
631 (setq current-vers (package-get-key pkg-sym :version))
|
|
|
632 (cond
|
|
1365
|
633 ((not current-vers)
|
|
|
634 (setq current-vers "-----"))
|
|
|
635 ((stringp current-vers)
|
|
|
636 (setq current-vers
|
|
|
637 (format "%.2f"
|
|
|
638 (string-to-number current-vers))))
|
|
|
639 ((numberp current-vers)
|
|
|
640 (setq current-vers (format "%.2f" current-vers))))
|
|
442
|
641 (insert
|
|
|
642 (format "%s %-15s %-5.2f %-5s %s\n"
|
|
|
643 (car disp) pkg-sym
|
|
|
644 (if (stringp version)
|
|
|
645 (string-to-number version)
|
|
|
646 version)
|
|
1365
|
647 current-vers desc)))
|
|
442
|
648 (insert (format "%s %-15s %-5s %s\n"
|
|
|
649 (car disp)
|
|
|
650 pkg-sym version desc)))
|
|
|
651 (save-excursion
|
|
|
652 (setq e (progn
|
|
|
653 (forward-line -1)
|
|
|
654 (end-of-line)
|
|
|
655 (point))))
|
|
|
656 (setq extent (make-extent b e))
|
|
|
657 (if (car (cdr disp))
|
|
|
658 (set-extent-face extent (get-face (car (cdr disp))))
|
|
|
659 (set-extent-face extent (get-face 'default)))
|
|
|
660 (set-extent-property extent 'highlight t)
|
|
|
661 (set-extent-property extent 'pui t)
|
|
|
662 (set-extent-property extent 'pui-package pkg-sym)
|
|
|
663 (set-extent-property extent 'pui-info info)
|
|
|
664 (set-extent-property extent 'help-echo 'pui-help-echo)
|
|
1365
|
665 (set-extent-property extent 'keymap pui-package-keymap)))
|
|
442
|
666 (sort (copy-sequence package-get-base)
|
|
|
667 #'(lambda (a b)
|
|
|
668 (string< (symbol-name (car a))
|
|
|
669 (symbol-name (car b))))))
|
|
428
|
670 (insert sep-string)
|
|
|
671 (insert (documentation 'list-packages-mode))
|
|
|
672 (set-buffer-modified-p nil)
|
|
|
673 (setq buffer-read-only t)
|
|
|
674 (pop-to-buffer outbuf)
|
|
|
675 (delete-other-windows)
|
|
|
676 (goto-char start)
|
|
|
677 (setq pui-selected-packages nil) ; Reset list
|
|
|
678 (setq pui-deleted-packages nil) ; Reset list
|
|
|
679 (when (featurep 'menubar)
|
|
|
680 (set-buffer-menubar current-menubar)
|
|
|
681 (add-submenu '() pui-menu)
|
|
|
682 (setq mode-popup-menu pui-menu))
|
|
1365
|
683 (clear-message)))
|
|
428
|
684
|
|
|
685 ;;;###autoload
|
|
|
686 (defalias 'list-packages 'pui-list-packages)
|
|
|
687
|
|
|
688 (provide 'package-ui)
|
|
|
689
|
|
|
690 ;;; package-ui.el ends here
|
