Mercurial > hg > xemacs-beta

comparison lisp/package-admin.el @ 325:f2b5d7006b0a r21-0-60

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0-60
author cvs
date Mon, 13 Aug 2007 10:47:35 +0200
parents 19dcec799385
children 03446687b7cc
comparison
equal deleted inserted replaced
324:8f2460f6e1f6 325:f2b5d7006b0a
121 ;; rest of command line follows 121 ;; rest of command line follows
122 package-admin-xemacs file destination))) 122 package-admin-xemacs file destination)))
123 123
124 (defun package-admin-install-function-mswindows (file pkg-dir buf) 124 (defun package-admin-install-function-mswindows (file pkg-dir buf)
125 "Install function for mswindows" 125 "Install function for mswindows"
126 (let ( (default-directory pkg-dir) ) 126 (let ((default-directory (file-name-as-directory pkg-dir)))
127 (call-process "djtar" nil buf t "-x" file) 127 (unless (file-directory-p default-directory)
128 )) 128 (make-directory default-directory t))
129 (call-process "djtar" nil buf t "-x" file)))
129 130
130 (defun package-admin-default-install-function (file pkg-dir buf) 131 (defun package-admin-default-install-function (file pkg-dir buf)
131 "Default function to install a package. 132 "Default function to install a package.
132 Install package FILENAME into directory PKG-DIR, with any messages output 133 Install package FILENAME into directory PKG-DIR, with any messages output
133 to buffer BUF." 134 to buffer BUF."
134 (let (filename) 135 (let* ((pkg-dir (file-name-as-directory pkg-dir))
135 (setq filename (expand-file-name file pkg-dir)) 136 (default-directory pkg-dir)
137 (filename (expand-file-name file)))
138 (unless (file-directory-p pkg-dir)
139 (make-directory pkg-dir t))
136 ;; Don't assume GNU tar. 140 ;; Don't assume GNU tar.
137 (if (shell-command (concat "gunzip -c " filename " | tar xvf -") buf) 141 (if (shell-command (concat "gunzip -c " filename " | tar xvf -") buf)
138 0 142 0
139 1) 143 1)
140 )) 144 ))
318 (let ((buf (get-buffer-create package-admin-temp-buffer)) 322 (let ((buf (get-buffer-create package-admin-temp-buffer))
319 (status 1) 323 (status 1)
320 start err-list 324 start err-list
321 ) 325 )
322 (setq pkg-dir (package-admin-get-install-dir 'unknown pkg-dir)) 326 (setq pkg-dir (package-admin-get-install-dir 'unknown pkg-dir))
323 ;; Insure that the current directory doesn't change 327 ;; Ensure that the current directory doesn't change
324 (save-excursion 328 (save-excursion
325 (set-buffer buf) 329 (set-buffer buf)
326 (setq default-directory pkg-dir) 330 ;; This is not really needed
331 (setq default-directory (file-name-as-directory pkg-dir))
327 (setq case-fold-search t) 332 (setq case-fold-search t)
328 (buffer-disable-undo) 333 (buffer-disable-undo)
329 (goto-char (setq start (point-max))) 334 (goto-char (setq start (point-max)))
330 (if (= 0 (setq status (funcall package-admin-install-function 335 (if (= 0 (setq status (funcall package-admin-install-function
331 file pkg-dir buf))) 336 file pkg-dir buf)))