1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
;;; -*- Mode: Emacs-Lisp -*-
;;; ilisp-utl.el --
;;; This file is part of ILISP.
;;; Version: 5.8
;;;
;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
;;; 1993, 1994 Ivan Vasquez
;;; 1994, 1995, 1996 Marco Antoniotti and Rick Busdiecker
;;; 1996 Marco Antoniotti and Rick Campbell
;;;
;;; Other authors' names for which this Copyright notice also holds
;;; may appear later in this file.
;;;
;;; Send mail to 'ilisp-request@naggum.no' to be included in the
;;; ILISP mailing list. 'ilisp@naggum.no' 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))
|
