- Use `=jis-x0208@{1978|1983|1990}' instead of
[chise/xemacs-chise.git.1] / lisp / package-ui.el
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
34   "Convenient interface to the package system."
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    
83 (defcustom pui-info-buffer "*Packages*"
84   "*Buffer to use for displaying package information."
85   :group 'pui
86   :type 'string)
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)
107     (define-key m "m" 'pui-display-maintainer)
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)))
144     (setq package-get-remote site)    
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)))
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))
168
169 ;;;###autoload
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
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
200 (defun pui-set-local-package-get-directory ()
201   "Set a new package binary directory in `package-get-remote'.
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."
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)))
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)))
231       (list "-" pui-uninstalled-package-face))))
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)
264       (set-buffer-modified-p nil))))
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)))
276     (pui-update-package-display extent pkg-sym)))
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)
285           (forward-line 1))
286       (error 'invalid-operation
287              "No package under cursor!"))))
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))
297       (setq pui-selected-packages
298             (delete pkg-sym pui-selected-packages)))
299     (pui-update-package-display extent pkg-sym)))
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)
309           (forward-line 1))
310       (error 'invalid-operation
311              "No package under cursor!"))))
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")
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)))
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))
331     (pui-list-packages)))
332
333 (defun pui-install-selected-packages ()
334   "Install selected packages."
335   (interactive)
336   (let ((tmpbuf "*Packages-To-Remove*") 
337         do-delete)
338     (when pui-deleted-packages
339       (save-window-excursion
340         (with-output-to-temp-buffer tmpbuf
341           (display-completion-list (sort
342                                     (mapcar #'symbol-name pui-deleted-packages)
343                                     #'string<)
344                                    :activate-callback nil
345                                    :help-string "Packages selected for removal:\n"
346                                    :completion-string t))
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
355                    pkg (package-admin-get-install-dir pkg)))
356                 (nreverse pui-deleted-packages))
357         (message "Packages deleted"))))
358          
359   (let ((tmpbuf "*Packages-To-Install*") 
360         do-install)
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
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"
374                :completion-string t))
375             (setq tmpbuf (get-buffer-create tmpbuf))
376             (display-buffer tmpbuf)
377             (setq do-install (y-or-n-p "Install these packages? "))
378             (kill-buffer tmpbuf))
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)
385                   (erase-buffer package-admin-temp-buffer))
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)))
392                               (nreverse pui-selected-packages))
393                       t)
394                     (progn
395                       (pui-list-packages)
396                       (message "Packages installed"))))
397             (clear-message)))
398       (if pui-deleted-packages
399           (pui-list-packages)
400         (error 'invalid-operation
401                "No packages have been selected!")))
402     ;; sync with windows type systems
403     (package-net-update-installed-db)))
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)))
459       (error 'invalid-operation
460              "No packages have been selected!"))))
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)."
466   (let (pkg-sym info inst-ver inst-auth-ver auth-ver date maintainer balloon req)
467     (if (or force-update (not (current-message))
468             (string-match ".*: .*: " (current-message)))
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)
473                 inst-auth-ver (package-get-key pkg-sym :author-version)
474                 auth-ver (package-get-info-prop info 'author-version)
475                 date (package-get-info-prop info 'date)
476                 maintainer (package-get-info-prop info 'maintainer)
477                 req (package-get-info-prop info 'requires))
478           (if (not inst-ver)
479               (setq inst-ver 0))
480           (if (featurep 'balloon-help)
481               (progn
482                 (setq balloon (format "
483 Package Information:  [For package: \"%s\"]
484 ================
485 Installed Upstream Ver: %s  Available Upstream Ver: %s
486 Maintainer : %s
487 Released : %s
488 Required Packages : %s\n\n"
489                                       pkg-sym inst-auth-ver auth-ver maintainer 
490                                       date req))
491                 (set-extent-property extent 'balloon-help balloon)))
492           (format 
493            "Installed upstream ver: %s  Available upstream ver: %s" 
494            inst-auth-ver auth-ver)))))
495
496 (defun pui-display-info (&optional no-error event)
497   "Display additional package info in the modeline.
498 Designed to be called interactively (from a keypress)."
499   (interactive)
500   (let (extent)
501     (save-excursion
502       (beginning-of-line)
503       (if (setq extent  (extent-at (point) (current-buffer) 'pui))
504           (message (pui-help-echo extent t))
505         (if no-error
506             (clear-message nil)
507           (error 'invalid-operation
508                  "No package under cursor!"))))))
509
510 (defun pui-display-maintainer (&optional no-error event)
511   "Display a package's maintainer in the minibuffer."
512   (interactive)
513   (let (extent pkg-sym info maintainer)
514     (save-excursion
515       (beginning-of-line)
516       (if (setq extent  (extent-at (point) (current-buffer) 'pui))
517           (progn
518             (setq pkg-sym (extent-property extent 'pui-package)
519                   info (extent-property extent 'pui-info)
520                   maintainer (package-get-info-prop info 'maintainer))
521             (message (format "Maintainer: %s" maintainer)))
522         (if no-error
523             (clear-message nil)
524           (error 'invalid-operation
525                  "No package under cursor!"))))))
526
527 (defvar pui-menu
528   '("Packages"
529     ["Toggle install " pui-toggle-package-key :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))]
530     ["Toggle delete " pui-toggle-package-delete-key :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))]
531     ["Info on" pui-display-info  :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))]
532     "---"
533     ["Add Required" pui-add-required-packages t]
534     ["Install/Remove Selected" pui-install-selected-packages t]
535     "---"
536     ["Verbose" pui-toggle-verbosity-redisplay
537      :active t :style toggle :selected pui-list-verbose]
538     ["Refresh" pui-list-packages t]
539     ["Help" pui-help t]
540     ["Quit" pui-quit t]))
541
542 ;;; "Why is there no standard function to do this?"
543 (defun pui-popup-context-sensitive (event)
544   (interactive "e")
545   (save-excursion
546     (set-buffer (event-buffer event))
547     (goto-char (event-point event))
548     (popup-menu pui-menu event)
549     ;; I agree with dired.el - this is seriously bogus.
550     (while (popup-up-p)
551       (dispatch-event (next-event)))))
552
553 (defun list-packages-mode ()
554     "Symbols in the leftmost column:
555
556   +     The package is marked for installation.
557   -     The package has not been installed.
558   D     The package has been marked for deletion.
559   *     The currently installed package is old, and a newer version is
560         available.
561
562 Useful keys:
563
564   `\\[pui-toggle-package-key]' to select/unselect the current package for installation.
565   `\\[pui-toggle-package-delete-key]' to select/unselect the current package for removal.
566   `\\[pui-add-required-packages]' to add any packages required by those selected.
567   `\\[pui-install-selected-packages]' to install/delete selected packages.
568   `\\[pui-display-info]' to display additional information about the package in the modeline.
569   `\\[pui-display-maintainer]' to display the package's maintainer in the minibuffer
570   `\\[pui-list-packages]' to refresh the package list.
571   `\\[pui-toggle-verbosity-redisplay]' to toggle between a verbose and non-verbose display.
572   `\\[pui-quit]' to kill this buffer.
573 "
574   (error 'invalid-operation
575          "You cannot enter this mode directly. Use `pui-list-packages'"))
576
577 (put 'list-packages-mode 'mode-class 'special)
578
579 ;;;###autoload
580 (defun pui-list-packages ()
581   "List all packages and package information.
582 The package name, version, and description are displayed.  From the displayed
583 buffer, the user can see which packages are installed, which are not, and
584 which are out-of-date (a newer version is available).  The user can then
585 select packages for installation via the keyboard or mouse."
586   (interactive)
587   (package-get-require-base t)
588   (let ((outbuf (get-buffer-create pui-info-buffer))
589         (sep-string "===============================================================================\n")
590         start)
591     (message "Creating package list ...") (sit-for 0)
592     (set-buffer outbuf)
593     (setq buffer-read-only nil)
594     (buffer-disable-undo outbuf)
595     (erase-buffer outbuf)
596     (kill-all-local-variables)
597     (use-local-map pui-display-keymap)
598     (setq major-mode 'list-packages-mode)
599     (setq mode-name "Packages")
600     (setq truncate-lines t)
601
602     (unless package-get-remote
603       (insert "
604 Warning: No download sites specified.  Package index may be out of date.
605          If you intend to install packages, specify download sites first.
606
607 "))
608     
609     (if pui-list-verbose
610         (insert "                 Latest Installed
611   Package name   Vers.  Vers.   Description
612 ")
613       (insert "                 Latest
614   Package name   Vers.  Description
615 "))
616     (insert sep-string)
617     (setq start (point))
618     (mapcar
619      #'(lambda (pkg)
620          (let (pkg-sym info version desc
621                        b e extent current-vers disp)
622            (setq pkg-sym (car pkg)
623                  info (package-get-info-version (cdr pkg) nil))
624            (setq version (package-get-info-prop info 'version)
625                  desc (package-get-info-prop info 'description))
626
627            (setq disp (pui-package-symbol-char pkg-sym
628                                                version))
629            (setq b (point))
630            (if pui-list-verbose
631                (progn
632                  (setq current-vers (package-get-key pkg-sym :version))
633                  (cond
634                   ((not current-vers)
635                    (setq current-vers "-----"))
636                   ((stringp current-vers)
637                    (setq current-vers
638                          (format "%.2f"
639                                  (string-to-number current-vers))))
640                   ((numberp current-vers)
641                    (setq current-vers (format "%.2f" current-vers))))
642                  (insert
643                   (format "%s %-15s %-5.2f  %-5s  %s\n"
644                           (car disp) pkg-sym 
645                           (if (stringp version)
646                               (string-to-number version)
647                             version)
648                           current-vers desc)))
649              (insert (format "%s %-15s %-5s %s\n"
650                              (car disp)
651                              pkg-sym version desc)))
652            (save-excursion
653              (setq e (progn
654                        (forward-line -1)
655                        (end-of-line)
656                        (point))))
657            (setq extent (make-extent b e))
658            (if (car (cdr disp))
659                (set-extent-face extent (get-face (car (cdr disp))))
660              (set-extent-face extent (get-face 'default)))
661            (set-extent-property extent 'highlight t)
662            (set-extent-property extent 'pui t)
663            (set-extent-property extent 'pui-package pkg-sym)
664            (set-extent-property extent 'pui-info info)
665            (set-extent-property extent 'help-echo 'pui-help-echo)
666            (set-extent-property extent 'keymap pui-package-keymap)))
667      (sort (copy-sequence package-get-base)
668            #'(lambda (a b)
669                (string< (symbol-name (car a))
670                         (symbol-name (car b))))))
671     (insert sep-string)
672     (insert (documentation 'list-packages-mode))
673     (set-buffer-modified-p nil)
674     (setq buffer-read-only t)
675     (pop-to-buffer outbuf)
676     (delete-other-windows)
677     (goto-char start)
678     (setq pui-selected-packages nil)    ; Reset list
679     (setq pui-deleted-packages nil)     ; Reset list
680     (when (featurep 'menubar)
681       (set-buffer-menubar current-menubar)
682       (add-submenu '() pui-menu)
683       (setq mode-popup-menu pui-menu))
684     (clear-message)))
685
686 ;;;###autoload
687 (defalias 'list-packages 'pui-list-packages)
688
689 (provide 'package-ui)
690
691 ;;; package-ui.el ends here