Don't add `=gt-pj-1' for J90-3476.
[chise/xemacs-chise.git-] / 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
84
85
86 (defvar pui-info-buffer "*Packages*"
87   "Buffer to use for displaying package information.")
88
89 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
90 ;; End of user-changeable variables.
91 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
92
93 (defvar pui-selected-packages nil
94   "The list of user-selected packages to install.")
95
96 (defvar pui-deleted-packages nil
97   "The list of user-selected packages to remove.")
98
99 (defvar pui-actual-package "")
100
101 (defvar pui-display-keymap
102   (let ((m (make-keymap)))
103     (suppress-keymap m)
104     (set-keymap-name m 'pui-display-keymap)
105     (define-key m "q" 'pui-quit)
106     (define-key m "g" 'pui-list-packages)
107     (define-key m "i" 'pui-display-info)
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 (defun pui-directory-exists (dir)
141   "Check to see if DIR exists in `package-get-remote'."
142   (let (found)
143     (mapcar #'(lambda (item)
144                 (if (and (null (car item))
145                          (string-equal (file-name-as-directory (car (cdr item)))
146                                        (file-name-as-directory dir)))
147                     (setq found t)))
148             package-get-remote)
149     found
150     ))
151
152 (defun pui-package-dir-list (buffer)
153   "In BUFFER, format the list of package binary paths."
154   (let ( (count 1) paths sys dir)
155     (set-buffer buffer)
156     (buffer-disable-undo buffer)
157     (erase-buffer buffer)
158     (insert "Existing package binary paths:\n\n")
159     (setq paths package-get-remote)
160     (while paths
161       (setq sys (car (car paths))
162             dir (car (cdr (car paths))))
163       (insert (format "%2s. " count))
164       (if (null sys)
165           (insert dir)
166         (insert sys ":" dir))
167       (insert "\n")
168       (setq count (1+ count))
169       (setq paths (cdr paths))
170       )
171     (insert "\nThese are the places that will be searched for package binaries.\n")
172     (goto-char (point-min))
173     ))
174
175 ;;;###autoload
176 (defun package-ui-add-site (site)
177   "Add site to package-get-remote and possibly offer to update package list."
178   (let ((had-none (null package-get-remote)))
179     (push site package-get-remote)    
180     (when (and had-none package-get-was-current
181                (y-or-n-p "Update Package list?"))
182       (setq package-get-was-current nil)
183       (package-get-require-base t)
184       (if (get-buffer pui-info-buffer)
185           (save-window-excursion
186             (pui-list-packages))))
187     (set-menubar-dirty-flag)))
188     
189
190 ;;;###autoload
191 (defun pui-add-install-directory (dir)
192   "Add a new package binary directory to the head of `package-get-remote'.
193 Note that no provision is made for saving any changes made by this function.
194 It exists mainly as a convenience for one-time package installations from
195 disk."
196   (interactive (let ( (tmpbuf (get-buffer-create
197                                "*Existing Package Binary Paths*"))
198                       dir)
199                  (save-window-excursion
200                    (save-excursion
201                      (unwind-protect
202                          (progn
203                            (pui-package-dir-list tmpbuf)
204                            (display-buffer tmpbuf)
205                            (setq dir (read-directory-name
206                                       "New package binary directory to add? "
207                                       nil nil t))
208                            )
209                        (kill-buffer tmpbuf)
210                        )))
211                  (list dir)
212                  ))
213   (progn
214     (if (not (pui-directory-exists dir))
215         (progn
216           (setq package-get-remote (cons (list nil dir) package-get-remote))
217           (message "Package directory \"%s\" added." dir)
218           )
219       (message "Directory \"%s\" already exists in `package-get-remote'." dir))
220     ))
221
222 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
223 ;; Package list/installer routines
224
225 (defun pui-quit ()
226   (interactive)
227   (kill-buffer nil))
228
229 (defun pui-package-symbol-char (pkg-sym version)
230   (progn
231     (if (package-get-info-find-package packages-package-list pkg-sym)
232         (let ((installed (package-get-key pkg-sym :version)))
233           (if (>= (if (stringp installed)
234                       (string-to-number installed)
235                     installed)
236                   (if (stringp version)
237                       (string-to-number version)
238                     version))
239               (list " " pui-up-to-date-package-face)
240             (list "*" pui-outdated-package-face)))
241       (list "-" pui-uninstalled-package-face))
242     ))
243
244 (defun pui-update-package-display (extent &optional pkg-sym version)
245   "Update the package status for EXTENT.
246 If PKG-SYM or VERSION are not given, they are read from the extent.
247 These are used to determine whether or not the package is installed,
248 and whether or not it is up-to-date."
249   (let (buffer-read-only disp sym-char)
250     (if (not pkg-sym)
251         (setq pkg-sym (extent-property extent 'pui-package)))
252     (if (not version)
253         (setq version (package-get-info-prop (extent-property extent 'pui-info)
254                                              'version)))
255     (cond ((member pkg-sym pui-selected-packages)
256              (if pui-selected-package-face
257                  (set-extent-face extent (get-face pui-selected-package-face))
258                (set-extent-face extent (get-face 'default)))
259              (setq sym-char "+"))
260           ((member pkg-sym pui-deleted-packages)
261            (if pui-deleted-package-face
262                  (set-extent-face extent (get-face pui-deleted-package-face))
263                (set-extent-face extent (get-face 'default)))
264              (setq sym-char "D"))
265           (t
266            (setq disp (pui-package-symbol-char pkg-sym version))
267            (setq sym-char (car disp))
268            (if (car (cdr disp))
269                (set-extent-face extent (get-face (car (cdr disp))))
270              (set-extent-face extent (get-face 'default)))))
271     (save-excursion
272       (goto-char (extent-start-position extent))
273       (delete-char 1)
274       (insert sym-char)
275       (set-buffer-modified-p nil)
276       )
277     ))
278
279 (defun pui-toggle-package (extent)
280   (let (pkg-sym)
281     (setq pkg-sym (extent-property extent 'pui-package))
282     (if (member pkg-sym pui-selected-packages)
283         (setq pui-selected-packages
284               (delete pkg-sym pui-selected-packages))
285       (setq pui-selected-packages
286             (cons pkg-sym pui-selected-packages))
287       (setq pui-deleted-packages
288             (delete pkg-sym pui-deleted-packages)))
289     (pui-update-package-display extent pkg-sym)
290     ))
291
292 (defun pui-toggle-package-key ()
293   "Select/unselect package for installation, using the keyboard."
294   (interactive)
295   (let (extent)
296     (if (setq extent (extent-at (point) (current-buffer) 'pui))
297         (progn
298           (pui-toggle-package extent)
299           (forward-line 1)
300           )
301       (error "No package under cursor!"))
302     ))
303
304 (defun pui-toggle-package-delete (extent)
305   (let (pkg-sym)
306     (setq pkg-sym (extent-property extent 'pui-package))
307     (if (member pkg-sym pui-deleted-packages)
308         (setq pui-deleted-packages
309               (delete pkg-sym pui-deleted-packages))
310       (setq pui-deleted-packages
311             (cons pkg-sym pui-deleted-packages))
312       (setq pui-selected-packages
313             (delete pkg-sym pui-selected-packages)))
314     (pui-update-package-display extent pkg-sym)
315     ))
316   
317
318 (defun pui-toggle-package-delete-key ()
319   "Select/unselect package for removal, using the keyboard."
320   (interactive)
321   (let (extent)
322     (if (setq extent (extent-at (point) (current-buffer) 'pui))
323         (progn
324           (pui-toggle-package-delete extent)
325           (forward-line 1)
326           )
327       (error "No package under cursor!"))
328     ))
329
330 (defun pui-current-package ()
331   (let ((extent (extent-at (point) (current-buffer) 'pui)))
332     (if extent
333         (extent-property extent 'pui-package))))
334
335 (defun pui-toggle-package-event (event)
336   "Select/unselect package for installation, using the mouse."
337   (interactive "e")
338   (let* ( (ep (event-point event))
339           (buffer (window-buffer (event-window event)))
340           (extent (extent-at ep buffer 'pui-package))
341           )
342     (pui-toggle-package extent)
343     ))
344
345 (defun pui-toggle-verbosity-redisplay ()
346   "Toggle verbose package info."
347   (interactive)
348   (progn
349     (setq pui-list-verbose (not pui-list-verbose))
350     (pui-list-packages)
351     ))
352
353 (defun pui-install-selected-packages ()
354   "Install selected packages."
355   (interactive)
356   (let ( (tmpbuf "*Packages-To-Remove*") do-delete)
357     (when pui-deleted-packages
358       (save-window-excursion
359         (with-output-to-temp-buffer tmpbuf
360           (display-completion-list (sort
361                                     (mapcar #'symbol-name pui-deleted-packages)
362                                     #'string<)
363                                    :activate-callback nil
364                                    :help-string "Packages selected for removal:\n"
365                                    :completion-string t
366                                    ))
367         (setq tmpbuf (get-buffer-create tmpbuf))
368         (display-buffer tmpbuf)
369         (setq do-delete (yes-or-no-p "Remove these packages? "))
370         (kill-buffer tmpbuf))       
371       (when do-delete
372         (message "Deleting selected packages ...") (sit-for 0)
373         (mapcar (lambda (pkg)
374                   (package-admin-delete-binary-package
375                    pkg (package-admin-get-install-dir pkg nil)))
376                 (nreverse pui-deleted-packages))
377         (message "Packages deleted"))))
378          
379   (let ( (tmpbuf "*Packages-To-Install*") do-install)
380     (if pui-selected-packages
381         (progn
382           ;; Don't change window config when asking the user if he really
383           ;; wants to install the packages.  We do this to avoid messing up
384           ;; the window configuration if errors occur (we don't want to
385           ;; display random buffers in addition to the error buffer, if
386           ;; errors occur, which would normally be caused by display-buffer).
387           (save-window-excursion
388             (with-output-to-temp-buffer tmpbuf
389               (display-completion-list
390                (sort (mapcar #'symbol-name pui-selected-packages) #'string<)
391                :activate-callback nil
392                :help-string "Packages selected for installation:\n"
393                :completion-string t
394                ))
395             (setq tmpbuf (get-buffer-create tmpbuf))
396             (display-buffer tmpbuf)
397             (setq do-install (y-or-n-p "Install these packages? "))
398             (kill-buffer tmpbuf)
399             )
400           (if do-install
401               (progn
402                 (save-excursion
403                   ;; Clear old temp buffer history
404                   (set-buffer (get-buffer-create package-admin-temp-buffer))
405                   (buffer-disable-undo package-admin-temp-buffer)
406                   (erase-buffer package-admin-temp-buffer)
407                   )
408                 (message "Installing selected packages ...") (sit-for 0)
409                 (if (catch 'done
410                       (mapcar (lambda (pkg)
411                                 (if (not (package-get pkg nil nil
412                                                       pui-package-install-dest-dir))
413                                     (throw 'done nil)))
414                               (nreverse pui-selected-packages))
415                       t)
416                     (progn
417                       (pui-list-packages)
418                       (message "Packages installed")
419                       ))
420                 )
421             (clear-message)
422             )
423           )
424       (if pui-deleted-packages
425           (pui-list-packages)
426         (error "No packages have been selected!")))
427     ;; sync with windows type systems
428     (package-net-update-installed-db)
429     ))
430
431 (defun pui-add-required-packages ()
432   "Select packages required by those already selected for installation."
433   (interactive)
434   (let ((tmpbuf "*Required-Packages*") do-select)
435     (if pui-selected-packages
436         (let ((dependencies
437                (delq nil (mapcar
438                           (lambda (pkg)
439                             (let ((installed
440                                    (package-get-key pkg :version))
441                                   (current
442                                    (package-get-info-prop
443                                     (package-get-info-version
444                                      (package-get-info-find-package
445                                       package-get-base pkg) nil)
446                                     'version)))
447                               (if (or (null installed)
448                                      (< (if (stringp installed)
449                                          (string-to-number installed)
450                                        installed)
451                                      (if (stringp current)
452                                          (string-to-number current)
453                                        current)))
454                                   pkg
455                                 nil)))
456                           (package-get-dependencies pui-selected-packages)))))
457           ;; Don't change window config when asking the user if he really
458           ;; wants to add the packages.  We do this to avoid messing up
459           ;; the window configuration if errors occur (we don't want to
460           ;; display random buffers in addition to the error buffer, if
461           ;; errors occur, which would normally be caused by display-buffer).
462           (save-window-excursion
463             (with-output-to-temp-buffer tmpbuf
464               (display-completion-list (sort
465                                         (mapcar #'(lambda (pkg)
466                                                     (symbol-name pkg))
467                                                 dependencies)
468                                         'string<)
469                                        :activate-callback nil
470                                        :help-string "Required packages:\n"
471                                        :completion-string t))
472             (setq tmpbuf (get-buffer-create tmpbuf))
473             (display-buffer tmpbuf)
474             (setq do-select (y-or-n-p "Select these packages? "))
475             (kill-buffer tmpbuf))
476           (if do-select
477               (progn
478                 (setq pui-selected-packages
479                       (union pui-selected-packages dependencies))
480                 (map-extents #'(lambda (extent maparg)
481                                  (pui-update-package-display extent))
482                              nil nil nil nil nil 'pui)
483                 (message "added dependencies"))
484               (clear-message)))
485       (error "No packages have been selected!"))))
486
487 (defun pui-help-echo (extent &optional force-update)
488   "Display additional package info in the modeline.
489 EXTENT determines the package to display (the package information is
490 attached to the extent as properties)."
491   (let (pkg-sym info inst-ver auth-ver date maintainer balloon req)
492     (if (or force-update (not (current-message))
493             (string-match ".*: .*: " (current-message))
494             )
495         (progn
496           (setq pkg-sym (extent-property extent 'pui-package)
497                 info (extent-property extent 'pui-info)
498                 inst-ver (package-get-key pkg-sym :version)
499                 auth-ver (package-get-info-prop info 'author-version)
500                 date (package-get-info-prop info 'date)
501                 maintainer (package-get-info-prop info 'maintainer)
502                 req (package-get-info-prop info 'requires))
503           (if (not inst-ver)
504               (setq inst-ver 0))
505           (if (featurep 'balloon-help)
506               (progn
507                 (setq balloon (format "
508 Package Information:  [For package: \"%s\"]
509 ================
510 Installed Version : %.2f
511 Author Version : %s
512 Maintainer: %s
513 Released: %s
514 Required Packages : %s\n\n"
515                                       pkg-sym inst-ver auth-ver maintainer 
516                                       date req))
517                 (set-extent-property extent 'balloon-help balloon)))
518           (if pui-list-verbose
519               (format 
520                "Inst V: %.2f Auth V: %s Maint: %s" 
521                inst-ver auth-ver maintainer)
522             (format "%.2f : %s : %s"
523                     inst-ver auth-ver maintainer))
524           ))
525     ))
526
527 (defun pui-display-info (&optional no-error event)
528   "Display additional package info in the modeline.
529 Designed to be called interactively (from a keypress)."
530   (interactive)
531   (let (extent)
532     (save-excursion
533       (beginning-of-line)
534       (if (setq extent  (extent-at (point) (current-buffer) 'pui))
535           (message (pui-help-echo extent t))
536         (if no-error
537             (clear-message nil)
538           (error "No package under cursor!")))
539       )))
540
541 (defvar pui-menu
542   '("Packages"
543     ["Toggle install " pui-toggle-package-key :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))]
544     ["Toggle delete " pui-toggle-package-delete-key :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))]
545     ["Info on" pui-display-info  :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))]
546     "---"
547     ["Add Required" pui-add-required-packages t]
548     ["Install/Remove Selected" pui-install-selected-packages t]
549     "---"
550     ["Verbose" pui-toggle-verbosity-redisplay
551      :active t :style toggle :selected pui-list-verbose]
552     ["Refresh" pui-list-packages t]
553     ["Help" pui-help t]
554     ["Quit" pui-quit t]))
555
556 ;;; "Why is there no standard function to do this?"
557 (defun pui-popup-context-sensitive (event)
558   (interactive "e")
559   (save-excursion
560     (set-buffer (event-buffer event))
561     (goto-char (event-point event))
562     (popup-menu pui-menu event)
563     ;; I agree with dired.el - this is seriously bogus.
564     (while (popup-up-p)
565       (dispatch-event (next-event)))))
566
567 (defun list-packages-mode ()
568     "Symbols in the leftmost column:
569
570   +     The package is marked for installation.
571   -     The package has not been installed.
572   D     The package has been marked for deletion.
573   *     The currently installed package is old, and a newer version is
574         available.
575
576 Useful keys:
577
578   `\\[pui-toggle-package-key]' to select/unselect the current package for installation.
579   `\\[pui-toggle-package-delete-key]' to select/unselect the current package for removal.
580   `\\[pui-add-required-packages]' to add any packages required by those selected.
581   `\\[pui-install-selected-packages]' to install/delete selected packages.
582   `\\[pui-display-info]' to display additional information about the package in the modeline.
583   `\\[pui-list-packages]' to refresh the package list.
584   `\\[pui-toggle-verbosity-redisplay]' to toggle between a verbose and non-verbose display.
585   `\\[pui-quit]' to kill this buffer.
586 "
587   (error "You cannot enter this mode directly. Use `pui-list-packages'"))
588
589 (put 'list-packages-mode 'mode-class 'special)
590
591 ;;;###autoload
592 (defun pui-list-packages ()
593   "List all packages and package information.
594 The package name, version, and description are displayed.  From the displayed
595 buffer, the user can see which packages are installed, which are not, and
596 which are out-of-date (a newer version is available).  The user can then
597 select packages for installation via the keyboard or mouse."
598   (interactive)
599   (package-get-require-base t)
600   (let ( (outbuf (get-buffer-create pui-info-buffer))
601          (sep-string "===============================================================================\n")
602          start )
603     (message "Creating package list ...") (sit-for 0)
604     (set-buffer outbuf)
605     (setq buffer-read-only nil)
606     (buffer-disable-undo outbuf)
607     (erase-buffer outbuf)
608     (kill-all-local-variables)
609     (use-local-map pui-display-keymap)
610     (setq major-mode 'list-packages-mode)
611     (setq mode-name "Packages")
612     (setq truncate-lines t)
613
614     (unless package-get-remote
615       (insert "
616 Warning: No download sites specified.  Package index may be out of date.
617          If you intend to install packages, specify download sites first.
618
619 "))
620     
621     (if pui-list-verbose
622         (insert "                 Latest Installed
623   Package name   Vers.  Vers.   Description
624 ")
625       (insert "                 Latest
626   Package name   Vers.  Description
627 "))
628     (insert sep-string)
629     (setq start (point))
630     (mapcar
631      #'(lambda (pkg)
632          (let (pkg-sym info version desc
633                        b e extent current-vers disp)
634            (setq pkg-sym (car pkg)
635                  info (package-get-info-version (cdr pkg) nil))
636            (setq version (package-get-info-prop info 'version)
637                  desc (package-get-info-prop info 'description))
638
639            (setq disp (pui-package-symbol-char pkg-sym
640                                                version))
641            (setq b (point))
642            (if pui-list-verbose
643                (progn
644                  (setq current-vers (package-get-key pkg-sym :version))
645                  (cond
646                   ( (not current-vers)
647                     (setq current-vers "-----") )
648                   ( (stringp current-vers)
649                     (setq current-vers
650                           (format "%.2f"
651                                   (string-to-number current-vers))) )
652                   ( (numberp current-vers)
653                     (setq current-vers (format "%.2f" current-vers)) )
654                   )
655                  (insert
656                   (format "%s %-15s %-5.2f  %-5s  %s\n"
657                           (car disp) pkg-sym 
658                           (if (stringp version)
659                               (string-to-number version)
660                             version)
661                           current-vers desc))
662                  ;; (insert
663                  ;;  (format "\t\t  %-12s  %s\n"
664                  ;;    (package-get-info-prop info 'author-version)
665                  ;;    (package-get-info-prop info 'date)))
666                  )
667              (insert (format "%s %-15s %-5s %s\n"
668                              (car disp)
669                              pkg-sym version desc)))
670            (save-excursion
671              (setq e (progn
672                        (forward-line -1)
673                        (end-of-line)
674                        (point))))
675            (setq extent (make-extent b e))
676            (if (car (cdr disp))
677                (set-extent-face extent (get-face (car (cdr disp))))
678              (set-extent-face extent (get-face 'default)))
679            (set-extent-property extent 'highlight t)
680            (set-extent-property extent 'pui t)
681            (set-extent-property extent 'pui-package pkg-sym)
682            (set-extent-property extent 'pui-info info)
683            (set-extent-property extent 'help-echo 'pui-help-echo)
684            (set-extent-property extent 'keymap pui-package-keymap)
685            ))
686      (sort (copy-sequence package-get-base)
687            #'(lambda (a b)
688                (string< (symbol-name (car a))
689                         (symbol-name (car b))))))
690     (insert sep-string)
691     (insert (documentation 'list-packages-mode))
692     (set-buffer-modified-p nil)
693     (setq buffer-read-only t)
694     (pop-to-buffer outbuf)
695     (delete-other-windows)
696     (goto-char start)
697     (setq pui-selected-packages nil)    ; Reset list
698     (setq pui-deleted-packages nil)     ; Reset list
699     (when (featurep 'menubar)
700       (set-buffer-menubar current-menubar)
701       (add-submenu '() pui-menu)
702       (setq mode-popup-menu pui-menu))
703     (clear-message)
704     ;;    (message (substitute-command-keys "Press `\\[pui-help]' for help."))
705     ))
706
707 ;;;###autoload
708 (defalias 'list-packages 'pui-list-packages)
709
710 (provide 'package-ui)
711
712 ;;; package-ui.el ends here