Skip to content
Newer
Older
100644 390 lines (345 sloc) 12.7 KB
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2 ;;;
67c5628 @bonzini update copyright years
bonzini authored Oct 17, 2008
3 ;;; Copyright 1988-92, 1994-95, 1999, 2000, 2003, 2007, 2008
333adf1 @bonzini update copyright from 2.3.6 release
bonzini authored Sep 6, 2007
4 ;;; Free Software Foundation, Inc.
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
5 ;;; Written by Steve Byrne.
6 ;;;
7 ;;; This file is part of GNU Smalltalk.
8 ;;;
9 ;;; GNU Smalltalk is free software; you can redistribute it and/or modify it
10 ;;; under the terms of the GNU General Public License as published by the Free
11 ;;; Software Foundation; either version 2, or (at your option) any later
12 ;;; version.
13 ;;;
14 ;;; GNU Smalltalk is distributed in the hope that it will be useful, but
15 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
16 ;;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 ;;; for more details.
18 ;;;
19 ;;; You should have received a copy of the GNU General Public License along
20 ;;; with GNU Smalltalk; see the file COPYING. If not, write to the Free
73bb346 @bonzini more updates to the FSF address
bonzini authored Jun 21, 2005
21 ;;; Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
22 ;;;
23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24
25 ;;; Incorporates Frank Caggiano's changes for Emacs 19.
26 ;;; Updates and changes for Emacs 20 and 21 by David Forster
27
28 (require 'comint)
29
30 (defvar smalltalk-prompt-pattern "^st> *"
31 "Regexp to match prompts in smalltalk buffer.")
32
33 (defvar *gst-process* nil
34 "Holds the GNU Smalltalk process")
7bcf0e5 @bonzini add gst-prog-name, patch from Stephen Compall
bonzini authored Sep 4, 2006
35 (defvar gst-program-name "@bindir@/gst -V"
36 "GNU Smalltalk command to run. Do not use the -a, -f or -- options.")
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
37
38 (defvar smalltalk-command-string nil
39 "Non nil means that we're accumulating output from Smalltalk")
40
41 (defvar smalltalk-eval-data nil
42 "?")
43
44 (defvar smalltalk-ctl-t-map
45 (let ((keymap (make-sparse-keymap)))
46 (define-key keymap "\C-d" 'smalltalk-toggle-decl-tracing)
47 (define-key keymap "\C-e" 'smalltalk-toggle-exec-tracing)
48 (define-key keymap "\C-v" 'smalltalk-toggle-verbose-exec-tracing)
49 keymap)
50 "Keymap of subcommands of C-c C-t, tracing related commands")
51
52 (defvar gst-mode-map
53 (let ((keymap (copy-keymap comint-mode-map)))
54 (define-key keymap "\C-c\C-t" smalltalk-ctl-t-map)
656505c @bonzini Emacs interactor mode refinements
bonzini authored Jun 6, 2007
55
56 (define-key keymap "\C-\M-f" 'smalltalk-forward-sexp)
57 (define-key keymap "\C-\M-b" 'smalltalk-backward-sexp)
58 (define-key keymap "\C-cd" 'smalltalk-doit)
59 (define-key keymap "\C-cf" 'smalltalk-filein)
60 (define-key keymap "\C-cp" 'smalltalk-print)
61 (define-key keymap "\C-cq" 'smalltalk-quit)
62 (define-key keymap "\C-cs" 'smalltalk-snapshot)
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
63 keymap)
64 "Keymap used in Smalltalk interactor mode.")
65
7bcf0e5 @bonzini add gst-prog-name, patch from Stephen Compall
bonzini authored Sep 4, 2006
66 (defun gst (command-line)
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
67 "Invoke GNU Smalltalk"
68 (interactive (list (if (null current-prefix-arg)
7bcf0e5 @bonzini add gst-prog-name, patch from Stephen Compall
bonzini authored Sep 4, 2006
69 gst-program-name
70 (read-smalltalk-command))))
71 (setq gst-program-name command-line)
72 (funcall (if (not (eq major-mode 'gst-mode))
73 #'switch-to-buffer-other-window
74 ;; invoked from a Smalltalk interactor window, so stay
75 ;; there
76 #'identity)
77 (apply 'make-gst "gst" (parse-smalltalk-command gst-program-name)))
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
78 (setq *smalltalk-process* (get-buffer-process (current-buffer))))
79
7bcf0e5 @bonzini add gst-prog-name, patch from Stephen Compall
bonzini authored Sep 4, 2006
80 (defun read-smalltalk-command (&optional command-line)
81 "Reads the program name and arguments to pass to Smalltalk,
82 providing COMMAND-LINE as a default (which itself defaults to
83 `gst-program-name'), answering the string."
84 (read-string "Invoke Smalltalk: " (or command-line gst-program-name)))
85
656505c @bonzini Emacs interactor mode refinements
bonzini authored Jun 6, 2007
86 (defun smalltalk-file-name (str)
87 (if (file-name-directory str) (expand-file-name str) str))
88
7bcf0e5 @bonzini add gst-prog-name, patch from Stephen Compall
bonzini authored Sep 4, 2006
89 (defun parse-smalltalk-command (&optional str)
90 "Parse a list of command-line arguments from STR (default
91 `gst-program-name'), adding --emacs-mode and answering the list."
92 (unless str (setq str gst-program-name))
93 (let (start end result-args)
94 (while (setq start (string-match "[^ \t]" str))
656505c @bonzini Emacs interactor mode refinements
bonzini authored Jun 6, 2007
95 (setq end (or (string-match " " str start) (length str)))
96 (push (smalltalk-file-name (substring str start end)) result-args)
97 (if (null (cdr result-args)) (push "--emacs-mode" result-args))
98 (setq str (substring str end)))
99 (nreverse result-args)))
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
100
101 (defun make-gst (name &rest switches)
102 (let ((buffer (get-buffer-create (concat "*" name "*")))
103 proc status size)
104 (setq proc (get-buffer-process buffer))
105 (if proc (setq status (process-status proc)))
106 (save-excursion
107 (set-buffer buffer)
108 ;; (setq size (buffer-size))
109 (if (memq status '(run stop))
110 nil
111 (if proc (delete-process proc))
112 (setq proc (apply 'start-process
113 name buffer
114 "env"
115 ;; I'm choosing to leave these here
116 ;;"-"
117 (format "TERMCAP=emacs:co#%d:tc=unknown:"
118 (frame-width))
119 "TERM=emacs"
120 "EMACS=t"
121 switches))
122 (setq name (process-name proc)))
123 (goto-char (point-max))
124 (set-marker (process-mark proc) (point))
125 (set-process-filter proc 'gst-filter)
126 (gst-mode))
127 buffer))
128
129 (defun gst-filter (process string)
130 "Make sure that the window continues to show the most recently output
131 text."
132 (let (where ch command-str)
133 (setq where 0) ;fake to get through the gate
134 (while (and string where)
135 (if smalltalk-command-string
136 (setq string (smalltalk-accum-command string)))
137 (if (and string
138 (setq where (string-match "\C-a\\|\C-b" string)))
139 (progn
140 (setq ch (aref string where))
141 (cond ((= ch ?\C-a) ;strip these out
142 (setq string (concat (substring string 0 where)
143 (substring string (1+ where)))))
144 ((= ch ?\C-b) ;start of command
145 (setq smalltalk-command-string "") ;start this off
146 (setq string (substring string (1+ where))))))))
147 (save-excursion
148 (set-buffer (process-buffer process))
149 (goto-char (point-max))
150 (and string
151 (setq mode-status "idle")
152 (insert string))
153 (if (process-mark process)
154 (set-marker (process-mark process) (point-max)))))
155 ;; (if (eq (process-buffer process)
156 ;; (current-buffer))
157 ;; (goto-char (point-max)))
158 ; (save-excursion
159 ; (set-buffer (process-buffer process))
160 ; (goto-char (point-max))
7bcf0e5 @bonzini add gst-prog-name, patch from Stephen Compall
bonzini authored Sep 4, 2006
161 ;; (set-window-point (get-buffer-window (current-buffer)) (point-max))
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
162 ; (sit-for 0))
163 (let ((buf (current-buffer)))
164 (set-buffer (process-buffer process))
165 (goto-char (point-max)) (sit-for 0)
7bcf0e5 @bonzini add gst-prog-name, patch from Stephen Compall
bonzini authored Sep 4, 2006
166 (set-window-point (get-buffer-window (current-buffer)) (point-max))
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
167 (set-buffer buf)))
168
169 (defun smalltalk-accum-command (string)
170 (let (where)
171 (setq where (string-match "\C-a" string))
172 (setq smalltalk-command-string
173 (concat smalltalk-command-string (substring string 0 where)))
174 (if where
175 (progn
176 (unwind-protect ;found the delimiter...do it
177 (smalltalk-handle-command smalltalk-command-string)
178 (setq smalltalk-command-string nil))
179 ;; return the remainder
180 (substring string where))
181 ;; we ate it all and didn't do anything with it
182 nil)))
183
184 (defun smalltalk-handle-command (str)
185 (eval (read str)))
186
187 (defun gst-mode ()
188 "Major mode for interacting Smalltalk subprocesses.
189
190 Entry to this mode calls the value of gst-mode-hook with no arguments,
191 if that value is non-nil; likewise with the value of comint-mode-hook.
192 gst-mode-hook is called after comint-mode-hook."
193 (interactive)
194 (kill-all-local-variables)
195 (setq major-mode 'gst-mode)
196 (setq mode-name "GST")
656505c @bonzini Emacs interactor mode refinements
bonzini authored Jun 6, 2007
197 (require 'comint)
198 (comint-mode)
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
199 (setq mode-line-format
200 '("" mode-line-modified mode-line-buffer-identification " "
201 global-mode-string " %[(" mode-name ": " mode-status
202 "%n" mode-line-process ")%]----" (-3 . "%p") "-%-"))
203
204 (setq comint-prompt-regexp smalltalk-prompt-pattern)
a20447f @bonzini set comint-use-prompt-regexp, patch from Nick Gasson
bonzini authored Jul 8, 2007
205 (setq comint-use-prompt-regexp t)
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
206 (use-local-map gst-mode-map)
207 (make-local-variable 'mode-status)
208 (make-local-variable 'smalltalk-command-string)
209 (setq smalltalk-command-string nil)
210 (setq mode-status "starting-up")
211 (run-hooks 'comint-mode-hook 'gst-mode-hook))
212
213
656505c @bonzini Emacs interactor mode refinements
bonzini authored Jun 6, 2007
214 (defun smalltalk-print-region (start end &optional label)
215 (let (str filename line pos extra)
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
216 (save-excursion
217 (save-restriction
218 (goto-char (max start end))
219 (smalltalk-backward-whitespace)
656505c @bonzini Emacs interactor mode refinements
bonzini authored Jun 6, 2007
220 (setq pos (point))
221 ;canonicalize
222 (while (progn (smalltalk-backward-whitespace)
223 (or (= (preceding-char) ?!)
224 (= (preceding-char) ?.)))
225 (backward-char 1))
226
227 (setq str (buffer-substring (min start end) (point)))
228 (setq extra (buffer-substring (point) pos))
229
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
230 ;; unrelated, but reusing save-excursion
231 (goto-char (min start end))
656505c @bonzini Emacs interactor mode refinements
bonzini authored Jun 6, 2007
232 (setq pos (1- (point)))
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
233 (setq filename (buffer-file-name))
234 (widen)
235 (setq line (1+ (count-lines 1 (point))))))
656505c @bonzini Emacs interactor mode refinements
bonzini authored Jun 6, 2007
236 (send-to-smalltalk (format "(%s) printNl%s\n" str extra)
237 (or label "eval")
238 (smalltalk-pos line pos))))
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
239
656505c @bonzini Emacs interactor mode refinements
bonzini authored Jun 6, 2007
240 (defun smalltalk-eval-region (start end &optional label)
241 "Evaluate START to END as a Smalltalk expression in Smalltalk window.
242 If the expression does not end with an exclamation point, one will be
243 added (at no charge)."
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
244 (let (str filename line pos)
245 (setq str (buffer-substring start end))
246 (save-excursion
247 (save-restriction
248 (goto-char (min start end))
249 (setq pos (point))
250 (setq filename (buffer-file-name))
251 (widen)
252 (setq line (1+ (count-lines 1 (point))))))
656505c @bonzini Emacs interactor mode refinements
bonzini authored Jun 6, 2007
253 (send-to-smalltalk (concat str "\n")
254 (or label "eval")
255 (smalltalk-pos line pos))))
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
256
656505c @bonzini Emacs interactor mode refinements
bonzini authored Jun 6, 2007
257 (defun smalltalk-doit (use-line)
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
258 (interactive "P")
656505c @bonzini Emacs interactor mode refinements
bonzini authored Jun 6, 2007
259 (let* ((start (or (mark) (point)))
260 (end (point))
261 (rgn (if (or use-line
262 (= start end))
263 (smalltalk-bound-expr)
264 (cons start end))))
265 (smalltalk-eval-region (car rgn) (cdr rgn) "doIt")))
266
267 (defun smalltalk-print (use-line)
268 (interactive "P")
269 (let* ((start (or (mark) (point)))
270 (end (point))
271 (rgn (if (or use-line
272 (= start end))
273 (smalltalk-bound-expr)
274 (cons start end))))
275 (smalltalk-print-region (car rgn) (cdr rgn) "printIt")))
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
276
277 (defun smalltalk-bound-expr ()
656505c @bonzini Emacs interactor mode refinements
bonzini authored Jun 6, 2007
278 "Returns a cons of the region of the buffer that contains a smalltalk expression."
279 (save-excursion
280 (beginning-of-line)
281 (cons
282 (point)
283 (progn (next-line)
284 (smalltalk-backward-whitespace)
285 (point)))))
286
287 (defun smalltalk-pos (line pos)
288 (let ((filename (buffer-file-name)))
289 (if filename (list line filename pos) nil)))
290
291 (defun smalltalk-compile (start end)
292 (interactive "r")
293 (let ((str (buffer-substring start end))
294 (filename (buffer-file-name))
295 (pos start)
296 (line (save-excursion
297 (save-restriction
298 (widen)
299 (setq line (1+ (line-number-at-pos start)))))))
300 (send-to-smalltalk str "compile"
301 (smalltalk-pos line pos))))
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
302
303 (defun smalltalk-quote-strings (str)
304 (let (new-str)
305 (save-excursion
306 (set-buffer (get-buffer-create " st-dummy "))
307 (erase-buffer)
308 (insert str)
309 (goto-char 1)
310 (while (and (not (eobp))
311 (search-forward "'" nil 'to-end))
312 (insert "'"))
313 (buffer-string))))
314
315 (defun smalltalk-snapshot (&optional snapshot-name)
316 (interactive (if current-prefix-arg
317 (list (setq snapshot-name
318 (expand-file-name
319 (read-file-name "Snapshot to: "))))))
320 (if snapshot-name
656505c @bonzini Emacs interactor mode refinements
bonzini authored Jun 6, 2007
321 (send-to-smalltalk (format "ObjectMemory snapshot: '%s'\n" "Snapshot"))
322 (send-to-smalltalk "ObjectMemory snapshot\n" "Snapshot")))
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
323
324 (defun smalltalk-quit ()
325 "Terminate the Smalltalk session and associated process. Emacs remains
326 running."
327 (interactive)
656505c @bonzini Emacs interactor mode refinements
bonzini authored Jun 6, 2007
328 (send-to-smalltalk "! ! ObjectMemory quit!" "Quitting"))
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
329
330 (defun smalltalk-filein (filename)
331 "Do a FileStream>>fileIn: on FILENAME."
332 (interactive "fSmalltalk file to load: ")
656505c @bonzini Emacs interactor mode refinements
bonzini authored Jun 6, 2007
333 (send-to-smalltalk (format "FileStream fileIn: '%s'\n"
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
334 (expand-file-name filename))
335 "fileIn"))
336
656505c @bonzini Emacs interactor mode refinements
bonzini authored Jun 6, 2007
337 (defun smalltalk-filein-buffer ()
338 (interactive)
339 (send-to-smalltalk (buffer-string) "fileIn" (smalltalk-pos 1 1)))
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
340
341 (defun smalltalk-toggle-decl-tracing ()
342 (interactive)
343 (send-to-smalltalk
656505c @bonzini Emacs interactor mode refinements
bonzini authored Jun 6, 2007
344 "Smalltalk declarationTrace: Smalltalk declarationTrace not\n"))
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
345
346 (defun smalltalk-toggle-exec-tracing ()
347 (interactive)
348 (send-to-smalltalk
656505c @bonzini Emacs interactor mode refinements
bonzini authored Jun 6, 2007
349 "Smalltalk executionTrace: Smalltalk executionTrace not\n"))
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
350
351
352 (defun smalltalk-toggle-verbose-exec-tracing ()
353 (interactive)
354 (send-to-smalltalk
656505c @bonzini Emacs interactor mode refinements
bonzini authored Jun 6, 2007
355 "Smalltalk verboseTrace: Smalltalk verboseTrace not\n"))
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
356
656505c @bonzini Emacs interactor mode refinements
bonzini authored Jun 6, 2007
357 (defun send-to-smalltalk (str &optional mode fileinfo)
358 (save-window-excursion
359 (gst gst-program-name)
360 (save-excursion
361 (goto-char (point-max))
362 (beginning-of-line)
363 (if (looking-at smalltalk-prompt-pattern)
364 (progn (end-of-line)
365 (insert "\n"))))
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
366
1936dd8 @bonzini fix Emacs mode glitches reported by Jeronimo Pellegrini
bonzini authored Mar 4, 2008
367 (if mode (setq mode-status mode))
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
368
1936dd8 @bonzini fix Emacs mode glitches reported by Jeronimo Pellegrini
bonzini authored Mar 4, 2008
369 (if fileinfo
656505c @bonzini Emacs interactor mode refinements
bonzini authored Jun 6, 2007
370 (let (temp-file buf switch-back old-buf)
371 (setq temp-file (concat "/tmp/" (make-temp-name "gst")))
372 (save-excursion
373 (setq buf (get-buffer-create " zap-buffer "))
374 (set-buffer buf)
375 (erase-buffer)
376 (princ str buf)
377 (write-region (point-min) (point-max) temp-file nil 'no-message)
378 )
379 (kill-buffer buf)
380 (process-send-string
381 *smalltalk-process*
382 (format
383 "FileStream fileIn: '%s' line: %d from: '%s' at: %d\n"
384 temp-file (nth 0 fileinfo) (nth 1 fileinfo) (nth 2 fileinfo))))
1936dd8 @bonzini fix Emacs mode glitches reported by Jeronimo Pellegrini
bonzini authored Mar 4, 2008
385 (comint-send-string *smalltalk-process* str))
386 (switch-to-buffer-other-window (process-buffer *smalltalk-process*))))
03dd8fd @bonzini initial import
bonzini authored Nov 4, 2004
387
388
389 (provide 'gst-mode)
Something went wrong with that request. Please try again.