misc/fuel/factor-mode.el

   1 ;;; factor-mode.el --- Major mode for editing Factor programs. -*- lexical-binding: t -*-
   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     "initial:" "IMPLEMENT-STRUCTS:"
 223     "MATH:"
 224     "METHOD:"
 225     "PRIVATE>" "PROTOCOL:"
 226     "read-only"
 227     "STRING:" "SYNTAX:"
 228     "VARIANT:"))
 229
 230 (defconst factor-parsing-words-regex
 231   (format "\\(?:^\\| \\)%s" (regexp-opt factor-parsing-words 'symbols)))
 232
 233 (defconst factor-constant-words
 234   '("f" "t"))
 235
 236 (defconst factor-constant-words-regex
 237   (regexp-opt factor-constant-words 'symbols))
 238
 239 (defconst factor-bracer-words
 240   '("B" "BV" "C" "CS" "HEX" "H" "HS" "S" "T" "V" "W" "flags"))
 241
 242 (defconst factor-brace-words-regex
 243   (format "%s{" (regexp-opt factor-bracer-words t)))
 244
 245 (defconst factor-declaration-words
 246   '("deprecated"
 247     "final"
 248     "flushable"
 249     "foldable"
 250     "inline"
 251     "parsing"
 252     "recursive"
 253     "delimiter"))
 254
 255 (defconst factor-declaration-words-regex
 256   (regexp-opt factor-declaration-words 'symbols))
 257
 258 (defconst factor-integer-regex
 259   (one-symbol "-?\\(?:0[xob][0-9a-fA-F][0-9a-fA-F,]*\\|[0-9][0-9,]*\\)"))
 260
 261 (defconst factor-raw-float-regex
 262   "[0-9]*\\.[0-9]*\\([eEpP][+-]?[0-9]+\\)?")
 263
 264 (defconst factor-float-regex
 265   (format "\\_<-?%s\\_>" factor-raw-float-regex))
 266
 267 (defconst factor-number-regex
 268   (format "\\([0-9]+\\|%s\\)" factor-raw-float-regex))
 269
 270 (defconst factor-ratio-regex
 271   (format "\\_<[+-]?%s/-?%s\\_>" factor-number-regex factor-number-regex))
 272
 273 (defconst factor-bad-string-regex
 274   "\\_<\"[^>]\\([^\"\n]\\|\\\\\"\\)*\n")
 275
 276 (defconst factor-word-definition-regex
 277   (concat
 278    (one-symbol (regexp-opt
 279                 '(":" "::" "GENERIC:" "GENERIC#:" "DEFER:" "HOOK:"
 280                   "IDENTITY-MEMO:" "MACRO:" "MACRO::" "MATH:" "MEMO:" "MEMO::"
 281                   "POSTPONE:" "PRIMITIVE:" "SYNTAX:" "TYPED:" "TYPED::")))
 282    ws+ symbol))
 283
 284 (defconst factor-method-definition-regex
 285   (syntax-and-2-symbols '("M" "M:" "BEFORE" "AFTER")))
 286
 287 ;; [parsing-word] [vocab-word]
 288 (defconst factor-vocab-ref-regex
 289   (syntax-and-1-symbol '("IN" "USE" "QUALIFIED")))
 290
 291 (defconst factor-using-lines-regex
 292   (concat (syntax-begin '("USING")) ws+ symbols-to-semicolon))
 293
 294 ;; [parsing-word] [symbol-word]
 295 (defconst factor-symbol-definition-regex
 296   (syntax-and-1-symbol
 297    '("&" "CONSTANT" "DESTRUCTOR" "EBNF" "FORGET" "FUNCTOR"
 298      "GAME" "GLSL-PROGRAM" "GLSL-SHADER"
 299      "HELP" "LIBRARY" "MAIN" "MAIN-WINDOW" "SLOT" "STRING"
 300      "SYMBOL" "VAR")))
 301
 302 ;; [parsing-word] [symbol-word]* ;
 303 (defconst factor-symbols-lines-regex
 304   (concat (syntax-begin '("SYMBOLS")) ws+ symbols-to-semicolon))
 305
 306 (defconst factor-types-lines-regex
 307   (concat
 308    (syntax-begin '("INTERSECTION" "SINGLETONS" "SPECIALIZED-ARRAYS"))
 309    ws+ symbols-to-semicolon))
 310
 311 ;; [parsing-word] [type-word]
 312 (defconst factor-type-definition-regex
 313   (syntax-and-1-symbol
 314    '("COM-INTERFACE" "C-TYPE" "MIXIN"
 315      "GLSL-SHADER-FILE"
 316      "SINGLETON" "SPECIALIZED-ARRAY" "SPECIALIZED-VECTOR"
 317      "TUPLE-ARRAY")))
 318
 319 (defconst factor-constructor-regex
 320   (one-symbol "<[^ >]+>"))
 321
 322 (defconst factor-getter-regex
 323   (one-symbol (concat symbol-nc ">>")))
 324
 325 (defconst factor-setter-regex
 326   (one-symbol (format ">>%s\\|%s<<" symbol-nc symbol-nc)))
 327
 328 (defconst factor-stack-effect-regex
 329   "\\( ( [^)]* )\\)\\|\\( (( [^)]* ))\\)")
 330
 331 (defconst factor-use-line-regex "^USE: +\\(.*\\)$")
 332
 333 (defconst factor-current-vocab-regex "^IN: +\\([^ \r\n\f]+\\)")
 334
 335 (defconst factor-sub-vocab-regex "^<\\([^ \n]+\\) *$")
 336
 337 (defconst factor-definition-start-regex
 338   (format "^\\(%s:\\) " (regexp-opt (append factor-no-indent-def-starts
 339                                             factor-indent-def-starts))))
 340
 341 (defconst factor-single-liner-regex
 342   (regexp-opt '("ABOUT:"
 343                 "ALIAS:"
 344                 "CONSTANT:" "C-GLOBAL:" "C-TYPE:"
 345                 "DEFER:" "DESTRUCTOR:"
 346                 "FORGET:"
 347                 "GAME:" "GENERIC:" "GENERIC#:"
 348                 "HOOK:"
 349                 "IN:" "INSTANCE:"
 350                 "LIBRARY:"
 351                 "MAIN:" "MATH:" "MIXIN:"
 352                 "NAN:"
 353                 "POSTPONE:" "PRIVATE>" "<PRIVATE"
 354                 "QUALIFIED-WITH:" "QUALIFIED:"
 355                 "RENAME:"
 356                 "SINGLETON:" "SLOT:" "SPECIALIZED-ARRAY:"
 357                 "TYPEDEF:"
 358                 "USE:")))
 359
 360 (defconst factor-begin-of-def-regex
 361   (format "^USING: \\|\\(%s\\)\\|\\(^%s .*\\)"
 362           factor-definition-start-regex
 363           factor-single-liner-regex))
 364
 365 (defconst factor-definition-end-regex
 366   (format "\\(^\\| +\\);\\( *%s\\)*\\($\\| +\\)"
 367           factor-declaration-words-regex))
 368
 369 (defconst factor-end-of-def-regex
 370   (format "^.*%s\\|^%s .*"
 371           factor-definition-end-regex
 372           factor-single-liner-regex))
 373
 374 (defconst factor-word-signature-regex
 375   (format ":[^ ]* \\([^ ]+\\)\\(%s\\)*" factor-stack-effect-regex))
 376
 377 (defconst factor-defun-signature-regex
 378   (format "\\(%s\\|%s\\)"
 379           factor-word-signature-regex
 380           "M[^:]*: [^ ]+ [^ ]+"))
 381
 382 (defconst factor-typedef-regex
 383   (syntax-and-2-symbols '("TYPEDEF" "INSTANCE")))
 384
 385 (defconst factor-rename-regex
 386   (concat (syntax-and-2-symbols '("RENAME")) ws+ "\\(=>\\)" ws+ symbol))
 387
 388 (defconst factor-from/exclude-regex
 389   (concat (syntax-begin '("FROM" "EXCLUDE")) ws+
 390           symbol ws+
 391           "\\(=>\\)" ws+ symbols-to-semicolon))
 392
 393 (defconst factor-predicate-regex
 394   (concat (syntax-begin '("PREDICATE")) ws+ symbol ws+ "\\(<\\)" ws+ symbol))
 395
 396 (defconst factor-alien-function-regex
 397   (concat (syntax-begin '("CALLBACK"
 398                           "FUNCTION"
 399                           "GL-CALLBACK"
 400                           "GL-FUNCTION"
 401                           "X-FUNCTION"))
 402           ws+ symbol
 403           ws+ symbol ws+))
 404
 405 ;; Regexp from hell that puts every type name in the first group,
 406 ;; names and brackets in the second and third.
 407 (defconst factor-function-params-regex
 408   (format "\\(?:%s%s\\(%s,?\\(?:%s)\\)?\\)\\|\\([()]\\)\\)" c-symbol ws+ c-symbol-nc ws+))
 409
 410 (defconst factor-function-alias-regex
 411   (concat (syntax-begin '("FUNCTION-ALIAS"))
 412           ws+ symbol
 413           ws+ symbol
 414           ws+ symbol ws+))
 415
 416 (defconst factor-group-name-to-face
 417   #s(hash-table test equal data
 418                 ("C" 'factor-font-lock-comment
 419                  "CO" 'factor-font-lock-constructor
 420                  "CT" 'factor-font-lock-constant
 421                  "P" 'factor-font-lock-parsing-word
 422                  "V" 'factor-font-lock-vocabulary-name
 423                  "T" 'factor-font-lock-type-name
 424                  "N" 'factor-font-lock-number
 425                  "W" 'factor-font-lock-word)))
 426
 427 (defun factor-group-name-to-face (group-name)
 428   (gethash group-name factor-group-name-to-face))
 429
 430 (defun factor-groups-to-font-lock (groups)
 431   (let ((i 0))
 432     (mapcar (lambda (x)
 433               (setq i (1+ i))
 434               (list i (factor-group-name-to-face x)))
 435             groups)))
 436
 437 (defun factor-syntax (regex groups)
 438   (append (list regex) (factor-groups-to-font-lock groups)))
 439
 440 \f
 441 ;;; Font lock:
 442
 443 (defconst factor-font-lock-keywords
 444   `(
 445     ,(factor-syntax factor-brace-words-regex '("P"))
 446     ,(factor-syntax factor-vocab-ref-regex '("P" "V"))
 447     ,(factor-syntax factor-using-lines-regex '("P" "V" "P"))
 448     ,(factor-syntax factor-symbols-lines-regex '("P" "W" "P"))
 449     ,(factor-syntax factor-from/exclude-regex '("P" "V" "P" "W" "P"))
 450     ,(factor-syntax (syntax-and-2-symbols '("C")) '("P" "W" "T"))
 451     ,(factor-syntax factor-symbol-definition-regex '("P" "W"))
 452     ,(factor-syntax factor-typedef-regex '("P" "T" "T"))
 453     ,(factor-syntax (syntax-and-2-symbols '("C-GLOBAL")) '("P" "T" "W"))
 454     ,(factor-syntax (syntax-and-2-symbols '("QUALIFIED-WITH")) '("P" "V" "W"))
 455     ,(factor-syntax factor-rename-regex '("P" "W" "V" "P" "W"))
 456     ,(factor-syntax factor-declaration-words-regex '("C"))
 457     ,(factor-syntax factor-word-definition-regex '("P" "W"))
 458     ,(factor-syntax (syntax-and-2-symbols '("ALIAS")) '("P" "W" "W"))
 459     ,(factor-syntax (syntax-and-2-symbols '("HINTS" "LOG")) '("P" "W" ""))
 460     ,(factor-syntax (syntax-and-1-symbol '("ALIEN" "CHAR" "COLOR" "NAN" "HEXCOLOR")) '("P" "CT"))
 461     ,(factor-syntax factor-types-lines-regex '("P" "T"))
 462
 463     (,factor-float-regex . 'factor-font-lock-number)
 464     (,factor-ratio-regex . 'factor-font-lock-ratio)
 465     ,(factor-syntax factor-type-definition-regex '("P" "T"))
 466     ,(factor-syntax factor-method-definition-regex '("P" "T" "W"))
 467
 468     ;; Highlights tuple and struct definitions. The TUPLE/STRUCT
 469     ;; parsing word, class name and optional parent classes are
 470     ;; matched in three groups. Then the text up until the end of the
 471     ;; definition that is terminated with ";" is searched for words
 472     ;; that are slot names which are highlighted with the face
 473     ;; factor-font-lock-symbol.
 474     (,(format
 475        "\\(%s:\\)[ \n]+%s\\(?:[ \n]+\\(<\\)[ \n]+%s\\)?"
 476        (regexp-opt '("BUILTIN"
 477                      "ENUM"
 478                      "ERROR"
 479                      "PROTOCOL"
 480                      "STRUCT"
 481                      "TUPLE"
 482                      "UNIFORM-TUPLE"
 483                      "UNION"
 484                      "UNION-STRUCT"
 485                      "VERTEX-FORMAT"))
 486        symbol
 487        symbol)
 488      (1 'factor-font-lock-parsing-word)
 489      (2 'factor-font-lock-type-name)
 490      (3 'factor-font-lock-parsing-word nil t)
 491      (4 'factor-font-lock-type-name nil t)
 492      ;; This allows three different slot styles:
 493      ;; 1) foo 2) { foo initial: 123 } 3) { foo initial: { 123 } }
 494      (,(format
 495         "{%s%s[^}]+}%s}\\|{%s%s[^}]+}\\|%s"
 496         ws+ symbol ws+
 497         ws+ symbol
 498         symbol)
 499       (factor-find-end-of-def)
 500       nil
 501       (1 'factor-font-lock-symbol nil t)
 502       (2 'factor-font-lock-symbol nil t)
 503       (3 'factor-font-lock-symbol nil t)))
 504     ,(factor-syntax factor-predicate-regex '("P" "T" "P" "T"))
 505     ;; Highlights alien function definitions. Types in stack effect
 506     ;; declarations are given a bold face.
 507     (,factor-alien-function-regex
 508      (1 'factor-font-lock-parsing-word)
 509      (2 'factor-font-lock-type-name)
 510      (3 'factor-font-lock-word)
 511      (,factor-function-params-regex
 512       (factor-find-ending-bracket)
 513       nil
 514       (1 'factor-font-lock-type-in-stack-effect nil t)
 515       (2 'factor-font-lock-stack-effect nil t)
 516       (3 'factor-font-lock-stack-effect nil t)))
 517
 518     ;; Almost identical to the previous one, but for function aliases.
 519     (,factor-function-alias-regex
 520      (1 'factor-font-lock-parsing-word)
 521      (2 'factor-font-lock-word)
 522      (3 'factor-font-lock-type-name)
 523      (4 'factor-font-lock-word)
 524      (,factor-function-params-regex
 525       (factor-find-ending-bracket)
 526       nil
 527       (1 'factor-font-lock-type-in-stack-effect nil t)
 528       (2 'factor-font-lock-stack-effect nil t)
 529       (3 'factor-font-lock-stack-effect nil t)))
 530     ,(factor-syntax factor-integer-regex '("N"))
 531     (factor-match-brackets . 'factor-font-lock-stack-effect)
 532     ,(factor-syntax factor-constructor-regex '("CO"))
 533     (,factor-setter-regex . 'factor-font-lock-setter-word)
 534     (,factor-getter-regex . 'factor-font-lock-getter-word)
 535     (,factor-bad-string-regex . 'factor-font-lock-invalid-syntax)
 536     ("\\_<\\(P\\|SBUF\\|DLL\\)\"" 1 'factor-font-lock-parsing-word)
 537     (,factor-constant-words-regex . 'factor-font-lock-constant)
 538     ,(factor-syntax factor-parsing-words-regex '("P"))
 539     (,"\t" . 'whitespace-highlight-face)))
 540
 541 ;; Handling of multi-line constructs
 542 (defun factor-font-lock-extend-region ()
 543   (eval-when-compile (defvar font-lock-beg) (defvar font-lock-end))
 544   (save-excursion
 545     (goto-char font-lock-beg)
 546     (let ((found (or (re-search-backward "\n\n" nil t) (point-min))))
 547       (goto-char font-lock-end)
 548       (when (re-search-forward "\n\n" nil t)
 549         (beginning-of-line)
 550         (setq font-lock-end (point)))
 551       (setq font-lock-beg found))))
 552
 553 ;;; Source code analysis:
 554
 555 (defsubst factor-brackets-depth ()
 556   (nth 0 (syntax-ppss)))
 557
 558 (defsubst factor-brackets-start ()
 559   (nth 1 (syntax-ppss)))
 560
 561 (defsubst factor-beginning-of-defun (&optional times)
 562   (re-search-backward factor-begin-of-def-regex nil t times))
 563
 564 (defsubst factor-end-of-defun ()
 565   (re-search-forward factor-end-of-def-regex nil t))
 566
 567 (defsubst factor-end-of-defun-pos ()
 568   (save-excursion
 569     (re-search-forward factor-end-of-def-regex nil t)
 570     (point)))
 571
 572 (defun factor-on-vocab ()
 573   "t if point is on a vocab name. We just piggyback on
 574   font-lock's pretty accurate information."
 575   (eq (get-char-property (point) 'face) 'factor-font-lock-vocabulary-name))
 576
 577 (defun factor-find-end-of-def (&rest foo)
 578   (save-excursion
 579     (re-search-forward "[ \n];" nil t)
 580     (1- (point))))
 581
 582 (defun factor-find-ending-bracket (&rest foo)
 583   (save-excursion
 584     (re-search-forward "[ \n]\)" nil t)
 585     (point)))
 586
 587 (defun factor-beginning-of-body ()
 588   (let ((p (point)))
 589     (and (factor-beginning-of-defun)
 590          (re-search-forward factor-defun-signature-regex p t)
 591          (not (re-search-forward factor-end-of-def-regex p t)))))
 592
 593 (defun factor-beginning-of-sexp ()
 594   (if (> (factor-brackets-depth) 0)
 595       (goto-char (factor-brackets-start))
 596     (factor-beginning-of-body)))
 597
 598 (defsubst factor-beginning-of-sexp-pos ()
 599   (save-excursion (factor-beginning-of-sexp) (point)))
 600
 601 \f
 602 ;;; USING/IN:
 603
 604 (defvar-local factor-current-vocab-function 'factor-find-vocab-name)
 605
 606 (defsubst factor-current-vocab ()
 607   (funcall factor-current-vocab-function))
 608
 609 (defun factor-find-in ()
 610   (save-excursion
 611     (beginning-of-line)
 612     (if (re-search-backward factor-current-vocab-regex nil t)
 613         (match-string-no-properties 1)
 614       (when (re-search-forward factor-current-vocab-regex nil t)
 615         (match-string-no-properties 1)))))
 616
 617 (defun factor-in-private? ()
 618   "t if point is withing a PRIVATE-block, nil otherwise."
 619   (save-excursion
 620     (when (re-search-backward "\\_<<?PRIVATE>?\\_>" nil t)
 621       (string= (match-string-no-properties 0) "<PRIVATE"))))
 622
 623 (defun factor-find-vocab-name ()
 624   "Name of the vocab with possible .private suffix"
 625   (concat (factor-find-in) (if (factor-in-private?) ".private" "")))
 626
 627
 628 (defvar-local factor-usings-function 'factor-find-usings)
 629
 630 (defsubst factor-usings ()
 631   (funcall factor-usings-function))
 632
 633 (defun factor-file-has-private ()
 634   (save-excursion
 635     (goto-char (point-min))
 636     (and (re-search-forward "\\_<<PRIVATE\\_>" nil t)
 637          (re-search-forward "\\_<PRIVATE>\\_>" nil t))))
 638
 639 (defun factor-find-usings (&optional no-private)
 640   "Lists all vocabs used by the vocab."
 641   (save-excursion
 642     (let ((usings))
 643       (goto-char (point-max))
 644       (while (re-search-backward factor-using-lines-regex nil t)
 645         (dolist (u (split-string (match-string-no-properties 2) nil t))
 646           (push u usings)))
 647       (when (and (not no-private) (factor-file-has-private))
 648         (goto-char (point-max))
 649         (push (concat (factor-find-in) ".private") usings))
 650       usings)))
 651
 652 \f
 653 ;;; Buffer cycling:
 654
 655 (defconst factor-cycle-endings
 656   '(".factor" "-tests.factor" "-docs.factor"))
 657
 658 (defvar factor-cycle-ring
 659   (let ((ring (make-ring (length factor-cycle-endings))))
 660     (dolist (e factor-cycle-endings ring)
 661       (ring-insert ring e))
 662     ring))
 663
 664 (defconst factor-cycle-basename-regex
 665   (format "\\(.+?\\)\\(%s\\)$" (regexp-opt factor-cycle-endings)))
 666
 667 (defun factor-cycle-split (basename)
 668   (when (string-match factor-cycle-basename-regex basename)
 669     (cons (match-string 1 basename) (match-string 2 basename))))
 670
 671 (defun factor-cycle-next (file skip)
 672   (let* ((dir (file-name-directory file))
 673          (basename (file-name-nondirectory file))
 674          (p/s (factor-cycle-split basename))
 675          (prefix (car p/s))
 676          (ring factor-cycle-ring)
 677          (idx (or (ring-member ring (cdr p/s)) 0))
 678          (len (ring-size ring))
 679          (i 1)
 680          (result nil))
 681     (while (and (< i len) (not result))
 682       (let* ((suffix (ring-ref ring (+ i idx)))
 683              (path (expand-file-name (concat prefix suffix) dir)))
 684         (when (or (file-exists-p path)
 685                   (and (not skip)
 686                        (not (member suffix factor-cycling-no-ask))
 687                        (y-or-n-p (format "Create %s? " path))))
 688           (setq result path))
 689         (when (and (not factor-cycle-always-ask-p)
 690                    (not (member suffix factor-cycling-no-ask)))
 691           (setq factor-cycling-no-ask
 692                 (cons name factor-cycling-no-ask))))
 693       (setq i (1+ i)))
 694     result))
 695
 696 (defun factor-visit-other-file (&optional create)
 697   "Cycle between code, tests and docs factor files.
 698 With prefix, non-existing files will be created."
 699   (interactive "P")
 700   (let ((file (factor-cycle-next (buffer-file-name) (not create))))
 701     (unless file (error "No other file found"))
 702     (find-file file)
 703     (unless (file-exists-p file)
 704       (set-buffer-modified-p t)
 705       (save-buffer))))
 706
 707 \f
 708 ;;; imenu tags
 709
 710 ;; TODO Handle the plural words (SINGLETONS:, SYMBOLS:, etc)
 711 (defvar factor-imenu-generic-expression
 712   `((nil
 713      ,(concat "^\\s-*"
 714               (regexp-opt '(":" "::" "ALIAS:" "BUILTIN:" "C:" "CONSTANT:" "ERROR:"
 715                             "GENERIC:" "GENERIC#:" "HOOK:" "INTERSECTION:" "MATH:"
 716                             "MIXIN:" "PREDICATE:" "PRIMITIVE:" "SINGLETON:" "SLOT:"
 717                             "SYMBOL:" "SYNTAX:" "TUPLE:" "UNION:" "LOG:" "C-TYPE:" "ENUM:"
 718                             "STRUCT:" "FUNCTION-ALIAS:"))
 719               "\\s-+\\(\\(?:\\s_\\|\\sw\\|\\s\\\\)+\\)")
 720      1)
 721     ("Methods"
 722      ,(concat "^\\s-*"
 723               (regexp-opt '("M:" "M::"))
 724               "\\s-+\\(\\(?:\\s_\\|\\sw|\\s\\\\)+\\s-+\\(?:\\s_\\|\\sw|\\s\\\\)+\\)")
 725      1)
 726     (nil
 727      ,(concat "^\\s-*"
 728               (regexp-opt '("FUNCTION:" "TYPEDEF:"))
 729               "\\s-+\\(?:\\(?:\\s_\\|\\sw\\|\\s\\\\)+\\s-+\\)\\(\\(?:\\s_\\|\\sw\\|\\s\\\\)+\\)")
 730      1))
 731   "Imenu generic expression for factor-mode. See `imenu-generic-expression'.")
 732
 733 \f
 734 ;;; factor-mode:
 735
 736 (defvar factor-mode-syntax-table (fuel-syntax-table))
 737
 738 (defun factor-setup-buffer-font-lock ()
 739   (setq-local comment-start "! ")
 740   (setq-local comment-end "")
 741   (setq-local comment-column factor-comment-column)
 742   (setq-local comment-start-skip "!+ *")
 743   (setq-local parse-sexp-ignore-comments t)
 744   (setq-local parse-sexp-lookup-properties t)
 745   (setq-local font-lock-defaults '(factor-font-lock-keywords))
 746   ;; Some syntactic constructs are often split over multiple lines so
 747   ;; we need to setup multiline font-lock.
 748   (setq-local font-lock-multiline t)
 749   (add-hook 'font-lock-extend-region-functions 'factor-font-lock-extend-region)
 750   (setq-local syntax-propertize-function 'factor-syntax-propertize))
 751
 752 (defun factor-font-lock-string (str)
 753   "Fontify STR as if it was Factor code."
 754   (with-temp-buffer
 755     (set-syntax-table factor-mode-syntax-table)
 756     (factor-setup-buffer-font-lock)
 757     (insert str)
 758     (let ((font-lock-verbose nil))
 759       (font-lock-fontify-buffer))
 760     (buffer-string)))
 761
 762 (defun factor-syntax-propertize (start end)
 763   (funcall
 764    (syntax-propertize-rules
 765     ("\\(^\\| \\|\t\\)\\(!\\|#!\\)\\($\\| \\|\t\\)" (2 "<   ")))
 766    start end))
 767
 768 ;;;###autoload
 769 (define-derived-mode factor-mode prog-mode "Factor"
 770   "A mode for editing programs written in the Factor programming language.
 771 \\{factor-mode-map}"
 772   (factor-setup-buffer-font-lock)
 773   (define-key factor-mode-map [remap ff-get-other-file]
 774     'factor-visit-other-file)
 775
 776   (setq-local electric-indent-chars
 777               (append '(?\] ?\} ?\n) electric-indent-chars))
 778
 779   ;; No tabs for you!!
 780   (setq-local indent-tabs-mode nil)
 781
 782   (add-hook 'smie-indent-functions #'factor-smie-indent nil t)
 783   (smie-setup factor-smie-grammar #'factor-smie-rules
 784               :forward-token #'factor-smie-forward-token
 785               :backward-token #'factor-smie-backward-token)
 786   (setq-local smie-indent-basic factor-block-offset)
 787   (setq-local imenu-generic-expression factor-imenu-generic-expression)
 788
 789   (setq-local beginning-of-defun-function 'factor-beginning-of-defun)
 790   (setq-local end-of-defun-function 'factor-end-of-defun)
 791   ;; Load fuel-mode too if factor-mode-use-fuel is t.
 792   (when factor-mode-use-fuel (require 'fuel-mode) (fuel-mode)))
 793
 794 ;;;###autoload
 795 (add-to-list 'auto-mode-alist '("\\.factor\\'" . factor-mode))
 796
 797 ;;;###autoload
 798 (add-to-list 'interpreter-mode-alist '("factor" . factor-mode))
 799
 800 \f
 801 (provide 'factor-mode)
 802
 803 ;;; factor-mode.el ends here