git.chise.org Git - chise/xemacs-chise.git.1/blob - 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   "Conventient 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-seleted-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 '(lambda (pkg)
 362                                                (symbol-name pkg)
 363                                                )
 364                                             pui-deleted-packages)
 365                                         'string<)
 366                                        :activate-callback nil
 367                                        :help-string "Packages selected for removal:\n"
 368                                        :completion-string t
 369                                        ))
 370             (setq tmpbuf (get-buffer-create tmpbuf))
 371             (display-buffer tmpbuf)
 372             (setq do-delete (yes-or-no-p "Remove these packages? "))
 373             (kill-buffer tmpbuf))
 374       (when do-delete
 375         (message "Deleting selected packages ...") (sit-for 0)
 376         (when (catch 'done
 377                 (mapcar (lambda (pkg)
 378                           (if (not
 379                                (package-admin-delete-binary-package
 380                                   pkg (package-admin-get-install-dir pkg nil)))
 381                                     (throw 'done nil)))
 382                               pui-deleted-packages)
 383                       t)
 384           (message "Packages deleted")
 385           ))))
 386
 387   (let ( (tmpbuf "*Packages-To-Install*") do-install)
 388     (if pui-selected-packages
 389         (progn
 390           ;; Don't change window config when asking the user if he really
 391           ;; wants to install the packages.  We do this to avoid messing up
 392           ;; the window configuration if errors occur (we don't want to
 393           ;; display random buffers in addition to the error buffer, if
 394           ;; errors occur, which would normally be caused by display-buffer).
 395           (save-window-excursion
 396             (with-output-to-temp-buffer tmpbuf
 397               (display-completion-list (sort
 398                                         (mapcar '(lambda (pkg)
 399                                                    (symbol-name pkg)
 400                                                    )
 401                                                 pui-selected-packages)
 402                                         'string<)
 403                                        :activate-callback nil
 404                                        :help-string "Packages selected for installation:\n"
 405                                        :completion-string t
 406                                        ))
 407             (setq tmpbuf (get-buffer-create tmpbuf))
 408             (display-buffer tmpbuf)
 409             (setq do-install (y-or-n-p "Install these packages? "))
 410             (kill-buffer tmpbuf)
 411             )
 412           (if do-install
 413               (progn
 414                 (save-excursion
 415                   ;; Clear old temp buffer history
 416                   (set-buffer (get-buffer-create package-admin-temp-buffer))
 417                   (buffer-disable-undo package-admin-temp-buffer)
 418                   (erase-buffer package-admin-temp-buffer)
 419                   )
 420                 (message "Installing selected packages ...") (sit-for 0)
 421                 (if (catch 'done
 422                       (mapcar (lambda (pkg)
 423                                 (if (not (package-get pkg nil nil
 424                                                       pui-package-install-dest-dir))
 425                                     (throw 'done nil)))
 426                               pui-selected-packages)
 427                       t)
 428                     (progn
 429                       (pui-list-packages)
 430                       (message "Packages installed")
 431                       ))
 432                 )
 433               (clear-message)
 434               )
 435           )
 436       (if pui-deleted-packages
 437           (pui-list-packages)
 438         (error "No packages have been selected!")))
 439     ))
 440
 441 (defun pui-add-required-packages ()
 442   "Select packages required by those already selected for installation."
 443   (interactive)
 444   (let ((tmpbuf "*Required-Packages*") do-select)
 445     (if pui-selected-packages
 446         (let ((dependencies
 447                (delq nil (mapcar
 448                           (lambda (pkg)
 449                             (let ((installed
 450                                    (package-get-key pkg :version))
 451                                   (current
 452                                    (package-get-info-prop
 453                                     (package-get-info-version
 454                                      (package-get-info-find-package
 455                                       package-get-base pkg) nil)
 456                                     'version)))
 457                               (if (< (if (stringp installed)
 458                                          (string-to-number installed)
 459                                        installed)
 460                                      (if (stringp current)
 461                                          (string-to-number current)
 462                                        current))
 463                                   pkg
 464                                 nil)))
 465                           (package-get-dependencies pui-selected-packages)))))
 466           ;; Don't change window config when asking the user if he really
 467           ;; wants to add the packages.  We do this to avoid messing up
 468           ;; the window configuration if errors occur (we don't want to
 469           ;; display random buffers in addition to the error buffer, if
 470           ;; errors occur, which would normally be caused by display-buffer).
 471           (save-window-excursion
 472             (with-output-to-temp-buffer tmpbuf
 473               (display-completion-list (sort
 474                                         (mapcar #'(lambda (pkg)
 475                                                     (symbol-name pkg))
 476                                                 dependencies)
 477                                         'string<)
 478                                        :activate-callback nil
 479                                        :help-string "Required packages:\n"
 480                                        :completion-string t))
 481             (setq tmpbuf (get-buffer-create tmpbuf))
 482             (display-buffer tmpbuf)
 483             (setq do-select (y-or-n-p "Select these packages? "))
 484             (kill-buffer tmpbuf))
 485           (if do-select
 486               (progn
 487                 (setq pui-selected-packages
 488                       (union pui-selected-packages dependencies))
 489                 (map-extents #'(lambda (extent maparg)
 490                                  (pui-update-package-display extent))
 491                              nil nil nil nil nil 'pui)
 492                 (message "added dependencies"))
 493               (clear-message)))
 494       (error "No packages have been selected!"))))
 495
 496 (defun pui-help-echo (extent &optional force-update)
 497   "Display additional package info in the modeline.
 498 EXTENT determines the package to display (the package information is
 499 attached to the extent as properties)."
 500   (let (pkg-sym info inst-ver auth-ver date maintainer)
 501     (if (or force-update (not (current-message))
 502             (string-match ".*: .*: " (current-message))
 503             )
 504         (progn
 505           (setq pkg-sym (extent-property extent 'pui-package)
 506                 info (extent-property extent 'pui-info)
 507                 inst-ver (package-get-key pkg-sym :version)
 508                 auth-ver (package-get-info-prop info 'author-version)
 509                 date (package-get-info-prop info 'date)
 510                 maintainer (package-get-info-prop info 'maintainer))
 511           (if (not inst-ver)
 512               (setq inst-ver ""))
 513           (if pui-list-verbose
 514               (format "Author version: %-8s %11s: %s"
 515                       auth-ver date maintainer)
 516             (format "%-6s: %-8s %11s: %s"
 517                     inst-ver auth-ver date maintainer))
 518           ))
 519     ))
 520
 521 (defun pui-display-info (&optional no-error event)
 522   "Display additional package info in the modeline.
 523 Designed to be called interactively (from a keypress)."
 524   (interactive)
 525   (let (extent)
 526     (save-excursion
 527       (beginning-of-line)
 528       (if (setq extent  (extent-at (point) (current-buffer) 'pui))
 529           (message (pui-help-echo extent t))
 530         (if no-error
 531             (clear-message nil)
 532           (error "No package under cursor!")))
 533       )))
 534
 535 ;;; "Why is there no standard function to do this?"
 536 (defun pui-popup-context-sensitive (event)
 537   (interactive "e")
 538   (save-excursion
 539     (set-buffer (event-buffer event))
 540     (goto-char (event-point event))
 541     (popup-menu pui-menu event)
 542     ;; I agreee with dired.el this is seriously bogus.
 543     (while (popup-menu-up-p)
 544       (dispatch-event (next-event)))))
 545
 546 (defvar pui-menu
 547   '("Packages"
 548     ["Toggle install " pui-toggle-package-key :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))]
 549     ["Toggle delete " pui-toggle-package-delete-key :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))]
 550     ["Info on" pui-display-info  :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))]
 551     "---"
 552     ["Add Required" pui-add-required-packages t]
 553     ["Install/Remove Selected" pui-install-selected-packages t]
 554     "---"
 555     ["Verbose" pui-toggle-verbosity-redisplay
 556      :active t :style toggle :selected pui-list-verbose]
 557     ["Refresh" pui-list-packages t]
 558     ["Help" pui-help t]
 559     ["Quit" pui-quit t]))
 560
 561
 562 (defun list-packages-mode ()
 563     "Symbols in the leftmost column:
 564
 565   +     The package is marked for installation.
 566   -     The package has not been installed.
 567   D     The package has been marked for deletion.
 568   *     The currently installed package is old, and a newer version is
 569         available.
 570
 571 Useful keys:
 572
 573   `\\[pui-toggle-package-key]' to select/unselect the current package for installation.
 574   `\\[pui-toggle-package-delete-key]' to select/unselect the current package for removal.
 575   `\\[pui-add-required-packages]' to add any packages required by those selected.
 576   `\\[pui-install-selected-packages]' to install/delete selected packages.
 577   `\\[pui-display-info]' to display additional information about the package in the modeline.
 578   `\\[pui-list-packages]' to refresh the package list.
 579   `\\[pui-toggle-verbosity-redisplay]' to toggle between a verbose and non-verbose display.
 580   `\\[pui-quit]' to kill this buffer.
 581 "
 582   (error "You cannot enter this mode directly. Use `pui-list-packages'"))
 583
 584 (put 'list-packages-mode 'mode-class 'special)
 585
 586 ;;;###autoload
 587 (defun pui-list-packages ()
 588   "List all packages and package information.
 589 The package name, version, and description are displayed.  From the displayed
 590 buffer, the user can see which packages are installed, which are not, and
 591 which are out-of-date (a newer version is available).  The user can then
 592 select packages for installation via the keyboard or mouse."
 593   (interactive)
 594   (package-get-require-base t)
 595   (let ( (outbuf (get-buffer-create pui-info-buffer))
 596          (sep-string "===============================================================================\n")
 597          start )
 598     (message "Creating package list ...") (sit-for 0)
 599     (set-buffer outbuf)
 600     (setq buffer-read-only nil)
 601     (buffer-disable-undo outbuf)
 602     (erase-buffer outbuf)
 603     (kill-all-local-variables)
 604     (use-local-map pui-display-keymap)
 605     (setq major-mode 'list-packages-mode)
 606     (setq mode-name "Packages")
 607     (setq truncate-lines t)
 608
 609     (unless package-get-remote
 610       (insert "
 611 Warning: No download sites specified.  Package index may be out of date.
 612          If you intend to install packages, specify download sites first.
 613
 614 "))
 615
 616     (if pui-list-verbose
 617         (insert "                 Latest Installed
 618   Package name   Vers.  Vers.   Description
 619 ")
 620       (insert "                 Latest
 621   Package name   Vers.  Description
 622 "))
 623     (insert sep-string)
 624     (setq start (point))
 625     (mapcar '(lambda (pkg)
 626                (let (pkg-sym info version desc
 627                              b e extent current-vers disp)
 628                  (setq pkg-sym (car pkg)
 629                        info (package-get-info-version (cdr pkg) nil))
 630                  (setq version (package-get-info-prop info 'version)
 631                        desc (package-get-info-prop info 'description))
 632
 633                  (setq disp (pui-package-symbol-char pkg-sym
 634                                                      version))
 635                  (setq b (point))
 636                  (if pui-list-verbose
 637                      (progn
 638                        (setq current-vers (package-get-key pkg-sym :version))
 639                        (cond
 640                         ( (not current-vers)
 641                           (setq current-vers "-----") )
 642                         ( (stringp current-vers)
 643                           (setq current-vers
 644                                 (format "%.2f"
 645                                         (string-to-number current-vers))) )
 646                         ( (numberp current-vers)
 647                           (setq current-vers (format "%.2f" current-vers)) )
 648                         )
 649                        (insert
 650                         (format "%s %-15s %-5.2f  %-5s  %s\n"
 651                                 (car disp) pkg-sym
 652                                 (if (stringp version)
 653                                     (string-to-number version)
 654                                   version)
 655                                 current-vers desc))
 656 ;;                     (insert
 657 ;;                      (format "\t\t  %-12s  %s\n"
 658 ;;                              (package-get-info-prop info 'author-version)
 659 ;;                              (package-get-info-prop info 'date)
 660 ;;                              ))
 661                        )
 662                    (insert (format "%s %-15s %-5s %s\n"
 663                                    (car disp)
 664                                    pkg-sym version desc)))
 665                  (save-excursion
 666                    (setq e (progn
 667                              (forward-line -1)
 668                              (end-of-line)
 669                              (point)))
 670                    )
 671                  (setq extent (make-extent b e))
 672                  (if (car (cdr disp))
 673                      (set-extent-face extent (get-face (car (cdr disp))))
 674                    (set-extent-face extent (get-face 'default)))
 675                  (set-extent-property extent 'highlight t)
 676                  (set-extent-property extent 'pui t)
 677                  (set-extent-property extent 'pui-package pkg-sym)
 678                  (set-extent-property extent 'pui-info info)
 679                  (set-extent-property extent 'help-echo 'pui-help-echo)
 680                  (set-extent-property extent 'keymap pui-package-keymap)
 681                  )) (sort (copy-sequence package-get-base)
 682                           '(lambda (a b)
 683                              (string< (symbol-name (car a))
 684                                       (symbol-name (car b)))
 685                                )))
 686     (insert sep-string)
 687     (insert (documentation 'list-packages-mode))
 688     (set-buffer-modified-p nil)
 689     (setq buffer-read-only t)
 690     (pop-to-buffer outbuf)
 691     (delete-other-windows)
 692     (goto-char start)
 693     (setq pui-selected-packages nil)    ; Reset list
 694     (setq pui-deleted-packages nil)     ; Reset list
 695     (when (featurep 'menubar)
 696       (set-buffer-menubar current-menubar)
 697       (add-submenu '() pui-menu)
 698       (setq mode-popup-menu pui-menu))
 699     (clear-message)
 700 ;    (message (substitute-command-keys "Press `\\[pui-help]' for help."))
 701     ))
 702
 703 ;;;###autoload
 704 (defalias 'list-packages 'pui-list-packages)
 705
 706 (provide 'package-ui)
 707
 708 ;;; package-ui.el ends here