Mercurial > hg > xemacs-beta

comparison lisp/package-admin.el @ 444:576fb035e263 r21-2-37

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-37
author cvs
date Mon, 13 Aug 2007 11:36:19 +0200
parents abe6d1db359e
children 3078fd1074e8
comparison
equal deleted inserted replaced
443:a8296e22da4e 444:576fb035e263
40 40
41 (defvar package-admin-install-function (if (eq system-type 'windows-nt) 41 (defvar package-admin-install-function (if (eq system-type 'windows-nt)
42 'package-admin-install-function-mswindows 42 'package-admin-install-function-mswindows
43 'package-admin-default-install-function) 43 'package-admin-default-install-function)
44 "The function to call to install a package. 44 "The function to call to install a package.
45 Three args are passed: FILENAME PKG-DIR BUF 45 Three args are passed: FILENAME PKG-DIR BUFFER
46 Install package FILENAME into directory PKG-DIR, with any messages output 46 Install package FILENAME into directory PKG-DIR, with any messages output
47 to buffer BUF.") 47 to buffer BUFFER.")
48 48
49 (defvar package-admin-error-messages '( 49 (defvar package-admin-error-messages '(
50 "No space left on device" 50 "No space left on device"
51 "No such file or directory" 51 "No such file or directory"
52 "Filename too long" 52 "Filename too long"
121 buf 121 buf
122 t 122 t
123 ;; rest of command line follows 123 ;; rest of command line follows
124 package-admin-xemacs file destination))) 124 package-admin-xemacs file destination)))
125 125
126 (defun package-admin-install-function-mswindows (file pkg-dir buf) 126 (defun package-admin-install-function-mswindows (file pkg-dir buffer)
127 "Install function for mswindows" 127 "Install function for mswindows."
128 (let ((default-directory (file-name-as-directory pkg-dir))) 128 (let ((default-directory (file-name-as-directory pkg-dir)))
129 (unless (file-directory-p default-directory) 129 (unless (file-directory-p default-directory)
130 (make-directory default-directory t)) 130 (make-directory default-directory t))
131 (call-process "minitar" nil buf t file))) 131 (call-process "minitar" nil buffer t file)))
132 132
133 (defun package-admin-default-install-function (file pkg-dir buf) 133 (defun package-admin-default-install-function (filename pkg-dir buffer)
134 "Default function to install a package. 134 "Default function to install a package.
135 Install package FILENAME into directory PKG-DIR, with any messages output 135 Install package FILENAME into directory PKG-DIR, with any messages output
136 to buffer BUF." 136 to BUFFER."
137 (let* ((pkg-dir (file-name-as-directory pkg-dir)) 137 (let* ((pkg-dir (file-name-as-directory pkg-dir))
138 (default-directory pkg-dir) 138 (default-directory pkg-dir)
139 (filename (expand-file-name file))) 139 (filename (expand-file-name filename)))
140 (unless (file-directory-p pkg-dir) 140 (unless (file-directory-p pkg-dir)
141 (make-directory pkg-dir t)) 141 (make-directory pkg-dir t))
142 ;; Don't assume GNU tar. 142 ;; Don't assume GNU tar.
143 (if (shell-command (concat "gunzip -c " filename " | tar xvf -") buf) 143 (if (shell-command (concat "gunzip -c " filename " | tar xvf -") buffer)
144 0 144 0
145 1) 145 1)
146 )) 146 ))
147 147
148 ; (call-process "add-big-package.sh" 148 ; (call-process "add-big-package.sh"
149 ; nil 149 ; nil
150 ; buf 150 ; buffer
151 ; t 151 ; t
152 ; ;; rest of command line follows 152 ; ;; rest of command line follows
153 ; package-admin-xemacs file pkg-dir)) 153 ; package-admin-xemacs file pkg-dir))
154 154
155 (defun package-admin-get-install-dir (package pkg-dir &optional mule-related) 155 (defun package-admin-get-install-dir (package pkg-dir &optional mule-related)
178 (if mule-related 178 (if mule-related
179 (package-admin-get-install-dir 'mule-base nil nil) 179 (package-admin-get-install-dir 'mule-base nil nil)
180 (if (eq package 'xemacs-base) 180 (if (eq package 'xemacs-base)
181 (car (last late-packages)) 181 (car (last late-packages))
182 (package-admin-get-install-dir 'xemacs-base nil nil))))))) 182 (package-admin-get-install-dir 'xemacs-base nil nil)))))))
183 183
184 184
185 185
186 (defun package-admin-get-manifest-file (pkg-topdir package) 186 (defun package-admin-get-manifest-file (pkg-topdir package)
187 "Return the name of the MANIFEST file for package PACKAGE. 187 "Return the name of the MANIFEST file for package PACKAGE.
188 Note that PACKAGE is a symbol, and not a string." 188 Note that PACKAGE is a symbol, and not a string."
292 (setq pathname (expand-file-name "pkginfo" 292 (setq pathname (expand-file-name "pkginfo"
293 pkg-topdir)) 293 pkg-topdir))
294 ;; Create pkginfo, if necessary 294 ;; Create pkginfo, if necessary
295 (if (not (file-directory-p pathname)) 295 (if (not (file-directory-p pathname))
296 (make-directory pathname)) 296 (make-directory pathname))
297 (setq pathname (expand-file-name 297 (setq pathname (expand-file-name
298 (concat "MANIFEST." package-name) 298 (concat "MANIFEST." package-name)
299 pathname)) 299 pathname))
300 (save-excursion 300 (save-excursion
301 (set-buffer manifest-buf) 301 (set-buffer manifest-buf)
302 ;; Put the files in sorted order 302 ;; Put the files in sorted order
433 ;; If it wants to, XEmacs may ask, but that is about all 433 ;; If it wants to, XEmacs may ask, but that is about all
434 ;; (set-file-modes file 438) ;; 438 -> #o666 434 ;; (set-file-modes file 438) ;; 438 -> #o666
435 ;; Note, user might have removed the file! 435 ;; Note, user might have removed the file!
436 (condition-case () 436 (condition-case ()
437 (delete-file file) 437 (delete-file file)
438 (error nil))) ;; We may want to turn the error into a Warning? 438 (error nil))) ;; We may want to turn the error into a Warning?
439 (forward-line 1)) 439 (forward-line 1))
440 440
441 ;; Delete empty directories. 441 ;; Delete empty directories.
442 (if dirs 442 (if dirs
443 (let ( (orig-default-directory default-directory) 443 (let ( (orig-default-directory default-directory)
444 ;; directory files file 444 ;; directory files file
445 ) 445 )
471 ;; on non-empty dirs anyway 471 ;; on non-empty dirs anyway
472 (mapc 472 (mapc
473 (lambda (dir) 473 (lambda (dir)
474 (condition-case () 474 (condition-case ()
475 (delete-directory dir))) 475 (delete-directory dir)))
476 dirs)) 476 dirs))
477 (setq default-directory orig-default-directory) 477 (setq default-directory orig-default-directory)
478 ))) 478 )))
479 ) 479 )
480 (kill-buffer tmpbuf) 480 (kill-buffer tmpbuf)
481 ;; Delete the MANIFEST file 481 ;; Delete the MANIFEST file
497 package-lispdir) 497 package-lispdir)
498 (sit-for 0) 498 (sit-for 0)
499 (package-admin-rmtree package-lispdir) 499 (package-admin-rmtree package-lispdir)
500 (message "Removing old lisp directory \"%s\" ... done" 500 (message "Removing old lisp directory \"%s\" ... done"
501 package-lispdir) 501 package-lispdir)
502 )) 502 ))
503 ;; Delete the package from the database of installed packages. 503 ;; Delete the package from the database of installed packages.
504 (package-delete-name package))) 504 (package-delete-name package)))
505 505
506 (provide 'package-admin) 506 (provide 'package-admin)
507 507