Mercurial > hg > xemacs-beta

comparison lisp/package-ui.el @ 1365:02909207294a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2003-03-20 13:19:56 by youngs] 2003-03-20 Steve Youngs <youngs@xemacs.org> * menubar-items.el (default-menubar): Add a "Pre-Release Download Sites" submenu to "Tools -> Packages" menu. Filter the package download sites menus through `menu-split-long-menu'. * obsolete.el (pui-add-install-directory): New. (package-get-download-menu): New. * package-admin.el: (package-admin-add-single-file-package): Removed. (package-admin-get-install-dir): Don't rely on an installed xemacs-base package to guess where a package needs to be installed to. (package-admin-get-manifest-file): Whitespace clean up. (package-admin-check-manifest): Use `directory-sep-char' to compute regexp. Only search 'lisp' and 'man' directories to determine package name. Don't error is xemacs-base package isn't installed, just don't sort the MANIFEST file and issue a warning. (package-admin-add-binary-package): Whitespace clean up. (package-admin-get-lispdir): Ditto. (package-admin-delete-binary-package): Use `with-temp-buffer' instead of creating a temporary buffer manually. * package-get.el: (package-get-remote): Change custom type so that only either a single directory or remote host:directory can be selected. (package-get-download-sites): Put the sites into alphabetical order of country. Make the description element be "Country (site)" instead of the other way around. (package-get-pre-release-download-sites): New. (package-get-require-signed-base-updates): Default to t. (package-get-download-menu): Removed. (package-get-locate-file): Change to reflect new format of 'package-get-remote'. (package-get-update-base-from-buffer): Whitespace clean up and remove an unneccessary 'when'. (package-get-interactive-package-query): Whitespace clean up. (package-get-update-all): Ditto. (package-get-all): Ditto. (package-get-init-package): Ditto. (package-get-info): New. (package-get): Bring into line with new format of 'package-get-remote'. Error if non-Mule XEmacsen try to install Mule packages. Don't rely on a Mule package having 'mule-base' in its "REQUIRES" to determine if it is a Mule package or not, instead we test "CATEGORY". Better handling of the situation where a partial package tarball exists on the local hard drive from a previous interupted download. Clean up after a failed package install. (package-get-set-version-prop): Removed. (package-get-installedp): Whitespace clean up. * package-ui.el: Whitespace clean up. (pui-info-buffer): Make it a defcustom. (pui-directory-exists): Removed. (pui-package-dir-list): Removed. (pui-add-install-directory): Removed. (package-ui-download-menu): New. (package-ui-pre-release-download-menu): New. (pui-set-local-package-get-directory): New. (pui-package-symbol-char): Whitespace clean up. (pui-update-package-display): Ditto. (pui-toggle-package): Ditto. (pui-toggle-package-key): Ditto. (pui-toggle-package-delete): Ditto. (pui-toggle-package-delete-key): Ditto. (pui-toggle-package-event): Ditto. (pui-toggle-verbosity-redisplay): Ditto. (pui-install-selected-packages): Ditto. (pui-help-echo): Ditto. (pui-display-info): Ditto. (pui-list-packages): Ditto. * packages.el: Whitespace clean up.
author youngs
date Thu, 20 Mar 2003 13:19:59 +0000
parents d83885ef293b
children d638fc15d68b
comparison
equal deleted inserted replaced
1364:29e39e3ac319 1365:02909207294a
78 "*The face to use for uninstalled packages. 78 "*The face to use for uninstalled packages.
79 Set this to `nil' to use the `default' face." 79 Set this to `nil' to use the `default' face."
80 :group 'pui 80 :group 'pui
81 :type 'face) 81 :type 'face)
82 82
83 83 (defcustom pui-info-buffer "*Packages*"
84 84 "*Buffer to use for displaying package information."
85 85 :group 'pui
86 (defvar pui-info-buffer "*Packages*" 86 :type 'string)
87 "Buffer to use for displaying package information.")
88 87
89 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 88 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
90 ;; End of user-changeable variables. 89 ;; End of user-changeable variables.
91 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 90 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
92 91
135 134
136 135
137 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 136 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
138 ;; Configuration routines 137 ;; Configuration routines
139 138
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 139 ;;;###autoload
176 (defun package-ui-add-site (site) 140 (defun package-ui-add-site (site)
177 "Add site to package-get-remote and possibly offer to update package list." 141 "Add site to package-get-remote and possibly offer to update package list."
178 (let ((had-none (null package-get-remote))) 142 (let ((had-none (null package-get-remote)))
179 (push site package-get-remote) 143 (setq package-get-remote site)
180 (when (and had-none package-get-was-current 144 (when (and had-none package-get-was-current
181 (y-or-n-p "Update Package list?")) 145 (y-or-n-p "Update Package list?"))
182 (setq package-get-was-current nil) 146 (setq package-get-was-current nil)
183 (package-get-require-base t) 147 (package-get-require-base t)
184 (if (get-buffer pui-info-buffer) 148 (if (get-buffer pui-info-buffer)
185 (save-window-excursion 149 (save-window-excursion
186 (pui-list-packages)))) 150 (pui-list-packages))))
187 (set-menubar-dirty-flag))) 151 (set-menubar-dirty-flag)))
188
189 152
190 ;;;###autoload 153 ;;;###autoload
191 (defun pui-add-install-directory (dir) 154 (defun package-ui-download-menu ()
192 "Add a new package binary directory to the head of `package-get-remote'. 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))
167
168 ;;;###autoload
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
184 (defun pui-set-local-package-get-directory (dir)
185 "Set a new package binary directory in `package-get-remote'.
193 Note that no provision is made for saving any changes made by this function. 186 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 187 It exists mainly as a convenience for one-time package installations from
195 disk." 188 disk."
196 (interactive (let ( (tmpbuf (get-buffer-create 189 (interactive)
197 "*Existing Package Binary Paths*")) 190 (let ((dir (read-directory-name
198 dir) 191 "New package binary directory to add? "
199 (save-window-excursion 192 nil nil t)))
200 (save-excursion 193 (setq package-get-remote (list nil dir))
201 (unwind-protect 194 (message "Package directory \"%s\" added." dir)))
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 195
222 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 196 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
223 ;; Package list/installer routines 197 ;; Package list/installer routines
224 198
225 (defun pui-quit () 199 (defun pui-quit ()
236 (if (stringp version) 210 (if (stringp version)
237 (string-to-number version) 211 (string-to-number version)
238 version)) 212 version))
239 (list " " pui-up-to-date-package-face) 213 (list " " pui-up-to-date-package-face)
240 (list "*" pui-outdated-package-face))) 214 (list "*" pui-outdated-package-face)))
241 (list "-" pui-uninstalled-package-face)) 215 (list "-" pui-uninstalled-package-face))))
242 ))
243 216
244 (defun pui-update-package-display (extent &optional pkg-sym version) 217 (defun pui-update-package-display (extent &optional pkg-sym version)
245 "Update the package status for EXTENT. 218 "Update the package status for EXTENT.
246 If PKG-SYM or VERSION are not given, they are read from the extent. 219 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, 220 These are used to determine whether or not the package is installed,
270 (set-extent-face extent (get-face 'default))))) 243 (set-extent-face extent (get-face 'default)))))
271 (save-excursion 244 (save-excursion
272 (goto-char (extent-start-position extent)) 245 (goto-char (extent-start-position extent))
273 (delete-char 1) 246 (delete-char 1)
274 (insert sym-char) 247 (insert sym-char)
275 (set-buffer-modified-p nil) 248 (set-buffer-modified-p nil))))
276 )
277 ))
278 249
279 (defun pui-toggle-package (extent) 250 (defun pui-toggle-package (extent)
280 (let (pkg-sym) 251 (let (pkg-sym)
281 (setq pkg-sym (extent-property extent 'pui-package)) 252 (setq pkg-sym (extent-property extent 'pui-package))
282 (if (member pkg-sym pui-selected-packages) 253 (if (member pkg-sym pui-selected-packages)
284 (delete pkg-sym pui-selected-packages)) 255 (delete pkg-sym pui-selected-packages))
285 (setq pui-selected-packages 256 (setq pui-selected-packages
286 (cons pkg-sym pui-selected-packages)) 257 (cons pkg-sym pui-selected-packages))
287 (setq pui-deleted-packages 258 (setq pui-deleted-packages
288 (delete pkg-sym pui-deleted-packages))) 259 (delete pkg-sym pui-deleted-packages)))
289 (pui-update-package-display extent pkg-sym) 260 (pui-update-package-display extent pkg-sym)))
290 ))
291 261
292 (defun pui-toggle-package-key () 262 (defun pui-toggle-package-key ()
293 "Select/unselect package for installation, using the keyboard." 263 "Select/unselect package for installation, using the keyboard."
294 (interactive) 264 (interactive)
295 (let (extent) 265 (let (extent)
296 (if (setq extent (extent-at (point) (current-buffer) 'pui)) 266 (if (setq extent (extent-at (point) (current-buffer) 'pui))
297 (progn 267 (progn
298 (pui-toggle-package extent) 268 (pui-toggle-package extent)
299 (forward-line 1) 269 (forward-line 1))
300 ) 270 (error "No package under cursor!"))))
301 (error "No package under cursor!"))
302 ))
303 271
304 (defun pui-toggle-package-delete (extent) 272 (defun pui-toggle-package-delete (extent)
305 (let (pkg-sym) 273 (let (pkg-sym)
306 (setq pkg-sym (extent-property extent 'pui-package)) 274 (setq pkg-sym (extent-property extent 'pui-package))
307 (if (member pkg-sym pui-deleted-packages) 275 (if (member pkg-sym pui-deleted-packages)
309 (delete pkg-sym pui-deleted-packages)) 277 (delete pkg-sym pui-deleted-packages))
310 (setq pui-deleted-packages 278 (setq pui-deleted-packages
311 (cons pkg-sym pui-deleted-packages)) 279 (cons pkg-sym pui-deleted-packages))
312 (setq pui-selected-packages 280 (setq pui-selected-packages
313 (delete pkg-sym pui-selected-packages))) 281 (delete pkg-sym pui-selected-packages)))
314 (pui-update-package-display extent pkg-sym) 282 (pui-update-package-display extent pkg-sym)))
315 ))
316 283
317 284
318 (defun pui-toggle-package-delete-key () 285 (defun pui-toggle-package-delete-key ()
319 "Select/unselect package for removal, using the keyboard." 286 "Select/unselect package for removal, using the keyboard."
320 (interactive) 287 (interactive)
321 (let (extent) 288 (let (extent)
322 (if (setq extent (extent-at (point) (current-buffer) 'pui)) 289 (if (setq extent (extent-at (point) (current-buffer) 'pui))
323 (progn 290 (progn
324 (pui-toggle-package-delete extent) 291 (pui-toggle-package-delete extent)
325 (forward-line 1) 292 (forward-line 1))
326 ) 293 (error "No package under cursor!"))))
327 (error "No package under cursor!"))
328 ))
329 294
330 (defun pui-current-package () 295 (defun pui-current-package ()
331 (let ((extent (extent-at (point) (current-buffer) 'pui))) 296 (let ((extent (extent-at (point) (current-buffer) 'pui)))
332 (if extent 297 (if extent
333 (extent-property extent 'pui-package)))) 298 (extent-property extent 'pui-package))))
334 299
335 (defun pui-toggle-package-event (event) 300 (defun pui-toggle-package-event (event)
336 "Select/unselect package for installation, using the mouse." 301 "Select/unselect package for installation, using the mouse."
337 (interactive "e") 302 (interactive "e")
338 (let* ( (ep (event-point event)) 303 (let* ((ep (event-point event))
339 (buffer (window-buffer (event-window event))) 304 (buffer (window-buffer (event-window event)))
340 (extent (extent-at ep buffer 'pui-package)) 305 (extent (extent-at ep buffer 'pui-package)))
341 ) 306 (pui-toggle-package extent)))
342 (pui-toggle-package extent)
343 ))
344 307
345 (defun pui-toggle-verbosity-redisplay () 308 (defun pui-toggle-verbosity-redisplay ()
346 "Toggle verbose package info." 309 "Toggle verbose package info."
347 (interactive) 310 (interactive)
348 (progn 311 (progn
349 (setq pui-list-verbose (not pui-list-verbose)) 312 (setq pui-list-verbose (not pui-list-verbose))
350 (pui-list-packages) 313 (pui-list-packages)))
351 ))
352 314
353 (defun pui-install-selected-packages () 315 (defun pui-install-selected-packages ()
354 "Install selected packages." 316 "Install selected packages."
355 (interactive) 317 (interactive)
356 (let ( (tmpbuf "*Packages-To-Remove*") do-delete) 318 (let ((tmpbuf "*Packages-To-Remove*")
319 do-delete)
357 (when pui-deleted-packages 320 (when pui-deleted-packages
358 (save-window-excursion 321 (save-window-excursion
359 (with-output-to-temp-buffer tmpbuf 322 (with-output-to-temp-buffer tmpbuf
360 (display-completion-list (sort 323 (display-completion-list (sort
361 (mapcar #'symbol-name pui-deleted-packages) 324 (mapcar #'symbol-name pui-deleted-packages)
362 #'string<) 325 #'string<)
363 :activate-callback nil 326 :activate-callback nil
364 :help-string "Packages selected for removal:\n" 327 :help-string "Packages selected for removal:\n"
365 :completion-string t 328 :completion-string t))
366 ))
367 (setq tmpbuf (get-buffer-create tmpbuf)) 329 (setq tmpbuf (get-buffer-create tmpbuf))
368 (display-buffer tmpbuf) 330 (display-buffer tmpbuf)
369 (setq do-delete (yes-or-no-p "Remove these packages? ")) 331 (setq do-delete (yes-or-no-p "Remove these packages? "))
370 (kill-buffer tmpbuf)) 332 (kill-buffer tmpbuf))
371 (when do-delete 333 (when do-delete
374 (package-admin-delete-binary-package 336 (package-admin-delete-binary-package
375 pkg (package-admin-get-install-dir pkg nil))) 337 pkg (package-admin-get-install-dir pkg nil)))
376 (nreverse pui-deleted-packages)) 338 (nreverse pui-deleted-packages))
377 (message "Packages deleted")))) 339 (message "Packages deleted"))))
378 340
379 (let ( (tmpbuf "*Packages-To-Install*") do-install) 341 (let ((tmpbuf "*Packages-To-Install*")
342 do-install)
380 (if pui-selected-packages 343 (if pui-selected-packages
381 (progn 344 (progn
382 ;; Don't change window config when asking the user if he really 345 ;; 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 346 ;; wants to install the packages. We do this to avoid messing up
384 ;; the window configuration if errors occur (we don't want to 347 ;; the window configuration if errors occur (we don't want to
388 (with-output-to-temp-buffer tmpbuf 351 (with-output-to-temp-buffer tmpbuf
389 (display-completion-list 352 (display-completion-list
390 (sort (mapcar #'symbol-name pui-selected-packages) #'string<) 353 (sort (mapcar #'symbol-name pui-selected-packages) #'string<)
391 :activate-callback nil 354 :activate-callback nil
392 :help-string "Packages selected for installation:\n" 355 :help-string "Packages selected for installation:\n"
393 :completion-string t 356 :completion-string t))
394 ))
395 (setq tmpbuf (get-buffer-create tmpbuf)) 357 (setq tmpbuf (get-buffer-create tmpbuf))
396 (display-buffer tmpbuf) 358 (display-buffer tmpbuf)
397 (setq do-install (y-or-n-p "Install these packages? ")) 359 (setq do-install (y-or-n-p "Install these packages? "))
398 (kill-buffer tmpbuf) 360 (kill-buffer tmpbuf))
399 )
400 (if do-install 361 (if do-install
401 (progn 362 (progn
402 (save-excursion 363 (save-excursion
403 ;; Clear old temp buffer history 364 ;; Clear old temp buffer history
404 (set-buffer (get-buffer-create package-admin-temp-buffer)) 365 (set-buffer (get-buffer-create package-admin-temp-buffer))
405 (buffer-disable-undo package-admin-temp-buffer) 366 (buffer-disable-undo package-admin-temp-buffer)
406 (erase-buffer package-admin-temp-buffer) 367 (erase-buffer package-admin-temp-buffer))
407 )
408 (message "Installing selected packages ...") (sit-for 0) 368 (message "Installing selected packages ...") (sit-for 0)
409 (if (catch 'done 369 (if (catch 'done
410 (mapcar (lambda (pkg) 370 (mapcar (lambda (pkg)
411 (if (not (package-get pkg nil nil 371 (if (not (package-get pkg nil nil
412 pui-package-install-dest-dir)) 372 pui-package-install-dest-dir))
413 (throw 'done nil))) 373 (throw 'done nil)))
414 (nreverse pui-selected-packages)) 374 (nreverse pui-selected-packages))
415 t) 375 t)
416 (progn 376 (progn
417 (pui-list-packages) 377 (pui-list-packages)
418 (message "Packages installed") 378 (message "Packages installed"))))
419 )) 379 (clear-message)))
420 )
421 (clear-message)
422 )
423 )
424 (if pui-deleted-packages 380 (if pui-deleted-packages
425 (pui-list-packages) 381 (pui-list-packages)
426 (error "No packages have been selected!"))) 382 (error "No packages have been selected!")))
427 ;; sync with windows type systems 383 ;; sync with windows type systems
428 (package-net-update-installed-db) 384 (package-net-update-installed-db)))
429 ))
430 385
431 (defun pui-add-required-packages () 386 (defun pui-add-required-packages ()
432 "Select packages required by those already selected for installation." 387 "Select packages required by those already selected for installation."
433 (interactive) 388 (interactive)
434 (let ((tmpbuf "*Required-Packages*") do-select) 389 (let ((tmpbuf "*Required-Packages*") do-select)
488 "Display additional package info in the modeline. 443 "Display additional package info in the modeline.
489 EXTENT determines the package to display (the package information is 444 EXTENT determines the package to display (the package information is
490 attached to the extent as properties)." 445 attached to the extent as properties)."
491 (let (pkg-sym info inst-ver auth-ver date maintainer balloon req) 446 (let (pkg-sym info inst-ver auth-ver date maintainer balloon req)
492 (if (or force-update (not (current-message)) 447 (if (or force-update (not (current-message))
493 (string-match ".*: .*: " (current-message)) 448 (string-match ".*: .*: " (current-message)))
494 )
495 (progn 449 (progn
496 (setq pkg-sym (extent-property extent 'pui-package) 450 (setq pkg-sym (extent-property extent 'pui-package)
497 info (extent-property extent 'pui-info) 451 info (extent-property extent 'pui-info)
498 inst-ver (package-get-key pkg-sym :version) 452 inst-ver (package-get-key pkg-sym :version)
499 auth-ver (package-get-info-prop info 'author-version) 453 auth-ver (package-get-info-prop info 'author-version)
518 (if pui-list-verbose 472 (if pui-list-verbose
519 (format 473 (format
520 "Inst V: %.2f Auth V: %s Maint: %s" 474 "Inst V: %.2f Auth V: %s Maint: %s"
521 inst-ver auth-ver maintainer) 475 inst-ver auth-ver maintainer)
522 (format "%.2f : %s : %s" 476 (format "%.2f : %s : %s"
523 inst-ver auth-ver maintainer)) 477 inst-ver auth-ver maintainer))))))
524 ))
525 ))
526 478
527 (defun pui-display-info (&optional no-error event) 479 (defun pui-display-info (&optional no-error event)
528 "Display additional package info in the modeline. 480 "Display additional package info in the modeline.
529 Designed to be called interactively (from a keypress)." 481 Designed to be called interactively (from a keypress)."
530 (interactive) 482 (interactive)
533 (beginning-of-line) 485 (beginning-of-line)
534 (if (setq extent (extent-at (point) (current-buffer) 'pui)) 486 (if (setq extent (extent-at (point) (current-buffer) 'pui))
535 (message (pui-help-echo extent t)) 487 (message (pui-help-echo extent t))
536 (if no-error 488 (if no-error
537 (clear-message nil) 489 (clear-message nil)
538 (error "No package under cursor!"))) 490 (error "No package under cursor!"))))))
539 )))
540 491
541 (defvar pui-menu 492 (defvar pui-menu
542 '("Packages" 493 '("Packages"
543 ["Toggle install " pui-toggle-package-key :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))] 494 ["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) "..."))] 495 ["Toggle delete " pui-toggle-package-delete-key :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))]
595 buffer, the user can see which packages are installed, which are not, and 546 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 547 which are out-of-date (a newer version is available). The user can then
597 select packages for installation via the keyboard or mouse." 548 select packages for installation via the keyboard or mouse."
598 (interactive) 549 (interactive)
599 (package-get-require-base t) 550 (package-get-require-base t)
600 (let ( (outbuf (get-buffer-create pui-info-buffer)) 551 (let ((outbuf (get-buffer-create pui-info-buffer))
601 (sep-string "===============================================================================\n") 552 (sep-string "===============================================================================\n")
602 start ) 553 start)
603 (message "Creating package list ...") (sit-for 0) 554 (message "Creating package list ...") (sit-for 0)
604 (set-buffer outbuf) 555 (set-buffer outbuf)
605 (setq buffer-read-only nil) 556 (setq buffer-read-only nil)
606 (buffer-disable-undo outbuf) 557 (buffer-disable-undo outbuf)
607 (erase-buffer outbuf) 558 (erase-buffer outbuf)
641 (setq b (point)) 592 (setq b (point))
642 (if pui-list-verbose 593 (if pui-list-verbose
643 (progn 594 (progn
644 (setq current-vers (package-get-key pkg-sym :version)) 595 (setq current-vers (package-get-key pkg-sym :version))
645 (cond 596 (cond
646 ( (not current-vers) 597 ((not current-vers)
647 (setq current-vers "-----") ) 598 (setq current-vers "-----"))
648 ( (stringp current-vers) 599 ((stringp current-vers)
649 (setq current-vers 600 (setq current-vers
650 (format "%.2f" 601 (format "%.2f"
651 (string-to-number current-vers))) ) 602 (string-to-number current-vers))))
652 ( (numberp current-vers) 603 ((numberp current-vers)
653 (setq current-vers (format "%.2f" current-vers)) ) 604 (setq current-vers (format "%.2f" current-vers))))
654 )
655 (insert 605 (insert
656 (format "%s %-15s %-5.2f %-5s %s\n" 606 (format "%s %-15s %-5.2f %-5s %s\n"
657 (car disp) pkg-sym 607 (car disp) pkg-sym
658 (if (stringp version) 608 (if (stringp version)
659 (string-to-number version) 609 (string-to-number version)
660 version) 610 version)
661 current-vers desc)) 611 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" 612 (insert (format "%s %-15s %-5s %s\n"
668 (car disp) 613 (car disp)
669 pkg-sym version desc))) 614 pkg-sym version desc)))
670 (save-excursion 615 (save-excursion
671 (setq e (progn 616 (setq e (progn
679 (set-extent-property extent 'highlight t) 624 (set-extent-property extent 'highlight t)
680 (set-extent-property extent 'pui t) 625 (set-extent-property extent 'pui t)
681 (set-extent-property extent 'pui-package pkg-sym) 626 (set-extent-property extent 'pui-package pkg-sym)
682 (set-extent-property extent 'pui-info info) 627 (set-extent-property extent 'pui-info info)
683 (set-extent-property extent 'help-echo 'pui-help-echo) 628 (set-extent-property extent 'help-echo 'pui-help-echo)
684 (set-extent-property extent 'keymap pui-package-keymap) 629 (set-extent-property extent 'keymap pui-package-keymap)))
685 ))
686 (sort (copy-sequence package-get-base) 630 (sort (copy-sequence package-get-base)
687 #'(lambda (a b) 631 #'(lambda (a b)
688 (string< (symbol-name (car a)) 632 (string< (symbol-name (car a))
689 (symbol-name (car b)))))) 633 (symbol-name (car b))))))
690 (insert sep-string) 634 (insert sep-string)
698 (setq pui-deleted-packages nil) ; Reset list 642 (setq pui-deleted-packages nil) ; Reset list
699 (when (featurep 'menubar) 643 (when (featurep 'menubar)
700 (set-buffer-menubar current-menubar) 644 (set-buffer-menubar current-menubar)
701 (add-submenu '() pui-menu) 645 (add-submenu '() pui-menu)
702 (setq mode-popup-menu pui-menu)) 646 (setq mode-popup-menu pui-menu))
703 (clear-message) 647 (clear-message)))
704 ;; (message (substitute-command-keys "Press `\\[pui-help]' for help."))
705 ))
706 648
707 ;;;###autoload 649 ;;;###autoload
708 (defalias 'list-packages 'pui-list-packages) 650 (defalias 'list-packages 'pui-list-packages)
709 651
710 (provide 'package-ui) 652 (provide 'package-ui)