|
|
1.1 ! root 1: ;; ! 2: ;; copyright (C) 1987, 1988 Franz Inc, Berkeley, Ca. ! 3: ;; ! 4: ;; The software, data and information contained herein are the property ! 5: ;; of Franz, Inc. ! 6: ;; ! 7: ;; This file (or any derivation of it) may be distributed without ! 8: ;; further permission from Franz Inc. as long as: ! 9: ;; ! 10: ;; * it is not part of a product for sale, ! 11: ;; * no charge is made for the distribution, other than a tape ! 12: ;; fee, and ! 13: ;; * all copyright notices and this notice are preserved. ! 14: ;; ! 15: ;; If you have any comments or questions on this interface, please feel ! 16: ;; free to contact Franz Inc. at ! 17: ;; Franz Inc. ! 18: ;; Attn: Kevin Layer ! 19: ;; 1995 University Ave ! 20: ;; Suite 275 ! 21: ;; Berkeley, CA 94704 ! 22: ;; (415) 548-3600 ! 23: ;; or ! 24: ;; emacs-info%[email protected] ! 25: ;; ucbvax!franz!emacs-info ! 26: ! 27: ;; $Header: utils.el,v 1.3 89/02/14 17:24:43 layer Exp $ ! 28: ! 29: ;;; Misc utilities ! 30: ! 31: (defun fi::symbol-value-in-buffer (symbol buffer) ! 32: "Return the value of the local binding of SYMBOL in BUFFER, or ! 33: nil if non-exists. Yes, a value of nil and no local value are the same." ! 34: (save-excursion ! 35: ;; the `set-buffer' non-sense is because there is a cache which is only ! 36: ;; updated when a `set-buffer' is done. ! 37: (set-buffer buffer) ! 38: (cdr (assoc symbol (buffer-local-variables buffer))))) ! 39: ! 40: (defun fi::set-in-buffer (symbol value buffer) ! 41: "Set the value of the local binding of SYMBOL to VALUE in BUFFER, or ! 42: nil if non-exists. Yes, a value of nil and no local value are the same." ! 43: (save-excursion ! 44: ;; the `set-buffer' non-sense is because there is a cache which is only ! 45: ;; updated when a `set-buffer' is done. ! 46: (set-buffer buffer) ! 47: (make-local-variable symbol) ! 48: (set symbol value))) ! 49: ! 50: (defun fi::file-name-sans-type (name) ! 51: "Return FILENAME sans file extension or type." ! 52: (substring name 0 ! 53: (or (string-match "\\.cl$" name) ! 54: (string-match "\\.lisp$" name) ! 55: (string-match "\\.l$" name) ! 56: (length name)))) ! 57: ! 58: (defun fi::substitute-chars-in-string (char-assoc-list string) ! 59: "Substitute character pairs of CHAR-ASSOC-LIST in STRING." ! 60: (let (pair) ! 61: (mapconcat '(lambda (char) ! 62: (if (setq pair (assq char char-assoc-list)) ! 63: (char-to-string (cdr pair)) ! 64: (char-to-string char))) ! 65: string ! 66: nil))) ! 67: ! 68: (defun fi::remove-chars-from-string (char-list string) ! 69: "Remove characters in CHAR-LIST from string STRING and return the result." ! 70: (mapconcat '(lambda (char) ! 71: (if (memq char char-list) ! 72: nil ! 73: (char-to-string char))) ! 74: string ! 75: nil)) ! 76: ! 77: (defun fi::process-running (buffer-name) ! 78: (let (temp) ! 79: (and (setq temp (get-buffer buffer-name)) ! 80: (setq temp (get-buffer-process temp)) ! 81: (setq temp (process-status temp)) ! 82: (or (eq 'run temp) (eq 'open temp))))) ! 83: ! 84: (defun fi::find-other-end-of-list (&optional arg) ! 85: (if (null arg) (setq arg 1)) ! 86: (save-excursion ! 87: (cond ((= (preceding-char) ?\)) (scan-sexps (point) (- arg))) ! 88: ((= (following-char) ?\() (scan-sexps (point) arg)) ! 89: ((= (following-char) ?\)) ! 90: (forward-char 1) (scan-sexps (point) (- arg))) ! 91: (t (error "not on the beginning or end of a list"))))) ! 92: ! 93: (defun fi::find-path (string) ! 94: (let ((p load-path) ! 95: (done nil) res) ! 96: (while (and (not done) p) ! 97: (if (file-exists-p (setq res (concat (car p) "/" string))) ! 98: (setq done t) ! 99: (setq res nil)) ! 100: (setq p (cdr p))) ! 101: res))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.