ledger-texi.el (6864B)
1 ;;; ledger-texi.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 ;;; Commentary: 23 ;; 24 25 ;;; Code: 26 (defvar ledger-binary-path) 27 28 (defgroup ledger-texi nil 29 "Options for working on Ledger texi documentation" 30 :group 'ledger) 31 32 (defcustom ledger-texi-sample-doc-path "~/ledger/doc/sample.dat" 33 "Location for sample data to be used in texi tests." 34 :type 'file 35 :group 'ledger-texi) 36 37 (defcustom ledger-texi-normalization-args "--args-only --columns 80" 38 "Texi normalization for producing ledger output." 39 :type 'string 40 :group 'ledger-texi) 41 42 (defun ledger-update-test () 43 (interactive) 44 (goto-char (point-min)) 45 (let ((command (buffer-substring (point-min) (line-end-position)))) 46 (re-search-forward "^<<<\n") 47 (let ((beg (point)) end) 48 (re-search-forward "^>>>") 49 (setq end (match-beginning 0)) 50 (forward-line 1) 51 (let ((output-beg (point))) 52 (re-search-forward "^>>>") 53 (goto-char (match-beginning 0)) 54 (delete-region output-beg (point)) 55 (apply #'call-process-region 56 beg end (expand-file-name "~/Products/ledger/debug/ledger") 57 nil t nil 58 "-f" "-" "--args-only" "--columns=80" "--no-color" 59 (split-string command " ")))))) 60 61 (defun ledger-texi-write-test (name command input output &optional category) 62 (let ((buf (current-buffer))) 63 (with-current-buffer (find-file-noselect 64 (expand-file-name (concat name ".test") category)) 65 (erase-buffer) 66 (let ((case-fold-search nil)) 67 (if (string-match "\\$LEDGER\\s-+" command) 68 (setq command (replace-match "" t t command))) 69 (if (string-match " -f \\$\\([-a-z]+\\)" command) 70 (setq command (replace-match "" t t command)))) 71 (insert command ?\n) 72 (insert "<<<" ?\n) 73 (insert input) 74 (insert ">>>1" ?\n) 75 (insert output) 76 (insert ">>>2" ?\n) 77 (insert "=== 0" ?\n) 78 (save-buffer) 79 (unless (eq buf (current-buffer)) 80 (kill-buffer (current-buffer)))))) 81 82 (defun ledger-texi-update-test () 83 (interactive) 84 (let ((details (ledger-texi-test-details)) 85 (name (file-name-sans-extension 86 (file-name-nondirectory (buffer-file-name))))) 87 (ledger-texi-write-test 88 name (nth 0 details) 89 (nth 1 details) 90 (ledger-texi-invoke-command 91 (ledger-texi-expand-command 92 (nth 0 details) 93 (ledger-texi-write-test-data name (nth 1 details))))))) 94 95 (defun ledger-texi-test-details () 96 (goto-char (point-min)) 97 (let ((command (buffer-substring (point) (line-end-position))) 98 input output) 99 (re-search-forward "^<<<") 100 (let ((input-beg (1+ (match-end 0)))) 101 (re-search-forward "^>>>1") 102 (let ((output-beg (1+ (match-end 0)))) 103 (setq input (buffer-substring input-beg (match-beginning 0))) 104 (re-search-forward "^>>>2") 105 (setq output (buffer-substring output-beg (match-beginning 0))) 106 (list command input output))))) 107 108 (defun ledger-texi-expand-command (command data-file) 109 (if (string-match "\\$LEDGER" command) 110 (replace-match (format "%s -f \"%s\" %s" ledger-binary-path 111 data-file ledger-texi-normalization-args) t t command) 112 (concat (format "%s -f \"%s\" %s " ledger-binary-path 113 data-file ledger-texi-normalization-args) command))) 114 115 (defun ledger-texi-invoke-command (command) 116 (with-temp-buffer (shell-command command t (current-buffer)) 117 (if (= (point-min) (point-max)) 118 (progn 119 (push-mark nil t) 120 (message "Command '%s' yielded no result at %d" command (point)) 121 (ding)) 122 (buffer-string)))) 123 124 (defun ledger-texi-write-test-data (name input) 125 (let ((path (expand-file-name name temporary-file-directory))) 126 (with-current-buffer (find-file-noselect path) 127 (erase-buffer) 128 (insert input) 129 (save-buffer)) 130 path)) 131 132 (defun ledger-texi-update-examples () 133 (interactive) 134 (save-excursion 135 (goto-char (point-min)) 136 (while (re-search-forward "^@c \\(\\(?:sm\\)?ex\\) \\(\\S-+\\): \\(.*\\)" nil t) 137 (let ((section (match-string 1)) 138 (example-name (match-string 2)) 139 (command (match-string 3)) 140 (data-file ledger-texi-sample-doc-path)) 141 (goto-char (match-end 0)) 142 (forward-line) 143 (when (looking-at "@\\(\\(?:small\\)?example\\)") 144 (let ((beg (point))) 145 (re-search-forward "^@end \\(\\(?:small\\)?example\\)") 146 (delete-region beg (1+ (point))))) 147 148 (when (let ((case-fold-search nil)) 149 (string-match " -f \\$\\([-a-z]+\\)" command)) 150 (let ((label (match-string 1 command))) 151 (setq command (replace-match "" t t command)) 152 (save-excursion 153 (goto-char (point-min)) 154 (search-forward (format "@c data: %s" label)) 155 (re-search-forward "@\\(\\(?:small\\)?example\\)") 156 (forward-line) 157 (let ((beg (point))) 158 (re-search-forward "@end \\(\\(?:small\\)?example\\)") 159 (setq data-file (ledger-texi-write-test-data 160 (format "%s.dat" label) 161 (buffer-substring-no-properties 162 beg (match-beginning 0)))))))) 163 164 (let ((section-name (if (string= section "smex") 165 "smallexample" 166 "example")) 167 (output (ledger-texi-invoke-command 168 (ledger-texi-expand-command command data-file)))) 169 (insert "@" section-name ?\n output 170 "@end " section-name ?\n)) 171 172 ;; Update the regression test associated with this example 173 (ledger-texi-write-test example-name command nil nil 174 "../test/manual"))))) 175 176 (provide 'ledger-texi) 177 178 ;;; ledger-texi.el ends here