config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

ledger-fonts.el (24920B)


      1 ;;; ledger-fonts.el --- Helper code for use with the "ledger" command-line tool  -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2003-2016 John Wiegley (johnw AT gnu DOT org)
      4 
      5 ;; This file is not part of GNU Emacs.
      6 
      7 ;; This is free software; you can redistribute it and/or modify it under
      8 ;; the terms of the GNU General Public License as published by the Free
      9 ;; Software Foundation; either version 2, or (at your option) any later
     10 ;; version.
     11 ;;
     12 ;; This is distributed in the hope that it will be useful, but WITHOUT
     13 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
     14 ;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
     15 ;; for more details.
     16 ;;
     17 ;; You should have received a copy of the GNU General Public License
     18 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
     19 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
     20 ;; MA 02110-1301 USA.
     21 
     22 
     23 
     24 ;;; Commentary:
     25 ;; All of the faces for ledger mode are defined here.
     26 
     27 ;;; Code:
     28 
     29 (require 'ledger-navigate)
     30 (require 'ledger-regex)
     31 (require 'ledger-state)
     32 (require 'ledger-fontify)
     33 
     34 (defgroup ledger-faces nil "Ledger mode highlighting" :group 'ledger)
     35 
     36 (defface ledger-font-auto-xact-face
     37   `((t :inherit font-lock-negation-char-face))
     38   "Default face for automatic transactions"
     39   :group 'ledger-faces)
     40 
     41 (defface ledger-font-periodic-xact-face
     42   `((t :inherit font-lock-constant-face))
     43   "Default face for automatic transactions"
     44   :group 'ledger-faces)
     45 
     46 (defface ledger-font-xact-cleared-face
     47   `((t :inherit ledger-font-payee-cleared-face))
     48   "Default face for cleared transaction"
     49   :group 'ledger-faces)
     50 
     51 (defface ledger-font-xact-pending-face
     52   `((t :inherit ledger-font-pending-face))
     53   "Default face for pending transaction"
     54   :group 'ledger-faces)
     55 
     56 (defface ledger-font-payee-uncleared-face
     57   `((t :inherit error))
     58   "Default face for Ledger"
     59   :group 'ledger-faces)
     60 
     61 (defface ledger-font-payee-cleared-face
     62   `((t :inherit shadow))
     63   "Default face for cleared (*) payees"
     64   :group 'ledger-faces)
     65 
     66 (defface ledger-font-payee-pending-face
     67   `((t :inherit ledger-font-pending-face))
     68   "Default face for pending (!) payees"
     69   :group 'ledger-faces)
     70 
     71 (defface ledger-font-xact-highlight-face
     72   `((t
     73      ,@(and (>= emacs-major-version 27) '(:extend t))
     74      :inherit ledger-occur-xact-face))
     75   "Default face for transaction under point"
     76   :group 'ledger-faces)
     77 
     78 (defface ledger-font-pending-face
     79   `((t :inherit warning))
     80   "Default face for pending (!) transactions"
     81   :group 'ledger-faces)
     82 
     83 (defface ledger-font-other-face
     84   `((t :inherit font-lock-type-face))
     85   "Default face for other transactions"
     86   :group 'ledger-faces)
     87 
     88 (defface ledger-font-directive-face
     89   `((t :inherit font-lock-preprocessor-face))
     90   "Default face for other transactions"
     91   :group 'ledger-faces)
     92 
     93 (defface ledger-font-account-directive-face
     94   `((t :inherit ledger-font-directive-face))
     95   "Default face for other transactions"
     96   :group 'ledger-faces)
     97 
     98 (defface ledger-font-account-name-face
     99   `((t :inherit font-lock-variable-name-face))
    100   "Face for account names in account and alias directives"
    101   :group 'ledger-faces)
    102 
    103 (defface ledger-font-note-directive-face
    104   `((t :inherit ledger-font-directive-face))
    105   "Face for note subdirectives"
    106   :group 'ledger-faces)
    107 
    108 (defface ledger-font-note-text-face
    109   `((t :inherit font-lock-doc-face))
    110   "Face for note subdirective text"
    111   :group 'ledger-faces)
    112 
    113 (defface ledger-font-default-directive-face
    114   `((t :inherit ledger-font-directive-face))
    115   "Face for default subdirectives"
    116   :group 'ledger-faces)
    117 
    118 (defface ledger-font-price-directive-face
    119   `((t :inherit ledger-font-directive-face))
    120   "Default face for other transactions"
    121   :group 'ledger-faces)
    122 
    123 (defface ledger-font-price-date-face
    124   `((t :inherit default))
    125   "Face for date and time in price directive"
    126   :group 'ledger-faces)
    127 
    128 (defface ledger-font-price-symbol-face
    129   `((t :inherit font-lock-constant-face))
    130   "Face for symbol in price directive"
    131   :group 'ledger-faces)
    132 
    133 (defface ledger-font-price-face
    134   `((t :inherit default))
    135   "Face for price in price directive"
    136   :group 'ledger-faces)
    137 
    138 (defface ledger-font-apply-directive-face
    139   `((t :inherit ledger-font-directive-face))
    140   "Default face for other transactions"
    141   :group 'ledger-faces)
    142 
    143 (defface ledger-font-apply-account-face
    144   `((t :inherit default))
    145   "Face for argument of apply account directive"
    146   :group 'ledger-faces)
    147 
    148 (defface ledger-font-apply-tag-face
    149   `((t :inherit default))
    150   "Face for argument of apply tag directive"
    151   :group 'ledger-faces)
    152 
    153 (defface ledger-font-alias-directive-face
    154   `((t :inherit ledger-font-directive-face))
    155   "Default face for other transactions"
    156   :group 'ledger-faces)
    157 
    158 (defface ledger-font-alias-definition-face
    159   `((t :inherit default))
    160   "Face for aliased account in alias directives"
    161   :group 'ledger-faces)
    162 
    163 (defface ledger-font-assert-directive-face
    164   `((t :inherit ledger-font-directive-face))
    165   "Default face for other transactions"
    166   :group 'ledger-faces)
    167 
    168 (defface ledger-font-condition-face
    169   `((t :inherit default))
    170   "Default face for check and assert conditions"
    171   :group 'ledger-faces)
    172 
    173 (defface ledger-font-assert-condition-face
    174   `((t :inherit ledger-font-condition-face))
    175   "Face for assert conditions"
    176   :group 'ledger-faces)
    177 
    178 (defface ledger-font-bucket-directive-face
    179   `((t :inherit ledger-font-directive-face))
    180   "Default face for other transactions"
    181   :group 'ledger-faces)
    182 
    183 (defface ledger-font-bucket-account-face
    184   `((t :inherit default))
    185   "Face for bucket directive argument"
    186   :group 'ledger-faces)
    187 
    188 (defface ledger-font-C-directive-face
    189   `((t :inherit ledger-font-directive-face))
    190   "Default face for C directive"
    191   :group 'ledger-faces)
    192 
    193 (defface ledger-font-C-amount-face
    194   `((t :inherit default))
    195   "Face for amounts in C directives"
    196   :group 'ledger-faces)
    197 
    198 (defface ledger-font-capture-directive-face
    199   `((t :inherit ledger-font-directive-face))
    200   "Default face for other transactions"
    201   :group 'ledger-faces)
    202 
    203 (defface ledger-font-capture-account-face
    204   `((t :inherit default))
    205   "Face for account name in capture directives"
    206   :group 'ledger-faces)
    207 
    208 (defface ledger-font-capture-regex-face
    209   `((t :inherit default))
    210   "Face for match regex in capture directives"
    211   :group 'ledger-faces)
    212 
    213 (defface ledger-font-check-directive-face
    214   `((t :inherit ledger-font-directive-face))
    215   "Default face for other transactions"
    216   :group 'ledger-faces)
    217 
    218 (defface ledger-font-check-condition-face
    219   `((t :inherit ledger-font-condition-face))
    220   "Face for check conditions"
    221   :group 'ledger-faces)
    222 
    223 (defface ledger-font-commodity-directive-face
    224   `((t :inherit ledger-font-directive-face))
    225   "Default face for other transactions"
    226   :group 'ledger-faces)
    227 
    228 (defface ledger-font-commodity-name-face
    229   `((t :inherit font-lock-constant-face))
    230   "Face for commodity name in commodity directives"
    231   :group 'ledger-faces)
    232 
    233 (defface ledger-font-format-directive-face
    234   `((t :inherit ledger-font-directive-face))
    235   "Face for format subdirective"
    236   :group 'ledger-faces)
    237 
    238 (defface ledger-font-commodity-format-face
    239   `((t :inherit default))
    240   "Face for format subdirective argument"
    241   :group 'ledger-faces)
    242 
    243 (defface ledger-font-D-directive-face
    244   `((t :inherit ledger-font-directive-face))
    245   "Default face for D directive"
    246   :group 'ledger-faces)
    247 
    248 (defface ledger-font-define-directive-face
    249   `((t :inherit ledger-font-directive-face))
    250   "Default face for other transactions"
    251   :group 'ledger-faces)
    252 
    253 (defface ledger-font-define-name-face
    254   `((t :inherit font-lock-variable-name-face))
    255   "Face for variable name in define directive"
    256   :group 'ledger-faces)
    257 
    258 (defface ledger-font-define-body-face
    259   `((t :inherit default))
    260   "Face for body in define directive"
    261   :group 'ledger-faces)
    262 
    263 (defface ledger-font-end-directive-face
    264   `((t :inherit ledger-font-directive-face))
    265   "Default face for other transactions"
    266   :group 'ledger-faces)
    267 
    268 (defface ledger-font-expr-directive-face
    269   `((t :inherit ledger-font-directive-face))
    270   "Default face for other transactions"
    271   :group 'ledger-faces)
    272 
    273 (defface ledger-font-expr-expression-face
    274   `((t :inherit default))
    275   "Face for expr and eval expressions"
    276   :group 'ledger-faces)
    277 
    278 (defface ledger-font-fixed-directive-face
    279   `((t :inherit ledger-font-directive-face))
    280   "Default face for other transactions"
    281   :group 'ledger-faces)
    282 
    283 (defface ledger-font-fixed-commodity-face
    284   `((t :inherit font-lock-constant-face))
    285   "Face for commodity name in fixed directive"
    286   :group 'ledger-faces)
    287 
    288 (defface ledger-font-fixed-price-face
    289   `((t :inherit default))
    290   "Face for price in fixed directive"
    291   :group 'ledger-faces)
    292 
    293 (defface ledger-font-include-directive-face
    294   `((t :inherit ledger-font-directive-face))
    295   "Default face for other transactions"
    296   :group 'ledger-faces)
    297 
    298 (defface ledger-font-include-filename-face
    299   `((t :inherit font-lock-string-face))
    300   "Face for file name in include directives"
    301   :group 'ledger-faces)
    302 
    303 (defface ledger-font-N-directive-face
    304   `((t :inherit ledger-font-directive-face))
    305   "Default face for N directive"
    306   :group 'ledger-faces)
    307 
    308 (defface ledger-font-N-symbol-face
    309   `((t :inherit default))
    310   "Face for symbol in N directives")
    311 
    312 (defface ledger-font-payee-directive-face
    313   `((t :inherit ledger-font-directive-face))
    314   "Default face for other transactions"
    315   :group 'ledger-faces)
    316 
    317 (defface ledger-font-payee-name-face
    318   `((t :inherit font-lock-function-name-face))
    319   "Face for payee name in payee directive"
    320   :group 'ledger-faces)
    321 
    322 (defface ledger-font-payee-regex-face
    323   `((t :inherit font-lock-string-face))
    324   "Face for payee subdirective regex in account directive"
    325   :group 'ledger-faces)
    326 
    327 (defface ledger-font-uuid-directive-face
    328   `((t :inherit ledger-font-directive-face))
    329   "Face for uuid subdirectives"
    330   :group 'ledger-faces)
    331 
    332 (defface ledger-font-uuid-face
    333   `((t :inherit default))
    334   "Face for uuid in uuid subdirectives"
    335   :group 'ledger-faces)
    336 
    337 (defface ledger-font-tag-directive-face
    338   `((t :inherit ledger-font-directive-face))
    339   "Default face for other transactions"
    340   :group 'ledger-faces)
    341 
    342 (defface ledger-font-tag-name-face
    343   `((t :inherit font-lock-type-face))
    344   "Face for tag name in tag directive"
    345   :group 'ledger-faces)
    346 
    347 (defface ledger-font-timeclock-directive-face
    348   `((t :inherit ledger-font-directive-face))
    349   "Default face for timeclock I,i,O,o,b,h directives"
    350   :group 'ledger-faces)
    351 
    352 (defface ledger-font-year-directive-face
    353   `((t :inherit ledger-font-directive-face))
    354   "Default face for other transactions"
    355   :group 'ledger-faces)
    356 
    357 (defface ledger-font-year-face
    358   `((t :inherit default))
    359   "Font for year in year directives"
    360   :group 'ledger-faces)
    361 
    362 (defface ledger-font-posting-account-face
    363   `((t :inherit ledger-font-default-directive-face))
    364   "Face for Ledger accounts"
    365   :group 'ledger-faces)
    366 
    367 (defface ledger-font-posting-account-cleared-face
    368   `((t :inherit ledger-font-payee-cleared-face))
    369   "Face for Ledger accounts"
    370   :group 'ledger-faces)
    371 
    372 (defface ledger-font-posting-amount-cleared-face
    373   `((t :inherit ledger-font-posting-account-cleared-face))
    374   "Face for Ledger accounts"
    375   :group 'ledger-faces)
    376 
    377 (defface ledger-font-posting-account-pending-face
    378   `((t :inherit ledger-font-pending-face))
    379   "Face for Ledger accounts"
    380   :group 'ledger-faces)
    381 
    382 (defface ledger-font-posting-amount-pending-face
    383   `((t :inherit ledger-font-posting-account-pending-face))
    384   "Face for Ledger accounts"
    385   :group 'ledger-faces)
    386 
    387 (defface ledger-font-posting-amount-face
    388   `((t :inherit font-lock-constant-face ))
    389   "Face for Ledger amounts"
    390   :group 'ledger-faces)
    391 
    392 (defface ledger-font-posting-date-face
    393   `((t :inherit font-lock-keyword-face))
    394   "Face for Ledger dates"
    395   :group 'ledger-faces)
    396 
    397 (defface ledger-occur-xact-face
    398   `((t :inherit highlight))
    399   "Default face for Ledger occur mode shown transactions"
    400   :group 'ledger-faces)
    401 
    402 (defface ledger-font-comment-face
    403   `((t :inherit font-lock-comment-face))
    404   "Face for Ledger comments"
    405   :group 'ledger-faces)
    406 
    407 (defface ledger-font-reconciler-uncleared-face
    408   `((t :inherit ledger-font-payee-uncleared-face))
    409   "Default face for uncleared transactions in the reconcile window"
    410   :group 'ledger-faces)
    411 
    412 (defface ledger-font-reconciler-cleared-face
    413   `((t :inherit ledger-font-payee-cleared-face))
    414   "Default face for cleared (*) transactions in the reconcile window"
    415   :group 'ledger-faces)
    416 
    417 (defface ledger-font-reconciler-pending-face
    418   `((t :inherit ledger-font-pending-face))
    419   "Default face for pending (!) transactions in the reconcile window"
    420   :group 'ledger-faces)
    421 
    422 (defface ledger-font-report-clickable-face
    423   `((t))
    424   "Face applied to clickable entries in the report window"
    425   :group 'ledger-faces)
    426 
    427 (defface ledger-font-code-face
    428   `((t :inherit default))
    429   "Face for Ledger codes"
    430   :group 'ledger-faces)
    431 
    432 (defun ledger-font-face-by-state (num faces)
    433   "Choose one of three faces depending on transaction state.
    434 NUM specifies a match group containing the state.
    435 FACES has the form (CLEARED PENDING OTHER).
    436 Return CLEARED if that group specifies a cleared transaction,
    437 PENDING if pending, and OTHER if none of the above."
    438   (let ((state (save-match-data (ledger-state-from-string (match-string num)))))
    439     (cond ((eq state 'cleared) (nth 0 faces))
    440           ((eq state 'pending) (nth 1 faces))
    441           (t (nth 2 faces)))))
    442 
    443 (defun ledger-font-face-by-timeclock-state (num faces)
    444   "Choose one of two faces depending on a timeclock directive character.
    445 NUM specifies a match group containing the character.
    446 FACES has the form (CLEARED UNCLEARED).
    447 Return CLEARED if the character specifies a cleared transaction,
    448 UNCLEARED otherwise."
    449   (if (member (match-string num) '("I" "O"))
    450       (nth 0 faces)
    451     (nth 1 faces)))
    452 
    453 (defun ledger-font-subdirectives (subdirectives)
    454   "Construct anchored highlighters for subdirectives.
    455 
    456 Each element of SUBDIRECTIVES should have the form (MATCHER
    457 SUBEXP-HIGHLIGHTERS…).  The result will be a list of elements of
    458 the form (MATCHER PRE-FORM POST-FORM SUBEXP-HIGHLIGHTERS) with
    459 PRE-FORM and POST-FORM set to appropriate values.
    460 
    461 See `font-lock-keywords' for the full description."
    462 
    463   (mapcar (lambda (item)
    464             `(,(car item)
    465               (save-excursion
    466                 (save-match-data
    467                   (ledger-navigate-end-of-xact))
    468                 (point))
    469               (goto-char (match-end 0))
    470               ,@(cdr item)))
    471           subdirectives))
    472 
    473 (defvar ledger-font-lock-keywords
    474   `(("^[;#%|*].*$" . 'ledger-font-comment-face)
    475     ("^\\(account\\)\\(?:[[:blank:]]\\(.*\\)\\)?$"
    476      (1 'ledger-font-account-directive-face)
    477      (2 'ledger-font-account-name-face nil :lax)
    478      ,@(ledger-font-subdirectives
    479         '(("^[ \t]+\\(;.*\\)" (1 'ledger-font-comment-face))
    480           ("^[ \t]+\\(note\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    481            (1 'ledger-font-note-directive-face)
    482            (2 'ledger-font-note-text-face nil :lax))
    483           ("^[ \t]+\\(alias\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    484            (1 'ledger-font-alias-directive-face)
    485            (2 'ledger-font-account-name-face nil :lax))
    486           ("^[ \t]+\\(payee\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    487            (1 'ledger-font-payee-directive-face)
    488            (2 'ledger-font-payee-regex-face nil :lax))
    489           ("^[ \t]+\\(check\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    490            (1 'ledger-font-check-directive-face)
    491            (2 'ledger-font-check-condition-face nil :lax))
    492           ("^[ \t]+\\(assert\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    493            (1 'ledger-font-assert-directive-face)
    494            (2 'ledger-font-assert-condition-face nil :lax))
    495           ("^[ \t]+\\(eval\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    496            (1 'ledger-font-expr-directive-face)
    497            (2 'ledger-font-expr-expression-face nil :lax))
    498           ("^[ \t]+\\(default\\)\\>.*"
    499            (1 'ledger-font-default-directive-face)))))
    500     ("^\\(alias\\)\\(?:[[:blank:]]+\\([^=\n]*\\)\\(?:=\\(.*\\)\\)?\\)?$"
    501      (1 'ledger-font-alias-directive-face)
    502      (2 'ledger-font-account-name-face nil :lax)
    503      (3 'ledger-font-alias-definition-face nil :lax))
    504     (,(concat "^\\(apply\\)\\(?:[[:blank:]]+"
    505               "\\(?:\\(account\\)\\(?:[[:blank:]]+\\(.*\\)\\)?"
    506               "\\|\\(tag\\)\\(?:[[:blank:]]+\\(.*\\)\\)?\\)\\)?$")
    507      (1 'ledger-font-apply-directive-face)
    508      (2 'ledger-font-apply-directive-face nil :lax)
    509      (3 'ledger-font-apply-account-face nil :lax)
    510      (4 'ledger-font-apply-directive-face nil :lax)
    511      (5 'ledger-font-apply-tag-face nil :lax))
    512     ("^\\(assert\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    513      (1 'ledger-font-assert-directive-face)
    514      (2 'ledger-font-assert-condition-face nil :lax))
    515     ("^\\(bucket\\|A\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    516      (1 'ledger-font-bucket-directive-face)
    517      (2 'ledger-font-bucket-account-face nil :lax))
    518     (,(concat "^\\(C\\)"
    519               "\\(?:[[:blank:]]+\\([^=\n]*?\\)[[:blank:]]*"
    520               "\\(?:=[[:blank:]]*\\(.*\\)\\)?\\)?$")
    521      (1 'ledger-font-C-directive-face)
    522      (2 'ledger-font-C-amount-face nil :lax)
    523      (3 'ledger-font-C-amount-face nil :lax))
    524     (,(concat "^\\(capture\\)"
    525               "\\(?:[[:blank:]]+\\(.*?\\)"
    526               "\\(?:\\(?:\t\\|[ \t]\\{2,\\}\\)\\(.*\\)\\)?\\)?$")
    527      (1 'ledger-font-capture-directive-face)
    528      (2 'ledger-font-capture-account-face nil :lax)
    529      (3 'ledger-font-capture-regex-face nil :lax))
    530     ("^\\(check\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    531      (1 'ledger-font-check-directive-face)
    532      (2 'ledger-font-check-condition-face nil :lax))
    533     (,(concat "^\\(?:comment\\|test\\)\\>"
    534               "[^\0]*?\n"
    535               "end[[:blank:]]+\\(?:comment\\|test\\)\\>.*\n")
    536      . 'ledger-font-comment-face)
    537     ("^\\(commodity\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    538      (1 'ledger-font-commodity-directive-face)
    539      (2 'ledger-font-commodity-name-face nil :lax)
    540      ,@(ledger-font-subdirectives
    541         '(("^[ \t]+\\(;.*\\)" (1 'ledger-font-comment-face))
    542           ("^[ \t]+\\(note\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    543            (1 'ledger-font-note-directive-face)
    544            (2 'ledger-font-note-text-face nil :lax))
    545           ("^[ \t]+\\(format\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    546            (1 'ledger-font-format-directive-face)
    547            (2 'ledger-font-commodity-format-face nil :lax))
    548           ("^[ \t]+\\(nomarket\\)\\>.*"
    549            (1 'ledger-font-N-directive-face))
    550           ("^[ \t]+\\(default\\)\\>.*"
    551            (1 'ledger-font-default-directive-face)))))
    552     ("^\\(D\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    553      (1 'ledger-font-D-directive-face)
    554      (2 'ledger-font-commodity-format-face nil :lax))
    555     (,(concat "^\\(define\\|def\\)"
    556               "\\(?:[[:blank:]]+\\([^=\n]*?\\)[[:blank:]]*"
    557               "\\(?:=[[:blank:]]*\\(.*\\)\\)?\\)?$")
    558      (1 'ledger-font-define-directive-face)
    559      (2 'ledger-font-define-name-face nil :lax)
    560      (3 'ledger-font-define-body-face nil :lax))
    561     (,(concat "^\\(end\\)"
    562               "\\(?:[[:blank:]]+\\(apply\\)"
    563               "\\(?:[[:blank:]]+\\(account\\|tag\\)\\>.*\\)?\\)?$")
    564      (1 'ledger-font-end-directive-face)
    565      (2 'ledger-font-end-directive-face nil :lax)
    566      (3 'ledger-font-end-directive-face nil :lax))
    567     ("^\\(endfixed\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    568      (1 'ledger-font-end-directive-face)
    569      (2 'ledger-font-fixed-commodity-face nil :lax))
    570     ("^\\(expr\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    571      (1 'ledger-font-expr-directive-face)
    572      (2 'ledger-font-expr-expression-face nil :lax))
    573     ("^\\(fixed\\)\\(?:[[:blank:]]+\\([^[:blank:]\n]+\\)\\(?:[[:blank:]]+\\(.*\\)\\)?\\)?$"
    574      (1 'ledger-font-fixed-directive-face)
    575      (2 'ledger-font-fixed-commodity-face nil :lax)
    576      (3 'ledger-font-fixed-price-face nil :lax))
    577     ("^\\(include\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    578      (1 'ledger-font-include-directive-face)
    579      (2 'ledger-font-include-filename-face nil :lax))
    580     ("^\\(N\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    581      (1 'ledger-font-N-directive-face)
    582      (2 'ledger-font-N-symbol-face nil :lax))
    583     ("^\\(payee\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    584      (1 'ledger-font-payee-directive-face)
    585      (2 'ledger-font-payee-name-face nil :lax)
    586      ,@(ledger-font-subdirectives
    587         '(("^[ \t]+\\(;.*\\)" (1 'ledger-font-comment-face))
    588           ("^[ \t]+\\(alias\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    589            (1 'ledger-font-alias-directive-face)
    590            (2 'ledger-font-payee-regex-face nil :lax))
    591           ("^[ \t]+\\(uuid\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    592            (1 'ledger-font-uuid-directive-face)
    593            (2 'ledger-font-uuid-face nil :lax)))))
    594     (,(concat "^\\(P\\)"
    595               "\\(?:[[:blank:]]+\\([^[:blank:]\n]+"
    596               "\\(?:[[:blank:]]+[[:digit:]][^[:blank:]\n]*\\)?\\)"
    597               "\\(?:[[:blank:]]+\\(\".*?\"\\|[^[:blank:]\n]+\\)"
    598               "\\(?:[[:blank:]]+\\(.*\\)\\)?\\)?\\)?$")
    599      (1 'ledger-font-price-directive-face)
    600      (2 'ledger-font-price-date-face nil :lax)
    601      (3 'ledger-font-price-symbol-face nil :lax)
    602      (4 'ledger-font-price-face nil :lax))
    603     ("^\\(tag\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    604      (1 'ledger-font-tag-directive-face)
    605      (2 'ledger-font-tag-name-face nil :lax)
    606      ,@(ledger-font-subdirectives
    607         '(("^[ \t]+\\(;.*\\)" (1 'ledger-font-comment-face))
    608           ("^[ \t]+\\(check\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    609            (1 'ledger-font-check-directive-face)
    610            (2 'ledger-font-check-condition-face nil :lax))
    611           ("^[ \t]+\\(assert\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    612            (1 'ledger-font-assert-directive-face)
    613            (2 'ledger-font-assert-condition-face nil :lax)))))
    614     (,(concat "^\\([IiOo]\\)"
    615               "\\(?:[[:blank:]]+\\([^[:blank:]\n]+"
    616               "\\(?:[[:blank:]]+[^[:blank:]\n]+\\)?\\)"
    617               "\\(?:[[:blank:]]+\\(.*?\\)"
    618               "\\(?:\\(?:\t\\|[ \t]\\{2,\\}\\)\\(.*?\\)"
    619               "\\(?:\\(?:\t\\|[ \t]\\{2,\\}\\)\\(;.*\\)\\)?\\)?\\)?\\)?$")
    620      (1 'ledger-font-timeclock-directive-face)
    621      (2 'ledger-font-posting-date-face nil :lax)
    622      (3 (ledger-font-face-by-timeclock-state 1 '(ledger-font-posting-account-cleared-face
    623                                                  ledger-font-posting-account-face)) nil :lax)
    624      (4 (ledger-font-face-by-timeclock-state 1 '(ledger-font-payee-cleared-face
    625                                                  ledger-font-payee-uncleared-face)) nil :lax)
    626      (5 'ledger-font-comment-face nil :lax))
    627     ("^\\([bh]\\)\\>.*$" (1 'ledger-font-timeclock-directive-face))
    628     ("^\\(year\\|Y\\)\\(?:[[:blank:]]+\\(.*\\)\\)?$"
    629      (1 'ledger-font-year-directive-face)
    630      (2 'ledger-font-year-face nil :lax))
    631 
    632     (,(lambda (limit)
    633         (when ledger-fontify-xact-state-overrides
    634           (re-search-forward
    635            (concat "^\\(?:\\([=~]\\)[ \t].*\\|" ; auto/periodic, subexpr 1
    636                    "[[:digit:]][^ \t\n]*"       ; date
    637                    "[ \t]+\\([*!]\\)"           ; mark, subexp 2
    638                    ".*\\)"                      ; rest of header
    639                    "\\(?:\n[ \t]+.*\\)*"        ; postings
    640                    )
    641            limit t)))
    642      (0 (cond ((equal "=" (match-string 1)) 'ledger-font-auto-xact-face)
    643               ((equal "~" (match-string 1)) 'ledger-font-periodic-xact-face)
    644               (t (ledger-font-face-by-state 2 '(ledger-font-xact-cleared-face
    645                                                 ledger-font-xact-pending-face))))))
    646     (,(concat "^\\(?:\\(\\([=~]\\).*\\)\\|"       ; auto/periodic, subexp 1, 2
    647               "\\([[:digit:]][^ \t\n]*\\)"        ; date, subexp 3
    648               ledger-xact-after-date-regex "\\)") ; mark 4, code 5, desc 6, comment 7
    649      (1 (cond ((equal "=" (match-string 2)) 'ledger-font-auto-xact-face)
    650               ((equal "~" (match-string 2)) 'ledger-font-periodic-xact-face)
    651               (t 'ledger-font-default-directive-face))
    652         nil :lax)
    653      (3 'ledger-font-posting-date-face nil :lax)
    654      (5 'ledger-font-code-face nil :lax)
    655      (6 (ledger-font-face-by-state 4 '(ledger-font-payee-cleared-face
    656                                        ledger-font-payee-pending-face
    657                                        ledger-font-payee-uncleared-face))
    658         nil :lax)
    659      (7 'ledger-font-comment-face nil :lax)
    660      ,@(ledger-font-subdirectives
    661         `(("^[ \t]+\\(;.*\\)"
    662            (1 'ledger-font-comment-face))
    663           (,ledger-posting-regex ; state and account 1, state 2, account 3, amount 4, comment 5
    664            (1 (ledger-font-face-by-state 2 '(ledger-font-posting-account-cleared-face
    665                                              ledger-font-posting-account-pending-face
    666                                              ledger-font-posting-account-face))
    667               nil :lax)
    668            (4 (ledger-font-face-by-state 2 '(ledger-font-posting-amount-cleared-face
    669                                              ledger-font-posting-amount-pending-face
    670                                              ledger-font-posting-amount-face))
    671               nil :lax)
    672            (5 'ledger-font-comment-face nil :lax))))))
    673   "Expressions to highlight in Ledger mode.")
    674 
    675 
    676 
    677 (provide 'ledger-fonts)
    678 
    679 ;;; ledger-fonts.el ends here