Mercurial > hg > xemacs-beta

comparison lisp/package-ui.el @ 404:2f8bb876ab1d r21-2-32

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-32
author cvs
date Mon, 13 Aug 2007 11:16:07 +0200
parents 74fd4e045ea6
children de805c49cfc1
comparison
equal deleted inserted replaced
403:9f011ab08d48 404:2f8bb876ab1d
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."
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 '(lambda (pkg) 361 (mapcar #'symbol-name pui-deleted-packages)
362 (symbol-name pkg) 362 #'string<)
363 )
364 pui-deleted-packages)
365 'string<)
366 :activate-callback nil 363 :activate-callback nil
367 :help-string "Packages selected for removal:\n" 364 :help-string "Packages selected for removal:\n"
368 :completion-string t 365 :completion-string t
369 )) 366 ))
370 (setq tmpbuf (get-buffer-create tmpbuf)) 367 (setq tmpbuf (get-buffer-create tmpbuf))
387 ;; the window configuration if errors occur (we don't want to 384 ;; the window configuration if errors occur (we don't want to
388 ;; display random buffers in addition to the error buffer, if 385 ;; display random buffers in addition to the error buffer, if
389 ;; errors occur, which would normally be caused by display-buffer). 386 ;; errors occur, which would normally be caused by display-buffer).
390 (save-window-excursion 387 (save-window-excursion
391 (with-output-to-temp-buffer tmpbuf 388 (with-output-to-temp-buffer tmpbuf
392 (display-completion-list (sort 389 (display-completion-list
393 (mapcar '(lambda (pkg) 390 (sort (mapcar #'symbol-name pui-selected-packages) #'string<)
394 (symbol-name pkg) 391 :activate-callback nil
395 ) 392 :help-string "Packages selected for installation:\n"
396 pui-selected-packages) 393 :completion-string t
397 'string<) 394 ))
398 :activate-callback nil
399 :help-string "Packages selected for installation:\n"
400 :completion-string t
401 ))
402 (setq tmpbuf (get-buffer-create tmpbuf)) 395 (setq tmpbuf (get-buffer-create tmpbuf))
403 (display-buffer tmpbuf) 396 (display-buffer tmpbuf)
404 (setq do-install (y-or-n-p "Install these packages? ")) 397 (setq do-install (y-or-n-p "Install these packages? "))
405 (kill-buffer tmpbuf) 398 (kill-buffer tmpbuf)
406 ) 399 )
616 (insert " Latest 609 (insert " Latest
617 Package name Vers. Description 610 Package name Vers. Description
618 ")) 611 "))
619 (insert sep-string) 612 (insert sep-string)
620 (setq start (point)) 613 (setq start (point))
621 (mapcar '(lambda (pkg) 614 (mapcar
622 (let (pkg-sym info version desc 615 #'(lambda (pkg)
623 b e extent current-vers disp) 616 (let (pkg-sym info version desc
624 (setq pkg-sym (car pkg) 617 b e extent current-vers disp)
625 info (package-get-info-version (cdr pkg) nil)) 618 (setq pkg-sym (car pkg)
626 (setq version (package-get-info-prop info 'version) 619 info (package-get-info-version (cdr pkg) nil))
627 desc (package-get-info-prop info 'description)) 620 (setq version (package-get-info-prop info 'version)
628 621 desc (package-get-info-prop info 'description))
629 (setq disp (pui-package-symbol-char pkg-sym 622
630 version)) 623 (setq disp (pui-package-symbol-char pkg-sym
631 (setq b (point)) 624 version))
632 (if pui-list-verbose 625 (setq b (point))
633 (progn 626 (if pui-list-verbose
634 (setq current-vers (package-get-key pkg-sym :version)) 627 (progn
635 (cond 628 (setq current-vers (package-get-key pkg-sym :version))
636 ( (not current-vers) 629 (cond
637 (setq current-vers "-----") ) 630 ( (not current-vers)
638 ( (stringp current-vers) 631 (setq current-vers "-----") )
639 (setq current-vers 632 ( (stringp current-vers)
640 (format "%.2f" 633 (setq current-vers
641 (string-to-number current-vers))) ) 634 (format "%.2f"
642 ( (numberp current-vers) 635 (string-to-number current-vers))) )
643 (setq current-vers (format "%.2f" current-vers)) ) 636 ( (numberp current-vers)
644 ) 637 (setq current-vers (format "%.2f" current-vers)) )
645 (insert 638 )
646 (format "%s %-15s %-5.2f %-5s %s\n" 639 (insert
647 (car disp) pkg-sym 640 (format "%s %-15s %-5.2f %-5s %s\n"
648 (if (stringp version) 641 (car disp) pkg-sym
649 (string-to-number version) 642 (if (stringp version)
650 version) 643 (string-to-number version)
651 current-vers desc)) 644 version)
652 ;; (insert 645 current-vers desc))
653 ;; (format "\t\t %-12s %s\n" 646 ;; (insert
654 ;; (package-get-info-prop info 'author-version) 647 ;; (format "\t\t %-12s %s\n"
655 ;; (package-get-info-prop info 'date) 648 ;; (package-get-info-prop info 'author-version)
656 ;; )) 649 ;; (package-get-info-prop info 'date)))
657 ) 650 )
658 (insert (format "%s %-15s %-5s %s\n" 651 (insert (format "%s %-15s %-5s %s\n"
659 (car disp) 652 (car disp)
660 pkg-sym version desc))) 653 pkg-sym version desc)))
661 (save-excursion 654 (save-excursion
662 (setq e (progn 655 (setq e (progn
663 (forward-line -1) 656 (forward-line -1)
664 (end-of-line) 657 (end-of-line)
665 (point))) 658 (point))))
666 ) 659 (setq extent (make-extent b e))
667 (setq extent (make-extent b e)) 660 (if (car (cdr disp))
668 (if (car (cdr disp)) 661 (set-extent-face extent (get-face (car (cdr disp))))
669 (set-extent-face extent (get-face (car (cdr disp)))) 662 (set-extent-face extent (get-face 'default)))
670 (set-extent-face extent (get-face 'default))) 663 (set-extent-property extent 'highlight t)
671 (set-extent-property extent 'highlight t) 664 (set-extent-property extent 'pui t)
672 (set-extent-property extent 'pui t) 665 (set-extent-property extent 'pui-package pkg-sym)
673 (set-extent-property extent 'pui-package pkg-sym) 666 (set-extent-property extent 'pui-info info)
674 (set-extent-property extent 'pui-info info) 667 (set-extent-property extent 'help-echo 'pui-help-echo)
675 (set-extent-property extent 'help-echo 'pui-help-echo) 668 (set-extent-property extent 'keymap pui-package-keymap)
676 (set-extent-property extent 'keymap pui-package-keymap) 669 ))
677 )) (sort (copy-sequence package-get-base) 670 (sort (copy-sequence package-get-base)
678 '(lambda (a b) 671 #'(lambda (a b)
679 (string< (symbol-name (car a)) 672 (string< (symbol-name (car a))
680 (symbol-name (car b))) 673 (symbol-name (car b))))))
681 )))
682 (insert sep-string) 674 (insert sep-string)
683 (insert (documentation 'list-packages-mode)) 675 (insert (documentation 'list-packages-mode))
684 (set-buffer-modified-p nil) 676 (set-buffer-modified-p nil)
685 (setq buffer-read-only t) 677 (setq buffer-read-only t)
686 (pop-to-buffer outbuf) 678 (pop-to-buffer outbuf)
691 (when (featurep 'menubar) 683 (when (featurep 'menubar)
692 (set-buffer-menubar current-menubar) 684 (set-buffer-menubar current-menubar)
693 (add-submenu '() pui-menu) 685 (add-submenu '() pui-menu)
694 (setq mode-popup-menu pui-menu)) 686 (setq mode-popup-menu pui-menu))
695 (clear-message) 687 (clear-message)
696 ; (message (substitute-command-keys "Press `\\[pui-help]' for help.")) 688 ;; (message (substitute-command-keys "Press `\\[pui-help]' for help."))
697 )) 689 ))
698 690
699 ;;;###autoload 691 ;;;###autoload
700 (defalias 'list-packages 'pui-list-packages) 692 (defalias 'list-packages 'pui-list-packages)
701 693