xemacs-beta: lisp/package-ui.el comparison

comparison lisp/package-ui.el @ 321:19dcec799385 r21-0-58

Import from CVS: tag r21-0-58

author	cvs
date	Mon, 13 Aug 2007 10:46:44 +0200
parents	512e409c26a2
children	03446687b7cc

comparison

equal deleted inserted replaced

-:73c75c43c1f2
+:19dcec799385
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; User-changeable variables:
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar pui-up-to-date-package-face nil
+(defgroup pui nil
-"The face to use for packages that are up-to-date.")
+"Conventient interface to the package system."
+:group 'package-tools
-(defvar pui-selected-package-face (get-face 'bold)
+:tag "Package User interface"
-"The face to use for selected packages.
+:prefix "pui-")
-Set this to `nil' to use the `default' face.")
+(defcustom pui-package-install-dest-dir nil
-(defvar pui-outdated-package-face (get-face 'red)
+"*If non-nil (Automatic) path to package tree to install packages in.
-"The face to use for outdated packages.
+Otherwise, use old path for installed packages and make a guess for
-Set this to `nil' to use the `default' face.")
+new ones."
+:group 'pui
-(defvar pui-uninstalled-package-face (get-face 'italic)
+:tag "Install Location"
-"The face to use for uninstalled packages.
+:type '(choice (const :tag "Automatic" nil)
-Set this to `nil' to use the `default' face.")
+		 (directory)))
-(defvar pui-list-verbose t
+(defcustom pui-list-verbose t
-"If non-nil, display verbose info in the package list buffer.")
+"*If non-nil, display verbose info in the package list buffer."
+:group 'pui
+:tag "Verbose Listing"
+:type 'boolean)
+(defcustom pui-up-to-date-package-face nil
+"*The face to use for packages that are up-to-date."
+:group 'pui
+:type 'face)
+(defcustom pui-selected-package-face 'bold
+"*The face to use for selected packages.
+Set this to `nil' to use the `default' face."
+:group 'pui
+:type 'face)
+(defcustom pui-outdated-package-face 'red
+"*The face to use for outdated packages.
+Set this to `nil' to use the `default' face."
+:group 'pui
+:type 'face)
+(defcustom pui-uninstalled-package-face 'italic
+"*The face to use for uninstalled packages.
+Set this to `nil' to use the `default' face."
+:group 'pui
+:type 'face)
 (defvar pui-info-buffer "*Packages*"
 "Buffer to use for displaying package information.")
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define-key m "v" 'pui-toggle-verbosity-redisplay)
 (define-key m "d" 'pui-toggle-verbosity-redisplay)
 (define-key m [return] 'pui-toggle-package-key)
 (define-key m "x" 'pui-install-selected-packages)
 (define-key m "I" 'pui-install-selected-packages)
+(define-key m "r" 'pui-add-required-packages)
 (define-key m "n" 'next-line)
 (define-key m "+" 'next-line)
 (define-key m "p" 'previous-line)
 (define-key m "-" 'previous-line)
 m)
 (defvar pui-package-keymap
 (let ((m (make-sparse-keymap)))
 (set-keymap-name m 'pui-package-keymap)
 (define-key m 'button2 'pui-toggle-package-event)
-(define-key m 'button3 'pui-toggle-package-event)
+;; We use a popup menu
+;;    (define-key m 'button3 'pui-toggle-package-event)
 m)
 "Keymap to use over package names/descriptions.")
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; End of variables
 ))
 (defun pui-package-symbol-char (pkg-sym version)
 (progn
 (if (package-get-info-find-package packages-package-list pkg-sym)
-	(if (package-get-installedp pkg-sym version)
+(let ((installed (package-get-key pkg-sym :version)))
-	    (list " " pui-up-to-date-package-face)
+(if (>= (if (stringp installed)
-	  (list "*" pui-outdated-package-face))
+(string-to-number installed)
+installed)
+(if (stringp version)
+(string-to-number version)
+version))
+(list " " pui-up-to-date-package-face)
+(list "*" pui-outdated-package-face)))
 (list "-" pui-uninstalled-package-face))
 ))
 (defun pui-update-package-display (extent &optional pkg-sym version)
 "Update the package status for EXTENT.
 	  (setq sym-char "+")
 	  )
 (progn
 	(setq disp (pui-package-symbol-char pkg-sym version))
 	(setq sym-char (car disp))
-	(if (cdr disp)
+	(if (car (cdr disp))
-	    (set-extent-face extent (car (cdr disp)))
+	    (set-extent-face extent (get-face (car (cdr disp))))
 	  (set-extent-face extent (get-face 'default)))
 	))
 (save-excursion
 (goto-char (extent-start-position extent))
 (delete-char 1)
 		  (erase-buffer package-admin-temp-buffer)
 		  )
 		(message "Installing selected packages ...") (sit-for 0)
 		(if (catch 'done
 		      (mapcar (lambda (pkg)
-				(if (not (package-get-all pkg nil))
+				(if (not (package-get pkg nil nil
+pui-package-install-dest-dir))
 				    (throw 'done nil)))
 			      pui-selected-packages)
 		      t)
 		    (progn
 		      (pui-list-packages)
 	      (clear-message)
 	      )
 	  )
 (error "No packages have been selected!"))
 ))
+(defun pui-add-required-packages ()
+"Select packages required by those already selected for installation."
+(interactive)
+(let ((tmpbuf "*Required-Packages*") do-select)
+(if pui-selected-packages
+	(let ((dependencies
+(delq nil (mapcar
+(lambda (pkg)
+(let ((installed
+(package-get-key pkg :version))
+(current
+(package-get-info-prop
+(package-get-info-version
+(package-get-info-find-package
+package-get-base pkg) nil)
+'version)))
+(if (< (if (stringp installed)
+(string-to-number installed)
+installed)
+(if (stringp current)
+(string-to-number current)
+current))
+pkg
+nil)))
+(package-get-dependencies pui-selected-packages)))))
+	  ;; Don't change window config when asking the user if he really
+	  ;; wants to add the packages.  We do this to avoid messing up
+	  ;; the window configuration if errors occur (we don't want to
+	  ;; display random buffers in addition to the error buffer, if
+	  ;; errors occur, which would normally be caused by display-buffer).
+	  (save-window-excursion
+	    (with-output-to-temp-buffer tmpbuf
+	      (display-completion-list (sort
+					(mapcar #'(lambda (pkg)
+(symbol-name pkg))
+						dependencies)
+					'string<)
+				       :activate-callback nil
+				       :help-string "Required packages:\n"
+				       :completion-string t))
+	    (setq tmpbuf (get-buffer-create tmpbuf))
+	    (display-buffer tmpbuf)
+	    (setq do-select (y-or-n-p "Select these packages? "))
+	    (kill-buffer tmpbuf))
+	  (if do-select
+(progn
+(setq pui-selected-packages
+(union pui-selected-packages dependencies))
+(map-extents #'(lambda (extent maparg)
+(pui-update-package-display extent))
+nil nil nil nil nil 'pui)
+(message "added dependencies"))
+	      (clear-message)))
+(error "No packages have been selected!"))))
 (defun pui-help-echo (extent &optional force-update)
 "Display additional package info in the modeline.
 EXTENT determines the package to display (the package information is
 attached to the extent as properties)."
 	available.
 Useful keys:
 `\\[pui-toggle-package-key]' to select/unselect the current package for installation.
+`\\[pui-add-required-packages]' to add any packages required by those selected.
 `\\[pui-install-selected-packages]' to install selected packages.
 `\\[pui-display-info]' to display additional information about the package in the modeline.
 `\\[pui-list-packages]' to refresh the package list.
 `\\[pui-toggle-verbosity-redisplay]' to toggle between a verbose and non-verbose display.
 `\\[pui-quit]' to kill this buffer.
 ")
 ))
+(defvar pui-menu
+'("Packages"
+["Select" pui-toggle-package-key t]
+["Info" pui-display-info t]
+"---"
+["Add Required" pui-add-required-packages t]
+["Install Selected" pui-install-selected-packages t]
+"---"
+["Verbose" pui-toggle-verbosity-redisplay
+:active t :style toggle :selected pui-list-verbose]
+["Refresh" pui-list-packages t]
+["Help" pui-help t]
+["Quit" pui-quit t]))
 ;;;###autoload
 (defun pui-list-packages ()
 "List all packages and package information.
 The package name, version, and description are displayed.  From the displayed
 buffer, the user can see which packages are installed, which are not, and
 which are out-of-date (a newer version is available).  The user can then
 select packages for installation via the keyboard or mouse."
 (interactive)
+(package-get-require-base t)
 (let ( (outbuf (get-buffer-create pui-info-buffer))
 	 (sep-string "===============================================================================\n")
 	 start )
 (message "Creating package list ...") (sit-for 0)
 (set-buffer outbuf)
 			     (forward-line -1)
 			     (end-of-line)
 			     (point)))
 		   )
 		 (setq extent (make-extent b e))
-		 (if (cdr disp)
+		 (if (car (cdr disp))
-		     (set-extent-face extent (car (cdr disp)))
+		     (set-extent-face extent (get-face (car (cdr disp))))
 		   (set-extent-face extent (get-face 'default)))
 		 (set-extent-property extent 'highlight t)
 		 (set-extent-property extent 'pui t)
 		 (set-extent-property extent 'pui-package pkg-sym)
 		 (set-extent-property extent 'pui-info info)
 (setq buffer-read-only t)
 (pop-to-buffer outbuf)
 (delete-other-windows)
 (goto-char start)
 (setq pui-selected-packages nil)	; Reset list
+(when (featurep 'menubar)
+(set-buffer-menubar current-menubar)
+(add-submenu '() pui-menu)
+(setq mode-popup-menu pui-menu))
 (clear-message)
 ;    (message (substitute-command-keys "Press `\\[pui-help]' for help."))
 ))
 (provide 'package-ui)
 ;;; package-ui.el ends here

Mercurial > hg > xemacs-beta

comparison lisp/package-ui.el @ 321:19dcec799385 r21-0-58