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

comparison lisp/package-ui.el @ 375:a300bb07d72d r21-2b3

Import from CVS: tag r21-2b3

author	cvs
date	Mon, 13 Aug 2007 11:04:51 +0200
parents	6240c7796c7a
children	d883f39b8495

comparison

equal deleted inserted replaced

-:4ebeb1a5388b
+:a300bb07d72d
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; 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
 	  (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
+					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 (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)
 (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 @ 375:a300bb07d72d r21-2b3