Mercurial > hg > xemacs-beta
diff lisp/ilisp/ilisp-utl.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:45:50 +0200 |
parents | |
children | b82b59fe008d |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/ilisp/ilisp-utl.el Mon Aug 13 08:45:50 2007 +0200 @@ -0,0 +1,128 @@ +;;; -*- Mode: Emacs-Lisp -*- + +;;; ilisp-utl.el -- + +;;; This file is part of ILISP. +;;; Version: 5.7 +;;; +;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell +;;; 1993, 1994 Ivan Vasquez +;;; 1994, 1995 Marco Antoniotti and Rick Busdiecker +;;; +;;; Other authors' names for which this Copyright notice also holds +;;; may appear later in this file. +;;; +;;; Send mail to 'ilisp-request@lehman.com' to be included in the +;;; ILISP mailing list. 'ilisp@lehman.com' is the general ILISP +;;; mailing list were bugs and improvements are discussed. +;;; +;;; ILISP is freely redistributable under the terms found in the file +;;; COPYING. + + + +;;; +;;; ILISP misc tools. +;;; + +(defun lisp-show-send (string) + "Show STRING in the *ilisp-send* buffer." + (save-excursion + (if (ilisp-buffer) + (set-buffer "*ilisp-send*") + (error "You must start an inferior LISP with run-ilisp.")) + (erase-buffer) + (insert string) + string)) + + +;;; +(defun lisp-slashify (string) + "Put string in the *ilisp-send* buffer, put backslashes before +quotes and backslashes and return the resulting string." + (save-excursion + (lisp-show-send string) + (set-buffer "*ilisp-send*") + (goto-char (point-min)) + (while (search-forward "\\" nil t) + (delete-char -1) + (insert "\\\\")) + (goto-char (point-min)) + (while (search-forward "\"" nil t) + (backward-char) + (insert ?\\) + (forward-char)) + (buffer-substring (point-min) (point-max)))) + + +;;;%%String +(defun lisp-prefix-p (s1 s2) + "Returns t if S1 is a prefix of S2 considering all non alphanumerics +as word delimiters." + (let ((len1 (length s1))) + (and (<= len1 (length s2)) + (let ((start 0) + (start2 0) + end + (match t)) + (while + (if (setq end (string-match "[^a-zA-Z0-9]" s1 start)) + ;; Found delimiter + (if (string= (substring s1 start end) + (substring s2 start2 (+ start2 (- end start)))) + ;; Words are the same + (progn (setq start (match-end 0)) + (if (string-match + (regexp-quote (substring s1 end start)) + s2 start2) + (setq start2 (match-end 0)) ;OK + (setq match nil))) ;Can't find delimiter + (setq match nil)) ;Words don't match + nil)) ;Ran out of delimiters in s1 + (and match + (string= (substring s1 start len1) + (substring s2 start2 (+ start2 (- len1 start))))))))) + + +;;; +(defun lisp-last-line (string) + "Return the last line of STRING with everything else." + (let* ((position 0)) + (while (string-match "\\(\n+\\)[^\n]" string position) + (setq position (match-end 1))) + (cons (substring string position) + (substring string 0 position)))) + + +;;;%%File +;;; +(defun lisp-file-extension (file extension) + "Return FILE with new EXTENSION." + (concat (substring file 0 (string-match ".[^.]*$" file)) + "." extension)) + +(defun ilisp-directory (file &optional dirs) + "Return the directory of DIRS that FILE is found in. By default +load-path is used for the directories." + (let* ((dirs (or dirs (cons "" load-path))) + (dir (car dirs))) + (while (and dir (not (file-exists-p (expand-file-name file dir)))) + (setq dirs (cdr dirs) + dir (car dirs))) + dir)) + + +;;; ilisp-update-status -- +;;; +;;; Note: changed in order to propagate the status change in the +;;; underlying process to the menu. + +(defun ilisp-update-status (status) + "Update process STATUS of the whole Ilisp system. +It updates the STATUS of the current buffer and let all lisp mode +buffers know as well. Also, do some 'exterior' things like make sure +that the menubar is in a consistent state." + (setq ilisp-status (if lisp-show-status (format " :%s" status))) + (if (not (member +ilisp-emacs-version-id+ '(xemacs lucid-19 lucid-19-new))) + (ilisp-update-menu status)) + (comint-update-status status))