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