|
0
|
1 ;;; -*- Mode: Emacs-Lisp -*-
|
|
|
2
|
|
|
3 ;;; ilisp-utl.el --
|
|
|
4
|
|
|
5 ;;; This file is part of ILISP.
|
|
|
6 ;;; Version: 5.7
|
|
|
7 ;;;
|
|
|
8 ;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
|
|
|
9 ;;; 1993, 1994 Ivan Vasquez
|
|
|
10 ;;; 1994, 1995 Marco Antoniotti and Rick Busdiecker
|
|
|
11 ;;;
|
|
|
12 ;;; Other authors' names for which this Copyright notice also holds
|
|
|
13 ;;; may appear later in this file.
|
|
|
14 ;;;
|
|
|
15 ;;; Send mail to 'ilisp-request@lehman.com' to be included in the
|
|
|
16 ;;; ILISP mailing list. 'ilisp@lehman.com' is the general ILISP
|
|
|
17 ;;; mailing list were bugs and improvements are discussed.
|
|
|
18 ;;;
|
|
|
19 ;;; ILISP is freely redistributable under the terms found in the file
|
|
|
20 ;;; COPYING.
|
|
|
21
|
|
|
22
|
|
|
23
|
|
|
24 ;;;
|
|
|
25 ;;; ILISP misc tools.
|
|
|
26 ;;;
|
|
|
27
|
|
|
28 (defun lisp-show-send (string)
|
|
|
29 "Show STRING in the *ilisp-send* buffer."
|
|
|
30 (save-excursion
|
|
|
31 (if (ilisp-buffer)
|
|
|
32 (set-buffer "*ilisp-send*")
|
|
|
33 (error "You must start an inferior LISP with run-ilisp."))
|
|
|
34 (erase-buffer)
|
|
|
35 (insert string)
|
|
|
36 string))
|
|
|
37
|
|
|
38
|
|
|
39 ;;;
|
|
|
40 (defun lisp-slashify (string)
|
|
|
41 "Put string in the *ilisp-send* buffer, put backslashes before
|
|
|
42 quotes and backslashes and return the resulting string."
|
|
|
43 (save-excursion
|
|
|
44 (lisp-show-send string)
|
|
|
45 (set-buffer "*ilisp-send*")
|
|
|
46 (goto-char (point-min))
|
|
|
47 (while (search-forward "\\" nil t)
|
|
|
48 (delete-char -1)
|
|
|
49 (insert "\\\\"))
|
|
|
50 (goto-char (point-min))
|
|
|
51 (while (search-forward "\"" nil t)
|
|
|
52 (backward-char)
|
|
|
53 (insert ?\\)
|
|
|
54 (forward-char))
|
|
|
55 (buffer-substring (point-min) (point-max))))
|
|
|
56
|
|
|
57
|
|
|
58 ;;;%%String
|
|
|
59 (defun lisp-prefix-p (s1 s2)
|
|
|
60 "Returns t if S1 is a prefix of S2 considering all non alphanumerics
|
|
|
61 as word delimiters."
|
|
|
62 (let ((len1 (length s1)))
|
|
|
63 (and (<= len1 (length s2))
|
|
|
64 (let ((start 0)
|
|
|
65 (start2 0)
|
|
|
66 end
|
|
|
67 (match t))
|
|
|
68 (while
|
|
|
69 (if (setq end (string-match "[^a-zA-Z0-9]" s1 start))
|
|
|
70 ;; Found delimiter
|
|
|
71 (if (string= (substring s1 start end)
|
|
|
72 (substring s2 start2 (+ start2 (- end start))))
|
|
|
73 ;; Words are the same
|
|
|
74 (progn (setq start (match-end 0))
|
|
|
75 (if (string-match
|
|
|
76 (regexp-quote (substring s1 end start))
|
|
|
77 s2 start2)
|
|
|
78 (setq start2 (match-end 0)) ;OK
|
|
|
79 (setq match nil))) ;Can't find delimiter
|
|
|
80 (setq match nil)) ;Words don't match
|
|
|
81 nil)) ;Ran out of delimiters in s1
|
|
|
82 (and match
|
|
|
83 (string= (substring s1 start len1)
|
|
|
84 (substring s2 start2 (+ start2 (- len1 start)))))))))
|
|
|
85
|
|
|
86
|
|
|
87 ;;;
|
|
|
88 (defun lisp-last-line (string)
|
|
|
89 "Return the last line of STRING with everything else."
|
|
|
90 (let* ((position 0))
|
|
|
91 (while (string-match "\\(\n+\\)[^\n]" string position)
|
|
|
92 (setq position (match-end 1)))
|
|
|
93 (cons (substring string position)
|
|
|
94 (substring string 0 position))))
|
|
|
95
|
|
|
96
|
|
|
97 ;;;%%File
|
|
|
98 ;;;
|
|
|
99 (defun lisp-file-extension (file extension)
|
|
|
100 "Return FILE with new EXTENSION."
|
|
|
101 (concat (substring file 0 (string-match ".[^.]*$" file))
|
|
|
102 "." extension))
|
|
|
103
|
|
|
104 (defun ilisp-directory (file &optional dirs)
|
|
|
105 "Return the directory of DIRS that FILE is found in. By default
|
|
|
106 load-path is used for the directories."
|
|
|
107 (let* ((dirs (or dirs (cons "" load-path)))
|
|
|
108 (dir (car dirs)))
|
|
|
109 (while (and dir (not (file-exists-p (expand-file-name file dir))))
|
|
|
110 (setq dirs (cdr dirs)
|
|
|
111 dir (car dirs)))
|
|
|
112 dir))
|
|
|
113
|
|
|
114
|
|
|
115 ;;; ilisp-update-status --
|
|
|
116 ;;;
|
|
|
117 ;;; Note: changed in order to propagate the status change in the
|
|
|
118 ;;; underlying process to the menu.
|
|
|
119
|
|
|
120 (defun ilisp-update-status (status)
|
|
|
121 "Update process STATUS of the whole Ilisp system.
|
|
|
122 It updates the STATUS of the current buffer and let all lisp mode
|
|
|
123 buffers know as well. Also, do some 'exterior' things like make sure
|
|
|
124 that the menubar is in a consistent state."
|
|
|
125 (setq ilisp-status (if lisp-show-status (format " :%s" status)))
|
|
|
126 (if (not (member +ilisp-emacs-version-id+ '(xemacs lucid-19 lucid-19-new)))
|
|
|
127 (ilisp-update-menu status))
|
|
|
128 (comint-update-status status))
|
