home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / functions / load-z.el < prev    next >
Encoding:
Text File  |  1991-08-04  |  3.2 KB  |  92 lines
  1. ; Path: dg-rtp!rock!mcnc!rutgers!stanford.edu!snorkelwacker.mit.edu!bu.edu!lll-winken!elroy.jpl.nasa.gov!usc!zaphod.mps.ohio-state.edu!cis.ohio-state.edu!ifi.uio.no!hallvard
  2. ; From: hallvard@ifi.uio.no (Hallvard B Furuseth)
  3. ; Newsgroups: gnu.emacs.sources
  4. ; Subject: Re: Wanted: Uncompress on load / Compress on save
  5. ; Date: 23 Jul 91 05:24:25 GMT
  6.  
  7. ;; LCD Archive Entry:
  8. ;; load-z|Hallvard B Furuseth|hallvard@ifi.uio.no
  9. ;; |As load-file, but looks for .Z files too
  10. ;; |91-07-23||~/functions/load-z.el.Z|
  11.  
  12. (defun load-z (lz-file &optional lz-noerr lz-nomsg lz-nosuf)
  13.   "As load-file, but looks for .Z files too."
  14.   (interactive "fLoad file (accept .Z): ")
  15.   (setq lz-file (where-is-file load-path lz-file
  16.                    (if lz-nosuf ":.Z"
  17.                  ".elc:.elc.Z:.el:.el.Z::.Z")))
  18.   (cond ((null lz-file)
  19.      (and (not lz-noerr)
  20.           (error "Cannot open load file")))
  21.     ((equal (substring lz-file -2) ".Z")
  22.      (or lz-nosuf
  23.          (message "Loading %s..." lz-file))
  24.      (eval (save-excursion
  25.          (set-buffer (get-buffer-create " *Z-elisp*"))
  26.          (unwind-protect
  27.              (progn
  28.                (erase-buffer)
  29.                (insert "(progn\n\n\n)")
  30.                (forward-char -3)
  31.                (call-process "uncompress" lz-file t nil)
  32.                (goto-char (point-min))
  33.                (prog1 (read (current-buffer))
  34.              (or (eobp)
  35.                  (error "Invalid read syntax"))))
  36.            (kill-buffer (current-buffer)))))
  37.      (or lz-nosuf
  38.          (message "Loading %s...done" lz-file))
  39.      t)
  40.     ((load lz-file lz-noerr lz-nomsg t))))
  41.  
  42. (defun require-z (rq-feature &optional rq-file)
  43.   (or (featurep rq-feature)
  44.       (progn (load-z (or rq-file (symbol-name rq-feature)) nil t)
  45.          (or (featurep rq-feature)
  46.          (error "required feature %s was not provided" rq-feature))))
  47.   rq-feature)
  48.  
  49. (defun where-is-file (path file &optional suffixes)
  50.   "Search through PATH (list) for a readable FILENAME, expanded by one of the
  51. optional SUFFIXES (string of suffixes separated by \":\"s).  Interactively,
  52. SUFFIXES (default \".elc:.el:\") is prompted when there is a prefix arg."
  53.   (interactive
  54.    (list (let ((path (read-minibuffer "Search path: " "load-path")))
  55.        (if (and (consp path) (or (stringp (car path)) (null (car path))))
  56.            path
  57.          (eval path)))
  58.      (read-string "Locate file: ")
  59.      (if current-prefix-arg
  60.          (read-string "Suffixes: " ".elc:.el:")
  61.        ".elc:.el:")))
  62.   (if (not (equal file ""))
  63.       (let ((filelist nil) pos temp templist)
  64.     ;; Make list of possible file names
  65.     (setq filelist
  66.           (if suffixes
  67.           (progn
  68.             (while (setq pos (string-match ":[^:]*\\'" suffixes))
  69.               (setq filelist (cons (concat file (substring suffixes
  70.                                    (1+ pos)))
  71.                        filelist))
  72.               (setq suffixes (substring suffixes 0 pos)))
  73.             (cons (concat file suffixes) filelist))
  74.         (list file)))
  75.     ;; Search PATH for a readable file in filelist
  76.     (catch 'bar
  77.       (if (file-name-absolute-p file) (setq path '(nil)))
  78.       (while path
  79.         (setq templist filelist)
  80.         (while
  81.         (progn
  82.           (setq temp (expand-file-name (car templist) (car path)))
  83.           (cond ((file-readable-p temp)
  84.              (if (interactive-p)
  85.                  (message "%s" temp))
  86.              (throw 'bar temp))
  87.             ((setq templist (cdr templist))))))
  88.         (setq path (cdr path)))
  89.       (if (interactive-p)
  90.           (message "(File %s not found)" file))
  91.       nil))))
  92.