Mercurial > hg > xemacs-beta

comparison lisp/package-ui.el @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents de805c49cfc1
children
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30 ;; User-changeable variables: 30 ;; User-changeable variables:
31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
32 32
33 (defgroup pui nil 33 (defgroup pui nil
34 "Convenient interface to the package system." 34 "Conventient interface to the package system."
35 :group 'package-tools 35 :group 'package-tools
36 :tag "Package User interface" 36 :tag "Package User interface"
37 :prefix "pui-") 37 :prefix "pui-")
38 38
39 (defcustom pui-package-install-dest-dir nil 39 (defcustom pui-package-install-dest-dir nil
138 ;; Configuration routines 138 ;; Configuration routines
139 139
140 (defun pui-directory-exists (dir) 140 (defun pui-directory-exists (dir)
141 "Check to see if DIR exists in `package-get-remote'." 141 "Check to see if DIR exists in `package-get-remote'."
142 (let (found) 142 (let (found)
143 (mapcar #'(lambda (item) 143 (mapcar '(lambda (item)
144 (if (and (null (car item)) 144 (if (and (null (car item))
145 (string-equal (file-name-as-directory (car (cdr item))) 145 (string-equal (file-name-as-directory (car (cdr item)))
146 (file-name-as-directory dir))) 146 (file-name-as-directory dir)))
147 (setq found t))) 147 (setq found t))
148 package-get-remote) 148 ) package-get-remote)
149 found 149 found
150 )) 150 ))
151 151
152 (defun pui-package-dir-list (buffer) 152 (defun pui-package-dir-list (buffer)
153 "In BUFFER, format the list of package binary paths." 153 "In BUFFER, format the list of package binary paths."
307 (if (member pkg-sym pui-deleted-packages) 307 (if (member pkg-sym pui-deleted-packages)
308 (setq pui-deleted-packages 308 (setq pui-deleted-packages
309 (delete pkg-sym pui-deleted-packages)) 309 (delete pkg-sym pui-deleted-packages))
310 (setq pui-deleted-packages 310 (setq pui-deleted-packages
311 (cons pkg-sym pui-deleted-packages)) 311 (cons pkg-sym pui-deleted-packages))
312 (setq pui-selected-packages 312 (setq pui-seleted-packages
313 (delete pkg-sym pui-selected-packages))) 313 (delete pkg-sym pui-selected-packages)))
314 (pui-update-package-display extent pkg-sym) 314 (pui-update-package-display extent pkg-sym)
315 )) 315 ))
316 316
317 317
356 (let ( (tmpbuf "*Packages-To-Remove*") do-delete) 356 (let ( (tmpbuf "*Packages-To-Remove*") do-delete)
357 (when pui-deleted-packages 357 (when pui-deleted-packages
358 (save-window-excursion 358 (save-window-excursion
359 (with-output-to-temp-buffer tmpbuf 359 (with-output-to-temp-buffer tmpbuf
360 (display-completion-list (sort 360 (display-completion-list (sort
361 (mapcar #'symbol-name pui-deleted-packages) 361 (mapcar '(lambda (pkg)
362 #'string<) 362 (symbol-name pkg)
363 )
364 pui-deleted-packages)
365 'string<)
363 :activate-callback nil 366 :activate-callback nil
364 :help-string "Packages selected for removal:\n" 367 :help-string "Packages selected for removal:\n"
365 :completion-string t 368 :completion-string t
366 )) 369 ))
367 (setq tmpbuf (get-buffer-create tmpbuf)) 370 (setq tmpbuf (get-buffer-create tmpbuf))
384 ;; the window configuration if errors occur (we don't want to 387 ;; the window configuration if errors occur (we don't want to
385 ;; display random buffers in addition to the error buffer, if 388 ;; display random buffers in addition to the error buffer, if
386 ;; errors occur, which would normally be caused by display-buffer). 389 ;; errors occur, which would normally be caused by display-buffer).
387 (save-window-excursion 390 (save-window-excursion
388 (with-output-to-temp-buffer tmpbuf 391 (with-output-to-temp-buffer tmpbuf
389 (display-completion-list 392 (display-completion-list (sort
390 (sort (mapcar #'symbol-name pui-selected-packages) #'string<) 393 (mapcar '(lambda (pkg)
391 :activate-callback nil 394 (symbol-name pkg)
392 :help-string "Packages selected for installation:\n" 395 )
393 :completion-string t 396 pui-selected-packages)
394 )) 397 'string<)
398 :activate-callback nil
399 :help-string "Packages selected for installation:\n"
400 :completion-string t
401 ))
395 (setq tmpbuf (get-buffer-create tmpbuf)) 402 (setq tmpbuf (get-buffer-create tmpbuf))
396 (display-buffer tmpbuf) 403 (display-buffer tmpbuf)
397 (setq do-install (y-or-n-p "Install these packages? ")) 404 (setq do-install (y-or-n-p "Install these packages? "))
398 (kill-buffer tmpbuf) 405 (kill-buffer tmpbuf)
399 ) 406 )
526 (interactive "e") 533 (interactive "e")
527 (save-excursion 534 (save-excursion
528 (set-buffer (event-buffer event)) 535 (set-buffer (event-buffer event))
529 (goto-char (event-point event)) 536 (goto-char (event-point event))
530 (popup-menu pui-menu event) 537 (popup-menu pui-menu event)
531 ;; I agree with dired.el - this is seriously bogus. 538 ;; I agreee with dired.el this is seriously bogus.
532 (while (popup-menu-up-p) 539 (while (popup-menu-up-p)
533 (dispatch-event (next-event))))) 540 (dispatch-event (next-event)))))
534 541
535 (defvar pui-menu 542 (defvar pui-menu
536 '("Packages" 543 '("Packages"
609 (insert " Latest 616 (insert " Latest
610 Package name Vers. Description 617 Package name Vers. Description
611 ")) 618 "))
612 (insert sep-string) 619 (insert sep-string)
613 (setq start (point)) 620 (setq start (point))
614 (mapcar 621 (mapcar '(lambda (pkg)
615 #'(lambda (pkg) 622 (let (pkg-sym info version desc
616 (let (pkg-sym info version desc 623 b e extent current-vers disp)
617 b e extent current-vers disp) 624 (setq pkg-sym (car pkg)
618 (setq pkg-sym (car pkg) 625 info (package-get-info-version (cdr pkg) nil))
619 info (package-get-info-version (cdr pkg) nil)) 626 (setq version (package-get-info-prop info 'version)
620 (setq version (package-get-info-prop info 'version) 627 desc (package-get-info-prop info 'description))
621 desc (package-get-info-prop info 'description)) 628
622 629 (setq disp (pui-package-symbol-char pkg-sym
623 (setq disp (pui-package-symbol-char pkg-sym 630 version))
624 version)) 631 (setq b (point))
625 (setq b (point)) 632 (if pui-list-verbose
626 (if pui-list-verbose 633 (progn
627 (progn 634 (setq current-vers (package-get-key pkg-sym :version))
628 (setq current-vers (package-get-key pkg-sym :version)) 635 (cond
629 (cond 636 ( (not current-vers)
630 ( (not current-vers) 637 (setq current-vers "-----") )
631 (setq current-vers "-----") ) 638 ( (stringp current-vers)
632 ( (stringp current-vers) 639 (setq current-vers
633 (setq current-vers 640 (format "%.2f"
634 (format "%.2f" 641 (string-to-number current-vers))) )
635 (string-to-number current-vers))) ) 642 ( (numberp current-vers)
636 ( (numberp current-vers) 643 (setq current-vers (format "%.2f" current-vers)) )
637 (setq current-vers (format "%.2f" current-vers)) ) 644 )
638 ) 645 (insert
639 (insert 646 (format "%s %-15s %-5.2f %-5s %s\n"
640 (format "%s %-15s %-5.2f %-5s %s\n" 647 (car disp) pkg-sym
641 (car disp) pkg-sym 648 (if (stringp version)
642 (if (stringp version) 649 (string-to-number version)
643 (string-to-number version) 650 version)
644 version) 651 current-vers desc))
645 current-vers desc)) 652 ;; (insert
646 ;; (insert 653 ;; (format "\t\t %-12s %s\n"
647 ;; (format "\t\t %-12s %s\n" 654 ;; (package-get-info-prop info 'author-version)
648 ;; (package-get-info-prop info 'author-version) 655 ;; (package-get-info-prop info 'date)
649 ;; (package-get-info-prop info 'date))) 656 ;; ))
650 ) 657 )
651 (insert (format "%s %-15s %-5s %s\n" 658 (insert (format "%s %-15s %-5s %s\n"
652 (car disp) 659 (car disp)
653 pkg-sym version desc))) 660 pkg-sym version desc)))
654 (save-excursion 661 (save-excursion
655 (setq e (progn 662 (setq e (progn
656 (forward-line -1) 663 (forward-line -1)
657 (end-of-line) 664 (end-of-line)
658 (point)))) 665 (point)))
659 (setq extent (make-extent b e)) 666 )
660 (if (car (cdr disp)) 667 (setq extent (make-extent b e))
661 (set-extent-face extent (get-face (car (cdr disp)))) 668 (if (car (cdr disp))
662 (set-extent-face extent (get-face 'default))) 669 (set-extent-face extent (get-face (car (cdr disp))))
663 (set-extent-property extent 'highlight t) 670 (set-extent-face extent (get-face 'default)))
664 (set-extent-property extent 'pui t) 671 (set-extent-property extent 'highlight t)
665 (set-extent-property extent 'pui-package pkg-sym) 672 (set-extent-property extent 'pui t)
666 (set-extent-property extent 'pui-info info) 673 (set-extent-property extent 'pui-package pkg-sym)
667 (set-extent-property extent 'help-echo 'pui-help-echo) 674 (set-extent-property extent 'pui-info info)
668 (set-extent-property extent 'keymap pui-package-keymap) 675 (set-extent-property extent 'help-echo 'pui-help-echo)
669 )) 676 (set-extent-property extent 'keymap pui-package-keymap)
670 (sort (copy-sequence package-get-base) 677 )) (sort (copy-sequence package-get-base)
671 #'(lambda (a b) 678 '(lambda (a b)
672 (string< (symbol-name (car a)) 679 (string< (symbol-name (car a))
673 (symbol-name (car b)))))) 680 (symbol-name (car b)))
681 )))
674 (insert sep-string) 682 (insert sep-string)
675 (insert (documentation 'list-packages-mode)) 683 (insert (documentation 'list-packages-mode))
676 (set-buffer-modified-p nil) 684 (set-buffer-modified-p nil)
677 (setq buffer-read-only t) 685 (setq buffer-read-only t)
678 (pop-to-buffer outbuf) 686 (pop-to-buffer outbuf)
683 (when (featurep 'menubar) 691 (when (featurep 'menubar)
684 (set-buffer-menubar current-menubar) 692 (set-buffer-menubar current-menubar)
685 (add-submenu '() pui-menu) 693 (add-submenu '() pui-menu)
686 (setq mode-popup-menu pui-menu)) 694 (setq mode-popup-menu pui-menu))
687 (clear-message) 695 (clear-message)
688 ;; (message (substitute-command-keys "Press `\\[pui-help]' for help.")) 696 ; (message (substitute-command-keys "Press `\\[pui-help]' for help."))
689 )) 697 ))
690 698
691 ;;;###autoload 699 ;;;###autoload
692 (defalias 'list-packages 'pui-list-packages) 700 (defalias 'list-packages 'pui-list-packages)
693 701