editors/scel/el/sclang-mode.el

   1 ;; copyright 2003-2005 stefan kersten <steve@k-hornz.de>
   2 ;;
   3 ;; This program is free software; you can redistribute it and/or
   4 ;; modify it under the terms of the GNU General Public License as
   5 ;; published by the Free Software Foundation; either version 2 of the
   6 ;; License, or (at your option) any later version.
   7 ;;
   8 ;; This program is distributed in the hope that it will be useful, but
   9 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  10 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11 ;; General Public License for more details.
  12 ;;
  13 ;; You should have received a copy of the GNU General Public License
  14 ;; along with this program; if not, write to the Free Software
  15 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
  16 ;; USA
  17
  18 (eval-when-compile
  19   (require 'cl)
  20   (load "cl-seq" nil t)
  21   (require 'font-lock)
  22   (require 'sclang-util))
  23
  24 (require 'sclang-interp)
  25 (require 'sclang-language)
  26 (require 'sclang-dev)
  27
  28 (defun sclang-fill-syntax-table (table)
  29   ;; string
  30   (modify-syntax-entry ?\" "\"" table)
  31   (modify-syntax-entry ?\' "\"" table) ; no string syntax class for single quotes
  32   ;; expression prefix
  33   (modify-syntax-entry ?~ "'" table)
  34   ;; escape
  35   (modify-syntax-entry ?\\ "\\" table)
  36   ;; character quote
  37   (modify-syntax-entry ?$  "/" table)
  38   ;; symbol
  39   (modify-syntax-entry ?_  "_" table)
  40   ;; symbol/punctuation
  41   (modify-syntax-entry ?!  "." table)
  42   (modify-syntax-entry ?%  "." table)
  43   (modify-syntax-entry ?&  "." table)
  44   (modify-syntax-entry ?*  ". 23n" table)
  45   (modify-syntax-entry ?+  "." table)
  46   (modify-syntax-entry ?-  "." table)
  47   (modify-syntax-entry ?/  ". 124b" table)
  48   (modify-syntax-entry ?<  "." table)
  49   (modify-syntax-entry ?=  "." table)
  50   (modify-syntax-entry ?>  "." table)
  51   (modify-syntax-entry ??  "." table)
  52   (modify-syntax-entry ?@  "." table)
  53   (modify-syntax-entry ?|  "." table)
  54   ;; punctuation
  55   (modify-syntax-entry ?:  "." table)
  56   (modify-syntax-entry ?\; "." table)
  57   (modify-syntax-entry ?^ "." table)
  58   ;; parenthesis
  59   (modify-syntax-entry ?\( "()" table)
  60   (modify-syntax-entry ?\) ")(" table)
  61   (modify-syntax-entry ?\[ "(]" table)
  62   (modify-syntax-entry ?\] ")[" table)
  63   (modify-syntax-entry ?\{ "(}" table)
  64   (modify-syntax-entry ?\} "){" table)
  65   ;; comment end
  66   (modify-syntax-entry ?\n "> b" table)
  67   ;; Give CR the same syntax as newline, for selective-display
  68   (modify-syntax-entry ?\^m "> b" table)
  69   ;; return table
  70   table)
  71
  72 (defun sclang-mode-make-menu (title)
  73   (easy-menu-create-menu
  74    title
  75    '(
  76          ["Start Interpreter"           sclang-start :included (not (sclang-library-initialized-p))]
  77          ["Restart Interpreter"         sclang-start :included (sclang-library-initialized-p)]
  78          ["Recompile Class Library"     sclang-recompile :included (sclang-library-initialized-p)]
  79          ["Stop Interpreter"            sclang-stop      :included (sclang-get-process)]
  80          ["Kill Interpreter"            sclang-kill      :included (sclang-get-process)]
  81          "-"
  82          ["Show Post Buffer"            sclang-show-post-buffer]
  83          ["Clear Post Buffer"           sclang-clear-post-buffer]
  84          "-"
  85          ["Switch To Workspace"         sclang-switch-to-workspace]
  86          "-"
  87          ["Evaluate Region"                     sclang-eval-region]
  88          ["Evaluate Line"                       sclang-eval-region-or-line]
  89          ["Evaluate Defun"                      sclang-eval-defun]
  90          ["Evaluate Expression ..."     sclang-eval-expression]
  91          ["Evaluate Document"           sclang-eval-document]
  92          "-"
  93          ["Find Definitions ..."        sclang-find-definitions]
  94          ["Find References ..."         sclang-find-references]
  95          ["Pop Mark"                            sclang-pop-definition-mark]
  96          ["Show Method Arguments"       sclang-show-method-args]
  97          ["Complete keyword"            sclang-complete-symbol]
  98          ["Dump Interface"                      sclang-dump-interface]
  99          ["Dump Full Interface"         sclang-dump-full-interface]
 100          "-"
 101          ["Index Help Topics"           sclang-index-help-topics]
 102          ["Find Help ..."                       sclang-find-help]
 103          ["Switch to Help Browser"      sclang-goto-help-browser]
 104          ["Open Help GUI"                       sclang-open-help-gui]
 105          "-"
 106          ["Run Main"                            sclang-main-run]
 107          ["Stop Main"                           sclang-main-stop]
 108          ["Show Server Panels"          sclang-show-server-panel]
 109          )))
 110
 111 (defun sclang-fill-mode-map (map)
 112   ;; process control
 113   (define-key map "\C-c\C-l"            'sclang-recompile)
 114   (define-key map "\C-c\C-o"            'sclang-start)
 115   ;; post buffer control
 116   (define-key map "\C-c<"                       'sclang-clear-post-buffer)
 117   (define-key map "\C-c>"                       'sclang-show-post-buffer)
 118   ;; workspace access
 119   (define-key map "\C-c\C-w"            'sclang-switch-to-workspace)
 120   ;; code evaluation
 121   (define-key map "\C-c\C-c"            'sclang-eval-region-or-line)
 122   (define-key map "\C-c\C-d"            'sclang-eval-region)
 123   (define-key map "\C-\M-x"                     'sclang-eval-defun)
 124   (define-key map "\C-c\C-e"            'sclang-eval-expression)
 125   (define-key map "\C-c\C-f"            'sclang-eval-document)
 126   ;; language information
 127   (define-key map "\C-c\C-n"            'sclang-complete-symbol)
 128   (define-key map "\M-\t"                       'sclang-complete-symbol)
 129   (define-key map "\C-c:"                       'sclang-find-definitions)
 130   (define-key map "\C-c;"                       'sclang-find-references)
 131   (define-key map "\C-c}"                       'sclang-pop-definition-mark)
 132   (define-key map "\C-c\C-m"            'sclang-show-method-args)
 133   (define-key map "\C-c{"                       'sclang-dump-full-interface)
 134   (define-key map "\C-c["                       'sclang-dump-interface)
 135   ;; documentation access
 136   (define-key map "\C-c\C-h"            'sclang-find-help)
 137   (define-key map "\C-\M-h"                     'sclang-goto-help-browser)
 138   (define-key map "\C-c\C-y"            'sclang-open-help-gui)
 139   (define-key map "\C-ch"                       'sclang-find-help-in-gui)
 140   ;; language control
 141   (define-key map "\C-c\C-r"            'sclang-main-run)
 142   (define-key map "\C-c\C-s"            'sclang-main-stop)
 143   (define-key map "\C-c\C-p"            'sclang-show-server-panel)
 144   (define-key map "\C-c\C-k"            'sclang-edit-dev-source)
 145   ;; electric characters
 146   (define-key map "}"                           'sclang-electric-brace)
 147   (define-key map ")"                           'sclang-electric-brace)
 148   (define-key map "]"                           'sclang-electric-brace)
 149   (define-key map "/"                           'sclang-electric-slash)
 150   (define-key map "*"                           'sclang-electric-star)
 151   ;; menu
 152   (let ((title "SCLang"))
 153         (define-key map [menu-bar sclang] (cons title (sclang-mode-make-menu title))))
 154   ;; return map
 155   map)
 156
 157 ;; =====================================================================
 158 ;; font-lock support
 159 ;; =====================================================================
 160
 161 (defconst sclang-font-lock-keyword-list
 162   '(
 163     "arg"
 164     "classvar"
 165     "const"
 166     "super"
 167     "this"
 168     "thisFunction"
 169     "thisFunctionDef"
 170     "thisMethod"
 171     "thisProcess"
 172     "thisThread"
 173     "var"
 174     )
 175   "*List of keywords to highlight in SCLang mode.")
 176
 177 (defconst sclang-font-lock-builtin-list
 178   '(
 179     "false"
 180     "inf"
 181     "nil"
 182     "true"
 183     )
 184   "*List of builtins to highlight in SCLang mode.")
 185
 186 (defconst sclang-font-lock-method-list
 187   '(
 188     "ar"
 189     "for"
 190     "forBy"
 191     "if"
 192     "ir"
 193     "kr"
 194     "tr"
 195     "loop"
 196     "while"
 197     )
 198   "*List of methods to highlight in SCLang mode.")
 199
 200 (defconst sclang-font-lock-error-list
 201   '(
 202     "die"
 203     "error"
 204     "exit"
 205     "halt"
 206     "verboseHalt"
 207     "warn"
 208     )
 209   "*List of methods signalling errors or warnings.")
 210
 211 (defvar sclang-font-lock-class-keywords nil)
 212
 213 (defvar sclang-font-lock-keywords-1 nil
 214   "Subdued level highlighting for SCLang mode.")
 215
 216 (defvar sclang-font-lock-keywords-2 nil
 217   "Medium level highlighting for SCLang mode.")
 218
 219 (defvar sclang-font-lock-keywords-3 nil
 220   "Gaudy level highlighting for SCLang mode.")
 221
 222 (defvar sclang-font-lock-keywords nil
 223   "Default expressions to highlight in SCLang mode.")
 224
 225 (defconst sclang-font-lock-defaults '((sclang-font-lock-keywords
 226                                        sclang-font-lock-keywords-1
 227                                        sclang-font-lock-keywords-2
 228                                        sclang-font-lock-keywords-3
 229                                        )
 230                                       nil nil
 231                                       nil
 232                                       beginning-of-defun
 233                                       ))
 234
 235 (defun sclang-font-lock-syntactic-face (state)
 236   (cond ((eq (nth 3 state) ?')
 237          ;; symbol
 238          'font-lock-constant-face)
 239         ((nth 3 state)
 240          ;; string
 241          'font-lock-string-face)
 242         ((nth 4 state)
 243          ;; comment
 244          'font-lock-comment-face)))
 245
 246 (defun sclang-font-lock-class-keyword-matcher (limit)
 247   (let ((regexp (or sclang-font-lock-class-keywords
 248                     (concat "\\<" sclang-class-name-regexp "\\>")))
 249         (case-fold-search nil))
 250     (re-search-forward regexp limit t)))
 251
 252 (defun sclang-set-font-lock-keywords ()
 253   (setq
 254    ;; level 1
 255    sclang-font-lock-keywords-1
 256    (list
 257     ;; keywords
 258     (cons (regexp-opt sclang-font-lock-keyword-list'words)
 259           'font-lock-keyword-face)
 260     ;; builtins
 261     (cons (regexp-opt sclang-font-lock-builtin-list 'words)
 262           'font-lock-builtin-face)
 263     ;; pi is a special case
 264     (cons "\\<\\([0-9]+\\(\\.\\)\\)pi\\>" 'font-lock-builtin-face)
 265     ;; constants
 266     (cons "\\s/\\s\\?." 'font-lock-constant-face) ; characters
 267     (cons (concat "\\\\\\(" sclang-symbol-regexp "\\)")
 268           'font-lock-constant-face)     ; symbols
 269     )
 270    ;; level 2
 271    sclang-font-lock-keywords-2
 272    (append
 273     sclang-font-lock-keywords-1
 274     (list
 275      ;; variables
 276      (cons (concat "\\s'\\(" sclang-identifier-regexp "\\)")
 277            'font-lock-variable-name-face) ; environment variables
 278      (cons (concat "\\<\\(" sclang-identifier-regexp "\\)\\>:") ; keyword arguments
 279            'font-lock-variable-name-face)
 280      ;; method definitions
 281      (cons sclang-method-definition-regexp
 282            (list 1 'font-lock-function-name-face))
 283      ;; methods
 284      (cons (regexp-opt sclang-font-lock-method-list 'words)
 285            'font-lock-function-name-face)
 286      ;; errors
 287      (cons (regexp-opt sclang-font-lock-error-list 'words)
 288            'font-lock-warning-face)
 289      ))
 290    ;; level 3
 291    sclang-font-lock-keywords-3
 292    (append
 293     sclang-font-lock-keywords-2
 294     (list
 295      ;; classes
 296      (cons 'sclang-font-lock-class-keyword-matcher 'font-lock-type-face)
 297 ;;      (cons (concat "\\<" sclang-class-name-regexp "\\>") 'font-lock-type-face)
 298      ))
 299    ;; default level
 300    sclang-font-lock-keywords sclang-font-lock-keywords-1
 301    ))
 302
 303 (defun sclang-update-font-lock ()
 304   "Update font-lock information in all sclang-mode buffers."
 305   (setq sclang-font-lock-class-keywords
 306         (and sclang-symbol-table
 307              (let* ((list (remove-if
 308                            (lambda (x) (or (not (sclang-class-name-p x))
 309                                            (sclang-string-match "^Meta_" x)))
 310                            sclang-symbol-table))
 311                     ;; need to set this for large numbers of classes
 312                     (max-specpdl-size (* (length list) 2)))
 313                (condition-case nil
 314                    (concat "\\<\\(?:Meta_\\)?\\(?:" (regexp-opt list) "\\)\\>")
 315                  (error nil)))))
 316   ;; too expensive
 317   ;;   (dolist (buffer (buffer-list))
 318   ;;     (with-current-buffer buffer
 319   ;;       (and (eq major-mode 'sclang-mode)
 320   ;;       (eq t (car font-lock-keywords))
 321   ;;       (setq font-lock-keywords (cdr font-lock-keywords)))))
 322   (if (eq major-mode 'sclang-mode)
 323       (font-lock-fontify-buffer)))
 324
 325 ;; =====================================================================
 326 ;; indentation
 327 ;; =====================================================================
 328
 329 (defcustom sclang-indent-level 4
 330   "*Indentation offset for SCLang statements."
 331   :group 'sclang-mode
 332   :type 'integer)
 333
 334 (defun sclang-indent-line ()
 335   "Indent current line as sclang code.
 336 Return the amount the indentation changed by."
 337   (let ((indent (calculate-sclang-indent))
 338         beg shift-amt
 339         (case-fold-search nil)
 340         (pos (- (point-max) (point))))
 341     (beginning-of-line)
 342     (setq beg (point))
 343     (skip-chars-forward " \t")
 344     (setq shift-amt (- indent (current-column)))
 345     (if (zerop shift-amt)
 346         (if (> (- (point-max) pos) (point))
 347             (goto-char (- (point-max) pos)))
 348       (delete-region beg (point))
 349       (indent-to indent)
 350       ;; if initial point was within line's indentation, position
 351       ;; after the indentation, else stay at same point in text.
 352       (if (> (- (point-max) pos) (point))
 353           (goto-char (- (point-max) pos))))
 354     shift-amt))
 355
 356 (defun calculate-sclang-indent (&optional parse-start)
 357   "Return appropriate indentation for current line as sclang code.
 358 Returns the column to indent to."
 359   (save-excursion
 360     (beginning-of-line)
 361     (let ((indent-point (point))
 362           (case-fold-search nil)
 363           state)
 364       (if parse-start
 365           (goto-char parse-start)
 366         (beginning-of-defun))
 367       (while (< (point) indent-point)
 368         (setq state (parse-partial-sexp (point) indent-point 0)))
 369       (let* ((containing-sexp (nth 1 state))
 370              (inside-string-p (nth 3 state))
 371              (inside-comment-p (nth 4 state)))
 372         (cond (inside-string-p
 373                ;; inside string: no change
 374                (current-indentation))
 375               ((integerp inside-comment-p)
 376                ;; inside comment
 377                (let ((base (if containing-sexp
 378                                (save-excursion
 379                                  (goto-char containing-sexp)
 380                                  (+ (current-indentation) sclang-indent-level))
 381                              0))
 382                      (offset (* sclang-indent-level
 383                                 (- inside-comment-p
 384                                    (if (save-excursion
 385                                          (back-to-indentation)
 386                                          (looking-at "\\*/"))
 387                                        1 0)))))
 388                  (+ base offset)))
 389               ((null containing-sexp)
 390                ;; top-level: no indentation
 391                0)
 392               (t
 393                (back-to-indentation)
 394                (let ((open-paren (and (looking-at "\\s)")
 395                                       (matching-paren (char-after))))
 396                      (indent (current-indentation)))
 397                  (goto-char containing-sexp)
 398                  (if (or (not open-paren) (eq open-paren (char-after)))
 399                      (cond ((progn (beginning-of-line) (looking-at sclang-block-regexp)) 0)
 400                            (open-paren (current-indentation))
 401                            (t (+ (current-indentation) sclang-indent-level)))
 402                    ;; paren mismatch: do nothing
 403                    indent))))))))
 404
 405 ;; =====================================================================
 406 ;; electric character commands
 407 ;; =====================================================================
 408
 409 (defun sclang-electric-brace (arg)
 410   (interactive "*P")
 411   (self-insert-command (prefix-numeric-value arg))
 412   (and (save-excursion
 413          (beginning-of-line)
 414          (looking-at "\\s *\\s)"))
 415        (indent-according-to-mode)))
 416
 417 (defun sclang-electric-slash (arg)
 418   (interactive "*P")
 419   (let* ((char (char-before))
 420          (indent-p (or (eq char ?/)
 421                        (eq char ?*))))
 422     (self-insert-command (prefix-numeric-value arg))
 423     (if indent-p (indent-according-to-mode))))
 424
 425 (defun sclang-electric-star (arg)
 426   (interactive "*P")
 427   (let ((indent-p (eq (char-before) ?/)))
 428     (self-insert-command (prefix-numeric-value arg))
 429     (if indent-p (indent-according-to-mode))))
 430
 431 ;; =====================================================================
 432 ;; document interface
 433 ;; =====================================================================
 434
 435 (defvar sclang-document-id nil)
 436 (defvar sclang-document-state nil)
 437 (defvar sclang-document-envir nil)
 438
 439 (defvar sclang-document-counter 0)
 440 (defvar sclang-document-list nil)
 441 (defvar sclang-current-document nil
 442   "Currently active document.")
 443
 444 (defvar sclang-document-idle-timer nil)
 445
 446 (defconst sclang-document-property-map
 447   '((sclang-document-name . (prSetTitle (buffer-name)))
 448     (sclang-document-path . (prSetFileName (buffer-file-name)))
 449     (sclang-document-listener-p . (prSetIsListener (eq (current-buffer) (sclang-get-post-buffer))))
 450     (sclang-document-editable-p . (prSetEditable (not buffer-read-only)))
 451     (sclang-document-edited-p . (prSetEdited (buffer-modified-p)))))
 452
 453 (defmacro sclang-next-document-id ()
 454   `(incf sclang-document-counter))
 455
 456 (defun sclang-document-list ()
 457   sclang-document-list)
 458
 459 (defun sclang-document-id (buffer)
 460   (cdr (assq 'sclang-document-id (buffer-local-variables buffer))))
 461
 462 (defun sclang-document-p (buffer)
 463   (integerp (sclang-document-id buffer)))
 464
 465 (defmacro with-sclang-document (buffer &rest body)
 466   `(when (sclang-document-p buffer)
 467      (with-current-buffer buffer
 468        ,@body)))
 469
 470 (defun sclang-get-document (id)
 471   (find-if (lambda (doc) (eq id (sclang-document-id doc)))
 472            (sclang-document-list)))
 473
 474 (defun sclang-init-document ()
 475   (set (make-local-variable 'sclang-document-id) (sclang-next-document-id))
 476   (set (make-local-variable 'sclang-document-envir) nil)
 477   (dolist (assoc sclang-document-property-map)
 478     (set (make-local-variable (car assoc)) nil))
 479   (pushnew (current-buffer) sclang-document-list))
 480
 481 (defun sclang-document-update-property-1 (assoc &optional force)
 482   (when (consp assoc)
 483     (let* ((key (car assoc))
 484            (prop (cdr assoc))
 485            (prev-value (eval key))
 486            (cur-value (eval (cadr prop))))
 487       (when (or force (not (equal prev-value cur-value)))
 488         (set key cur-value)
 489         (sclang-perform-command-no-result
 490          'documentSetProperty sclang-document-id
 491          (car prop) cur-value)))))
 492
 493 (defun sclang-document-update-property (key &optional force)
 494   (sclang-document-update-property-1 (assq key sclang-document-property-map) force))
 495
 496 (defun sclang-document-update-properties (&optional force)
 497   (dolist (assoc sclang-document-property-map)
 498     (sclang-document-update-property-1 assoc force)))
 499
 500 (defun sclang-make-document ()
 501   (sclang-perform-command-no-result 'documentNew sclang-document-id)
 502   (sclang-document-update-properties t))
 503
 504 (defun sclang-close-document (buffer)
 505   (with-sclang-document
 506    buffer
 507    (setq sclang-document-list (delq buffer sclang-document-list))
 508    (sclang-perform-command-no-result
 509     'documentClosed sclang-document-id)))
 510
 511 (defun sclang-set-current-document (buffer &optional force)
 512   (when (or force (not (eq buffer sclang-current-document)))
 513     (setq sclang-current-document buffer)
 514     (sclang-perform-command-no-result 'documentSetCurrent (sclang-document-id buffer))
 515     t))
 516
 517 (defun sclang-document-library-startup-hook-function ()
 518   (dolist (buffer (sclang-document-list))
 519     (with-current-buffer buffer
 520       (sclang-make-document)))
 521   (sclang-set-current-document (current-buffer) t))
 522
 523 (defun sclang-document-kill-buffer-hook-function ()
 524   (sclang-close-document (current-buffer)))
 525
 526 (defun sclang-document-post-command-hook-function ()
 527   (when (and (sclang-library-initialized-p)
 528              (sclang-document-p (current-buffer)))
 529     (sclang-document-update-properties))
 530   (sclang-set-current-document (current-buffer)))
 531
 532 (defun sclang-document-change-major-mode-hook-function ()
 533   (sclang-close-document (current-buffer)))
 534
 535 ;; =====================================================================
 536 ;; command handlers
 537 ;; =====================================================================
 538
 539 (sclang-set-command-handler
 540  '_documentOpen
 541  (lambda (arg)
 542    (multiple-value-bind (file-name region-start region-length) arg
 543      (let ((buffer (get-file-buffer file-name)))
 544        (unless buffer
 545          (setf buffer (find-file-noselect file-name)))
 546        (when buffer
 547          (unless (sclang-document-p buffer)
 548            (with-current-buffer buffer (sclang-mode)))
 549          (goto-char (max (point-min) (min (point-max) region-start)))
 550          ;; TODO: how to activate region in transient-mark-mode?
 551          (sclang-document-id buffer))))))
 552
 553 (sclang-set-command-handler
 554  '_documentNew
 555  (lambda (arg)
 556    (multiple-value-bind (name str make-listener) arg
 557      (let ((buffer (generate-new-buffer name)))
 558        (with-current-buffer buffer
 559          (insert str)
 560          (set-buffer-modified-p nil)
 561          (sclang-mode))
 562        (sclang-document-id buffer)))))
 563
 564 (sclang-set-command-handler
 565  '_documentClose
 566  (lambda (arg)
 567    (let ((doc (and (integerp arg) (sclang-get-document arg))))
 568      (and doc (kill-buffer doc)))
 569    nil))
 570
 571 (sclang-set-command-handler
 572  '_documentRename
 573  (lambda (arg)
 574    (multiple-value-bind (id name) arg
 575      (when (stringp name)
 576        (let ((doc (and (integerp id) (sclang-get-document id))))
 577          (when doc
 578            (with-current-buffer doc
 579              (rename-buffer name t)
 580              (sclang-document-update-property 'sclang-document-name))))))
 581    nil))
 582
 583 (sclang-set-command-handler
 584  '_documentSetEditable
 585  (lambda (arg)
 586    (multiple-value-bind (id flag) arg
 587      (let ((doc (and (integerp id) (sclang-get-document id))))
 588        (when doc
 589          (with-current-buffer doc
 590            (setq buffer-read-only (not flag))
 591            (sclang-document-update-property 'sclang-editable-p)))))
 592    nil))
 593
 594 (sclang-set-command-handler
 595  '_documentSwitchTo
 596  (lambda (arg)
 597    (let ((doc (and (integerp arg) (sclang-get-document arg))))
 598      (and doc (switch-to-buffer doc)))
 599    nil))
 600
 601 (sclang-set-command-handler
 602  '_documentPutString
 603 (lambda (arg)
 604    (multiple-value-bind (id str) arg
 605      (let ((doc (and (integerp id) (sclang-get-document id))))
 606        (when doc
 607          (with-current-buffer doc
 608          (insert str)
 609          )
 610        nil)))))
 611
 612 (sclang-set-command-handler
 613  '_documentPopTo
 614  (lambda (arg)
 615    (let ((doc (and (integerp arg) (sclang-get-document arg))))
 616      (and doc (display-buffer doc)))
 617    nil))
 618
 619 ;; =====================================================================
 620 ;; sclang-mode
 621 ;; =====================================================================
 622
 623 (defun sclang-mode-set-local-variables ()
 624   (set (make-local-variable 'require-final-newline) nil)
 625   ;; indentation
 626   (set (make-local-variable 'indent-line-function)
 627        'sclang-indent-line)
 628   (set (make-local-variable 'tab-width) 4)
 629   (set (make-local-variable 'indent-tabs-mode) t)
 630   ;; comment formatting
 631   (set (make-local-variable 'comment-start) "// ")
 632   (set (make-local-variable 'comment-end) "")
 633   (set (make-local-variable 'comment-column) 40)
 634   (set (make-local-variable 'comment-start-skip) "/\\*+ *\\|//+ *")
 635   ;;        "\\(^\\|\\s-\\);?// *")
 636   (set (make-local-variable 'comment-multi-line) t)
 637   ;; parsing and movement
 638   (set (make-local-variable 'parse-sexp-ignore-comments) t)
 639   (set (make-local-variable 'beginning-of-defun-function)
 640        'sclang-beginning-of-defun)
 641   (set (make-local-variable 'end-of-defun-function)
 642        'sclang-end-of-defun)
 643   ;; paragraph formatting
 644   ;;   (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
 645   ;; mostly copied from c++-mode, seems to work
 646   (set (make-local-variable 'paragraph-start)
 647        "[ \t]*\\(//+\\|\\**\\)[ \t]*$\\|^\f")
 648   (set (make-local-variable 'paragraph-separate) paragraph-start)
 649   (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
 650   (set (make-local-variable 'adaptive-fill-mode) t)
 651   (set (make-local-variable 'adaptive-fill-regexp)
 652        "[ \t]*\\(//+\\|\\**\\)[ \t]*\\([ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*\\)")
 653   ;; font lock
 654   (set (make-local-variable 'font-lock-syntactic-face-function)
 655        'sclang-font-lock-syntactic-face)
 656   (set (make-local-variable 'font-lock-defaults)
 657        sclang-font-lock-defaults)
 658   ;; ---
 659   nil)
 660
 661 (defvar sclang-mode-map (sclang-fill-mode-map (make-sparse-keymap))
 662   "Keymap used in SuperCollider mode.")
 663
 664 (defvar sclang-mode-syntax-table (sclang-fill-syntax-table (make-syntax-table))
 665   "Syntax table used in SuperCollider mode.")
 666
 667 (defcustom sclang-mode-hook nil
 668   "*Hook run when entering SCLang mode."
 669   :group 'sclang-mode
 670   :type 'hook)
 671
 672 (defun sclang-mode ()
 673   "Major mode for editing SuperCollider language code.
 674 \\{sclang-mode-map}
 675 "
 676   (interactive)
 677   (kill-all-local-variables)
 678   (set-syntax-table sclang-mode-syntax-table)
 679   (use-local-map sclang-mode-map)
 680   (setq mode-name "SCLang")
 681   (setq major-mode 'sclang-mode)
 682   (sclang-mode-set-local-variables)
 683   (sclang-set-font-lock-keywords)
 684   (sclang-init-document)
 685   (sclang-make-document)
 686   (run-hooks 'sclang-mode-hook))
 687
 688 ;; =====================================================================
 689 ;; module initialization
 690 ;; =====================================================================
 691
 692 (add-to-list 'auto-mode-alist '("\\.\\(sc\\|scd\\)$" . sclang-mode))
 693 (add-to-list 'interpreter-mode-alist '("sclang" . sclang-mode))
 694
 695 (add-hook 'sclang-library-startup-hook 'sclang-document-library-startup-hook-function)
 696 (add-hook 'kill-buffer-hook 'sclang-document-kill-buffer-hook-function)
 697 (add-hook 'post-command-hook 'sclang-document-post-command-hook-function)
 698 (add-hook 'change-major-mode-hook 'sclang-document-change-major-mode-hook-function)
 699
 700 (provide 'sclang-mode)
 701
 702 ;; EOF