misc/fuel/factor-mode.el

   1 ;;; factor-mode.el --- Major mode for editing Factor programs.
   2
   3 ;; Copyright (C) 2013 Erik Charlebois
   4 ;; Copyright (C) 2008, 2009, 2010 Jose Antonio Ortega Ruiz
   5 ;; See http://factorcode.org/license.txt for BSD license.
   6
   7 ;; Maintainer: Erik Charlebois <erikcharlebois@gmail.com>
   8 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
   9 ;; Keywords: languages, factor
  10 ;; Start date: Tue Dec 02, 2008 21:32
  11
  12 ;;; Commentary:
  13
  14 ;; A major mode for editing Factor programs. It provides indenting and
  15 ;; font-lock support.
  16
  17
  18 ;;; Code:
  19
  20 (require 'thingatpt)
  21 (require 'font-lock)
  22 (require 'ring)
  23 (require 'fuel-base)
  24 (require 'factor-smie)
  25
  26 ;;; Customization:
  27
  28 ;;;###autoload
  29 (defgroup factor nil
  30   "Major mode for Factor source code."
  31   :group 'languages)
  32
  33 (defcustom factor-cycling-no-ask nil
  34   "Whether to never create source/doc/tests file when cycling."
  35   :type 'boolean
  36   :group 'factor)
  37
  38 (defcustom factor-cycle-always-ask-p t
  39   "Whether to always ask for file creation when cycling to a
  40 source/docs/tests file. When set to false, you'll be asked only once."
  41   :type 'boolean
  42   :group 'factor)
  43
  44 (defcustom factor-comment-column 32
  45   "Indentation column of comments."
  46   :type 'integer
  47   :safe 'integerp
  48   :group 'factor)
  49
  50 (defcustom factor-mode-use-fuel t
  51   "Whether to use the full FUEL facilities in factor mode.
  52
  53 Set this variable to nil if you just want to use Emacs as the
  54 external editor of your Factor environment, e.g., by putting
  55 these lines in your .emacs:
  56
  57   (add-to-list 'load-path \"/path/to/factor/misc/fuel\")
  58   (setq factor-mode-use-fuel nil)
  59   (require 'factor-mode)
  60 "
  61   :type 'boolean
  62   :group 'factor)
  63
  64 \f
  65 ;;; Faces:
  66
  67 ;;;###autoload
  68 (defgroup factor-faces nil
  69   "Faces used by factor-mode."
  70   :group 'factor
  71   :group 'faces)
  72
  73 (defface factor-font-lock-constructor '((t (:inherit font-lock-type-face)))
  74   "Factor for constructor words."
  75   :group 'factor-faces
  76   :group 'faces)
  77
  78 (defface factor-font-lock-constant '((t (:inherit font-lock-constant-face)))
  79   "Face for constant and literal values."
  80   :group 'factor-faces
  81   :group 'faces)
  82
  83 (defface factor-font-lock-number '((t (:inherit font-lock-constant-face)))
  84   "Face for integer and floating-point constants."
  85   :group 'factor-faces
  86   :group 'faces)
  87
  88 (defface factor-font-lock-ratio '((t (:inherit font-lock-constant-face)))
  89   "Face for ratio constants."
  90   :group 'factor-faces
  91   :group 'faces)
  92
  93 (defface factor-font-lock-parsing-word '((t (:inherit font-lock-keyword-face)))
  94   "parsing words"
  95   :group 'factor-faces
  96   :group 'faces)
  97
  98 (defface factor-font-lock-setter-word
  99   '((t (:inherit font-lock-function-name-face)))
 100   "setter words (>>foo)"
 101   :group 'factor-faces
 102   :group 'faces)
 103
 104 (defface factor-font-lock-getter-word
 105   '((t (:inherit font-lock-function-name-face)))
 106   "getter words (foo>>)"
 107   :group 'factor-faces
 108   :group 'faces)
 109
 110 (defface factor-font-lock-string '((t (:inherit font-lock-string-face)))
 111   "strings"
 112   :group 'factor-faces
 113   :group 'faces)
 114
 115 (defface factor-font-lock-symbol '((t (:inherit font-lock-variable-name-face)))
 116   "name of symbol being defined"
 117   :group 'factor-faces
 118   :group 'faces)
 119
 120 (defface factor-font-lock-type-name '((t (:inherit font-lock-type-face)))
 121   "type names"
 122   :group 'factor-faces
 123   :group 'faces)
 124
 125 (defface factor-font-lock-vocabulary-name
 126   '((t (:inherit font-lock-constant-face)))
 127   "vocabulary names"
 128   :group 'factor-faces
 129   :group 'faces)
 130
 131 (defface factor-font-lock-word
 132   '((t (:inherit font-lock-function-name-face)))
 133   "Face for the word, generic or method being defined."
 134   :group 'factor-faces
 135   :group 'faces)
 136
 137 (defface factor-font-lock-invalid-syntax
 138   '((t (:inherit font-lock-warning-face)))
 139   "syntactically invalid constructs"
 140   :group 'factor-faces
 141   :group 'faces)
 142
 143 (defface factor-font-lock-comment '((t (:inherit font-lock-comment-face)))
 144   "Face for Factor comments."
 145   :group 'factor-faces
 146   :group 'faces)
 147
 148 (defface factor-font-lock-stack-effect '((t :inherit font-lock-comment-face))
 149   "Face for Factor stack effect declarations."
 150   :group 'factor-faces
 151   :group 'faces)
 152
 153 (defface factor-font-lock-type-in-stack-effect '((t :inherit font-lock-comment-face
 154                                                     :bold t))
 155   "Face for Factor types in stack effect declarations."
 156   :group 'factor-faces
 157   :group 'faces)
 158
 159 \f
 160 ;;; Thing-at-point:
 161
 162 (defun factor-beginning-of-symbol ()
 163   "Move point to the beginning of the current symbol."
 164   (skip-syntax-backward "w_()\""))
 165
 166 (defun factor-end-of-symbol ()
 167   "Move point to the end of the current symbol."
 168   (skip-syntax-forward "w_()\""))
 169
 170 (put 'factor-symbol 'end-op 'factor-end-of-symbol)
 171 (put 'factor-symbol 'beginning-op 'factor-beginning-of-symbol)
 172
 173 (defun factor-symbol-at-point ()
 174   (let ((thing (thing-at-point 'factor-symbol t)))
 175     (and (> (length thing) 0) thing)))
 176
 177 \f
 178 ;;; Regexps galore:
 179
 180 ;; Utility regexp used by other regexps to match a Factor symbol name
 181 (setq-local symbol-nc "\\(?:\\sw\\|\\s_\\|\"\\|\\s(\\|\\s)\\|\\s\\\\)+")
 182 (setq-local symbol (format "\\(%s\\)" symbol-nc))
 183 (setq-local c-symbol-nc "\\(?:\\sw\\|\\s_\\|\\[\\|\\]\\)+")
 184 (setq-local c-symbol (format "\\(%s\\)" c-symbol-nc))
 185 (setq-local ws+ "[ \n\t]+")
 186 (setq-local symbols-to-semicolon "\\([^;\t]*\\)\\(;\\)")
 187
 188 (defun one-symbol (content)
 189   (concat "\\_<\\(" content "\\)\\_>"))
 190
 191 (defun syntax-begin (content)
 192   (one-symbol (concat (regexp-opt content) ":")))
 193
 194 (defun syntax-and-1-symbol (prefixes)
 195   (concat (syntax-begin prefixes) ws+ symbol))
 196
 197 (defun syntax-and-2-symbols (prefixes)
 198   (concat (syntax-and-1-symbol prefixes) ws+ symbol))
 199
 200 ;; Used to font-lock stack effect declarations with may be nested.
 201 (defun factor-match-brackets (limit)
 202   (let ((start (point)))
 203     (when (re-search-forward "[ \n]([ \n]" limit t)
 204       (backward-char 2)
 205       (let ((bracket-start (point)))
 206         (when (condition-case nil
 207                   (progn (forward-sexp) 't)
 208                 ('scan-error nil))
 209           (let ((bracket-stop (point)))
 210             (goto-char bracket-start)
 211             (re-search-forward "\\(.\\|\n\\)+" bracket-stop 'mv)))))))
 212
 213 ;; Excludes parsing words that are handled by other regexps
 214 (defconst factor-parsing-words
 215   '(":" "::" ";" ":>" "&:" "<<" "<PRIVATE" ">>"
 216     "ABOUT:" "ARTICLE:"
 217     "B"
 218     "CONSULT:" "call-next-method"
 219     "FOREIGN-ATOMIC-TYPE:" "FOREIGN-ENUM-TYPE:" "FOREIGN-RECORD-TYPE:" "FUNCTION-ALIAS:"
 220     ";FUNCTOR>"
 221     "GIR:"
 222     "GLSL-SHADER:" "GLSL-PROGRAM:"
 223     "initial:" "IMPLEMENT-STRUCTS:"
 224     "MATH:"
 225     "METHOD:"
 226     "PRIVATE>" "PROTOCOL:" "PROVIDE:"
 227     "read-only"
 228     "STRING:" "SYNTAX:"
 229     "UNIFORM-TUPLE:"
 230     "VARIANT:" "VERTEX-FORMAT:"))
 231
 232 (defconst factor-parsing-words-regex
 233   (format "\\(?:^\\| \\)%s" (regexp-opt factor-parsing-words 'symbols)))
 234
 235 (defconst factor-constant-words
 236   '("f" "t"))
 237
 238 (defconst factor-constant-words-regex
 239   (regexp-opt factor-constant-words 'symbols))
 240
 241 (defconst factor-bracer-words
 242   '("B" "BV" "C" "CS" "HEX" "H" "HS" "S" "T" "V" "W" "flags"))
 243
 244 (defconst factor-brace-words-regex
 245   (format "%s{" (regexp-opt factor-bracer-words t)))
 246
 247 (defconst factor-declaration-words
 248   '("deprecated"
 249     "final"
 250     "flushable"
 251     "foldable"
 252     "inline"
 253     "parsing"
 254     "recursive"
 255     "delimiter"))
 256
 257 (defconst factor-declaration-words-regex
 258   (regexp-opt factor-declaration-words 'symbols))
 259
 260 (defconst factor-integer-regex
 261   (one-symbol "-?\\(?:0[xob][0-9a-fA-F][0-9a-fA-F,]*\\|[0-9][0-9,]*\\)"))
 262
 263 (defconst factor-raw-float-regex
 264   "[0-9]*\\.[0-9]*\\([eEpP][+-]?[0-9]+\\)?")
 265
 266 (defconst factor-float-regex
 267   (format "\\_<-?%s\\_>" factor-raw-float-regex))
 268
 269 (defconst factor-number-regex
 270   (format "\\([0-9]+\\|%s\\)" factor-raw-float-regex))
 271
 272 (defconst factor-ratio-regex
 273   (format "\\_<[+-]?%s/-?%s\\_>" factor-number-regex factor-number-regex))
 274
 275 (defconst factor-bad-string-regex
 276   "\\_<\"[^>]\\([^\"\n]\\|\\\\\"\\)*\n")
 277
 278 (defconst factor-word-definition-regex
 279   (concat
 280    (one-symbol (regexp-opt
 281                 '(":" "::" "GENERIC:" "GENERIC#:" "DEFER:" "HOOK:"
 282                   "IDENTITY-MEMO:" "MACRO:" "MACRO::" "MATH:" "MEMO:" "MEMO::"
 283                   "POSTPONE:" "PRIMITIVE:" "SYNTAX:" "TYPED:" "TYPED::")))
 284    ws+ symbol))
 285
 286 (defconst factor-method-definition-regex
 287   (syntax-and-2-symbols '("M" "M:" "BEFORE" "AFTER")))
 288
 289 ;; [parsing-word] [vocab-word]
 290 (defconst factor-vocab-ref-regex
 291   (syntax-and-1-symbol '("IN" "USE" "QUALIFIED")))
 292
 293 (defconst factor-using-lines-regex
 294   (concat (syntax-begin '("USING")) ws+ symbols-to-semicolon))
 295
 296 ;; [parsing-word] [symbol-word]
 297 (defconst factor-symbol-definition-regex
 298   (syntax-and-1-symbol
 299    '("&" "CONSTANT" "DESTRUCTOR" "EBNF" "FORGET" "FUNCTOR"
 300      "GAME" "HELP" "LIBRARY" "MAIN" "MAIN-WINDOW" "SLOT" "STRING"
 301      "SYMBOL" "VAR")))
 302
 303 ;; [parsing-word] [symbol-word]* ;
 304 (defconst factor-symbols-lines-regex
 305   (concat (syntax-begin '("SYMBOLS")) ws+ symbols-to-semicolon))
 306
 307 (defconst factor-types-lines-regex
 308   (concat
 309    (syntax-begin '("INTERSECTION" "SINGLETONS" "SPECIALIZED-ARRAYS"))
 310    ws+ symbols-to-semicolon))
 311
 312 (defconst factor-type-definition-regex
 313   (syntax-and-1-symbol
 314    '("COM-INTERFACE" "C-TYPE" "MIXIN" "SINGLETON" "SPECIALIZED-ARRAY"
 315      "TUPLE-ARRAY")))
 316
 317 (defconst factor-constructor-regex
 318   (one-symbol "<[^ >]+>"))
 319
 320 (defconst factor-getter-regex
 321   (one-symbol (concat symbol-nc ">>")))
 322
 323 (defconst factor-setter-regex
 324   (one-symbol (format ">>%s\\|%s<<" symbol-nc symbol-nc)))
 325
 326 (defconst factor-stack-effect-regex
 327   "\\( ( [^)]* )\\)\\|\\( (( [^)]* ))\\)")
 328
 329 (defconst factor-use-line-regex "^USE: +\\(.*\\)$")
 330
 331 (defconst factor-current-vocab-regex "^IN: +\\([^ \r\n\f]+\\)")
 332
 333 (defconst factor-sub-vocab-regex "^<\\([^ \n]+\\) *$")
 334
 335 (defconst factor-definition-start-regex
 336   (format "^\\(%s:\\) " (regexp-opt (append factor-no-indent-def-starts
 337                                             factor-indent-def-starts))))
 338
 339 (defconst factor-single-liner-regex
 340   (regexp-opt '("ABOUT:"
 341                 "ALIAS:"
 342                 "CONSTANT:" "C-GLOBAL:" "C-TYPE:"
 343                 "DEFER:" "DESTRUCTOR:"
 344                 "FORGET:"
 345                 "GAME:" "GENERIC:" "GENERIC#:" "GLSL-PROGRAM:"
 346                 "HOOK:"
 347                 "IN:" "INSTANCE:"
 348                 "LIBRARY:"
 349                 "MAIN:" "MATH:" "MIXIN:"
 350                 "NAN:"
 351                 "POSTPONE:" "PRIVATE>" "<PRIVATE"
 352                 "QUALIFIED-WITH:" "QUALIFIED:"
 353                 "RENAME:"
 354                 "SINGLETON:" "SLOT:" "SPECIALIZED-ARRAY:"
 355                 "TYPEDEF:"
 356                 "USE:")))
 357
 358 (defconst factor-begin-of-def-regex
 359   (format "^USING: \\|\\(%s\\)\\|\\(^%s .*\\)"
 360           factor-definition-start-regex
 361           factor-single-liner-regex))
 362
 363 (defconst factor-definition-end-regex
 364   (format "\\(^\\| +\\);\\( *%s\\)*\\($\\| +\\)"
 365           factor-declaration-words-regex))
 366
 367 (defconst factor-end-of-def-regex
 368   (format "^.*%s\\|^%s .*"
 369           factor-definition-end-regex
 370           factor-single-liner-regex))
 371
 372 (defconst factor-word-signature-regex
 373   (format ":[^ ]* \\([^ ]+\\)\\(%s\\)*" factor-stack-effect-regex))
 374
 375 (defconst factor-defun-signature-regex
 376   (format "\\(%s\\|%s\\)"
 377           factor-word-signature-regex
 378           "M[^:]*: [^ ]+ [^ ]+"))
 379
 380 (defconst factor-typedef-regex
 381   (syntax-and-2-symbols '("TYPEDEF" "INSTANCE")))
 382
 383 (defconst factor-rename-regex
 384   (concat (syntax-and-2-symbols '("RENAME")) ws+ "\\(=>\\)" ws+ symbol))
 385
 386 (defconst factor-from/exclude-regex
 387   (concat (syntax-begin '("FROM" "EXCLUDE")) ws+
 388           symbol ws+
 389           "\\(=>\\)" ws+ symbols-to-semicolon))
 390
 391 (defconst factor-predicate-regex
 392   (concat (syntax-begin '("PREDICATE")) ws+ symbol ws+ "\\(<\\)" ws+ symbol))
 393
 394 (defconst factor-alien-function-regex
 395   (concat (syntax-begin '("CALLBACK"
 396                           "FUNCTION"
 397                           "GL-CALLBACK"
 398                           "GL-FUNCTION"
 399                           "X-FUNCTION"))
 400           ws+ symbol
 401           ws+ symbol ws+))
 402
 403 ;; Regexp from hell that puts every type name in the first group,
 404 ;; names and brackets in the second and third.
 405 (defconst factor-function-params-regex
 406   (format "\\(?:%s%s\\(%s,?\\(?:%s)\\)?\\)\\|\\([()]\\)\\)" c-symbol ws+ c-symbol-nc ws+))
 407
 408 (defconst factor-function-alias-regex
 409   (concat (syntax-begin '("FUNCTION-ALIAS"))
 410           ws+ symbol
 411           ws+ symbol
 412           ws+ symbol ws+))
 413
 414 (defconst factor-group-name-to-face
 415   #s(hash-table test equal data
 416                 ("C" 'factor-font-lock-comment
 417                  "CO" 'factor-font-lock-constructor
 418                  "CT" 'factor-font-lock-constant
 419                  "P" 'factor-font-lock-parsing-word
 420                  "V" 'factor-font-lock-vocabulary-name
 421                  "T" 'factor-font-lock-type-name
 422                  "N" 'factor-font-lock-number
 423                  "W" 'factor-font-lock-word)))
 424
 425 (defun factor-group-name-to-face (group-name)
 426   (gethash group-name factor-group-name-to-face))
 427
 428 (defun factor-groups-to-font-lock (groups)
 429   (let ((i 0))
 430     (mapcar (lambda (x)
 431               (setq i (1+ i))
 432               (list i (factor-group-name-to-face x)))
 433             groups)))
 434
 435 (defun factor-syntax (regex groups)
 436   (append (list regex) (factor-groups-to-font-lock groups)))
 437
 438 \f
 439 ;;; Font lock:
 440
 441 (defconst factor-font-lock-keywords
 442   `(
 443     ,(factor-syntax factor-brace-words-regex '("P"))
 444     ,(factor-syntax factor-vocab-ref-regex '("P" "V"))
 445     ,(factor-syntax factor-using-lines-regex '("P" "V" "P"))
 446     ,(factor-syntax factor-symbols-lines-regex '("P" "W" "P"))
 447     ,(factor-syntax factor-from/exclude-regex '("P" "V" "P" "W" "P"))
 448     ,(factor-syntax (syntax-and-2-symbols '("C")) '("P" "W" "T"))
 449     ,(factor-syntax factor-symbol-definition-regex '("P" "W"))
 450     ,(factor-syntax factor-typedef-regex '("P" "T" "T"))
 451     ,(factor-syntax (syntax-and-2-symbols '("C-GLOBAL")) '("P" "T" "W"))
 452     ,(factor-syntax (syntax-and-2-symbols '("QUALIFIED-WITH")) '("P" "V" "W"))
 453     ,(factor-syntax factor-rename-regex '("P" "W" "V" "P" "W"))
 454     ,(factor-syntax factor-declaration-words-regex '("C"))
 455     ,(factor-syntax factor-word-definition-regex '("P" "W"))
 456     ,(factor-syntax (syntax-and-2-symbols '("ALIAS")) '("P" "W" "W"))
 457     ,(factor-syntax (syntax-and-2-symbols '("HINTS" "LOG")) '("P" "W" ""))
 458     ,(factor-syntax (syntax-and-1-symbol '("ALIEN" "CHAR" "COLOR" "NAN" "HEXCOLOR")) '("P" "CT"))
 459     ,(factor-syntax factor-types-lines-regex '("P" "T"))
 460
 461     (,factor-float-regex . 'factor-font-lock-number)
 462     (,factor-ratio-regex . 'factor-font-lock-ratio)
 463     ,(factor-syntax factor-type-definition-regex '("P" "T"))
 464     ,(factor-syntax factor-method-definition-regex '("P" "T" "W"))
 465
 466     ;; Highlights tuple and struct definitions. The TUPLE/STRUCT
 467     ;; parsing word, class name and optional parent classes are
 468     ;; matched in three groups. Then the text up until the end of the
 469     ;; definition that is terminated with ";" is searched for words
 470     ;; that are slot names which are highlighted with the face
 471     ;; factor-font-lock-symbol.
 472     (,(format
 473        "\\(%s:\\)[ \n]+%s\\(?:[ \n]+\\(<\\)[ \n]+%s\\)?"
 474        (regexp-opt '("BUILTIN"
 475                      "ENUM"
 476                      "ERROR"
 477                      "PROTOCOL"
 478                      "STRUCT"
 479                      "TUPLE"
 480                      "UNION"
 481                      "UNION-STRUCT"))
 482        symbol
 483        symbol)
 484      (1 'factor-font-lock-parsing-word)
 485      (2 'factor-font-lock-type-name)
 486      (3 'factor-font-lock-parsing-word nil t)
 487      (4 'factor-font-lock-type-name nil t)
 488      ;; This allows three different slot styles:
 489      ;; 1) foo 2) { foo initial: 123 } 3) { foo initial: { 123 } }
 490      (,(format
 491         "{%s%s[^}]+}%s}\\|{%s%s[^}]+}\\|%s"
 492         ws+ symbol ws+
 493         ws+ symbol
 494         symbol)
 495       (factor-find-end-of-def)
 496       nil
 497       (1 'factor-font-lock-symbol nil t)
 498       (2 'factor-font-lock-symbol nil t)
 499       (3 'factor-font-lock-symbol nil t)))
 500     ,(factor-syntax factor-predicate-regex '("P" "T" "P" "T"))
 501     ;; Highlights alien function definitions. Types in stack effect
 502     ;; declarations are given a bold face.
 503     (,factor-alien-function-regex
 504      (1 'factor-font-lock-parsing-word)
 505      (2 'factor-font-lock-type-name)
 506      (3 'factor-font-lock-word)
 507      (,factor-function-params-regex
 508       (factor-find-ending-bracket)
 509       nil
 510       (1 'factor-font-lock-type-in-stack-effect nil t)
 511       (2 'factor-font-lock-stack-effect nil t)
 512       (3 'factor-font-lock-stack-effect nil t)))
 513
 514     ;; Almost identical to the previous one, but for function aliases.
 515     (,factor-function-alias-regex
 516      (1 'factor-font-lock-parsing-word)
 517      (2 'factor-font-lock-word)
 518      (3 'factor-font-lock-type-name)
 519      (4 'factor-font-lock-word)
 520      (,factor-function-params-regex
 521       (factor-find-ending-bracket)
 522       nil
 523       (1 'factor-font-lock-type-in-stack-effect nil t)
 524       (2 'factor-font-lock-stack-effect nil t)
 525       (3 'factor-font-lock-stack-effect nil t)))
 526     ,(factor-syntax factor-integer-regex '("N"))
 527     (factor-match-brackets . 'factor-font-lock-stack-effect)
 528     ,(factor-syntax factor-constructor-regex '("CO"))
 529     (,factor-setter-regex . 'factor-font-lock-setter-word)
 530     (,factor-getter-regex . 'factor-font-lock-getter-word)
 531     (,factor-bad-string-regex . 'factor-font-lock-invalid-syntax)
 532     ("\\_<\\(P\\|SBUF\\|DLL\\)\"" 1 'factor-font-lock-parsing-word)
 533     (,factor-constant-words-regex . 'factor-font-lock-constant)
 534     ,(factor-syntax factor-parsing-words-regex '("P"))
 535     (,"\t" . 'whitespace-highlight-face)))
 536
 537 ;; Handling of multi-line constructs
 538 (defun factor-font-lock-extend-region ()
 539   (eval-when-compile (defvar font-lock-beg) (defvar font-lock-end))
 540   (save-excursion
 541     (goto-char font-lock-beg)
 542     (let ((found (or (re-search-backward "\n\n" nil t) (point-min))))
 543       (goto-char font-lock-end)
 544       (when (re-search-forward "\n\n" nil t)
 545         (beginning-of-line)
 546         (setq font-lock-end (point)))
 547       (setq font-lock-beg found))))
 548
 549 ;;; Source code analysis:
 550
 551 (defsubst factor-brackets-depth ()
 552   (nth 0 (syntax-ppss)))
 553
 554 (defsubst factor-brackets-start ()
 555   (nth 1 (syntax-ppss)))
 556
 557 (defsubst factor-beginning-of-defun (&optional times)
 558   (re-search-backward factor-begin-of-def-regex nil t times))
 559
 560 (defsubst factor-end-of-defun ()
 561   (re-search-forward factor-end-of-def-regex nil t))
 562
 563 (defsubst factor-end-of-defun-pos ()
 564   (save-excursion
 565     (re-search-forward factor-end-of-def-regex nil t)
 566     (point)))
 567
 568 (defun factor-on-vocab ()
 569   "t if point is on a vocab name. We just piggyback on
 570   font-lock's pretty accurate information."
 571   (eq (get-char-property (point) 'face) 'factor-font-lock-vocabulary-name))
 572
 573 (defun factor-find-end-of-def (&rest foo)
 574   (save-excursion
 575     (re-search-forward "[ \n];" nil t)
 576     (1- (point))))
 577
 578 (defun factor-find-ending-bracket (&rest foo)
 579   (save-excursion
 580     (re-search-forward "[ \n]\)" nil t)
 581     (point)))
 582
 583 (defun factor-beginning-of-body ()
 584   (let ((p (point)))
 585     (and (factor-beginning-of-defun)
 586          (re-search-forward factor-defun-signature-regex p t)
 587          (not (re-search-forward factor-end-of-def-regex p t)))))
 588
 589 (defun factor-beginning-of-sexp ()
 590   (if (> (factor-brackets-depth) 0)
 591       (goto-char (factor-brackets-start))
 592     (factor-beginning-of-body)))
 593
 594 (defsubst factor-beginning-of-sexp-pos ()
 595   (save-excursion (factor-beginning-of-sexp) (point)))
 596
 597 \f
 598 ;;; USING/IN:
 599
 600 (defvar-local factor-current-vocab-function 'factor-find-vocab-name)
 601
 602 (defsubst factor-current-vocab ()
 603   (funcall factor-current-vocab-function))
 604
 605 (defun factor-find-in ()
 606   (save-excursion
 607     (beginning-of-line)
 608     (if (re-search-backward factor-current-vocab-regex nil t)
 609         (match-string-no-properties 1)
 610       (when (re-search-forward factor-current-vocab-regex nil t)
 611         (match-string-no-properties 1)))))
 612
 613 (defun factor-in-private? ()
 614   "t if point is withing a PRIVATE-block, nil otherwise."
 615   (save-excursion
 616     (when (re-search-backward "\\_<<?PRIVATE>?\\_>" nil t)
 617       (string= (match-string-no-properties 0) "<PRIVATE"))))
 618
 619 (defun factor-find-vocab-name ()
 620   "Name of the vocab with possible .private suffix"
 621   (concat (factor-find-in) (if (factor-in-private?) ".private" "")))
 622
 623
 624 (defvar-local factor-usings-function 'factor-find-usings)
 625
 626 (defsubst factor-usings ()
 627   (funcall factor-usings-function))
 628
 629 (defun factor-file-has-private ()
 630   (save-excursion
 631     (goto-char (point-min))
 632     (and (re-search-forward "\\_<<PRIVATE\\_>" nil t)
 633          (re-search-forward "\\_<PRIVATE>\\_>" nil t))))
 634
 635 (defun factor-find-usings (&optional no-private)
 636   "Lists all vocabs used by the vocab."
 637   (save-excursion
 638     (let ((usings))
 639       (goto-char (point-max))
 640       (while (re-search-backward factor-using-lines-regex nil t)
 641         (dolist (u (split-string (match-string-no-properties 2) nil t))
 642           (push u usings)))
 643       (when (and (not no-private) (factor-file-has-private))
 644         (goto-char (point-max))
 645         (push (concat (factor-find-in) ".private") usings))
 646       usings)))
 647
 648 \f
 649 ;;; Buffer cycling:
 650
 651 (defconst factor-cycle-endings
 652   '(".factor" "-tests.factor" "-docs.factor"))
 653
 654 (defvar factor-cycle-ring
 655   (let ((ring (make-ring (length factor-cycle-endings))))
 656     (dolist (e factor-cycle-endings ring)
 657       (ring-insert ring e))
 658     ring))
 659
 660 (defconst factor-cycle-basename-regex
 661   (format "\\(.+?\\)\\(%s\\)$" (regexp-opt factor-cycle-endings)))
 662
 663 (defun factor-cycle-split (basename)
 664   (when (string-match factor-cycle-basename-regex basename)
 665     (cons (match-string 1 basename) (match-string 2 basename))))
 666
 667 (defun factor-cycle-next (file skip)
 668   (let* ((dir (file-name-directory file))
 669          (basename (file-name-nondirectory file))
 670          (p/s (factor-cycle-split basename))
 671          (prefix (car p/s))
 672          (ring factor-cycle-ring)
 673          (idx (or (ring-member ring (cdr p/s)) 0))
 674          (len (ring-size ring))
 675          (i 1)
 676          (result nil))
 677     (while (and (< i len) (not result))
 678       (let* ((suffix (ring-ref ring (+ i idx)))
 679              (path (expand-file-name (concat prefix suffix) dir)))
 680         (when (or (file-exists-p path)
 681                   (and (not skip)
 682                        (not (member suffix factor-cycling-no-ask))
 683                        (y-or-n-p (format "Create %s? " path))))
 684           (setq result path))
 685         (when (and (not factor-cycle-always-ask-p)
 686                    (not (member suffix factor-cycling-no-ask)))
 687           (setq factor-cycling-no-ask
 688                 (cons name factor-cycling-no-ask))))
 689       (setq i (1+ i)))
 690     result))
 691
 692 (defun factor-visit-other-file (&optional create)
 693   "Cycle between code, tests and docs factor files.
 694 With prefix, non-existing files will be created."
 695   (interactive "P")
 696   (let ((file (factor-cycle-next (buffer-file-name) (not create))))
 697     (unless file (error "No other file found"))
 698     (find-file file)
 699     (unless (file-exists-p file)
 700       (set-buffer-modified-p t)
 701       (save-buffer))))
 702
 703 \f
 704 ;;; factor-mode:
 705
 706 (defvar factor-mode-syntax-table (fuel-syntax-table))
 707
 708 (defun factor-setup-buffer-font-lock ()
 709   (setq-local comment-start "! ")
 710   (setq-local comment-end "")
 711   (setq-local comment-column factor-comment-column)
 712   (setq-local comment-start-skip "!+ *")
 713   (setq-local parse-sexp-ignore-comments t)
 714   (setq-local parse-sexp-lookup-properties t)
 715   (setq-local font-lock-defaults '(factor-font-lock-keywords))
 716   ;; Some syntactic constructs are often split over multiple lines so
 717   ;; we need to setup multiline font-lock.
 718   (setq-local font-lock-multiline t)
 719   (add-hook 'font-lock-extend-region-functions 'factor-font-lock-extend-region)
 720   (setq-local syntax-propertize-function 'factor-syntax-propertize))
 721
 722 (defun factor-font-lock-string (str)
 723   "Fontify STR as if it was Factor code."
 724   (with-temp-buffer
 725     (set-syntax-table factor-mode-syntax-table)
 726     (factor-setup-buffer-font-lock)
 727     (insert str)
 728     (let ((font-lock-verbose nil))
 729       (font-lock-fontify-buffer))
 730     (buffer-string)))
 731
 732 (defun factor-syntax-propertize (start end)
 733   (funcall
 734    (syntax-propertize-rules
 735     ("\\(^\\| \\|\t\\)\\(!\\|#!\\)\\($\\| \\|\t\\)" (2 "<   ")))
 736    start end))
 737
 738 ;;;###autoload
 739 (define-derived-mode factor-mode prog-mode "Factor"
 740   "A mode for editing programs written in the Factor programming language.
 741 \\{factor-mode-map}"
 742   (factor-setup-buffer-font-lock)
 743   (define-key factor-mode-map [remap ff-get-other-file]
 744     'factor-visit-other-file)
 745
 746   (setq-local electric-indent-chars
 747               (append '(?\] ?\} ?\n) electric-indent-chars))
 748
 749   ;; No tabs for you!!
 750   (setq-local indent-tabs-mode nil)
 751
 752   (add-hook 'smie-indent-functions #'factor-smie-indent nil t)
 753   (smie-setup factor-smie-grammar #'factor-smie-rules
 754               :forward-token #'factor-smie-forward-token
 755               :backward-token #'factor-smie-backward-token)
 756   (setq-local smie-indent-basic factor-block-offset)
 757
 758   (setq-local beginning-of-defun-function 'factor-beginning-of-defun)
 759   (setq-local end-of-defun-function 'factor-end-of-defun)
 760   ;; Load fuel-mode too if factor-mode-use-fuel is t.
 761   (when factor-mode-use-fuel (require 'fuel-mode) (fuel-mode)))
 762
 763 ;;;###autoload
 764 (add-to-list 'auto-mode-alist '("\\.factor\\'" . factor-mode))
 765
 766 ;;;###autoload
 767 (add-to-list 'interpreter-mode-alist '("factor" . factor-mode))
 768
 769 \f
 770 (provide 'factor-mode)
 771
 772 ;;; factor-mode.el ends here