etc/slate-mode.el

   1 ;;; @(#) slate-mode.el --- Slate mode
   2
   3 ;; Copyright (C) 2002-2009 Lee Salzman and Brian T. Rice.
   4
   5 ;; Authors: Brian T. Rice <BrianTRice@gmail.com>
   6 ;; Created: August 21, 2002
   7 ;; Keywords: languages oop
   8
   9 ;; This file is not part of GNU Emacs.
  10
  11 ;; Permission is hereby granted, free of charge, to any person
  12 ;; obtaining a copy of this software and associated documentation
  13 ;; files (the "Software"), to deal in the Software without
  14 ;; restriction, including without limitation the rights to use, copy,
  15 ;; modify, merge, publish, distribute, sublicense, and/or sell copies
  16 ;; of the Software, and to permit persons to whom the Software is
  17 ;; furnished to do so, subject to the following conditions:
  18
  19 ;; The above copyright notice and this permission notice shall be
  20 ;; included in all copies or substantial portions of the Software.
  21
  22 ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  23 ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  24 ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  25 ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
  26 ;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
  27 ;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
  28 ;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
  29 ;; SOFTWARE.
  30
  31 ;;; Commentary:
  32
  33 ;; Some recognition of method definition syntax is still needed in order to
  34 ;; recognize them, which would enable intelligent highlighting of the signature
  35 ;; (which is lacking) as well as indentation. Specifically, avoiding the
  36 ;; highlighting of `slate-globals-regexp' keywords while being able to
  37 ;; make the selector (unary, binary, not just keyword) stands out correctly
  38 ;; is desired.
  39
  40 ;;; Code:
  41
  42 (defvar slate-mode-abbrev-table nil
  43   "Abbrev table in use in slate-mode buffers.")
  44 (define-abbrev-table 'slate-mode-abbrev-table ())
  45
  46 ;; Customize Support
  47 ;; =================
  48
  49 (defgroup slate nil
  50   "Major mode for editing Slate code."
  51   :prefix "slate-"
  52   :group 'languages)
  53
  54 (defcustom slate-mode-hook nil
  55   "Normal hook run when entering Slate mode."
  56   :type 'hook
  57   :options '(imenu-add-menubar-index)
  58   :group 'slate)
  59
  60 (defcustom slate-indent-increment 2
  61   "Amount to adjust indentation by."
  62   :type 'integer
  63   :options '(2 4)
  64   :group 'slate)
  65
  66 ;; Templates
  67 ;; =========
  68
  69 (defvar slate-template-map
  70   (let ((map (make-sparse-keymap)))
  71     (define-key map "m" 'slate-method-template)
  72     (define-key map "p" 'slate-prototype-template)
  73     (define-key map "t" 'slate-traits-template)
  74     map)
  75   "Slate template creation keys")
  76
  77 (defun slate-prototype-template (namespace proto-name value)
  78   "Invokes a template, asking for expressions to fill in for a new prototype."
  79   (interactive
  80    (list (read-string "Namespace: " "lobby")
  81      (read-string "New Name: " "x")
  82      (read-string "Value: " "Oddball clone")))
  83   (insert (format "%s addSlot: #%s valued: %s.\n"
  84           namespace proto-name value)))
  85
  86 (defun slate-traits-template (namespace proto-name parent)
  87   "Invokes a template, asking for expressions to fill in for a new traits."
  88   (interactive
  89    (list (read-string "Namespace: " "lobby")
  90      (read-string "New Name: " "x")
  91      (read-string "Parent: " "Cloneable")))
  92   (insert (format "%s define: #%s &parents: {%s}."
  93           namespace proto-name parent))
  94   (save-excursion
  95     (insert (format "\n\"A %s is a %s.\"\n" proto-name parent))))
  96
  97 (defun slate-method-template (first-arg first-dispatch locals)
  98   "Invokes a template, asking for expressions to fill in for a new method."
  99   (interactive
 100    (list (read-string "First Argument Name: " "_")
 101      (read-string "First Dispatch: " "Cloneable traits")
 102      (read-string "Locals: " "")))
 103   (insert (format "\n%s@(%s) " first-arg first-dispatch))
 104   (save-excursion
 105     (insert (format "\n[%s\n  \n].\n" (if (string= locals "") ""
 106                     (concat "| " locals " |"))))))
 107
 108 (defvar slate-mode-map
 109   (let ((map (make-sparse-keymap)))
 110     (mapcar
 111      #'(lambda (l)
 112          (define-key map (car l) (cdr l)))
 113      `(("\M-\t" . slate-tab)
 114        ("\t" . slate-reindent)
 115        ([backspace] . backward-delete-char-untabify)
 116        ("\n" . slate-newline-and-indent)
 117        ("\M-\C-a" . slate-begin-of-defun)
 118        ("\M-\C-f" . slate-forward-sexp)
 119        ("\M-\C-b" . slate-backward-sexp)
 120        (":" . slate-colon)
 121        ;;("@" . slate-dispatch)
 122        ;;("\C-c\C-d" . slate-category-definition)
 123        ;;("\C-cc" . slate-compile)
 124        ("\C-cd" . slate-macroexpand-region)
 125        ("\C-ce" . slate-eval-region)
 126        ("\C-cf" . slate-filein)
 127        ("\C-cm" . slate)
 128        ("\C-cp" . slate-print)
 129        ("\C-cq" . slate-quit)
 130        ;;("\C-cr" . slate-reeval-region)
 131        ("\C-cs" . slate-snapshot)
 132        ("\C-ct" . ,slate-template-map)
 133        ("\C-cu" . slate-unit-tests)
 134        ("\C-cw" . slate-workspace)
 135        ;;("\C-c\C-s" . slate-browse-selectors)
 136        ;;("\C-x c" . slate-complete-traits)
 137        ))
 138     map)
 139   "Slate mode keymappings")
 140
 141 ;; Syntax-Handling
 142 ;; ===============
 143
 144 (defconst slate-name-chars "A-Za-z0-9"
 145   "The collection of character that can compose a Slate identifier")
 146
 147 (defconst slate-name-regexp (concat "[A-Za-z][-" slate-name-chars "_:]*[^:]")
 148   "A regular expression that matches a Slate identifier")
 149
 150 (defconst slate-globals-regexp
 151   (regexp-opt '("lobby" "True" "False" "Nil" "NoRole" "thisContext"
 152         "resend" "clone" "here" "it" "_") 'words))
 153
 154 (defconst slate-binop-chars "-+*/\\~;<>=&?"
 155   "The collection of characters that can compose a Slate binary selector.")
 156
 157 (defconst slate-binop-regexp
 158   (concat "\\([" slate-binop-chars "]+\\|[" slate-binop-chars "]+[" slate-name-chars "]*[" slate-binop-chars "]+\\)")
 159   "A regular expression that matches a Slate binary selector")
 160
 161 (defconst slate-keyword-regexp
 162   (concat "\\([-" slate-name-chars "_]+[-" slate-name-chars "_:]*:\\| :[^A-Za-z]+\\)")
 163   "A regular expression that matches a Slate keyword")
 164
 165 (defconst slate-opt-keyword-regexp (concat "&" slate-keyword-regexp)
 166   "A regular expression that matches a Slate optional-keyword")
 167
 168 (defconst slate-whitespace-chars " \t\n\f")
 169
 170 (defconst hexdigit-regexp "[0-9a-fA-F]")
 171
 172 (defconst slate-mode-syntax-table
 173   (let ((table (make-syntax-table)))
 174     (mapcar
 175      #'(lambda (l)
 176          (modify-syntax-entry (car l) (cdr l) table))
 177      '((?\' . "\"") ; String
 178        (?\" . "\"") ; Comment
 179        (?+  . "w") ; Binary selector elements...
 180        (?-  . "w")
 181        (?*  . "w")
 182        (?/  . "w")
 183        (?=  . "w")
 184        (??  . "w")
 185        (?%  . "w")
 186        (?~  . "w")
 187        (?%  . "w")
 188        (?\; . "w")
 189        (?<  . "w")
 190        (?>  . "w")
 191        (?\[ . "(]") ; Block opener
 192        (?\] . ")[") ; Block closer
 193        (?\( . "()") ; Parens opener
 194        (?\) . ")(") ; Parens closer
 195        (?{  . "(}") ; Array opener
 196        (?}  . "){") ; Array closer
 197        (?&  . "'") ; Optional keyword marker
 198        (?`  . "'") ; Macro character
 199        (?$  . "'") ; Character literal
 200        (?#  . "'") ; Symbol
 201        (?|  . "$") ; Locals
 202        (?_  . "w") ; Word-element and anonymous argument
 203        (?:  . "_") ; Keyword marker
 204        (?\\ . "\\") ; C-like escape
 205        (?!  . "'") ; A stop in Smalltalk. A type annotation in Slate.
 206        (?@  . "'") ; Dispatch annotator
 207        (?^  . "w") ; Return
 208        (?,  . ".") ; Comma for *rest parameters
 209        (?.  . "."))) ; Statement separator
 210     table)
 211   "Slate character types")
 212
 213 (defconst bold 'bold
 214   "Emacs requires this; ugly.")
 215
 216 (defconst italic 'italic)
 217
 218 (defconst slate-font-lock-keywords
 219   `((,(concat "#[" slate-name-chars slate-binop-chars "_:]+")
 220      . font-lock-constant-face)                        ; symbol
 221     ("#'\\([^']\\|\\'\\)*'" . font-lock-constant-face) ; quoted symbol
 222     ("\"\\([^\"]\\|\\\"\\)\"" . font-lock-comment-face) ; comment
 223     (,(concat "[$]\\([^\\\\]\\|\\\\[^x]\\|\\\\x" hexdigit-regexp hexdigit-regexp "[^\\]\\)")
 224      . font-lock-string-face)                          ; character
 225     ("[^#$\\]'\\(.\\|\'\\)*'" . font-lock-string-face) ; string
 226     (,(concat "`" slate-name-regexp ":[^" slate-name-chars "_]")
 227      . ,(if (boundp 'font-lock-preprocessor-face)
 228         'font-lock-preprocessor-face
 229       'font-lock-builtin-face))         ; macro keyword call
 230     (,(concat "`\\(" slate-binop-regexp "\\|" slate-name-regexp "[:]?\\)\\>")
 231      . ,(if (boundp 'font-lock-preprocessor-face)
 232         'font-lock-preprocessor-face
 233       'font-lock-builtin-face))         ; macro call
 234     ("[^#]\\(=?:=\\>\\)"
 235      . ,(if (boundp 'font-lock-preprocessor-face)
 236         'font-lock-preprocessor-face
 237       'font-lock-keyword-face))      ; assignment/match/unify specials
 238     (,(concat "\\<[-+*/\\;&?]=\\>")
 239      . ,(if (boundp 'font-lock-preprocessor-face)
 240         'font-lock-preprocessor-face
 241       'font-lock-keyword-face))         ; op-assignment specials
 242     ("\\<\\(\\^[0-9^]?\\>\\)"
 243      . ,(if (boundp 'font-lock-preprocessor-face)
 244         'font-lock-preprocessor-face
 245      'font-lock-keyword-face))          ; return specials
 246     ("`+"
 247      . ,(if (boundp 'font-lock-preprocessor-face)
 248         'font-lock-preprocessor-face
 249       'font-lock-builtin-face))         ; quotation syntax
 250     (,slate-opt-keyword-regexp
 251      . font-lock-variable-name-face)    ; optional keywords
 252     ("\\(?:_\\|[A-Za-z]+[_A-Za-z0-9]*\\)@+?"
 253      . font-lock-variable-name-face)    ; declaration dispatchings
 254     ("|[A-Za-z0-9:&_*!() \n]*|"
 255      . font-lock-variable-name-face)    ; block local slots
 256     ("\\<\\(:\\|&\\|*\\)[A-Za-z0-9_]+"
 257      . font-lock-variable-name-face)    ; block input slots
 258     (,slate-keyword-regexp
 259      . font-lock-keyword-face)          ; keyword sends
 260     ("!\\([A-Za-z]*\\|\([A-Za-z0-9_ ]*\)\\)"
 261      . font-lock-type-face)             ; type-declaration
 262     ("\\<[+-]?[0-9]+\\([.][0-9]+\\)?\\>"
 263      . font-lock-constant-face)        ; numbers (integers and floats)
 264     (,(concat "\\<[+-]?[0-9_]+[Rr]" hexdigit-regexp "+\\([.]" hexdigit-regexp "+\\)?\\>")
 265      . font-lock-constant-face)        ; numbers (integers and floats)
 266     ("\\([.]\\)\\(?:$\\|[^0-9\"]\\)"
 267      . font-lock-warning-face)          ; statement separators
 268     ("\\(?:[A-Za-z0-9_]* \\)*\\(?:traits\\|derive\\)"
 269      . font-lock-type-face)                     ; traits name
 270     ("\\<[0-9_]+\\>" . font-lock-constant-face) ; integers
 271     (,slate-globals-regexp
 272      . font-lock-builtin-face)          ; globals
 273 ;;     (,(concat "\\<" slate-binop-regexp "\\>")
 274 ;;      . font-lock-string-face)        ; binary message send
 275    )
 276   "Slate highlighting matchers.")
 277
 278 ;; Inferior-Mode Support
 279 ;; =====================
 280
 281 (require 'comint)
 282
 283 (defconst slate-prompt-regexp "^slate[-A-z]*\[[0-9]+\]>"
 284   "Regexp to match prompts in slate buffer.")
 285
 286 (defconst slate-debug-prompt-regexp "^slate-debug\[[0-9]+[.]?[.]?[0-9]+?\]>"
 287   "Regexp to match prompts in slate buffer.")
 288
 289 (defconst slate-prompt-line-regexp (concat slate-prompt-regexp " .*")
 290   "Regexp to match the prompt line in the slate buffer.")
 291
 292 (defconst slate-debug-frame-regexp "^\\(frame: [0-9]+\\)"
 293   "Regexp to match the frame line label in the Slate debugger.")
 294
 295 (defconst slate-debug-fileref-regexp " @ \\([-A-z/_.]+:[0-9]+\\)$"
 296   "Regexp to match filename:linenumber in the Slate debugger.")
 297
 298 (defconst slate-debug-restart-regexp "^restart: [0-9]+"
 299   "Regexp to match restart listings in the Slate debugger.")
 300
 301 (defvar slate-cmd "slate"
 302   "The name/path of the VM to be executed for the interactive mode.")
 303
 304 (defvar slate-dir "."
 305   "The current working directory for the Slate process; this should also be
 306    set in a preference. It should generally be one's slate installation root.")
 307
 308 (defvar slate-args '()
 309   "Arguments to pass to the `slate-cmd' launcher. This should be overridden
 310    in the user's init file.")
 311
 312 (defvar *slate-process* nil
 313   "The Slate process")
 314
 315 (defvar inferior-slate-buffer-name "*slate*"
 316   "The Slate interaction buffer name.")
 317
 318 (defvar slate-output-buffer nil
 319   "Stores accumulating output from the Slate printer.")
 320
 321 (defvar slate-input-queue nil
 322   "Stores pending inputs to the Slate reader.")
 323
 324 (defconst slate-inf-mode-map (copy-keymap comint-mode-map)
 325   "The modemap used for interactive Slate sessions.")
 326 (set-keymap-parent slate-inf-mode-map slate-mode-map)
 327
 328 (defvar slate-fileref-keymap (copy-keymap slate-inf-mode-map))
 329 (set-keymap-parent slate-fileref-keymap slate-inf-mode-map)
 330 (define-key slate-fileref-keymap [return] 'slate-follow-name-at-point)
 331 (define-key slate-fileref-keymap [mouse-1] 'slate-follow-name-at-point)
 332
 333 (defvar slate-frameref-keymap (copy-keymap slate-inf-mode-map))
 334 (set-keymap-parent slate-frameref-keymap slate-inf-mode-map)
 335 (define-key slate-frameref-keymap [return] 'slate-run-overlay-at-point)
 336 (define-key slate-frameref-keymap [mouse-1] 'slate-run-overlay-at-point)
 337
 338 (defvar slate-restart-keymap (copy-keymap slate-inf-mode-map))
 339 (set-keymap-parent slate-restart-keymap slate-inf-mode-map)
 340 (define-key slate-restart-keymap [return] 'slate-run-overlay-at-point)
 341 (define-key slate-restart-keymap [mouse-1] 'slate-run-overlay-at-point)
 342
 343 (defconst slate-inf-font-lock-keywords
 344   `((,slate-prompt-regexp . 'comint-highlight-prompt)    ; normal prompt
 345     (,slate-debug-prompt-regexp . 'comint-highlight-prompt) ; debug prompt
 346     ("^\\(Warning\\|Error\\):" . 'font-lock-warning-face) ; warnings/errors
 347     ("^[ ]*\\(Loading\\) " . 'font-lock-warning-face) ; informative
 348     ;(,slate-debug-fileref-regexp 1 'link) ; filename/lineno debugger reports
 349     ("^Slate:" . compilation-info-face) ; VM messages
 350     ,@slate-font-lock-keywords)
 351   "Simplified and adjusted highlighting matchers for the interaction.")
 352
 353 (defun slate-inf-mode ()
 354   "Major mode for interacting Slate subprocesses.
 355
 356 The following commands imitate the usual Unix interrupt and
 357 editing control characters:
 358 \\{slate-inf-mode-map}
 359
 360 Entry to this mode calls the value of `slate-inf-mode-hook' with no arguments,
 361 if that value is non-nil.  Likewise with the value of `shell-mode-hook'.
 362 `slate-inf-mode-hook' is called after `shell-mode-hook'."
 363   (interactive)
 364   (kill-all-local-variables)
 365   (comint-mode)
 366   (setq comint-prompt-regexp slate-prompt-line-regexp)
 367   (setq comint-use-prompt-regexp t)
 368   (setq comint-prompt-read-only t)
 369   (setq major-mode 'slate-inf-mode)
 370   (setq mode-name "Slate Interaction")
 371   (use-local-map slate-inf-mode-map)
 372   (make-local-variable 'mode-status)
 373   (set-syntax-table slate-mode-syntax-table)
 374   (setq font-lock-defaults '(slate-inf-font-lock-keywords))
 375   (font-lock-mode 1)
 376   ;(lazy-lock-mode 1)
 377   (setq slate-output-buffer nil)
 378   (setq mode-status "Starting Up")
 379   (run-hooks 'comint-mode-hook 'slate-inf-mode-hook))
 380
 381 (defun slate (&optional cmd)
 382   "Starting an inferior Slate process.
 383    Input and output via buffer `inferior-slate-buffer-name'."
 384   (interactive
 385    (list (or slate-cmd
 386          (read-from-minibuffer "Slate toplevel to run: " slate-cmd))))
 387   (if (eq major-mode 'slate-inf-mode)
 388       (apply 'inf-slate slate-cmd slate-args)
 389     (switch-to-buffer-other-window
 390      (apply 'inf-slate slate-cmd slate-args)))
 391   (slate-inf-mode)
 392   (setq list-buffers-directory slate-dir)
 393   (setq *slate-process* (get-buffer-process (current-buffer))))
 394
 395 (defun slate-workspace ()
 396   "Create a scratch workspace buffer `*slate-scratch*' for Slate expressions."
 397   (interactive)
 398   (let ((buffer (get-buffer-create "*slate-scratch*")))
 399     (save-excursion
 400       (set-buffer buffer)
 401       (slate-mode)
 402       (setq mode-name "Slate Workspace")
 403       (font-lock-mode))
 404     (pop-to-buffer "*slate-scratch*")))
 405
 406 (defun slate-run-overlay-at-point ()
 407   (interactive)
 408   (let* ((overlays (overlays-at (point)))
 409      (first-overlay (car overlays))
 410      (code (buffer-substring-no-properties (overlay-start first-overlay)
 411                     (overlay-end first-overlay))))
 412     (goto-char (point-max))
 413     (insert code)
 414     (slate-send-input code)))
 415
 416 (defun slate-follow-name-at-point ()
 417   "Follows a file reference of the form filename:linenumber at/after the point."
 418   (interactive)
 419   (push-mark)
 420   (setq filename
 421     (save-excursion
 422       (skip-chars-forward "^:")
 423       (setq end (point))
 424       (skip-chars-backward "^ ")
 425       (buffer-substring-no-properties (point) end)))
 426   (setq line-number
 427     (save-excursion
 428       (skip-chars-forward "^:")
 429       (forward-char)
 430       (string-to-number (buffer-substring-no-properties (point) (progn (forward-word 1) (point))))))
 431   ;(find-file-at-point)
 432   (find-file filename)
 433   (goto-line line-number))
 434
 435 (defun inf-slate (cmd &rest args)
 436   "Run an inferior Slate process `*slate-process*'.
 437    Input and output via buffer `inferior-slate-buffer-name'."
 438   (let ((buffer (get-buffer-create inferior-slate-buffer-name))
 439     proc status)
 440     (when (setq proc (get-buffer-process buffer))
 441       (setq status (process-status proc)))
 442     (save-excursion
 443       (set-buffer buffer)
 444       (cd slate-dir)
 445       (unless (memq status '(run stop))
 446     (when proc (delete-process proc))
 447     (setq proc
 448           (if (equal window-system "x")
 449           (apply 'start-process
 450              cmd buffer
 451              "env"
 452              (format "TERMCAP=emacs:co#%d:tc=unknown:"
 453                  (frame-width))
 454              "TERM=emacs" "EMACS=t"
 455              cmd args)
 456         (apply 'start-process cmd buffer cmd args)))
 457     (setq cmd (process-name proc)))
 458       (goto-char (point-max))
 459       (set-marker (process-mark proc) (point))
 460       (set-process-filter proc 'slate-inf-filter)
 461       ;(set-process-sentinel proc 'slate-inf-sentinel)
 462       (slate-inf-mode))
 463     buffer))
 464
 465 (defun slate-handle-command (str)
 466   (eval (read str)))
 467
 468 (defun slate-accum-command (string)
 469   (let (where)
 470     (setq where (string-match "\C-a" string))
 471     (setq slate-output-buffer
 472       (concat slate-output-buffer (substring string 0 where)))
 473     (if where
 474     (progn
 475       (unwind-protect        ;found the delimiter...do it
 476           (slate-handle-command slate-output-buffer)
 477         (setq slate-output-buffer nil))
 478       ;; return the remainder
 479       (substring string where))
 480       ;; we ate it all and didn't do anything with it
 481       nil)))
 482
 483 ;(defun slate-inf-sentinel ())
 484 (when (featurep 'xemacs)
 485   (require 'overlay))
 486
 487 (defun slate-overlay (begin end face mouse-face action help)
 488   (let ((the-overlay (make-overlay begin end)))
 489     (overlay-put the-overlay 'face face)
 490     (overlay-put the-overlay 'mouse-face mouse-face)
 491     (overlay-put the-overlay 'help-echo help)
 492     the-overlay))
 493
 494 (defun slate-inf-filter (process string)
 495   "Make sure that the window continues to show the most recently output
 496 text."
 497   (with-current-buffer (process-buffer process)
 498     (when (buffer-name (current-buffer))
 499       (let ((where 0) ch command-str
 500         (moving (= (point) (process-mark process))))
 501     (while (and string where)
 502       (when slate-output-buffer
 503         (setq string (slate-accum-command string)))
 504       (when (and string
 505              (setq where (string-match "\C-a\\|\C-b" string)))
 506         (setq ch (aref string where))
 507         (cond ((= ch ?\C-a)        ;strip these out
 508            (setq string (concat (substring string 0 where)
 509                     (substring string (1+ where)))))
 510           ((= ch ?\C-b)               ;start of command
 511            (setq slate-output-buffer "") ;start this off
 512            (setq string (substring string (1+ where)))))))
 513     (save-excursion
 514       (goto-char (point-max))
 515       (when string
 516         (setq mode-status "Idle")
 517         (insert string))
 518       (save-excursion     ; Handle most recent debugger output:
 519         (goto-char (point-max))
 520         (re-search-backward "^Debugging: " nil t)
 521         (save-excursion        ; Handle debugger file references:
 522           (let (fileref-end)
 523         (while (setq fileref-end (re-search-forward slate-debug-fileref-regexp nil t))
 524           (let ((fileref-overlay (slate-overlay (match-beginning 1) fileref-end 'link 'highlight nil "mouse-1: visit this file and line")))
 525             (overlay-put fileref-overlay 'keymap slate-fileref-keymap)))))
 526                     ; Handle debugger frame references:
 527         (while (re-search-forward slate-debug-frame-regexp nil t)
 528           (let ((frameref-overlay (slate-overlay (match-beginning 1) (match-end 1) 'button nil nil "mouse-1: navigate to this frame")))
 529         (overlay-put frameref-overlay 'keymap slate-frameref-keymap)))
 530                     ; Handle debugger restart listing:
 531         (let (restart-end)
 532           (while (setq restart-end (re-search-forward slate-debug-restart-regexp nil t))
 533         (let ((restart-overlay (slate-overlay (match-beginning 0) restart-end 'button nil nil "mouse-1: select this restart")))
 534           (overlay-put restart-overlay 'keymap slate-restart-keymap)))))
 535       (when (process-mark process)
 536         (set-marker (process-mark process) (point-max))))
 537     (if moving (goto-char (process-mark process)))
 538     (sit-for 0)
 539     (set-window-point (get-buffer-window (current-buffer)) (point-max))))))
 540
 541 (defun slate-inf-filter-redirect (process string)
 542   )
 543
 544 (defvar slate-interactor-mode-map
 545   (let ((map (copy-keymap slate-mode-map)))
 546     (mapcar
 547      #'(lambda (l) (define-key map (car l) (cdr l)))
 548      '(("\C-m"      . 'comint-send-input)
 549        ("\C-c\C-d"  . comint-delchar-or-maybe-eof)
 550        ("\C-c\C-u"  . comint-kill-input)
 551        ("\C-c\C-c"  . comint-interrupt-subjob)
 552        ("\C-c\C-z"  . comint-stop-subjob)
 553        ("\C-c\C-\\" . comint-quit-subjob)
 554        ("\C-c\C-o"  . comint-kill-output)
 555        ("\C-c\C-r"  . comint-show-output)))
 556     map)
 557   "Keymap for controlling the Slate listener")
 558
 559 (defun slate-ensure-running ()
 560   (unless (comint-check-proc inferior-slate-buffer-name)
 561     (slate)))
 562
 563 (defun slate-eval-region (start end)
 564   "Send the current region to the inferior Slate process. A stop character (a period) will be added to the end if necessary."
 565   (interactive "r")
 566   (slate-ensure-running)
 567   (save-excursion
 568     (goto-char end)
 569     (slate-backward-whitespace)
 570     (slate-send-input (buffer-substring-no-properties start (point)))
 571     (display-buffer inferior-slate-buffer-name t)))
 572
 573 (defun slate-macroexpand-region (start end)
 574   "Send the current region to the inferior Slate process, quoted, with a macroExpand call to get the macroExpand'd result."
 575   (interactive "r")
 576   (slate-ensure-running)
 577   (save-excursion
 578     (goto-char end)
 579     (slate-backward-whitespace)
 580     (comint-send-string
 581      inferior-slate-buffer-name
 582      "`(")
 583     (comint-send-region inferior-slate-buffer-name start (point))
 584     (comint-send-string
 585      inferior-slate-buffer-name
 586      ") macroExpand.\n")
 587     (display-buffer inferior-slate-buffer-name t)))
 588
 589 (defun slate-print (start end)
 590   "Performs `slate-eval-region' on the current region and inserts the output
 591 into the current buffer after the cursor."
 592   (interactive "r")
 593   (slate-ensure-running)
 594   (set-process-filter *slate-process*
 595               (lambda (proc string) (insert string)))
 596   (save-excursion
 597     (goto-char end)
 598     (slate-backward-whitespace)
 599     (slate-send-input (buffer-substring-no-properties start (point)) t)
 600     (accept-process-output *slate-process*))
 601   (set-process-filter *slate-process* 'slate-inf-filter))
 602
 603 (defun slate-quit ()
 604   "Terminate the Slate session and associated process."
 605   (interactive)
 606   (setq mode-status "Quitting")
 607   (comint-send-eof))
 608
 609 (defun slate-snapshot (filename)
 610   "Save a Slate snapshot."
 611   (interactive "FSnapshot name to save:")
 612   (setq mode-status "Saving")
 613   (slate-send-input (format "Image saveNamed: '%s'"
 614                 (expand-file-name filename))))
 615
 616 (defun slate-filein (filename)
 617   "Do a load: on FILENAME."
 618   (interactive "FSlate file to load: ")
 619   (slate-ensure-running)
 620   (setq mode-status "Loading")
 621   (slate-send-input (format "load: '%s'" (expand-file-name filename))))
 622
 623 (defun slate-unit-tests (filename)
 624   "Load the unit-test file for the current file and run the tests."
 625   (interactive "FUnit-test file to load: ")
 626   (slate-filein filename)
 627   (setq mode-status "Running tests")
 628   (slate-send-input (format "load: '%s'" (expand-file-name filename)))
 629   (slate-send-input "Tests CurrentUnit testSuite"))
 630
 631 (defun slate-send-input (string &optional hide-p)
 632   (slate-ensure-running)
 633   (set-buffer (get-buffer-create inferior-slate-buffer-name))
 634   (unless hide-p
 635     (save-excursion
 636       (point-max)
 637       (insert string)
 638       (insert (if (and (>= (point) 2) (eq (preceding-char) ?.)) "\n" ".\n"))))
 639   (setq mode-status "Running")
 640   (comint-send-string inferior-slate-buffer-name string)
 641   (comint-send-string
 642    inferior-slate-buffer-name
 643    (if (and (>= (point) 2) (eq (preceding-char) ?.)) "\n" ".\n")))
 644
 645 ;; (defun slate-send (str &optional mode)
 646 ;;   (let (temp-file buf old-buf)
 647 ;;     (setq temp-file (concat temporary-file-directory (make-temp-name "slate")))
 648 ;;     (save-excursion
 649 ;;       (setq buf (get-buffer-create " zap-buffer "))
 650 ;;       (set-buffer buf)
 651 ;;       (erase-buffer)
 652 ;;       (princ str buf)
 653 ;;       (write-region (point-min) (point-max) temp-file nil 'no-message))
 654 ;;     (kill-buffer buf)
 655 ;;     ;; this should probably be conditional
 656 ;;     (save-window-excursion (slate slate-args))
 657 ;;     (setq old-buf (current-buffer))
 658 ;;     (setq buf (process-buffer *slate-process*))
 659 ;;     (pop-to-buffer buf)
 660 ;;     (when mode
 661 ;;       (setq mode-status mode))
 662 ;;     (goto-char (point-max))
 663 ;;     (newline)
 664 ;;     (pop-to-buffer old-buf)
 665 ;;     (comint-send-string *slate-process*
 666 ;;                (format "load: '%s'.\n" temp-file))))
 667
 668 ;; Indentation
 669 ;; ===========
 670
 671 ;; Basic utilities: rely on only basic Emacs functions.
 672
 673 (defun slate-comment-indent ()
 674   "This is used by `indent-for-comment' to decide how much to indent a comment
 675 in Slate code based on its context."
 676   (if (looking-at "^\"")
 677       0                ;Existing comment at bol stays there.
 678       (save-excursion
 679         (skip-chars-backward " \t")
 680         (max (1+ (current-column))    ;Else indent at comment column
 681              comment-column))))    ; except leave at least one space.
 682
 683 (defun slate-indent-to-column (col)
 684   (save-excursion
 685     (beginning-of-line)
 686     (indent-line-to col))
 687   (when (< (current-column) col)
 688     (move-to-column col)))
 689
 690 (defun slate-current-column ()
 691   "Returns the current column of the given line, regardless of narrowed buffer."
 692   (save-restriction
 693     (widen)
 694     (current-column)))
 695
 696 (defun slate-previous-nonblank-line ()
 697   (forward-line -1)
 698   (while (and (not (bobp))
 699           (looking-at "^[ \t]*$"))
 700     (forward-line -1)))
 701
 702 (defun slate-in-string ()
 703   "Returns non-nil delimiter as a string if the current location is
 704 actually inside a string or string like context."
 705   (let (state)
 706     (setq state (parse-partial-sexp (point-min) (point)))
 707     (and (nth 3 state)
 708      (char-to-string (nth 3 state)))))
 709
 710 (defun slate-white-to-bolp ()
 711   "Returns T if from the current position to beginning of line is whitespace."
 712   (let (done is-white line-start-pos)
 713     (save-excursion
 714       (save-excursion
 715     (beginning-of-line)
 716     (setq line-start-pos (point)))
 717       (while (not done)
 718     (unless (bolp)
 719       (skip-chars-backward " \t"))
 720     (cond ((bolp)
 721            (setq done t)
 722            (setq is-white t))
 723           ((eq (char-after (1- (point))) ?\")
 724            (backward-sexp)
 725            (when (< (point) line-start-pos) ;comment is multi line
 726          (setq done t)))
 727           (t
 728            (setq done t))))
 729       is-white)))
 730
 731 (defun slate-backward-comment ()
 732   "Moves to the beginning of the containing comment, or
 733 the end of the previous one if not in a comment."
 734   (search-backward "\"")        ;find its start
 735   (while (eq (preceding-char) ?\\)    ;skip over escaped ones
 736     (backward-char 1)
 737     (search-backward "\"")))
 738
 739 ;; Basic utilities that use `slate-mode' variables.
 740
 741 (defun slate-forward-whitespace ()
 742   "Skip white space and comments forward, stopping at end of buffer
 743 or non-white space, non-comment character."
 744   (while (looking-at (concat "[" slate-whitespace-chars "\"]"))
 745     (skip-chars-forward slate-whitespace-chars)
 746     (when (eq (following-char) ?\")
 747       (forward-sexp))))
 748
 749 (defun slate-backward-whitespace ()
 750   "Like `slate-forward-whitespace' only going towards the start of the buffer."
 751   (while (progn (skip-chars-backward slate-whitespace-chars)
 752         (eq (preceding-char) ?\"))
 753     (backward-sexp)))
 754
 755 (defun slate-tab ()
 756   "This gets called when the user hits [tab] in a `slate-mode' buffer."
 757   (interactive)
 758   (let (col)
 759     ;; round up, with overflow
 760     (setq col (* (/ (+ (current-column) slate-indent-increment)
 761             slate-indent-increment)
 762          slate-indent-increment))
 763     (indent-to-column col)))
 764
 765 ;; Higher-level utilities calling `slate-mode' functions.
 766
 767 (defun slate-forward-sexp (&optional n)
 768   "Move forward N Slate expressions."
 769   (interactive "p")
 770   (unless n (setq n 1))
 771   (cond ((< n 0)
 772          (slate-backward-sexp (- n)))
 773         ((null parse-sexp-ignore-comments)
 774          (forward-sexp n))
 775         (t
 776          (while (> n 0)
 777            (slate-forward-whitespace)
 778            (forward-sexp)
 779            (decf n)))))
 780
 781 (defun slate-backward-sexp (&optional n)
 782   "Move backward N Slate expressions."
 783   (interactive "p")
 784   (unless n (setq n 1))
 785   (cond ((< n 0)
 786          (slate-forward-sexp (- n)))
 787         ((null parse-sexp-ignore-comments)
 788          (backward-sexp n))
 789         (t
 790          (while (> n 0)
 791            (slate-backward-whitespace)
 792            (backward-sexp)
 793            (decf n)))))
 794
 795 (defun slate-find-statement-begin ()
 796   "Leaves the point at the first non-blank, non-comment character of a new
 797 statement.  If beginning of buffer is reached, then the point is left there.
 798 This routine only will return with the point pointing at the first non-blank
 799 on a line; it won't be fooled by multiple statements on a line into stopping
 800 prematurely.  Also, goes to start of method if we started in the method
 801 selector."
 802   (let (start ch)
 803     (when (eq (preceding-char) ?.) ; if we start at eos
 804       (backward-char 1))          ; we find the begin of THAT stmt
 805     (while (and (null start) (not (bobp)))
 806       (slate-backward-whitespace)
 807       (setq ch (preceding-char))
 808       (cond ((eq ch ?.)
 809          (let (saved-point)
 810            (setq saved-point (point))
 811            (slate-forward-whitespace)
 812            (if (slate-white-to-bolp)
 813            (setq start (point))
 814          (goto-char saved-point)
 815          (slate-backward-sexp 1))))
 816         ((eq ch ?^)     ; HACK -- presuming that when we back
 817                     ;up into a return that we're at the
 818                     ;start of a statement
 819          (backward-char 1)
 820          (setq start (point)))
 821         ((eq ch ?\[)
 822          (if (> (current-column) 1)
 823          (setq start (point))
 824            (forward-line 1)
 825            (beginning-of-line)
 826            (slate-forward-whitespace)
 827            (setq start (point))))
 828         ((eq ch ?\{)
 829          (setq start (point)))
 830         ((eq ch ?\()
 831          (backward-char 1))
 832         ((eq ch ?|)
 833          (backward-char 1)
 834          (skip-chars-backward "^[")
 835          ;(slate-backward-whitespace)
 836          )
 837         (t
 838          (slate-backward-sexp 1))))
 839     (unless start
 840       (goto-char (point-min))
 841       (slate-forward-whitespace)
 842       (setq start (point)))
 843     start))
 844
 845 (defun slate-calculate-indent ()
 846   "The core calculations for indentation."
 847   (let (indent-amount start-of-line state (parse-sexp-ignore-comments t))
 848     (save-excursion
 849       (save-restriction
 850         (widen)
 851         (narrow-to-region (point-min) (point)) ;only care about what's before
 852         (setq state (parse-partial-sexp (point-min) (point)))
 853         (cond ((eq (nth 3 state) ?\") ;in a comment
 854                (save-excursion
 855                  (slate-backward-comment)
 856                  (setq indent-amount (+ (current-column) slate-indent-increment))))
 857               ((eq (nth 3 state) ?') ;in a string
 858                (setq indent-amount 0))
 859               ((eq (nth 3 state) ?\))
 860                (setq indent-amount (+ (current-column) slate-indent-increment))))
 861         (unless indent-amount
 862           (slate-narrow-to-method)
 863           (beginning-of-line)
 864           (setq state (parse-partial-sexp (point-min) (point)))
 865           (slate-narrow-to-paren state)
 866           (slate-backward-whitespace)
 867           (cond ((bobp)         ;must be first statement in block or exp
 868                  (if (nth 1 state)        ;within a paren exp
 869                      (save-restriction
 870                        (widen)
 871                        (beginning-of-line)
 872                        (slate-forward-whitespace)
 873                        (setq indent-amount (+ (slate-current-column)
 874                                               slate-indent-increment)))
 875                    ;; we're top level
 876                    (setq indent-amount slate-indent-increment)))
 877                 ((equal (nth 0 state) 0)  ;at top-level
 878                  (beginning-of-line)
 879                  (slate-forward-whitespace)
 880                  (setq indent-amount (slate-current-column)))
 881                 ((eq (preceding-char) ?.) ;at end of statement
 882                  (slate-find-statement-begin)
 883                  (setq indent-amount (slate-current-column)))
 884                 ((eq (preceding-char) ?|)
 885                  (slate-find-statement-begin)
 886                  (setq indent-amount (slate-current-column)))
 887                 ((eq (preceding-char) ?:)
 888                  (beginning-of-line)
 889                  (slate-forward-whitespace)
 890                  (setq indent-amount (+ (slate-current-column)
 891                                         slate-indent-increment)))
 892                 (t                     ;must be a statement continuation
 893                  (slate-find-statement-begin)
 894                  (setq indent-amount (+ (slate-current-column)
 895                                         slate-indent-increment)))))))
 896     (save-excursion
 897       (save-restriction
 898         (widen)
 899         (beginning-of-line)
 900         (skip-chars-forward " \t")
 901         (when (memq (following-char) '(?\} ?\) ?\]))
 902           (setq indent-amount (max 0 (- indent-amount slate-indent-increment))))
 903         (while (memq (following-char) '(?\} ?\) ?\]))
 904           (setq indent-amount (max 0 (- indent-amount slate-indent-increment)))
 905           (forward-char))))
 906     (when (= indent-amount 1) (setq indent-amount slate-indent-increment))
 907     indent-amount))
 908
 909 (defun slate-indent-line ()
 910   "Sees if the current line is a new statement, in which case indent the same
 911 as the previous statement, or determine by context. If not the start of a new
 912 statement, the start of the previous line is used, except if that starts a
 913 new line, in which case it indents by `slate-indent-increment'."
 914   (let (indent-amount is-keyword)
 915     (save-excursion
 916       (beginning-of-line)
 917       (slate-forward-whitespace)
 918       (when (looking-at "[A-Za-z][A-Za-z0-9]*:") ;indent for colon
 919         (let ((parse-sexp-ignore-comments t))
 920           (beginning-of-line)
 921           (slate-forward-whitespace)
 922           (unless (memq (preceding-char) '(?. ?| ?\[ ?\( ?\{))
 923             (setq is-keyword t)))))
 924       (setq indent-amount (slate-calculate-indent))
 925       (slate-indent-to-column indent-amount)))
 926
 927 (defun slate-reindent ()
 928   (interactive)
 929   ;; Still loses if at first character on line
 930   (slate-indent-line))
 931
 932 (defun slate-newline-and-indent ()
 933   (interactive "p")
 934   (newline)
 935   (slate-indent-line))
 936
 937 (defun slate-begin-of-defun ()
 938   "Skip to the beginning of the current method.
 939 If already at the beginning of a method, skips to the beginning of the
 940 previous one."
 941   (interactive)
 942   (let ((parse-sexp-ignore-comments t) here delim start)
 943     (setq here (point))
 944     (while (and (search-backward "@" nil 'to-end)
 945         (setq delim (slate-in-string)))
 946       (search-backward delim))
 947     (setq start (point))
 948     (beginning-of-line)
 949     (slate-forward-whitespace)
 950     ;; check to see if we were already at the start of a method
 951     ;; in which case, the semantics are to go to the one preceding
 952     ;; this one
 953     (when (and (= here (point))
 954            (/= start (point-min)))
 955       (goto-char start)
 956       (slate-backward-whitespace)    ;may be at ! "foo" !
 957       (when (eq (preceding-char) ?@)
 958 ;    (backward-char)
 959     (beginning-of-line)
 960     (slate-forward-whitespace)
 961     (slate-backward-sexp 1))
 962       (slate-begin-of-defun))))        ;and go to the next one
 963
 964 (defun slate-narrow-to-paren (state)
 965   "Narrows the region to between point and the closest previous opening bracket.
 966 It also skips over block headers, and following whitespace on the same line."
 967   (let ((paren-addr (nth 1 state))
 968         start c)
 969     (when paren-addr
 970       (save-excursion
 971         (goto-char paren-addr)
 972         (setq c (following-char))
 973         (when (memq c '(?\( ?\{ ?\[))
 974           (setq start (if (> (point) 2) (1+ (point)) 0))))
 975       (narrow-to-region start (point)))))
 976
 977 (defun slate-at-method-begin ()
 978   "Return T if at the beginning of a block, otherwise nil"
 979   (let ((parse-sexp-ignore-comments t))
 980     (when (bolp)
 981       (save-excursion
 982         (slate-backward-whitespace)
 983         (eq (preceding-char) ?\[)))))
 984
 985 (defun slate-colon ()
 986   "Possibly reindents a line when a colon is typed.
 987 If the colon appears on a keyword that's at the start of the line (ignoring
 988 whitespace, of course), then the previous line is examined to see if there
 989 is a colon on that line, in which case this colon should be aligned with the
 990 left most character of that keyword.  This function is not fooled by nested
 991 expressions."
 992   (interactive)
 993   (self-insert-command 1)
 994   (let (needs-indent state (parse-sexp-ignore-comments t))
 995     (setq state (parse-partial-sexp (point-min) (point)))
 996     (unless (nth 3 state)        ;unless in string or comment
 997       (save-excursion
 998     (skip-chars-backward slate-name-chars)
 999     (when (and (looking-at slate-name-regexp)
1000            (not (slate-at-method-begin)))
1001       (setq needs-indent (slate-white-to-bolp))))
1002       (when needs-indent
1003     (slate-indent-for-colon)))))
1004
1005 (defun slate-indent-for-colon ()
1006   "Called only for lines which look like `<whitespace>foo:'."
1007   (let (indent-amount c state done default-amount start-line
1008               (parse-sexp-ignore-comments t))
1009     (save-excursion
1010       (save-restriction
1011     (widen)
1012     (slate-narrow-to-method)
1013     (beginning-of-line)
1014     (setq state (parse-partial-sexp (point-min) (point)))
1015     (narrow-to-region (point-min) (point))
1016     (setq start-line (point))
1017     (slate-backward-whitespace)
1018     (cond
1019      ((bobp)
1020       (setq indent-amount (slate-current-column)))
1021      ((or (eq (setq c (preceding-char)) ?|)
1022           (eq c ?\[))        ; method header before
1023       (skip-chars-backward "^[")
1024       (slate-find-statement-begin)
1025       (setq indent-amount (slate-current-column)))
1026      ((eq c ?.)    ; stmt end, indent like it
1027       (slate-find-statement-begin)
1028       (setq indent-amount (slate-current-column)))
1029      (t                ;could be a winner
1030       (slate-find-statement-begin)
1031       ;; we know that since we weren't at bobp above after backing
1032       ;; up over white space, and we didn't run into a ., we aren't
1033       ;; at the beginning of a statement, so the default indentation
1034       ;; is one level from statement begin
1035       (setq default-amount
1036         (+ (slate-current-column) ;just in case
1037            slate-indent-increment))
1038       ;; might be at the beginning of a method (the selector), decide
1039       ;; this here
1040       (unless (looking-at slate-keyword-regexp)
1041         ;; not a method selector
1042         (while (and (not done) (not (eobp)))
1043           (slate-forward-sexp 1) ;skip over receiver
1044           (slate-forward-whitespace)
1045           (unless (and indent-amount ;pick up only first one
1046                (not (looking-at slate-keyword-regexp)))
1047         (setq indent-amount (slate-current-column)))))
1048       (unless indent-amount
1049         (setq indent-amount default-amount))))))
1050     (when indent-amount
1051       (slate-indent-to-column indent-amount))))
1052
1053 (defun slate-narrow-to-method ()
1054   "Narrows the buffer to the contents and signature of the method."
1055   ; TODO: Make sure the signature plus optional head comment is included.
1056   (interactive)
1057   (let ((end (point))
1058     (parse-sexp-ignore-comments t)
1059     handled)
1060     (save-excursion
1061       (slate-begin-of-defun)
1062       (if (looking-at "[A-Za-z]")    ;either unary or keyword msg
1063       ;; or maybe an immediate expression...
1064       (progn
1065         (forward-sexp)
1066         (if (eq (following-char) ?:) ;keyword selector
1067         (progn            ;parse full keyword selector
1068           (backward-sexp 1)    ;setup for common code
1069           (slate-forward-keyword-selector))
1070           ;; else maybe just a unary selector or maybe not
1071           ;; see if there's stuff following this guy on the same line
1072           (let (here eol-point)
1073         (setq here (point))
1074         (end-of-line)
1075         (setq eol-point (point))
1076         (goto-char here)
1077         (slate-forward-whitespace)
1078         (if (< (point) eol-point) ;if there is, we're not a method
1079             (beginning-of-line)
1080           (goto-char here)    ;else we're a unary method (guess)
1081           ))))
1082           ;; this must be a binary selector, or a temporary
1083           (when (eq (following-char) ?|)
1084         (end-of-line)    ;could be temporary
1085         (slate-backward-whitespace)
1086         (when (eq (preceding-char) ?|)
1087           (setq handled t))
1088         (beginning-of-line))
1089           (unless handled
1090         (skip-chars-forward (concat "^" slate-whitespace-chars))
1091         (slate-forward-whitespace)
1092         (skip-chars-forward slate-name-chars))) ;skip over operand
1093       (slate-forward-whitespace)
1094       (if (eq (following-char) ?|)    ;scan for temporaries
1095       (progn
1096         (forward-char)        ;skip over |
1097         (slate-forward-whitespace)
1098         (while (and (not (eobp))
1099             (looking-at "[A-Za-z]"))
1100           (skip-chars-forward slate-name-chars)
1101           (slate-forward-whitespace))
1102         (when (and (eq (following-char) ?|) ;if a matching | as a temp
1103                (< (point) end))    ;and we're after the temps
1104           (narrow-to-region (1+ (point)) end) ;we limit the buffer
1105           ))
1106     (when (< (point) end)
1107       (narrow-to-region (point) end))))))
1108
1109 (defun slate-forward-keyword-selector ()
1110   "Starting on a keyword, this function skips forward over a keyword selector.
1111 It is typically used to skip over the actual selector for a method."
1112   (interactive)
1113   (let (done)
1114     (while (not done)
1115       (if (not (looking-at "[A-Za-z_]"))
1116       (setq done t)
1117     (skip-chars-forward slate-name-chars)
1118     (if (eq (following-char) ?:)
1119         (progn
1120           (forward-char)
1121           (slate-forward-sexp)
1122           (slate-forward-whitespace))
1123       (setq done t)
1124       (backward-sexp))))))
1125
1126 (defun slate-collect-selector ()
1127   "Point is stationed inside or at the beginning of the selector in question.
1128 This function computes the Slate selector (unary, binary, or keyword) and
1129 returns it as a string.  Point is not changed."
1130   (save-excursion
1131     (let (start selector done ch
1132         (parse-sexp-ignore-comments t))
1133       (skip-chars-backward (concat "^" "\"" slate-whitespace-chars))
1134       (setq start (point)) ;back to whitespace
1135       (if (looking-at slate-name-regexp)
1136       (progn            ;maybe unary, maybe keyword
1137         (skip-chars-forward slate-name-chars)
1138         (if (eq (following-char) ?:)    ;keyword?
1139         (progn
1140           (forward-char 1)
1141           (setq selector (buffer-substring start (point)))
1142           (setq start (point))
1143           (while (not done)
1144             (slate-forward-whitespace)
1145             (setq ch (following-char))
1146             (cond ((memq ch '(?@ ?\] ?\) ?.)) ;stop at end of expr
1147                (setq done t))
1148               ((eq ch ?:) ;add the next keyword
1149                (forward-char 1)
1150                (setq selector
1151                  (concat selector
1152                      (buffer-substring start (point)))))
1153               (t
1154                (setq start (point))
1155                (slate-forward-sexp 1)))))
1156           (setq selector (buffer-substring start (point)))))
1157     (skip-chars-forward (concat "^\"" slate-whitespace-chars))
1158     (setq selector (buffer-substring start (point))))
1159       selector)))
1160
1161 (defun slate-collect-signature ()
1162   "Similar to slate-collect-selector except that it looks for dispatching
1163 annotations. It returns the selector string and the names of the arguments in
1164 a list. Note that the first argument must be found by searching backwards."
1165   (save-excursion
1166     (let (start selector done ch arg-names
1167         (parse-sexp-ignore-comments t))
1168       (skip-chars-backward (concat "^" "\"" slate-whitespace-chars))
1169       (setq start (point))
1170       (if (looking-at slate-name-regexp)
1171       (progn            ;maybe unary, maybe keyword
1172         (skip-chars-forward slate-name-chars)
1173         (if (eq (following-char) ?:)    ;keyword?
1174         (progn
1175           (forward-char 1)
1176           (setq selector (buffer-substring start (point)))
1177           (setq start (point))
1178           (while (not done)
1179             (slate-forward-whitespace)
1180             (setq ch (following-char))
1181             (cond ((memq ch '(?@ ?\] ?\) ?.))
1182                (setq done t))
1183               ((eq ch ?:)
1184                (forward-char 1)
1185                (setq selector
1186                  (concat selector
1187                      (buffer-substring start (point)))))
1188               (t
1189                (setq start (point))
1190                (slate-forward-sexp 1)))))
1191           (setq selector (buffer-substring start (point)))))
1192     (skip-chars-forward (concat "^" ?\" slate-whitespace-chars))
1193     (setq selector (buffer-substring start (point))))
1194       selector)))
1195
1196 ;; Imenu Support
1197 ;; =============
1198
1199 (defconst slate-imenu-generic-expression
1200   `(("Slots" ,(format "^.*add[A-Za-z]*Slot: #\\(%s\\) valued: .* derive"
1201                       slate-name-regexp) 1)
1202     ("Namespaces" ,(format "^\\(.*\\) ensureNamespace: #\\(%s\\).*\."
1203                            slate-name-regexp) 2)
1204     ("Definitions" ,(format "^\\(.*\\) addPrototype: #\\(%s\\) derivedFrom: {.*}\."
1205                             slate-name-regexp) 2)
1206     ("Definitions" ,(format "^\\(.*\s*\\)?define: #\\(%s\\)"
1207                             slate-name-regexp) 2)
1208     ("Definitions" ,(format "#\\(%s\\) :?:="
1209                             slate-name-regexp) 2)
1210     ("Methods" "^\\([^\[]*@[^\[\"]*\\)$" 1) ; Matches the whole signature.
1211     ))
1212
1213 (defun slate-mode ()
1214   "Major mode for editing Slate code.
1215 Type `M-x slate' to open a Slate interaction area.
1216 Notes:
1217 `slate-mode-hook' is activated on entering the mode.
1218 \\{slate-mode-map}"
1219   (interactive)
1220   (kill-all-local-variables)
1221   (setq major-mode 'slate-mode
1222         mode-name "Slate")
1223   (use-local-map slate-mode-map)
1224   (set-syntax-table slate-mode-syntax-table)
1225   (setq font-lock-defaults '(slate-font-lock-keywords))
1226   (mapc
1227    (lambda (l)
1228      (set (make-local-variable (car l)) (cdr l)))
1229    '((paragraph-start              . "^\f\\|$")
1230      (paragraph-separate           . "[ ^\f\\|]*$")
1231      (paragraph-ignore-fill-prefix . t)
1232      (indent-line-function         . slate-indent-line)
1233      (require-final-newline        . t)
1234      (comment-start                . "\"")
1235      (comment-end                  . "\"")
1236      (comment-column               . 32)
1237      (comment-start-skip           . "\" *")
1238      (comment-indent-function      . slate-comment-indent)
1239      (parse-sexp-ignore-comments   . nil)
1240      (local-abbrev-table           . slate-mode-abbrev-table)
1241      ))
1242   (setq imenu-generic-expression slate-imenu-generic-expression)
1243   (setq font-lock-verbose t)
1244   (run-hooks 'slate-mode-hook))
1245
1246 (provide 'slate-mode)
1247
1248 (add-to-list 'auto-mode-alist '("\\.slate" . slate-mode))