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