|
0
|
1 ;;; -*- Mode: Emacs-Lisp -*-
|
|
|
2
|
|
|
3 ;;; ilisp-mod.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 mode top level definitions.
|
|
|
27 ;;;
|
|
|
28
|
|
|
29 ;;;%ilisp-mode
|
|
|
30
|
|
|
31 (defun ilisp-byte-code-to-list (function)
|
|
|
32 "Returns a list suitable for passing to make-byte-code from FUNCTION."
|
|
|
33 (let ((function-object
|
|
|
34 (if (symbolp function)
|
|
|
35 (symbol-function function)
|
|
|
36 function)))
|
|
|
37 (if (fboundp 'compiled-function-arglist)
|
|
|
38 ;; XEmacs
|
|
|
39 (read (concat "("
|
|
|
40 (substring (let ((print-readably t))
|
|
|
41 (prin1-to-string function-object))
|
|
|
42 2 -1)
|
|
|
43 ")"))
|
|
|
44 ;; FSFmacs
|
|
|
45 (append function-object nil))))
|
|
|
46
|
|
|
47 ;;;
|
|
|
48 (defun ilisp-set-doc (function string)
|
|
|
49 "Set the documentation of the symbol FUNCTION to STRING."
|
|
|
50 (let* ((old-function (symbol-function function)))
|
|
|
51 (cond ((listp old-function)
|
|
|
52 ;; Probe to test whether function is in preloaded read-only
|
|
|
53 ;; memory, and if so make writable copy:
|
|
|
54 (condition-case nil
|
|
|
55 (setcar old-function (car old-function))
|
|
|
56 (error
|
|
|
57 (setq old-function (copy-sequence old-function)) ; shallow copy only
|
|
|
58 (fset function old-function)))
|
|
|
59 (let ((ndoc-cdr (nthcdr 2 old-function)))
|
|
|
60 (if (stringp (car ndoc-cdr))
|
|
|
61 ;; Replace the existing docstring.
|
|
|
62 (setcar ndoc-cdr string)
|
|
|
63 ;; There is no docstring. Insert the overwrite msg.
|
|
|
64 (setcdr ndoc-cdr (cons (car ndoc-cdr) (cdr ndoc-cdr)))
|
|
|
65 (setcar ndoc-cdr string))))
|
|
|
66 (t
|
|
|
67 ;; it's an emacs19 compiled-code object
|
|
|
68 (let ((new-code (ilisp-byte-code-to-list old-function)))
|
|
|
69 (if (nthcdr 4 new-code)
|
|
|
70 (setcar (nthcdr 4 new-code) string)
|
|
|
71 (setcdr (nthcdr 3 new-code) (cons string nil)))
|
|
|
72 (fset function (apply 'make-byte-code new-code)))))))
|
|
|
73
|
|
|
74
|
|
|
75
|
|
|
76 ;;;
|
|
|
77 (defun ilisp-mode ()
|
|
|
78 (interactive)
|
|
|
79 (run-ilisp))
|
|
|
80
|
|
|
81 (ilisp-set-doc 'ilisp-mode ilisp-documentation)
|
|
|
82 (ilisp-set-doc 'lisp-mode ilisp-documentation)
|
|
|
83
|
|
|
84 ;;;%%ILISP
|
|
|
85 (defun lisp-command-args (string)
|
|
|
86 "Break up STRING into (command args ...)."
|
|
|
87 (let ((len (length string))
|
|
|
88 (position 0)
|
|
|
89 (arg 0)
|
|
|
90 (args nil))
|
|
|
91 (while (< position len)
|
|
|
92 (if (eq (aref string position) ?\ )
|
|
|
93 (setq args (cons (substring string arg position) args)
|
|
|
94 arg (1+ position)))
|
|
|
95 (setq position (1+ position)))
|
|
|
96 (setq args (reverse (cons (substring string arg position) args)))
|
|
|
97 args))
|
|
|
98
|
|
|
99
|
|
|
100
|
|
|
101 ;;;
|
|
|
102 (defun ilisp (name setup)
|
|
|
103 "Run an inferior LISP process NAME, input and output via buffer *name*.
|
|
|
104 If there is a process already running in *name*, just switch to that buffer.
|
|
|
105 Takes the program name from the variable ilisp-program.
|
|
|
106 \(Type \\[describe-mode] in the process buffer for a list of commands.)"
|
|
|
107 (set-buffer ilisp-buffer)
|
|
|
108 (if (not (comint-check-proc ilisp-buffer))
|
|
|
109 (let* ((dialect (car ilisp-dialect))
|
|
|
110 (program ilisp-program)
|
|
|
111 (args (lisp-command-args program))
|
|
|
112 ;; Use pipes so that strings can be long
|
|
|
113 (process-connection-type nil)
|
|
|
114 (names (format "%s" name))
|
|
|
115 start)
|
|
|
116 (apply 'make-comint name (car args) nil (cdr args))
|
|
|
117 (comint-setup-ipc)
|
|
|
118 ;; Because comint-mode kills all buffer-local variables in
|
|
|
119 ;; fsf-19 we have to re-call the setup here.
|
|
|
120 (funcall setup name)
|
|
|
121 (setq major-mode 'ilisp-mode
|
|
|
122 mode-name "ILISP")
|
|
|
123 (rplaca (car comint-send-queue)
|
|
|
124 (function (lambda ()
|
|
|
125 (run-hooks 'ilisp-init-hook))))
|
|
|
126 (setq ilisp-initialized (lisp-del ilisp-buffer ilisp-initialized))
|
|
|
127 (if (not (lisp-memk names ilisp-buffers 'car))
|
|
|
128 (setq ilisp-buffers (cons (list names) ilisp-buffers)))
|
|
|
129 (lisp-pop-to-buffer ilisp-buffer)
|
|
|
130 (setq start (window-start (selected-window))
|
|
|
131 ilisp-program program)
|
|
|
132 (goto-char (point-max))
|
|
|
133 (insert (format "Starting %s ...\n" ilisp-program))
|
|
|
134 (set-marker (process-mark (ilisp-process)) (point))
|
|
|
135 (funcall comint-update-status 'start)
|
|
|
136 (if ilisp-motd
|
|
|
137 (progn (lisp-display-output (format ilisp-motd ilisp-version))
|
|
4
|
138 (sleep-for 3)
|
|
0
|
139 (set-window-start (selected-window) start)))
|
|
|
140 (if (not ilisp-prefix-match) (require 'completer)))
|
|
|
141 (lisp-pop-to-buffer ilisp-buffer))
|
|
|
142 (use-local-map ilisp-use-map)
|
|
|
143 ;; This is necessary to get mode documentation to come out right
|
|
|
144 (set-default 'ilisp-use-map ilisp-use-map))
|
|
|
145
|
|
|
146
|
|
|
147 ;;;%Manual
|
|
|
148 (autoload 'fi:clman "fi/clman"
|
|
|
149 "Look up SYMBOL in the online manual with completion." t)
|
|
|
150 (autoload 'fi:clman-apropos "fi/clman"
|
|
|
151 "Do an apropos search in online manual for STRING." t)
|
|
|
152
|
|
|
153 ;;;%Bridges
|
|
|
154 (autoload 'install-bridge "bridge" "Install process bridge." t)
|
|
|
155
|
|
|
156 ;;;%Modes
|
|
|
157 (set-default 'auto-mode-alist
|
|
|
158 (append '(("\\.cl$" . lisp-mode) ("\\.lisp$" . lisp-mode))
|
|
|
159 auto-mode-alist))
|
|
|
160 (setq completion-ignored-extensions
|
|
|
161 (append '(".68fasl" ".sfasl" ".ifasl" ".pfasl"
|
|
|
162 ".68fasl4" ".sfasl4" ".ifasl4" ".pfasl4"
|
|
|
163 ".sbin")
|
|
|
164 completion-ignored-extensions))
|
