[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/smalltalk-mode 1521656 01/34: initial import
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] externals/smalltalk-mode 1521656 01/34: initial import |
|
Date: |
Tue, 9 Apr 2019 22:30:41 -0400 (EDT) |
branch: externals/smalltalk-mode
commit 15216569f8df9d7db9cbf2428ef49df9957d1707
Author: Paolo Bonzini <address@hidden>
Commit: Paolo Bonzini <address@hidden>
initial import
git-archimport-id: address@hidden/smalltalk--devo--2.1--base-0
---
gst-mode.el.in | 515 +++++++++++++++++++++++++++++++
smalltalk-mode.el.in | 837 +++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 1352 insertions(+)
diff --git a/gst-mode.el.in b/gst-mode.el.in
new file mode 100644
index 0000000..cfb4bab
--- /dev/null
+++ b/gst-mode.el.in
@@ -0,0 +1,515 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Copyright 1988-92, 1994-95, 1999, 2000, 2003 Free Software Foundation, Inc.
+;;; Written by Steve Byrne.
+;;;
+;;; This file is part of GNU Smalltalk.
+;;;
+;;; GNU Smalltalk is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by the Free
+;;; Software Foundation; either version 2, or (at your option) any later
+;;; version.
+;;;
+;;; GNU Smalltalk is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+;;; for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License along
+;;; with GNU Smalltalk; see the file COPYING. If not, write to the Free
+;;; Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
USA.
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; Incorporates Frank Caggiano's changes for Emacs 19.
+;;; Updates and changes for Emacs 20 and 21 by David Forster
+
+(require 'comint)
+
+(defvar smalltalk-prompt-pattern "^st> *"
+ "Regexp to match prompts in smalltalk buffer.")
+
+(defvar *gst-process* nil
+ "Holds the GNU Smalltalk process")
+(defvar gst-args '("-Vp")
+ "Arguments to pass to GNU Smalltalk")
+
+(defvar smalltalk-command-string nil
+ "Non nil means that we're accumulating output from Smalltalk")
+
+(defvar smalltalk-eval-data nil
+ "?")
+
+(defvar smalltalk-ctl-t-map
+ (let ((keymap (make-sparse-keymap)))
+ (define-key keymap "\C-d" 'smalltalk-toggle-decl-tracing)
+ (define-key keymap "\C-e" 'smalltalk-toggle-exec-tracing)
+ (define-key keymap "\C-v" 'smalltalk-toggle-verbose-exec-tracing)
+ keymap)
+ "Keymap of subcommands of C-c C-t, tracing related commands")
+
+(defvar gst-mode-map
+ (let ((keymap (copy-keymap comint-mode-map)))
+ (define-key keymap "\C-c\C-t" smalltalk-ctl-t-map)
+ keymap)
+ "Keymap used in Smalltalk interactor mode.")
+
+(defun gst (args)
+ "Invoke GNU Smalltalk"
+ (interactive (list (if (null current-prefix-arg)
+ gst-args
+ (read-smalltalk-args))))
+ (setq gst-args args)
+ (if (not (eq major-mode 'gst-mode))
+ (switch-to-buffer-other-window
+ (apply 'make-gst "gst" gst-args))
+ ;; invoked from a Smalltalk interactor window, so stay there
+ (apply 'make-gst "gst" gst-args))
+ (setq *smalltalk-process* (get-buffer-process (current-buffer))))
+
+(defun read-smalltalk-args ()
+ "Reads the arguments to pass to Smalltalk as a string, returns a list."
+ (let (str args args-str result-args start end)
+ (setq args gst-args)
+ (setq args-str "")
+ (while args
+ (setq args-str (concat args-str " " (car args)))
+ (setq args (cdr args)))
+ (setq str (read-string "Invoke Smalltalk: " args-str))
+ (while (setq start (string-match "[^ ]" str))
+ (setq end (or (string-match " " str start) (length str)))
+ (setq result-args (cons (substring str start end) result-args))
+ (setq str (substring str end)))
+ (reverse result-args)))
+
+(defun make-gst (name &rest switches)
+ (let ((buffer (get-buffer-create (concat "*" name "*")))
+ proc status size)
+ (setq proc (get-buffer-process buffer))
+ (if proc (setq status (process-status proc)))
+ (save-excursion
+ (set-buffer buffer)
+ ;; (setq size (buffer-size))
+ (if (memq status '(run stop))
+ nil
+ (if proc (delete-process proc))
+ (setq proc (apply 'start-process
+ name buffer
+ "env"
+ ;; I'm choosing to leave these here
+ ;;"-"
+ (format "TERMCAP=emacs:co#%d:tc=unknown:"
+ (frame-width))
+ "TERM=emacs"
+ "EMACS=t"
+ "@bindir@/gst"
+ switches))
+ (setq name (process-name proc)))
+ (goto-char (point-max))
+ (set-marker (process-mark proc) (point))
+ (set-process-filter proc 'gst-filter)
+ (gst-mode))
+ buffer))
+
+(defun gst-filter (process string)
+ "Make sure that the window continues to show the most recently output
+text."
+ (let (where ch command-str)
+ (setq where 0) ;fake to get through the gate
+ (while (and string where)
+ (if smalltalk-command-string
+ (setq string (smalltalk-accum-command string)))
+ (if (and string
+ (setq where (string-match "\C-a\\|\C-b" string)))
+ (progn
+ (setq ch (aref string where))
+ (cond ((= ch ?\C-a) ;strip these out
+ (setq string (concat (substring string 0 where)
+ (substring string (1+ where)))))
+ ((= ch ?\C-b) ;start of command
+ (setq smalltalk-command-string "") ;start this off
+ (setq string (substring string (1+ where))))))))
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (goto-char (point-max))
+ (and string
+ (setq mode-status "idle")
+ (insert string))
+ (if (process-mark process)
+ (set-marker (process-mark process) (point-max)))))
+ ;; (if (eq (process-buffer process)
+ ;; (current-buffer))
+ ;; (goto-char (point-max)))
+ ; (save-excursion
+ ; (set-buffer (process-buffer
process))
+ ; (goto-char (point-max))
+ ;; (set-window-dot (get-buffer-window (current-buffer)) (point-max))
+ ; (sit-for 0))
+ (let ((buf (current-buffer)))
+ (set-buffer (process-buffer process))
+ (goto-char (point-max)) (sit-for 0)
+ (set-window-dot (get-buffer-window (current-buffer)) (point-max))
+ (set-buffer buf)))
+
+(defun smalltalk-accum-command (string)
+ (let (where)
+ (setq where (string-match "\C-a" string))
+ (setq smalltalk-command-string
+ (concat smalltalk-command-string (substring string 0 where)))
+ (if where
+ (progn
+ (unwind-protect ;found the delimiter...do it
+ (smalltalk-handle-command smalltalk-command-string)
+ (setq smalltalk-command-string nil))
+ ;; return the remainder
+ (substring string where))
+ ;; we ate it all and didn't do anything with it
+ nil)))
+
+(defun smalltalk-handle-command (str)
+ (eval (read str)))
+
+(defun gst-mode ()
+ "Major mode for interacting Smalltalk subprocesses.
+
+Entry to this mode calls the value of gst-mode-hook with no arguments,
+if that value is non-nil; likewise with the value of comint-mode-hook.
+gst-mode-hook is called after comint-mode-hook."
+ (interactive)
+ (kill-all-local-variables)
+ (setq major-mode 'gst-mode)
+ (setq mode-name "GST")
+ (setq mode-line-format
+ '("" mode-line-modified mode-line-buffer-identification " "
+ global-mode-string " %[(" mode-name ": " mode-status
+ "%n" mode-line-process ")%]----" (-3 . "%p") "-%-"))
+
+ (require 'comint)
+ (comint-mode)
+ (setq comint-prompt-regexp smalltalk-prompt-pattern)
+ (use-local-map gst-mode-map)
+ (make-local-variable 'mode-status)
+ (make-local-variable 'smalltalk-command-string)
+ (setq smalltalk-command-string nil)
+ (setq mode-status "starting-up")
+ (run-hooks 'comint-mode-hook 'gst-mode-hook))
+
+
+(defun smalltalk-eval-region (start end &optional label)
+ "Evaluate START to END as a Smalltalk expression in Smalltalk window.
+If the expression does not end with an exclamation point, one will be
+added (at no charge)."
+ (interactive "r")
+ (let (str filename line pos)
+ (setq str (buffer-substring start end))
+ (save-excursion
+ (save-restriction
+ (goto-char (max start end))
+ (smalltalk-backward-whitespace)
+ (if (/= (preceding-char) ?!) ;canonicalize
+ (setq str (concat str "!")))
+ ;; unrelated, but reusing save-excursion
+ (goto-char (min start end))
+ (setq pos (point))
+ (setq filename (buffer-file-name))
+ (widen)
+ (setq line (1+ (count-lines 1 (point))))))
+ (send-to-smalltalk str (or label "eval")
+ (list line filename pos))))
+
+(defun smalltalk-reeval-region (remember)
+ (interactive "P")
+ (and remember
+ (let (rgn start end)
+ (setq rgn (smalltalk-bound-expr))
+ (setq start (car rgn)
+ end (cdr rgn))
+ (setq smalltalk-eval-data
+ (smalltalk-get-eval-region-data start end "re-doIt"))))
+ (apply 'send-to-smalltalk smalltalk-eval-data))
+
+(defun smalltalk-get-eval-region-data (start end &optional label)
+ (interactive "r")
+ (let (str filename line pos)
+ (setq str (buffer-substring start end))
+ (save-excursion
+ (save-restriction
+ (goto-char (max start end))
+ (smalltalk-backward-whitespace)
+ (if (/= (preceding-char) ?!) ;canonicalize
+ (setq str (concat str "!")))
+ ;; unrelated, but reusing save-excursion
+ (goto-char (min start end))
+ (setq pos (point))
+ (setq filename (buffer-file-name))
+ (widen)
+ (setq line (1+ (count-lines 1 (point))))))
+ ;; certainly not perfect, should probably use markers to bound the region
+ (list str (or label "eval")
+ (list line filename pos))))
+
+(defun smalltalk-eval-region-with-memory (start end &optional label)
+ "Evaluate START to END as a Smalltalk expression in Smalltalk window.
+If the expression does not end with an exclamation point, one will be
+added (at no charge)."
+ (interactive "r")
+
+; (let (str filename line pos)
+; (setq str (buffer-substring start end))
+; (save-excursion
+; (save-restriction
+; (goto-char (max start end))
+; (smalltalk-backward-whitespace)
+; (if (/= (preceding-char) ?!) ;canonicalize
+; (setq str (concat str "!")))
+; ;; unrelated, but reusing save-excursion
+; (goto-char (min start end))
+; (setq pos (point))
+; (setq filename (buffer-file-name))
+; (widen)
+; (setq line (1+ (count-lines 1 (point))))
+; )
+; )
+; ;; certainly not perfect, should probably use markers to bound the region
+; (setq smalltalk-eval-data
+; (list str (or label "eval")
+; (list line filename pos)))
+ (setq smalltalk-eval-data (smalltalk-get-eval-region-data start end label))
+ (smalltalk-reeval-region 't)) ;)
+
+(defun smalltalk-doit (use-region)
+ (interactive "P")
+ (let (start end rgn)
+ (if use-region
+ (progn
+ (setq start (min (mark) (point)))
+ (setq end (max (mark) (point))))
+ (setq rgn (smalltalk-bound-expr))
+ (setq start (car rgn)
+ end (cdr rgn)))
+ (smalltalk-eval-region start end "doIt")))
+
+(defun smalltalk-bound-expr ()
+ "Returns a cons of the region of the buffer that contains a smalltalk
expression.
+It's pretty dumb right now...looks for a line that starts with ! at the end and
+a non-white-space line at the beginning, but this should handle the typical
+cases nicely."
+ (let (start end here)
+ (save-excursion
+ (setq here (point))
+ (re-search-forward "^!")
+ (setq end (point))
+ (beginning-of-line)
+ (if (looking-at "^[^ \t\"]")
+ (progn
+ (goto-char here)
+ (re-search-backward "^[^ \t\"]")
+ (while (looking-at "^$") ;this is a hack to get around a bug
+ (re-search-backward "^[^ \t\"]")))) ;with GNU Emacs's regexp
system
+ (setq start (point))
+ (cons start end))))
+
+(defun smalltalk-compile (use-region)
+ (interactive "P")
+ (let (str start end rgn filename line pos header classname category)
+ (if use-region
+ (progn
+ (setq start (min (point) (mark)))
+ (setq end (max (point) (mark)))
+ (setq str (buffer-substring start end))
+ (save-excursion
+ (goto-char end)
+ (smalltalk-backward-whitespace)
+ (if (/= (preceding-char) ?!) ;canonicalize
+ (setq str (concat str "!"))))
+ (send-to-smalltalk str "compile"))
+ (setq rgn (smalltalk-bound-method))
+ (setq str (buffer-substring (car rgn) (cdr rgn)))
+ (setq filename (buffer-file-name))
+ (setq pos (car rgn))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (setq line (1+ (count-lines 1 (car rgn))))))
+ (if (buffer-file-name)
+ (progn
+ (save-excursion
+ (re-search-backward "^![ \t]*[A-Za-z]")
+ (setq start (point))
+ (forward-char 1)
+ (search-forward "!")
+ (setq end (point))
+ (setq line (- line (1- (count-lines start end))))
+ ;; extra -1 here to compensate for emacs positions being 1 based,
+ ;; and smalltalk's (really ftell & friends) being 0 based.
+ (setq pos (- pos (- end start) 1)))
+ (setq str (concat (buffer-substring start end) "\n\n" str "!"))
+ (send-to-smalltalk str "compile"
+ ;-2 accounts for num lines and num chars extra
+ (list (- line 2) filename (- pos 2))))
+ (save-excursion
+ (re-search-backward "^!\\(.*\\) methodsFor: \\(.*\\)!")
+ (setq classname (buffer-substring
+ (match-beginning 1) (match-end 1)))
+ (setq category (buffer-substring
+ (match-beginning 2) (match-end 2)))
+ (goto-char (match-end 0))
+ (setq str (smalltalk-quote-strings str))
+ (setq str (format "%s compile: '%s' classified: %s!\n"
+ classname (substring str 0 -1) category))
+ (save-excursion (set-buffer (get-buffer-create "junk"))
+ (erase-buffer)
+ (insert str))
+ (send-to-smalltalk str "compile"
+ (list line nil 0)))))))
+
+(defun smalltalk-bound-method ()
+ (let (start end)
+ (save-excursion
+ (re-search-forward "^!")
+ (setq end (point)))
+ (save-excursion
+ (re-search-backward "^[^ \t\"]")
+ (while (looking-at "^$") ;this is a hack to get around a bug
+ (re-search-backward "^[^ \t\"]")) ;with GNU Emacs's regexp system
+ (setq start (point)))
+ (cons start end)))
+
+(defun smalltalk-quote-strings (str)
+ (let (new-str)
+ (save-excursion
+ (set-buffer (get-buffer-create " st-dummy "))
+ (erase-buffer)
+ (insert str)
+ (goto-char 1)
+ (while (and (not (eobp))
+ (search-forward "'" nil 'to-end))
+ (insert "'"))
+ (buffer-string))))
+
+(defun smalltalk-snapshot (&optional snapshot-name)
+ (interactive (if current-prefix-arg
+ (list (setq snapshot-name
+ (expand-file-name
+ (read-file-name "Snapshot to: "))))))
+ (if snapshot-name
+ (send-to-smalltalk (format "ObjectMemory snapshot: '%s'!" "Snapshot"))
+ (send-to-smalltalk "ObjectMemory snapshot!" "Snapshot")))
+
+(defun smalltalk-print (start end)
+ "Evaluate the expression delimited by START and END and print the result.
+Interactively, the region is used. Printing is done in the standard Smalltalk
+output window."
+ (interactive "r")
+ (let (str)
+ (setq str (buffer-substring start end))
+ (save-excursion
+ (goto-char (max start end))
+ (smalltalk-backward-whitespace)
+ (if (= (preceding-char) ?!) ;canonicalize
+ (setq str (buffer-substring (min start end) (point))))
+ (setq str (format "(%s) printNl!" str))
+ (send-to-smalltalk str "print"))))
+
+(defun smalltalk-quit ()
+ "Terminate the Smalltalk session and associated process. Emacs remains
+running."
+ (interactive)
+ (send-to-smalltalk "ObjectMemory quit!" "Quitting"))
+
+(defun smalltalk-filein (filename)
+ "Do a FileStream>>fileIn: on FILENAME."
+ (interactive "fSmalltalk file to load: ")
+ (send-to-smalltalk (format "FileStream fileIn: '%s'!"
+ (expand-file-name filename))
+ "fileIn"))
+
+
+(defun smalltalk-toggle-decl-tracing ()
+ (interactive)
+ (send-to-smalltalk
+ "Smalltalk declarationTrace:
+ Smalltalk declarationTrace not!"))
+
+(defun smalltalk-toggle-exec-tracing ()
+ (interactive)
+ (send-to-smalltalk
+ "Smalltalk executionTrace: Smalltalk executionTrace not!"))
+
+
+(defun smalltalk-toggle-verbose-exec-tracing ()
+ (interactive)
+ (send-to-smalltalk
+ "Smalltalk verboseTrace: Smalltalk verboseTrace not!"))
+
+(defun test-func (arg &optional cmd-arg)
+ (let ((buf (current-buffer)))
+ (unwind-protect
+ (progn
+ (if (not (consp (cdr arg)))
+ (progn
+ (find-file-other-window (car arg))
+ (goto-char (1+ (cdr arg)))
+ (recenter '(0)) ;hack to recenter the window without
+ ;redisplaying everything
+ )
+ (switch-to-buffer-other-window (get-buffer-create (car arg)))
+ (smalltalk-mode)
+ (erase-buffer)
+ (insert (format "!%s methodsFor: '%s'!
+
+%s! !" (nth 0 arg) (nth 1 arg) (nth 2 arg)))
+ (beginning-of-buffer)
+ (forward-line 2))) ;skip to start of method
+ (pop-to-buffer buf))))
+
+(defun send-to-smalltalk (str &optional mode fileinfo)
+ (let (temp-file buf switch-back old-buf)
+ (setq temp-file (concat "/tmp/" (make-temp-name "gst")))
+ (save-excursion
+ (setq buf (get-buffer-create " zap-buffer "))
+ (set-buffer buf)
+ (erase-buffer)
+ (princ str buf)
+ (write-region (point-min) (point-max) temp-file nil 'no-message)
+ )
+ (kill-buffer buf)
+ ;; this should probably be conditional
+ (save-window-excursion (gst gst-args))
+;;; why is this like this?
+;; (if mode
+;; (progn
+;; (save-excursion
+;; (set-buffer (process-buffer *smalltalk-process*))
+;; (setq mode-status mode))
+;; ))
+ (setq old-buf (current-buffer))
+ (setq buf (process-buffer *smalltalk-process*))
+ (pop-to-buffer buf)
+ (if mode
+ (setq mode-status mode))
+ (goto-char (point-max))
+ (newline)
+ (pop-to-buffer old-buf)
+; (if (not (eq buf (current-buffer)))
+; (progn
+; (switch-to-buffer-other-window buf)
+; (setq switch-back t))
+; )
+; (if mode
+; (setq mode-status mode))
+; (goto-char (point-max))
+; (newline)
+; (and switch-back (other-window 1))
+; ;;(sit-for 0)
+ (if fileinfo
+ (process-send-string
+ *smalltalk-process*
+ (format
+ "FileStream fileIn: '%s' line: %d from: '%s' at: %d!\n"
+ temp-file (nth 0 fileinfo) (nth 1 fileinfo) (nth 2 fileinfo)))
+ (process-send-string *smalltalk-process*
+ (concat "FileStream fileIn: '" temp-file "'!\n")))))
+
+
+(provide 'gst-mode)
diff --git a/smalltalk-mode.el.in b/smalltalk-mode.el.in
new file mode 100644
index 0000000..c56ed13
--- /dev/null
+++ b/smalltalk-mode.el.in
@@ -0,0 +1,837 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Copyright 1988-92, 1994-95, 1999, 2000, 2003 Free Software Foundation, Inc.
+;;; Written by Steve Byrne.
+;;;
+;;; This file is part of GNU Smalltalk.
+;;;
+;;; GNU Smalltalk is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by the Free
+;;; Software Foundation; either version 2, or (at your option) any later
+;;; version.
+;;;
+;;; GNU Smalltalk is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+;;; for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License along
+;;; with GNU Smalltalk; see the file COPYING. If not, write to the Free
+;;; Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
USA.
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; Incorporates Frank Caggiano's changes for Emacs 19.
+;;; Updates and changes for Emacs 20 and 21 by David Forster
+
+;; ===[ Variables and constants ]=====================================
+
+(defvar smalltalk-name-regexp "[A-z][A-z0-9_]*"
+ "A regular expression that matches a Smalltalk identifier")
+
+(defvar smalltalk-keyword-regexp (concat smalltalk-name-regexp ":")
+ "A regular expression that matches a Smalltalk keyword")
+
+(defvar smalltalk-name-chars "A-z0-9"
+ "The collection of character that can compose a Smalltalk identifier")
+
+(defvar smalltalk-whitespace " \t\n\f")
+
+(defconst smalltalk-indent-amount 4
+ "*'Tab size'; used for simple indentation alignment.")
+
+;; ---[ Syntax Table ]------------------------------------------------
+
+;; This may very well be a bug, but certin chars like ?+ are set to be
+;; punctuation, when in fact one might think of them as words (that
+;; is, they are valid selector names). Some functions will fail
+;; however, (like smalltalk-begin-of-defun) so there punctuation.
+;; Works for now...
+
+(defvar smalltalk-mode-syntax-table
+ (let ((table (make-syntax-table)))
+ (setq smalltalk-mode-syntax-table (make-syntax-table))
+ ;; Make sure A-z0-9 are set to "w " for completeness
+ (let ((c 0))
+ (setq c ?0)
+ (while (<= c ?9)
+ (setq c (1+ c))
+ (modify-syntax-entry c "w " table))
+ (setq c ?A)
+ (while (<= c ?Z)
+ (setq c (1+ c))
+ (modify-syntax-entry c "w " table))
+ (setq c ?a)
+ (while (<= c ?z)
+ (setq c (1+ c))
+ (modify-syntax-entry c "w " table)))
+ (modify-syntax-entry ?: ". " table) ; Symbol-char
+ (modify-syntax-entry ?_ "_ " table) ; Symbol-char
+ (modify-syntax-entry ?\" "! " table) ; Comment (generic)
+ (modify-syntax-entry ?' "\" " table) ; String
+ (modify-syntax-entry ?# "' " table) ; Symbol or Array constant
+ (modify-syntax-entry ?\( "() " table) ; Grouping
+ (modify-syntax-entry ?\) ")( " table) ; Grouping
+ (modify-syntax-entry ?\[ "(] " table) ; Block-open
+ (modify-syntax-entry ?\] ")[ " table) ; Block-close
+ (modify-syntax-entry ?{ "(} " table) ; Array-open
+ (modify-syntax-entry ?} "){ " table) ; Array-close
+ (modify-syntax-entry ?$ "/ " table) ; Character literal
+ (modify-syntax-entry ?! ". " table) ; End message / Delimit defs
+ (modify-syntax-entry ?\; ". " table) ; Cascade
+ (modify-syntax-entry ?| ". " table) ; Temporaries
+ (modify-syntax-entry ?^ ". " table) ; Return
+ ;; Just to make sure these are not set to "w "
+ (modify-syntax-entry ?< ". " table)
+ (modify-syntax-entry ?> ". " table)
+ (modify-syntax-entry ?+ ". " table) ; math
+ (modify-syntax-entry ?- ". " table) ; math
+ (modify-syntax-entry ?* ". " table) ; math
+ (modify-syntax-entry ?/ ". " table) ; math
+ (modify-syntax-entry ?= ". " table) ; bool/assign
+ (modify-syntax-entry ?% ". " table) ; valid selector
+ (modify-syntax-entry ?& ". " table) ; boolean
+ (modify-syntax-entry ?\\ ". " table) ; ???
+ (modify-syntax-entry ?~ ". " table) ; misc. selector
+ (modify-syntax-entry ?@ ". " table) ; Point
+ (modify-syntax-entry ?, ". " table) ; concat
+ table)
+ "Syntax table used by Smalltalk mode")
+
+;; ---[ Abbrev table ]------------------------------------------------
+
+(defvar smalltalk-mode-abbrev-table nil
+ "Abbrev table in use in smalltalk-mode buffers.")
+(define-abbrev-table 'smalltalk-mode-abbrev-table ())
+
+;; ---[ Keymap ]------------------------------------------------------
+
+(defvar smalltalk-template-map
+ (let ((keymap (make-sparse-keymap)))
+ (define-key keymap "p" 'smalltalk-private-template)
+ (define-key keymap "c" 'smalltalk-class-template)
+ (define-key keymap "i" 'smalltalk-instance-template)
+ keymap)
+ "Keymap of template creation keys")
+
+(defvar smalltalk-mode-map
+ (let ((keymap (make-sparse-keymap)))
+ (define-key keymap "\n" 'smalltalk-newline-and-indent)
+ (define-key keymap "\C-\M-a" 'smalltalk-begin-of-defun)
+ (define-key keymap "\C-\M-f" 'smalltalk-forward-sexp)
+ (define-key keymap "\C-\M-b" 'smalltalk-backward-sexp)
+ (define-key keymap "!" 'smalltalk-bang)
+ (define-key keymap ":" 'smalltalk-colon)
+ (define-key keymap "\C-ct" smalltalk-template-map)
+
+ ;; -----
+
+ (define-key keymap "\C-cc" 'smalltalk-compile)
+ (define-key keymap "\C-cd" 'smalltalk-doit)
+ (define-key keymap "\C-ce" 'smalltalk-eval-region)
+ (define-key keymap "\C-cf" 'smalltalk-filein)
+ (define-key keymap "\C-cm" 'gst)
+ (define-key keymap "\C-cp" 'smalltalk-print)
+ (define-key keymap "\C-cq" 'smalltalk-quit)
+ (define-key keymap "\C-cr" 'smalltalk-reeval-region)
+ (define-key keymap "\C-cs" 'smalltalk-snapshot)
+
+ keymap)
+ "Keymap for Smalltalk mode")
+
+(defconst smalltalk-binsel "\\([-+*/~,<>=&?]\\{1,2\\}\\|:=\\|||\\)"
+ "Smalltalk binary selectors")
+
+(defconst smalltalk-font-lock-keywords
+ (list
+ '("#[A-z][A-z0-9_]*" . font-lock-constant-face)
+ '("\\<[A-z][A-z0-9_]*:" . font-lock-function-name-face)
+ (cons smalltalk-binsel 'font-lock-function-name-face)
+; '("\\^" . font-lock-keyword-face)
+ '("\\$." . font-lock-string-face) ;; Chars
+ '("\\<[A-Z]\\sw*\\>" . font-lock-type-face))
+ "Basic Smalltalk keywords font-locking")
+
+(defconst smalltalk-font-lock-keywords-1
+ smalltalk-font-lock-keywords
+ "Level 1 Smalltalk font-locking keywords")
+
+(defconst smalltalk-font-lock-keywords-2
+ (append smalltalk-font-lock-keywords-1
+ (list
+ '("\\<\\(true\\|false\\|nil\\|self\\|super\\)\\>"
+ . font-lock-builtin-face)
+ '(":[a-z][A-z0-9_]*" . font-lock-variable-name-face)
+ '(" |" . font-lock-type-face)
+ '("<.*>" . font-lock-builtin-face)))
+
+ "Level 2 Smalltalk font-locking keywords")
+
+;; ---[ Interactive functions ]---------------------------------------
+
+(defun smalltalk-mode ()
+ "Major mode for editing Smalltalk code."
+ (interactive)
+ (kill-all-local-variables)
+ (setq major-mode 'smalltalk-mode)
+ (setq mode-name "Smalltalk")
+
+ (use-local-map smalltalk-mode-map)
+ (set-syntax-table smalltalk-mode-syntax-table)
+ (setq local-abbrev-table smalltalk-mode-abbrev-table)
+
+ ;; Buffer locals
+
+ (set (make-local-variable 'paragraph-start)
+ (concat "^$\\|" page-delimiter))
+ (set (make-local-variable 'paragraph-separate)
+ paragraph-start)
+ (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
+ (set (make-local-variable 'indent-line-function)
+ 'smalltalk-indent-line)
+ (set (make-local-variable 'require-final-newline) t)
+ (set (make-local-variable 'comment-start) "\"")
+ (set (make-local-variable 'comment-end) "\"")
+ (set (make-local-variable 'comment-column) 32)
+ (set (make-local-variable 'comment-start-skip) "\" *")
+ ;; Doesn't seem useful...?
+ (set (make-local-variable 'comment-indent-function)
+ 'smalltalk-comment-indent)
+ ;; For interactive f-b sexp
+ (set (make-local-variable 'parse-sexp-ignore-comments) t)
+
+ ;; font-locking
+ (set (make-local-variable 'font-lock-defaults)
+ '((smalltalk-font-lock-keywords
+ smalltalk-font-lock-keywords-1
+ smalltalk-font-lock-keywords-2)
+ nil nil nil nil))
+
+ ;; Run hooks, must be last
+ (run-hooks 'smalltalk-mode-hook))
+
+(defun smalltalk-tab ()
+ (interactive)
+ (let (col)
+ ;; round up, with overflow
+ (setq col (* (/ (+ (current-column) smalltalk-indent-amount)
+ smalltalk-indent-amount)
+ smalltalk-indent-amount))
+ (indent-to-column col)))
+
+(defun smalltalk-begin-of-defun ()
+ "Skips to the beginning of the current method. If already at
+the beginning of a method, skips to the beginning of the previous
+one."
+ (interactive)
+ (let ((parse-sexp-ignore-comments t) here delim start)
+ (setq here (point))
+ (while (and (search-backward "!" nil 'to-end)
+ (setq delim (smalltalk-in-string)))
+ (search-backward delim))
+ (setq start (point))
+ (if (looking-at "!")
+ (forward-char 1))
+ (smalltalk-forward-whitespace)
+ ;; check to see if we were already at the start of a method
+ ;; in which case, the semantics are to go to the one preceeding
+ ;; this one
+ (if (and (= here (point))
+ (/= start (point-min)))
+ (progn
+ (goto-char start)
+ (smalltalk-backward-whitespace) ;may be at ! "foo" !
+ (if (= (preceding-char) ?!)
+ (backward-char 1))
+ (smalltalk-begin-of-defun))))) ;and go to the next one
+
+(defun smalltalk-forward-sexp (n)
+ (interactive "p")
+ (let (i)
+ (cond ((< n 0)
+ (smalltalk-backward-sexp (- n)))
+ ((null parse-sexp-ignore-comments)
+ (forward-sexp n))
+ (t
+ (while (> n 0)
+ (smalltalk-forward-whitespace)
+ (forward-sexp 1)
+ (setq n (1- n)))))))
+
+(defun smalltalk-backward-sexp (n)
+ (interactive "p")
+ (let (i)
+ (cond ((< n 0)
+ (smalltalk-forward-sexp (- n)))
+ ((null parse-sexp-ignore-comments)
+ (backward-sexp n))
+ (t
+ (while (> n 0)
+ (smalltalk-backward-whitespace)
+ (backward-sexp 1)
+ (setq n (1- n)))))))
+
+(defun smalltalk-reindent ()
+ (interactive)
+ (smalltalk-indent-line))
+
+(defun smalltalk-newline-and-indent (levels)
+ "Called basically to do newline and indent. Sees if the current line is a
+new statement, in which case the indentation is the same as the previous
+statement (if there is one), or is determined by context; or, if the current
+line is not the start of a new statement, in which case the start of the
+previous line is used, except if that is the start of a new line in which case
+it indents by smalltalk-indent-amount."
+ (interactive "p")
+ (newline)
+ (smalltalk-indent-line))
+
+(defun smalltalk-colon ()
+ "Possibly reindents a line when a colon is typed.
+If the colon appears on a keyword that's at the start of the line (ignoring
+whitespace, of course), then the previous line is examined to see if there
+is a colon on that line, in which case this colon should be aligned with the
+left most character of that keyword. This function is not fooled by nested
+expressions."
+ (interactive)
+ (let (needs-indent state (parse-sexp-ignore-comments t))
+ (setq state (parse-partial-sexp (point-min) (point)))
+
+ (if (null (nth 3 state)) ;we're not in string or comment
+ (progn
+ (save-excursion
+ (skip-chars-backward "A-z0-9_")
+ (if (and (looking-at smalltalk-name-regexp)
+ (not (smalltalk-at-method-begin)))
+ (setq needs-indent (smalltalk-white-to-bolp))))
+ (and needs-indent
+ (smalltalk-indent-for-colon))))
+ ;; out temporarily
+ ;; (expand-abbrev) ;I don't think this is the
"correct"
+ ;; ;way to do this...I suspect that
+ ;; ;some flavor of "call interactively"
+ ;; ;is better.
+ (self-insert-command 1)))
+
+(defun smalltalk-bang ()
+ (interactive)
+ (insert "!")
+ (save-excursion
+ (beginning-of-line)
+ (if (looking-at "^[ \t]+!")
+ (delete-horizontal-space))))
+
+(defun smalltalk-instance-template (class-name category-name)
+ (interactive
+ (list (read-string "Class: " (smalltalk-backward-find-class-name))
+ (read-string "Category: ")))
+ (insert (format "!%s methodsFor: '%s'!\n\n" class-name category-name))
+ (save-excursion
+ (insert "\n! !\n")))
+
+(defun smalltalk-private-template (class-name)
+ (interactive
+ (list (read-string "Class: " (smalltalk-backward-find-class-name))))
+ (insert (format "!%s methodsFor: 'private'!\n\n" class-name))
+ (save-excursion
+ (insert "\n! !\n")))
+
+(defun smalltalk-class-template (class-name category-name)
+ (interactive
+ (list (read-string "Class: " (smalltalk-backward-find-class-name))
+ (read-string "Category: " "instance creation")))
+ (insert (format "!%s class methodsFor: '%s'!\n\n" class-name category-name))
+ (save-excursion
+ (insert "\n! !\n")))
+
+;; ---[ Non-interactive functions ]-----------------------------------
+
+;; This is used by indent-for-comment
+;; to decide how much to indent a comment in Smalltalk code
+;; based on its context.
+(defun smalltalk-comment-indent ()
+ (if (looking-at "^\"")
+ 0 ;Existing comment at bol stays there.
+ (save-excursion
+ (skip-chars-backward " \t")
+ (max (1+ (current-column)) ;Else indent at comment column
+ comment-column)))) ; except leave at least one space.
+
+(defun smalltalk-indent-line ()
+ (let (indent-amount is-keyword)
+ (save-excursion
+ (beginning-of-line)
+ (if (smalltalk-in-comment)
+ ;; We are in the middle of a multi-line comment
+ (progn
+ (search-backward "\"")
+ (setq indent-amount (1+ (current-column))))
+ (progn
+ (smalltalk-forward-whitespace)
+ (if (looking-at "[A-z][A-z0-9_]*:")
+ (setq is-keyword t)
+ (setq indent-amount (calculate-smalltalk-indent))))))
+ (if is-keyword
+ (smalltalk-indent-for-colon)
+ (smalltalk-indent-to-column indent-amount))))
+
+(defun calculate-smalltalk-indent ()
+ (let (needs-indent indent-amount done c state orig start-of-line
+ (parse-sexp-ignore-comments t))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (narrow-to-region (point-min) (point)) ;only care about what's before
+ (setq state (parse-partial-sexp (point-min) (point)))
+ (cond ((equal (nth 3 state) ?\") ;in a comment
+ (save-excursion
+ (smalltalk-backward-comment)
+ (setq indent-amount (1+ (current-column)))))
+ ((equal (nth 3 state) ?') ;in a string
+ (setq indent-amount 0))
+ (t
+ (save-excursion
+ (smalltalk-backward-whitespace)
+ (if (or (bobp)
+ (= (preceding-char) ?!))
+ (setq indent-amount 0)))))
+ (if (null indent-amount)
+ (progn
+ (smalltalk-narrow-to-method)
+ (beginning-of-line)
+ (setq state (smalltalk-parse-sexp-and-narrow-to-paren))
+ (smalltalk-backward-whitespace)
+ (cond ((bobp) ;must be first statment in block or exp
+ (if (nth 1 state) ;we're in a paren exp
+ (if (looking-at "$")
+ ;; block with no statements, indent by 4
+ (setq indent-amount (+ (smalltalk-current-indent)
+ smalltalk-indent-amount))
+
+ ;; block with statements, indent to first
non-whitespace
+ (setq indent-amount (smalltalk-current-column)))
+
+ ;; we're top level
+ (setq indent-amount smalltalk-indent-amount)))
+ ((= (preceding-char) ?.) ;at end of statement
+ (smalltalk-find-statement-begin)
+ (setq indent-amount (smalltalk-current-column)))
+ ((= (preceding-char) ?:)
+ (beginning-of-line)
+ (smalltalk-forward-whitespace)
+ (setq indent-amount (+ (smalltalk-current-column)
+ smalltalk-indent-amount)))
+ ((= (preceding-char) ?>) ;maybe <primitive: xxx>
+ (setq orig (point))
+ (backward-char 1)
+ (smalltalk-backward-whitespace)
+ (skip-chars-backward "0-9")
+ (smalltalk-backward-whitespace)
+ (if (= (preceding-char) ?:)
+ (progn
+ (backward-char 1)
+ (skip-chars-backward "a-zA-Z_")
+ (if (looking-at "primitive:")
+ (progn
+ (smalltalk-backward-whitespace)
+ (if (= (preceding-char) ?<)
+ (setq indent-amount (1-
(smalltalk-current-column))))))))
+ (if (null indent-amount)
+ (progn
+ (goto-char orig)
+ (smalltalk-find-statement-begin)
+ (setq indent-amount (+ (smalltalk-current-column)
+ smalltalk-indent-amount)))))
+ (t ;must be a statement continuation
+ (save-excursion
+ (beginning-of-line)
+ (setq start-of-line (point)))
+ (smalltalk-find-statement-begin)
+ (setq indent-amount (+ (smalltalk-current-column)
+ smalltalk-indent-amount))))))
+ indent-amount))))
+
+
+(defun smalltalk-previous-nonblank-line ()
+ (forward-line -1)
+ (while (and (not (bobp))
+ (looking-at "^[ \t]*$"))
+ (forward-line -1)))
+
+(defun smalltalk-in-string ()
+ "Returns non-nil delimiter as a string if the current location is
+actually inside a string or string like context."
+ (let (state)
+ (setq state (parse-partial-sexp (point-min) (point)))
+ (and (nth 3 state)
+ (char-to-string (nth 3 state)))))
+
+(defun smalltalk-in-comment ()
+ "Returns non-nil if the current location is inside a comment"
+ (let (state)
+ (setq state (parse-partial-sexp (point-min) (point)))
+ (nth 4 state)))
+
+(defun smalltalk-forward-whitespace ()
+ "Skip white space and comments forward, stopping at end of buffer
+or non-white space, non-comment character"
+ (while (looking-at (concat "[" smalltalk-whitespace "]"))
+ (skip-chars-forward smalltalk-whitespace)
+ (if (= (following-char) ?\")
+ (forward-comment 1))))
+
+;; (defun smalltalk-forward-whitespace ()
+;; "Skip white space and comments forward, stopping at end of buffer
+;; or non-white space, non-comment character"
+;; (forward-comment 1)
+;; (if (= (following-char) ?\n)
+;; (forward-char)))
+
+(defun smalltalk-backward-whitespace ()
+ "Like forward whitespace only going towards the start of the buffer"
+ (while (progn (skip-chars-backward smalltalk-whitespace)
+ (= (preceding-char) ?\"))
+ (search-backward "\"" nil t 2)))
+
+
+(defun smalltalk-current-column ()
+ "Returns the current column of the given line, regardless of narrowed
buffer."
+ (save-restriction
+ (widen)
+ (current-column))) ;this changed in 18.56
+
+(defun smalltalk-current-indent ()
+ "Returns the indentation of the given line, regardless of narrowed buffer."
+ (save-restriction
+ (widen)
+ (beginning-of-line)
+ (skip-chars-forward smalltalk-whitespace)
+ (current-column)))
+
+(defun smalltalk-find-statement-begin ()
+ "Leaves the point at the first non-blank, non-comment character of a new
+statement. If begininning of buffer is reached, then the point is left there.
+This routine only will return with the point pointing at the first non-blank
+on a line; it won't be fooled by multiple statements on a line into stopping
+prematurely. Also, goes to start of method if we started in the method
+selector."
+ (let (start ch)
+ (if (= (preceding-char) ?.) ;if we start at eos
+ (backward-char 1)) ;we find the begin of THAT stmt
+ (while (and (null start) (not (bobp)))
+ (smalltalk-backward-whitespace)
+ (cond ((= (setq ch (preceding-char)) ?.)
+ (let (saved-point)
+ (setq saved-point (point))
+ (smalltalk-forward-whitespace)
+ (if (smalltalk-white-to-bolp)
+ (setq start (point))
+ (goto-char saved-point)
+ (smalltalk-backward-sexp 1))
+ ))
+ ((= ch ?^) ;HACK -- presuming that when we back
+ ;up into a return that we're at the
+ ;start of a statement
+ (backward-char 1)
+ (setq start (point)))
+ ((= ch ?!)
+ (smalltalk-forward-whitespace)
+ (setq start (point)))
+ (t
+ (smalltalk-backward-sexp 1))))
+ (if (null start)
+ (progn
+ (goto-char (point-min))
+ (smalltalk-forward-whitespace)
+ (setq start (point))))
+ start))
+
+(defun smalltalk-match-paren (state)
+ "Answer the closest previous open paren.
+Actually, skips over any block parameters, and skips over the whitespace
+following on the same line."
+ (let ((paren-addr (nth 1 state))
+ start c done)
+ (if (not paren-addr)
+ ()
+ (save-excursion
+ (goto-char paren-addr)
+ (setq c (following-char))
+ (cond ((or (eq c ?\() (eq c ?{))
+ (1+ (point)))
+ ((eq c ?\[)
+ (forward-char 1)
+
+ ;; Now skip over the block parameters, if any
+ (setq done nil)
+ (while (not done)
+ (skip-chars-forward " \t")
+ (setq c (following-char))
+ (cond ((eq c ?:)
+ (smalltalk-forward-sexp 1))
+ ((eq c ?|)
+ (forward-char 1) ;skip vbar
+ (skip-chars-forward " \t")
+ (setq done t)) ;and leave
+ (t
+ (setq done t))))
+
+ ;; Now skip over the block temporaries, if any
+ (cond ((eq (following-char) ?|)
+ (setq done nil)
+ (forward-char 1))
+ (t
+ (setq done t)))
+
+ (while (not done)
+ (skip-chars-forward " \t")
+ (setq c (following-char))
+ (cond ((eq c ?|)
+ (forward-char 1) ;skip vbar
+ (skip-chars-forward " \t")
+ (setq done t)) ;and leave
+ (t
+ (smalltalk-forward-sexp 1))))
+
+ (point)))))))
+
+(defun smalltalk-parse-sexp-and-narrow-to-paren ()
+ "Narrows the region to between point and the closest previous open paren.
+Actually, skips over any block parameters, and skips over the whitespace
+following on the same line."
+ (let* ((state (parse-partial-sexp (point-min) (point)))
+ (start (smalltalk-match-paren state)))
+ (if (null start) () (narrow-to-region start (point)))
+ state))
+
+(defun smalltalk-at-method-begin ()
+ "Returns T if at the beginning of a method definition, otherwise nil"
+ (let ((parse-sexp-ignore-comments t))
+ (if (bolp)
+ (save-excursion
+ (smalltalk-backward-whitespace)
+ (= (preceding-char) ?!)
+ ))))
+
+(defun smalltalk-indent-for-colon ()
+ (let (indent-amount c start-line state done default-amount
+ (parse-sexp-ignore-comments t))
+ ;; we're called only for lines which look like "<whitespace>foo:"
+ (save-excursion
+ (save-restriction
+ (widen)
+ (smalltalk-narrow-to-method)
+ (beginning-of-line)
+ (setq state (smalltalk-parse-sexp-and-narrow-to-paren))
+ (narrow-to-region (point-min) (point))
+ (setq start-line (point))
+ (smalltalk-backward-whitespace)
+ (cond
+ ((bobp)
+ (setq indent-amount (smalltalk-current-column)))
+ ((eq (setq c (preceding-char)) ?\;) ; cascade before, treat as stmt
continuation
+ (smalltalk-find-statement-begin)
+ (setq indent-amount (+ (smalltalk-current-column)
+ smalltalk-indent-amount)))
+ ((eq c ?.) ; stmt end, indent like it (syntax error here?)
+ (smalltalk-find-statement-begin)
+ (setq indent-amount (smalltalk-current-column)))
+ (t ;could be a winner
+ (smalltalk-find-statement-begin)
+ ;; we know that since we weren't at bobp above after backing
+ ;; up over white space, and we didn't run into a ., we aren't
+ ;; at the beginning of a statement, so the default indentation
+ ;; is one level from statement begin
+ (setq default-amount
+ (+ (smalltalk-current-column) ;just in case
+ smalltalk-indent-amount))
+ ;; might be at the beginning of a method (the selector), decide
+ ;; this here
+ (if (not (looking-at smalltalk-keyword-regexp ))
+ ;; not a method selector
+ (while (and (not done) (not (eobp)))
+ (smalltalk-forward-sexp 1) ;skip over receiver
+ (smalltalk-forward-whitespace)
+ (cond ((eq (following-char) ?\;)
+ (setq done t)
+ (setq indent-amount default-amount))
+ ((and (null indent-amount) ;pick up only first one
+ (looking-at smalltalk-keyword-regexp))
+ (setq indent-amount (smalltalk-current-column))))))
+ (and (null indent-amount)
+ (setq indent-amount default-amount))))))
+ (if indent-amount
+ (smalltalk-indent-to-column indent-amount))))
+
+(defun smalltalk-indent-to-column (col)
+ (save-excursion
+ (beginning-of-line)
+ (delete-horizontal-space)
+ (indent-to col))
+ (if (bolp)
+ ;;delete horiz space may have moved us to bol instead of staying where
+ ;; we were. this fixes it up.
+ (move-to-column col)))
+
+(defun smalltalk-narrow-to-method ()
+ "Narrows the buffer to the contents of the method, exclusive of the
+method selector and temporaries."
+ (let ((end (point))
+ (parse-sexp-ignore-comments t)
+ done handled)
+ (save-excursion
+ (smalltalk-begin-of-defun)
+ (if (looking-at "[a-zA-z]") ;either unary or keyword msg
+ ;; or maybe an immediate expression...
+ (progn
+ (forward-sexp)
+ (if (= (following-char) ?:) ;keyword selector
+ (progn ;parse full keyword selector
+ (backward-sexp 1) ;setup for common code
+ (smalltalk-forward-keyword-selector))
+ ;; else maybe just a unary selector or maybe not
+ ;; see if there's stuff following this guy on the same line
+ (let (here eol-point)
+ (setq here (point))
+ (end-of-line)
+ (setq eol-point (point))
+ (goto-char here)
+ (smalltalk-forward-whitespace)
+ (if (< (point) eol-point) ;if there is, we're not a method
+ ; (a heuristic guess)
+ (beginning-of-line)
+ (goto-char here))))) ;else we're a unary method (guess)
+ ;; this must be a binary selector, or a temporary
+ (if (= (following-char) ?|)
+ (progn ;could be temporary
+ (end-of-line)
+ (smalltalk-backward-whitespace)
+ (if (= (preceding-char) ?|)
+ (progn
+ (setq handled t)))
+ (beginning-of-line)))
+ (if (not handled)
+ (progn
+ (skip-chars-forward (concat "^" smalltalk-whitespace))
+ (smalltalk-forward-whitespace)
+ (skip-chars-forward smalltalk-name-chars)))) ;skip over operand
+ (smalltalk-forward-whitespace)
+ ;;sbb 6-Sep-93 14:58:54 attempted fix(skip-chars-forward
smalltalk-whitespace)
+ (if (= (following-char) ?|) ;scan for temporaries
+ (progn
+ (forward-char) ;skip over |
+ (smalltalk-forward-whitespace)
+ (while (and (not (eobp))
+ (looking-at "[a-zA-Z_]"))
+ (skip-chars-forward smalltalk-name-chars)
+ (smalltalk-forward-whitespace)
+ )
+ (if (and (= (following-char) ?|) ;only if a matching | as a temp
+ (< (point) end)) ;and we're after the temps
+ (narrow-to-region (1+ (point)) end))) ;do we limit the buffer
+ ;; added "and <..." Dec 29 1991 as a test
+ (and (< (point) end)
+ (narrow-to-region (point) end))))))
+
+(defun smalltalk-forward-keyword-selector ()
+ "Starting on a keyword, this function skips forward over a keyword selector.
+It is typically used to skip over the actual selector for a method."
+ (let (done)
+ (while (not done)
+ (if (not (looking-at "[a-zA-Z_]"))
+ (setq done t)
+ (skip-chars-forward smalltalk-name-chars)
+ (if (= (following-char) ?:)
+ (progn
+ (forward-char)
+ (smalltalk-forward-sexp 1)
+ (smalltalk-forward-whitespace))
+ (setq done t)
+ (backward-sexp 1))))))
+
+(defun smalltalk-white-to-bolp ()
+ "Returns T if from the current position to beginning of line is whitespace.
+Whitespace is defined as spaces, tabs, and comments."
+ (let (done is-white line-start-pos)
+ (save-excursion
+ (save-excursion
+ (beginning-of-line)
+ (setq line-start-pos (point)))
+ (while (not done)
+ (and (not (bolp))
+ (skip-chars-backward " \t"))
+ (cond ((bolp)
+ (setq done t)
+ (setq is-white t))
+ ((= (char-after (1- (point))) ?\")
+ (backward-sexp)
+ (if (< (point) line-start-pos) ;comment is multi line
+ (setq done t)))
+ (t
+ (setq done t))))
+ is-white)))
+
+
+(defun smalltalk-backward-comment ()
+ (search-backward "\"") ;find its start
+ (while (= (preceding-char) ?\") ;skip over doubled ones
+ (backward-char 1)
+ (search-backward "\"")))
+
+(defun smalltalk-collect-selector ()
+ "Point is stationed inside or at the beginning of the selector in question.
+This function computes the Smalltalk selector (unary, binary, or keyword) and
+returns it as a string. Point is not changed."
+ (save-excursion
+ (let (start selector done ch
+ (parse-sexp-ignore-comments t))
+ (skip-chars-backward (concat "^" "\"" smalltalk-whitespace))
+ (setq start (point))
+ (if (looking-at smalltalk-name-regexp)
+ (progn ;maybe unary, maybe keyword
+ (skip-chars-forward smalltalk-name-chars)
+ (if (= (following-char) ?:) ;keyword?
+ (progn
+ (forward-char 1)
+ (setq selector (buffer-substring start (point)))
+ (setq start (point))
+ (while (not done)
+ (smalltalk-forward-whitespace)
+ (setq ch (following-char))
+ (cond ((memq ch '(?\; ?. ?\] ?\) ?} ?! ))
+ (setq done t))
+ ((= ch ?:)
+ (forward-char 1)
+ (setq selector
+ (concat selector
+ (buffer-substring start (point)))))
+ (t
+ (setq start (point))
+ (smalltalk-forward-sexp 1)))))
+ (setq selector (buffer-substring start (point)))))
+ (skip-chars-forward (concat "^" ?\" smalltalk-whitespace))
+ (setq selector (buffer-substring start (point))))
+ selector)))
+
+(defun smalltalk-backward-find-class-name ()
+ (let (first-hit-point first-hit second-hit-point second-hit)
+ (save-excursion
+ (if (setq first-hit-point
+ (search-backward-regexp "^![ \t]*\\(\\w+\\)[ \t]+" nil t))
+ (setq first-hit (buffer-substring (match-beginning 1) (match-end
1)))))
+ (save-excursion
+ (if (setq second-hit-point
+ (search-backward-regexp
+ "^\\w+[
\t]+\\(variable\\|variableWord\\|variableByte\\)?subclass:[ \t]+#\\(\\w+\\)"
nil t))
+ (setq second-hit (buffer-substring
+ (match-beginning 2)
+ (match-end 2)))))
+ (if first-hit-point
+ (if (and second-hit-point (> second-hit-point first-hit-point))
+ second-hit
+ first-hit)
+ (or second-hit ""))))
+
+
+(provide 'smalltalk-mode)
+(autoload 'gst "@lispdir@/gst-mode.elc" "" t)
- [elpa] externals/smalltalk-mode 453b7f5 34/34: smalltalk-mode: Fix version and author in header, (continued)
- [elpa] externals/smalltalk-mode 453b7f5 34/34: smalltalk-mode: Fix version and author in header, Stefan Monnier, 2019/04/09
- [elpa] externals/smalltalk-mode d7f4421 28/34: emacs: Fix the smalltalk-mode mode for emacs 24.2 and later, Stefan Monnier, 2019/04/09
- [elpa] externals/smalltalk-mode 7706ca9 22/34: merge smalltalk-mode bugfixes and tags support, Stefan Monnier, 2019/04/09
- [elpa] externals/smalltalk-mode 83e5fa6 03/34: more updates to the FSF address, Stefan Monnier, 2019/04/09
- [elpa] externals/smalltalk-mode 81dda06 10/34: fix Emacs mode glitches reported by Jeronimo Pellegrini, Stefan Monnier, 2019/04/09
- [elpa] externals/smalltalk-mode f5a8ddb 13/34: update copyright notices for 2009, Stefan Monnier, 2019/04/09
- [elpa] externals/smalltalk-mode 12cf1d9 19/34: more smalltalk mode improvements from Mathieu, Stefan Monnier, 2019/04/09
- [elpa] externals/smalltalk-mode aaa7cb0 17/34: improve smalltalk.el detection of a new method's indent, Stefan Monnier, 2019/04/09
- [elpa] externals/smalltalk-mode a5a661a 30/34: Silence byte-compiler warnings, Stefan Monnier, 2019/04/09
- [elpa] externals/smalltalk-mode f5845a2 06/34: Emacs interactor mode refinements, Stefan Monnier, 2019/04/09
- [elpa] externals/smalltalk-mode 1521656 01/34: initial import,
Stefan Monnier <=
- [elpa] externals/smalltalk-mode c81b497 21/34: Fix smalltalk-mode.el, Stefan Monnier, 2019/04/09
- [elpa] externals/smalltalk-mode cd36013 26/34: smalltalk-mode fixes, Stefan Monnier, 2019/04/09
- [elpa] externals/smalltalk-mode 58ef6fd 05/34: improvements to the Emacs mode, Stefan Monnier, 2019/04/09
- [elpa] externals/smalltalk-mode a1e76a8 27/34: new smalltalk-mode navigational shortcuts, Stefan Monnier, 2019/04/09
- [elpa] externals/smalltalk-mode d3cea5f 25/34: fix typo, Stefan Monnier, 2019/04/09
- [elpa] externals/smalltalk-mode 99e6910 33/34: smalltalk-mode: Fix issues spotted by Emacs' checkdoc, Stefan Monnier, 2019/04/09
- [elpa] externals/smalltalk-mode a1d6a5d 29/34: Ensure header and footer match Emacs conventions, Stefan Monnier, 2019/04/09