Mercurial > hg > xemacs-beta

comparison lisp/ilisp/ilisp-mod.el @ 0:376386a54a3c r19-14

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