From b3484b533476aa6d6263775b7a79670bc9eec70e Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Wed, 21 Dec 2016 02:21:54 +0530 Subject: Initial commit --- ksh-forms-improved.el | 95 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 95 insertions(+) create mode 100644 ksh-forms-improved.el (limited to 'ksh-forms-improved.el') diff --git a/ksh-forms-improved.el b/ksh-forms-improved.el new file mode 100644 index 0000000..a8a2e12 --- /dev/null +++ b/ksh-forms-improved.el @@ -0,0 +1,95 @@ +;; -*- lexical-binding: t -*- + +(require 'org) +(require 'subr-x) +(require 'cl-lib) + +;; General settings +(setq doc-view-continuous t) +(setq lpr-switches (list "-o sides=two-sided-long-edge" + "-o fit-to-page")) +(setq export-properties + (list :section-numbers nil + :with-toc nil)) + +;; Printing +(defun print-report () + (interactive) + (shell-command + (format "lpr -o sides=two-sided-long-edge -o fit-to-page %s" (buffer-file-name)))) +(defalias 'print-buffer 'print-report) + +;; Utilities +(defmacro setfun (function-name function) + "Set functions like using define in scheme" + `(defun ,function-name (&rest args) + (apply ,function args))) + +(defun mapped (mapper function) + "Apply the mapping function MAPPER on function FUNCTION" + (lambda (arglist) + (funcall mapper function arglist))) + +(defun set-values (record values) + "Set record RECORD to values in alist VALUES" + (mapc (lambda (field-value) + (aset record (car field-value) (cdr field-value))) values)) + +;; Entry creation functions for form display +(defun form-entry (label-field) + (list (format "%s\n" (car label-field)) + (cdr label-field) "\n\n")) + +(setfun form-entries (mapped 'cl-mapcan 'form-entry)) + +(defun new-record-filter (record) + (set-values record default-field-values) + record) +(setq forms-new-record-filter 'new-record-filter) + +;; Entry creation functions for org export +(defun make-org-entry-function (format-string) + (lambda (label-field) + (let* ((label (car label-field)) + (field-no (cdr label-field)) + (value (get-field field-no))) + (if value + (princ (format format-string label + (replace-regexp-in-string "\n" "\n\n" value))) + (user-error "Field \"%s\" should not be blank" label))))) + +(defun get-field (field) + "Parse form and return field FIELD from form" + (cond ((integerp field) (nth (1- field) (forms--parse-form))) + ((stringp field) field))) + +(setfun single-line-org-entry (make-org-entry-function "*%s:* %s\n\n")) +(setfun multi-line-org-entry (make-org-entry-function "\n* %s\n%s\n\n")) +(setfun single-line-org-entries (mapped 'mapc 'single-line-org-entry)) +(setfun multi-line-org-entries (mapped 'mapc 'multi-line-org-entry)) + +(defun text-if-non-blank (text) + (if (and text (not (string-blank-p text))) + (princ (format "%s\n\n" text)))) + +(defun org-keyword (keyword-value) + (princ (format "#+%s: %s\n" (car keyword-value) (cdr keyword-value)))) + +(defun org-latex-header (header) + (org-keyword (cons "LATEX_HEADER" header))) + +(setfun org-keywords (mapped 'mapc 'org-keyword)) +(setfun org-latex-headers (mapped 'mapc 'org-latex-header)) + +(defun forms-print () + (interactive) + (find-file (org-to-pdf (funcall form-to-org)))) + +(defun org-to-pdf (org-source) + (let ((tex-file-path (format "%s.tex" (make-temp-file "report")))) + (with-temp-buffer + (insert org-source) + (org-export-to-file 'latex tex-file-path + nil nil nil nil export-properties 'org-latex-compile)))) + +(make-variable-buffer-local 'form-to-org) -- cgit v1.2.3