Mercurial > hg > xemacs-beta

comparison lisp/package-admin.el @ 4720:3c92890f3750

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add `file-system-ignore-case-p', use it. 2009-10-24 Aidan Kehoe <kehoea@parhasard.net> * files.el (default-file-system-ignore-case): New variable. (file-system-case-alist): New variable. (file-system-ignore-case-p): New function; return t if file names under PATH should be treated case-insensitively. * minibuf.el (read-file-name-1, read-file-name-internal-1) (read-file-name-internal-1): * package-admin.el (package-admin-check-manifest): Use file-system-ignore-case-p instead of checking system-type directly in these functions. (Even though minibuf.el is dumped before files.el, the function is only called in interactive usage, there's no dump time order dependency here.)
author Aidan Kehoe <kehoea@parhasard.net>
date Sat, 24 Oct 2009 15:33:23 +0100
parents 15139dbf89f4
children 308d34e9f07d
comparison
equal deleted inserted replaced
4719:bd51ab22afa8 4720:3c92890f3750
277 "Check for a MANIFEST.<package> file in the package distribution. 277 "Check for a MANIFEST.<package> file in the package distribution.
278 If it doesn't exist, create and write one. 278 If it doesn't exist, create and write one.
279 PKG-OUTBUF is the buffer that holds the output from `tar', and PKG-TOPDIR 279 PKG-OUTBUF is the buffer that holds the output from `tar', and PKG-TOPDIR
280 is the top-level directory under which the package was installed." 280 is the top-level directory under which the package was installed."
281 (let ((manifest-buf " *pkg-manifest*") 281 (let ((manifest-buf " *pkg-manifest*")
282 (old-case-fold-search case-fold-search) 282 (case-fold-search (file-system-ignore-case-p pkg-topdir))
283 regexp package-name pathname regexps) 283 regexp package-name pathname regexps)
284 (unwind-protect 284 (save-excursion ;; Probably redundant.
285 (save-excursion ;; Probably redundant. 285 (set-buffer (get-buffer pkg-outbuf)) ;; Probably already the current buffer.
286 (set-buffer (get-buffer pkg-outbuf)) ;; Probably already the current buffer. 286 (goto-char (point-min))
287 (goto-char (point-min)) 287 (setq regexp (concat "\\bpkginfo"
288 288 (char-to-string directory-sep-char)
289 ;; Make filenames case-insensitive, if necessary 289 "MANIFEST\\...*"))
290 (if (eq system-type 'windows-nt) 290
291 (setq case-fold-search t)) 291 ;; Look for the manifest.
292 292 (if (not (re-search-forward regexp nil t))
293 (setq regexp (concat "\\bpkginfo" 293 (progn
294 (char-to-string directory-sep-char) 294 ;; We didn't find a manifest. Make one.
295 "MANIFEST\\...*")) 295
296 296 ;; Yuk. We weren't passed the package name, and so we have
297 ;; Look for the manifest. 297 ;; to dig for it. Look for it as the subdirectory name below
298 (if (not (re-search-forward regexp nil t)) 298 ;; "lisp", or "man".
299 (progn 299 ;; Here, we don't use a single regexp because we want to search
300 ;; We didn't find a manifest. Make one. 300 ;; the directories for a package name in a particular order.
301 301 (if (catch 'done
302 ;; Yuk. We weren't passed the package name, and so we have 302 (let ((dirs '("lisp" "man"))
303 ;; to dig for it. Look for it as the subdirectory name below 303 rexp)
304 ;; "lisp", or "man". 304 (while dirs
305 ;; Here, we don't use a single regexp because we want to search 305 (setq rexp (concat "\\b" (car dirs)
306 ;; the directories for a package name in a particular order. 306 "[\\/]\\([^\\/]+\\)[\//]"))
307 (if (catch 'done 307 (if (re-search-forward rexp nil t)
308 (let ((dirs '("lisp" "man")) 308 (throw 'done t))
309 rexp) 309 (setq dirs (cdr dirs)))))
310 (while dirs 310 (progn
311 (setq rexp (concat "\\b" (car dirs) 311 (setq package-name (buffer-substring (match-beginning 1)
312 "[\\/]\\([^\\/]+\\)[\//]")) 312 (match-end 1)))
313 (if (re-search-forward rexp nil t) 313
314 (throw 'done t)) 314 ;; Get and erase the manifest buffer
315 (setq dirs (cdr dirs))))) 315 (setq manifest-buf (get-buffer-create manifest-buf))
316 (progn 316 (buffer-disable-undo manifest-buf)
317 (setq package-name (buffer-substring (match-beginning 1) 317 (erase-buffer manifest-buf)
318 (match-end 1))) 318
319 319 ;; Now, scan through the output buffer, looking for
320 ;; Get and erase the manifest buffer 320 ;; file and directory names.
321 (setq manifest-buf (get-buffer-create manifest-buf)) 321 (goto-char (point-min))
322 (buffer-disable-undo manifest-buf) 322 ;; for each line ...
323 (erase-buffer manifest-buf) 323 (while (< (point) (point-max))
324 324 (beginning-of-line)
325 ;; Now, scan through the output buffer, looking for 325 (setq pathname nil)
326 ;; file and directory names. 326
327 (goto-char (point-min)) 327 ;; scan through the regexps, looking for a pathname
328 ;; for each line ... 328 (if (catch 'found-path
329 (while (< (point) (point-max)) 329 (setq regexps package-admin-tar-filename-regexps)
330 (beginning-of-line) 330 (while regexps
331 (setq pathname nil) 331 (if (looking-at (car regexps))
332 332 (progn
333 ;; scan through the regexps, looking for a pathname 333 (setq pathname
334 (if (catch 'found-path 334 (buffer-substring
335 (setq regexps package-admin-tar-filename-regexps) 335 (match-beginning 1)
336 (while regexps 336 (match-end 1)))
337 (if (looking-at (car regexps)) 337 (throw 'found-path t)))
338 (progn 338 (setq regexps (cdr regexps))))
339 (setq pathname 339 (progn
340 (buffer-substring 340 ;; found a pathname -- add it to the manifest
341 (match-beginning 1) 341 ;; buffer
342 (match-end 1))) 342 (save-excursion
343 (throw 'found-path t))) 343 (set-buffer manifest-buf)
344 (setq regexps (cdr regexps)))) 344 (goto-char (point-max))
345 (progn 345 (insert pathname "\n"))))
346 ;; found a pathname -- add it to the manifest 346 (forward-line 1))
347 ;; buffer 347
348 (save-excursion 348 ;; Processed all lines.
349 (set-buffer manifest-buf) 349 ;; Now, create the file, pkginfo/MANIFEST.<pkgname>
350 (goto-char (point-max)) 350
351 (insert pathname "\n")))) 351 ;; We use `expand-file-name' instead of `concat',
352 (forward-line 1)) 352 ;; for portability.
353 353 (setq pathname (expand-file-name "pkginfo"
354 ;; Processed all lines. 354 pkg-topdir))
355 ;; Now, create the file, pkginfo/MANIFEST.<pkgname> 355 ;; Create pkginfo, if necessary
356 356 (if (not (file-directory-p pathname))
357 ;; We use `expand-file-name' instead of `concat', 357 (make-directory pathname))
358 ;; for portability. 358 (setq pathname (expand-file-name
359 (setq pathname (expand-file-name "pkginfo" 359 (concat "MANIFEST." package-name)
360 pkg-topdir)) 360 pathname))
361 ;; Create pkginfo, if necessary 361 (save-excursion
362 (if (not (file-directory-p pathname)) 362 (set-buffer manifest-buf)
363 (make-directory pathname)) 363 ;; Put the files in sorted order
364 (setq pathname (expand-file-name 364 (if-fboundp 'sort-lines
365 (concat "MANIFEST." package-name) 365 (sort-lines nil (point-min) (point-max))
366 pathname)) 366 (warn "`xemacs-base' not installed, MANIFEST.%s not sorted"
367 (save-excursion 367 package-name))
368 (set-buffer manifest-buf) 368 ;; Write the file.
369 ;; Put the files in sorted order 369 ;; Note that using `write-region' *BYPASSES* any check
370 (if-fboundp 'sort-lines 370 ;; to see if XEmacs is currently editing/visiting the
371 (sort-lines nil (point-min) (point-max)) 371 ;; file.
372 (warn "`xemacs-base' not installed, MANIFEST.%s not sorted" 372 (write-region (point-min) (point-max) pathname))
373 package-name)) 373 (kill-buffer manifest-buf))))))))
374 ;; Write the file.
375 ;; Note that using `write-region' *BYPASSES* any check
376 ;; to see if XEmacs is currently editing/visiting the
377 ;; file.
378 (write-region (point-min) (point-max) pathname))
379 (kill-buffer manifest-buf))))))
380 ;; Restore old case-fold-search status
381 (setq case-fold-search old-case-fold-search))))
382 374
383 ;;;###autoload 375 ;;;###autoload
384 (defun package-admin-add-binary-package (file &optional pkg-dir) 376 (defun package-admin-add-binary-package (file &optional pkg-dir)
385 "Install a pre-bytecompiled XEmacs package into package hierarchy." 377 "Install a pre-bytecompiled XEmacs package into package hierarchy."
386 (interactive "fPackage tarball: ") 378 (interactive "fPackage tarball: ")