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