diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/seam-export.el | 249 | ||||
| -rw-r--r-- | lisp/seam-html.el | 49 | ||||
| -rw-r--r-- | lisp/seam-test.el | 258 | ||||
| -rw-r--r-- | lisp/seam.el | 207 |
4 files changed, 550 insertions, 213 deletions
diff --git a/lisp/seam-export.el b/lisp/seam-export.el index 7fa6c2d..edde896 100644 --- a/lisp/seam-export.el +++ b/lisp/seam-export.el @@ -28,12 +28,18 @@ ;;; Code: (require 'cl-lib) +(require 'mustache) (require 'seam-html) (defvar seam-export--types nil) (defvar seam-export--template nil) +(defvar seam-export--template-values nil) (defvar seam-export--root-path nil) +(defvar seam-export--include-drafts nil) (defvar seam-export--no-extension nil) +(defvar seam-export--time-format nil) +(defvar seam-export--time-format-dt nil) +(defvar seam-export--time-zone nil) (defvar seam-export--internal-link-class nil) (defvar seam-export--options nil) @@ -55,26 +61,53 @@ properties: `:template-file' - The HTML template file to be used by the exporter. If this is - missing, falls back to :template-string, `seam-export-template-file', - or `seam-export-template-string' in that order. + The HTML template file to be used by the exporter. If this + is missing, falls back to :template-string, + `seam-export-template-file', or `seam-export-template-string' + in that order. `:template-string' - The HTML template string to be used by the exporter. If this is - missing, falls back to :template-file, `seam-export-template-file', - or `seam-export-template-string' in that order. + The HTML template string to be used by the exporter. If this + is missing, falls back to :template-file, + `seam-export-template-file', or `seam-export-template-string' + in that order. + + `:template-values' + + An alist of template variables and their values. Values + specified here will take precedence over those in + `seam-export-template-values'. Defaults to nil. `:root-path' The root path used for rendering internal links. Defaults to \"\", which means all paths are relative. + `:include-drafts' + + Whether to export draft notes as well. Defaults to nil. + `:no-extension' Whether to drop the \".html\" file extension in links. Defaults to nil. + `:time-format' + + Human-readable format for template time strings. Defaults to + the value of `seam-export-time-format'. + + `:time-format-dt' + + Machine-readable format for template time strings. Defaults + to the value of `seam-export-time-format-dt'. + + `:time-zone' + + Time zone used for template time strings. Defaults to the + value of `seam-export-time-zone'. + `:internal-link-class' CSS class name for internal links. Defaults to the value of @@ -107,21 +140,23 @@ See `seam-export-alist' for more information about specifying templates." <body> <main> <header> -<h1>{{title}}</h1> +<h1>{{{raw-title}}}</h1> <p class=\"modified\">Last modified: <time datetime=\"{{modified-dt}}\">{{modified}}</time></p> </header> -{{contents}} +{{{contents}}} <section class=\"backlinks\"> <h1>Backlinks</h1> -{{backlinks}} +{{{backlinks}}} </section> </main> </body> </html>" "The default HTML template string if no other template is specified. -It should be plain HTML5. Several variables are defined which can be -interpolated using the {{variable}} syntax: +It should be plain HTML5. Several variables are defined which +can be interpolated using Mustache bracket syntax. {{variable}} +will HTML-escape the interpolated text, while {{{variable}}} will +interpolate it as-is. `contents' @@ -129,12 +164,27 @@ interpolated using the {{variable}} syntax: `title' - The note's title (HTML-escaped). + The note's title, in a plain text format suitable for a + <title> tag. + + `raw-title' + + The note's title, in an HTML format suitable for an <h1> tag. `backlinks' A list (<ul>) of notes that link to the given note. + `created' + + The human-readable date that the note was created. See + `seam-export-time-format'. + + `created-dt' + + The machine-readable date that the note was created. See + `seam-export-time-format-dt'. + `modified' The human-readable date that the note was last modified. See @@ -142,8 +192,8 @@ interpolated using the {{variable}} syntax: `modified-dt' - The machine-readable date that the note was last modified. See - `seam-export-time-format-datetime'.") + The machine-readable date that the note was last modified. + See `seam-export-time-format-dt'.") (defcustom seam-export-template-string seam-export-default-template-string "The HTML template string to be used by the exporter. The template @@ -153,13 +203,21 @@ See `seam-export-alist' for more information about specifying templates." :group 'seam-export :type '(choice string (const nil))) +(defcustom seam-export-template-values nil + "An alist of (VAR . VALUE) pairs, where VAR is a string naming a +template variable, and VALUE is the value to be used when +interpolating that variable. See the mustache.el docs for more +information." + :group 'seam-export + :type '(alist :key-type string :value-type sexp)) + (defcustom seam-export-time-format "%e %B %Y" "Human-readable format for template time strings. Passed to `format-time-string'." :group 'seam-export :type 'string) -(defcustom seam-export-time-format-datetime "%Y-%m-%d" +(defcustom seam-export-time-format-dt "%Y-%m-%d" "Machine-readable format for template time strings. Meant to be used in the datetime attribute of <time>. Passed to `format-time-string'." :group 'seam-export @@ -196,7 +254,7 @@ notes)." :with-smart-quotes t :with-toc nil)) -(defmacro seam-export--to-string (&rest body) +(defmacro seam-export--export-to-html-string (&rest body) (declare (indent 0)) (let ((buf (gensym))) `(let ((,buf (generate-new-buffer " *seam-export*"))) @@ -210,67 +268,116 @@ notes)." (buffer-string))) (kill-buffer ,buf))))) -;;; Some HACK-ery to get fully escaped and smartquote-ized string. -(defun seam-export--escape-string (s) +(defmacro seam-export--export-to-text-string (&rest body) + (declare (indent 0)) + (let ((buf (gensym))) + `(let ((,buf (generate-new-buffer " *seam-export*"))) + (unwind-protect + (progn (with-temp-buffer + ,@body + ;; This let prevents Org from popping up a window. + (let ((org-export-show-temporary-export-buffer nil) + (org-ascii-charset 'utf-8)) + (org-export-to-buffer 'ascii ,buf nil nil nil t seam-export--options nil))) + (with-current-buffer ,buf + (buffer-string))) + (kill-buffer ,buf))))) + +(defun seam-export--org-to-html (s) + "Convert single-line Org string to HTML via Org exporter." (string-remove-prefix "<p>\n" (string-remove-suffix "</p>\n" - (seam-export--to-string + (seam-export--export-to-html-string (insert s))))) -(defun seam-export--replace-variable (var replacement) - (goto-char 1) - (while (re-search-forward (format "{{%s}}" var) nil t) - (replace-match replacement t t))) +(defun seam-export--org-to-text (s) + "Convert single-line Org string to plain text via Org exporter." + (string-chop-newline + (seam-export--export-to-text-string + (insert s)))) + +(defun seam-export--get-props (file props) + (with-temp-buffer + (insert-file-contents file) + (when (re-search-forward "^\\* " nil t) + (org-mode) + (cl-loop for prop in props + collect (org-element-property prop (org-element-at-point)))))) (defun seam-export--generate-backlinks (file) - (seam-export--to-string - (let ((files (sort + (seam-export--export-to-html-string + (let ((files (cl-sort (let ((seam--subset seam-export--types)) (cl-loop for x in (seam-get-links-to-file file) collect (cons (seam-get-title-from-file x) x))) - :key #'car - :lessp #'string<))) + #'string< + :key #'car))) (when files (cl-loop for (title . file) in files do (insert (format "- [[seam:%s][%s]]\n" (file-name-base file) title))))))) (defun seam-export--note-to-html (note-file html-directory) (seam-ensure-directory-exists html-directory) - (let ((html-file (file-name-concat html-directory - (concat (file-name-base note-file) ".html"))) - (modified (file-attribute-modification-time - (file-attributes note-file)))) - (with-temp-buffer - (insert seam-export--template) - (seam-export--replace-variable - "title" - (seam-export--escape-string - (seam-get-title-from-file note-file))) - (seam-export--replace-variable - "modified" - (format-time-string - seam-export-time-format - modified - seam-export-time-zone)) - (seam-export--replace-variable - "modified-dt" - (format-time-string - seam-export-time-format-datetime - modified - seam-export-time-zone)) - (seam-export--replace-variable - "contents" - (seam-export--to-string - (insert-file-contents note-file) - (re-search-forward (org-headline-re 1)) - (org-mode) ;Needed for `org-set-property'. - (org-set-property "seam-title-p" "t"))) - (seam-export--replace-variable - "backlinks" - (seam-export--generate-backlinks note-file)) - (write-file html-file)))) + (cl-destructuring-bind (created-prop modified-prop) + (seam-export--get-props note-file '(:SEAM_CREATED :SEAM_MODIFIED)) + (let* ((html-file (file-name-concat html-directory + (concat (seam-get-slug-from-file-name note-file) ".html"))) + (modified + (or (ignore-errors (parse-iso8601-time-string modified-prop)) + (file-attribute-modification-time + (file-attributes note-file)))) + (created + (or (ignore-errors (parse-iso8601-time-string created-prop)) + modified))) + (with-temp-buffer + (insert + (mustache-render + seam-export--template + (append + seam-export--template-values + seam-export-template-values + `(("title" . + ,(seam-export--org-to-text + (seam-get-title-from-file note-file))) + ("raw-title" . + ,(seam-export--org-to-html + (seam-get-title-from-file note-file))) + ("created" . + ,(format-time-string + seam-export--time-format + created + seam-export--time-zone)) + ("created-dt" . + ,(format-time-string + seam-export--time-format-dt + created + seam-export--time-zone)) + ("modified" . + ,(format-time-string + seam-export--time-format + modified + seam-export--time-zone)) + ("modified-dt" . + ,(format-time-string + seam-export--time-format-dt + modified + seam-export--time-zone)) + ("modified?" . + ,(lambda (template context) + (unless (equal created modified) + (mustache-render template context)))) + ("contents" . + ,(seam-export--export-to-html-string + (insert-file-contents note-file) + (re-search-forward "^\\* ") + (org-mode) ;Needed for `org-set-property'. + (org-set-property "seam-title-p" "t"))) + ("backlinks" . + ,(seam-export--generate-backlinks note-file))) + nil))) + (write-file html-file))))) (defun seam-export--file-string (file) (with-temp-buffer @@ -278,12 +385,14 @@ notes)." (buffer-string))) (defun seam-export-note (file) - (let ((type (seam-get-note-type file))) + (let ((type (seam-get-note-type file)) + (draft-p (seam-draft-p file))) (cl-loop for (dir . plist) in seam-export-alist do (let ((types (plist-get plist :types)) (template-file (plist-get plist :template-file)) - (template-string (plist-get plist :template-string))) + (template-string (plist-get plist :template-string)) + (template-values (plist-get plist :template-values))) (unless types (error "You must specify :types for export")) (let ((template @@ -294,11 +403,24 @@ notes)." seam-export-template-file)) (seam-export-template-string seam-export-template-string) (t (error "You must specify a template for export (see `seam-export-alist')"))))) - (when (member type types) + (when (and (member type types) + (or (not (seam-draft-p file)) + (plist-get plist :include-drafts))) (let ((seam-export--types types) (seam-export--root-path (or (plist-get plist :root-path) "")) + (seam-export--include-drafts (plist-get plist :include-drafts)) (seam-export--no-extension (plist-get plist :no-extension)) (seam-export--template template) + (seam-export--template-values template-values) + (seam-export--time-format + (or (plist-get plist :time-format) + seam-export-time-format)) + (seam-export--time-format-dt + (or (plist-get plist :time-format-dt) + seam-export-time-format-dt)) + (seam-export--time-zone + (or (plist-get plist :time-zone) + seam-export-time-zone)) (seam-export--internal-link-class (or (plist-get plist :internal-link-class) seam-export-internal-link-class)) @@ -314,6 +436,7 @@ notes)." (error "Nothing to export. Please configure `seam-export-alist'.")) (dolist (dir (seam-note-subdirectories)) (dolist (file (directory-files dir t seam-note-file-regexp)) + (seam-delete-html-files-for-note file) (seam-export-note file)))) (provide 'seam-export) diff --git a/lisp/seam-html.el b/lisp/seam-html.el index 018e56f..57cd9b9 100644 --- a/lisp/seam-html.el +++ b/lisp/seam-html.el @@ -1,6 +1,7 @@ ;;; seam-html.el --- Seam HTML exporter -*- lexical-binding: t -*- ;; Copyright (C) 2025 Spencer Williams +;; Copyright (C) 2011-2025 Free Software Foundation, Inc. ;; Author: Spencer Williams <spnw@plexwave.org> @@ -28,15 +29,34 @@ ;; This was blithely hacked together using large chunks of code lifted ;; straight from ox-html.el, and could do with much improvement. ;; -;; Original ox-html code is licensed under GPL v3+. Copyright (c) -;; 2011-2025 Free Software Foundation, Inc. Original authors: Carsten -;; Dominik <carsten.dominik@gmail.com> and Jambunathan K <kjambunathan -;; at gmail dot com>. +;; The original authors of ox-html are: +;; Carsten Dominik <carsten.dominik@gmail.com> +;; Jambunathan K <kjambunathan at gmail dot com> ;;; Code: (require 'ox-html) +;;; Org <9.7 compatibility. + +(fset 'seam-html--element-parent-element + (if (fboundp 'org-element-parent-element) + 'org-element-parent-element + 'org-export-get-parent-element)) + +(fset 'seam-html--element-parent + (if (fboundp 'org-element-parent) + 'org-element-parent + (lambda (node) + (org-element-property :parent node)))) + +(fset 'seam-html--element-type-p + (if (fboundp 'org-element-type-p) + 'org-element-type-p + (lambda (node types) + (memq (org-element-type node) + (ensure-list types))))) + ;;; NOTE: This function does not respect `:headline-levels' or ;;; `:html-self-link-headlines'. (defun seam-html-headline (headline contents info) @@ -102,8 +122,8 @@ images, set it to: (lambda (paragraph) (org-element-property :caption paragraph))" (let ((paragraph (pcase (org-element-type element) (`paragraph element) - (`link (org-element-parent element))))) - (and (org-element-type-p paragraph 'paragraph) + (`link (seam-html--element-parent element))))) + (and (seam-html--element-type-p paragraph 'paragraph) (or (not (and (boundp 'seam-html-standalone-image-predicate) (fboundp seam-html-standalone-image-predicate))) (funcall seam-html-standalone-image-predicate paragraph)) @@ -146,11 +166,13 @@ INFO is a plist holding contextual information. See (path (cond ((string= "seam" link-type) - (let ((slug raw-path)) + (let ((slug (string-remove-prefix "-" raw-path))) (when-let ((file (seam-lookup-slug slug))) (let ((type (seam-get-note-type file))) (when (and (member type seam-export--types) - (file-exists-p (seam-make-file-name slug type))) + (or seam-export--include-drafts + (not (seam-draft-p file))) + (file-exists-p (seam-make-file-name raw-path type))) (concat seam-export--root-path slug (if seam-export--no-extension "" ".html"))))))) @@ -187,9 +209,9 @@ INFO is a plist holding contextual information. See ;; do this for the first link in parent (inner image link ;; for inline images). This is needed as long as ;; attributes cannot be set on a per link basis. - (let* ((parent (org-element-parent-element link)) - (link (let ((container (org-element-parent link))) - (if (and (org-element-type-p container 'link) + (let* ((parent (seam-html--element-parent-element link)) + (link (let ((container (seam-html--element-parent link))) + (if (and (seam-html--element-type-p container 'link) (org-html-inline-image-p link info)) container link)))) @@ -268,7 +290,7 @@ INFO is a plist holding contextual information. See (_ (if (and destination (memq (plist-get info :with-latex) '(mathjax t)) - (org-element-type-p destination 'latex-environment) + (seam-html--element-type-p destination 'latex-environment) (eq 'math (org-latex--environment-type destination))) ;; Caption and labels are introduced within LaTeX ;; environment. Use "ref" or "eqref" macro, depending on user @@ -279,7 +301,7 @@ INFO is a plist holding contextual information. See (seam-html-standalone-image-predicate #'org-html--has-caption-p) (counter-predicate - (if (org-element-type-p destination 'latex-environment) + (if (seam-html--element-type-p destination 'latex-environment) #'org-html--math-environment-p #'org-html--has-caption-p)) (number @@ -322,7 +344,6 @@ INFO is a plist holding contextual information. See ;; No path, only description. (t desc)))) - (defun seam-html-src-block (src-block _contents info) "Transcode a SRC-BLOCK element from Org to HTML. CONTENTS holds the contents of the item. INFO is a plist holding diff --git a/lisp/seam-test.el b/lisp/seam-test.el index 5d4a562..5bae015 100644 --- a/lisp/seam-test.el +++ b/lisp/seam-test.el @@ -39,14 +39,16 @@ (defmacro seam-test-environment (&rest body) (declare (indent 0)) - `(let* ((seam-test-directory (make-temp-file "seam-test" t)) + `(let* ((seam-test-directory (file-name-as-directory (make-temp-file "seam-test" t))) (seam-note-directory seam-test-directory) (default-directory seam-test-directory) + (seam-create-as-draft nil) (seam-note-types '("private" "public")) (seam-default-note-type "private") - (seam-title-formatter (lambda (title _type) title)) + (seam-title-formatter (lambda (title _type _draft-p) title)) (seam-export-template-file nil) (seam-export-template-string seam-export-default-template-string) + (seam-export-template-values nil) (seam-export-internal-link-class nil) (seam-export-alist `((,(file-name-concat seam-test-directory "html") @@ -65,16 +67,18 @@ `(seam-test-environment (let ,options (let ,(cl-loop for (name . args) in varlist - collect `(,name (seam-make-note ,@args))) + collect `(,name (seam-create-note ,@args))) + ;; FIXME: It's quite possible for tests to fail in such a way + ;; that this does not kill the buffers. (unwind-protect (progn ,@body) (mapcar #'kill-buffer (list ,@(mapcar #'car varlist)))))))) -(defun seam-test-remove-testdir (filename) - (string-remove-prefix (concat seam-test-directory "/") filename)) +(defun seam-test-strip-testdir (filename) + (string-remove-prefix seam-test-directory filename)) (defun seam-test-list-files () (mapcar - #'seam-test-remove-testdir + #'seam-test-strip-testdir (directory-files-recursively seam-test-directory ""))) (defun seam-test-add-contents (buffer contents) @@ -100,7 +104,7 @@ (cl-loop for ret = (re-search-forward "<a href=\"/\\(.*\\)?\">" nil t) while ret collect (match-string 1))))) -(ert-deftest seam-test-make-note-private () +(ert-deftest seam-test-create-note-private () (should (equal '("private/note.org") @@ -108,7 +112,7 @@ ((note "Note")) (seam-test-list-files))))) -(ert-deftest seam-test-make-note-public () +(ert-deftest seam-test-create-note-public () (should (equal '("html/note.html" "public/note.org") @@ -116,12 +120,12 @@ ((note "Note" "public")) (seam-test-list-files))))) -(ert-deftest seam-test-make-note-weird-filename () +(ert-deftest seam-test-create-note-weird-filename () (should (equal - '("./Weird file name!" ("private/weird-file-name.org")) + '("./Weir'd file name!" ("private/weird-file-name.org")) (seam-test-with-notes () - ((weird "./Weird file name! ")) + ((weird "./Weir'd file name! ")) (list (buffer-name weird) (seam-test-list-files)))))) @@ -151,22 +155,22 @@ (buffer-name note) (seam-get-title-from-file (buffer-file-name note)))))) -(ert-deftest seam-test-make-note-invalid-type () +(ert-deftest seam-test-create-note-invalid-type () (should-error (seam-test-environment - (kill-buffer (seam-make-note "Note" "invalid-type"))))) + (kill-buffer (seam-create-note "Note" "invalid-type"))))) -(ert-deftest seam-test-make-note-name-conflict () +(ert-deftest seam-test-create-note-name-conflict () (should-error (seam-test-environment - (kill-buffer (seam-make-note " Note 1 ")) - (kill-buffer (seam-make-note "Note_1"))))) + (kill-buffer (seam-create-note " Note 1 ")) + (kill-buffer (seam-create-note "Note_1"))))) -(ert-deftest seam-test-make-note-name-conflict-different-types () +(ert-deftest seam-test-create-note-name-conflict-different-types () (should-error (seam-test-environment - (kill-buffer (seam-make-note "Note")) - (kill-buffer (seam-make-note "Note" "public"))))) + (kill-buffer (seam-create-note "Note")) + (kill-buffer (seam-create-note "Note" "public"))))) (ert-deftest seam-test-rename-note () (should @@ -202,14 +206,16 @@ (ert-deftest seam-test-buffer-name-format-custom () (should (equal - "[private] Note" + "[private draft] Note" (seam-test-with-notes ((seam-title-formatter - (lambda (title type) (format "[%s] %s" type title)))) - ((note "Note")) + (lambda (title type draft-p) + (format "[%s%s] %s" type (if draft-p " draft" "") title)))) + ((note "Note" nil nil t)) (buffer-name note))))) (ert-deftest seam-test-link-update () - "Test that renaming a note updates its HTML and that of notes which link to it." + "Test that renaming a note updates its HTML and that of notes +which link to it." (should (equal '(("qux.html") ("public/qux.org") @@ -222,7 +228,7 @@ (seam-test-replace-contents bar "* qux") (list (seam-test-links-from-html "html/foo.html") - (mapcar #'seam-test-remove-testdir (seam-get-links-from-file (buffer-file-name foo))) + (mapcar #'seam-test-strip-testdir (seam-get-links-from-file (buffer-file-name foo))) (seam-test-list-files))))))) (ert-deftest seam-test-link-update-no-unnecessary-export () @@ -252,8 +258,8 @@ re-export note to which it links." (re-search-forward "<a href=\"/bar.html\">"))))) (ert-deftest seam-test-link-no-extension () - "Test that the :no-extension option causes links to render without .html -extension." + "Test that the :no-extension option causes links to render without +.html extension." (should (identity (seam-test-with-notes ((seam-export-alist @@ -270,8 +276,8 @@ extension." (re-search-forward "<a href=\"/bar\">")))))) (ert-deftest seam-test-link-internal-class () - "Test that setting `seam-export-internal-link-class' correctly renders -the class." + "Test that setting `seam-export-internal-link-class' correctly +renders the class." (should (identity (seam-test-with-notes ((seam-export-internal-link-class "internal")) @@ -297,13 +303,13 @@ the class." (seam-test-add-contents foo (seam-test-link-to-buffer qux)) (seam-test-add-contents bar (seam-test-link-to-buffer qux)) (list - (mapcar #'seam-test-remove-testdir (seam-get-links-from-file (buffer-file-name foo))) - (mapcar #'seam-test-remove-testdir (seam-get-links-to-file (buffer-file-name bar))) - (mapcar #'seam-test-remove-testdir (seam-get-links-to-file (buffer-file-name qux)))))))) + (mapcar #'seam-test-strip-testdir (seam-get-links-from-file (buffer-file-name foo))) + (mapcar #'seam-test-strip-testdir (seam-get-links-to-file (buffer-file-name bar))) + (mapcar #'seam-test-strip-testdir (seam-get-links-to-file (buffer-file-name qux)))))))) (ert-deftest seam-test-delete-note () - "Test that deleting a note also deletes its HTML and re-exports linking -notes such that they no longer link to it." + "Test that deleting a note also deletes its HTML and re-exports +linking notes such that they no longer link to it." (should (equal '(nil ("html/foo.html" "public/foo.org")) @@ -319,10 +325,11 @@ notes such that they no longer link to it." (seam-test-list-files)))))) (ert-deftest seam-test-backlinks-public () - "Test that linking to a note from a public note creates a backlink." + "Test that linking to a note from a public note creates a +backlink." (should (identity - (seam-test-with-notes ((seam-export-template-string "{{backlinks}}")) + (seam-test-with-notes ((seam-export-template-string "{{{backlinks}}}")) ((foo "foo" "public") (bar "bar" "public")) (with-current-buffer foo @@ -334,47 +341,53 @@ notes such that they no longer link to it." (ert-deftest seam-test-backlinks-private () "Test that linking to a note from a private note does not create a backlink." - (should-error - (seam-test-with-notes ((seam-export-template-string "{{backlinks}}")) - ((foo "foo") - (bar "bar" "public")) - (with-current-buffer foo - (seam-test-add-contents foo (seam-test-link-to-buffer bar))) - (with-temp-buffer - (insert-file-contents "html/bar.html") - (re-search-forward "<a href=\"/foo.html\">"))))) + (should + (equal + "" + (seam-test-with-notes ((seam-export-template-string "{{{backlinks}}}")) + ((foo "foo") + (bar "bar" "public")) + (with-current-buffer foo + (seam-test-add-contents foo (seam-test-link-to-buffer bar))) + (with-temp-buffer + (insert-file-contents "html/bar.html") + (buffer-string)))))) (ert-deftest seam-test-backlinks-delete () "Test that deleting a note removes backlink." - (should-error - (seam-test-with-notes ((seam-export-template-string "{{backlinks}}")) - ((foo "foo" "public") - (bar "bar" "public")) - (with-current-buffer foo - (seam-test-add-contents foo (seam-test-link-to-buffer bar))) - (let ((delete-by-moving-to-trash nil)) - (seam-delete-note (buffer-file-name foo))) - (with-temp-buffer - (insert-file-contents "html/bar.html") - (re-search-forward "<a href=\"/foo.html\">"))))) - -(ert-deftest seam-test-backlinks-comment () - "Test that a commented-out link does not add a backlink." - :expected-result :failed - (should-error - (identity - (seam-test-with-notes ((seam-export-template-string "{{backlinks}}")) + (should + (equal + "" + (seam-test-with-notes ((seam-export-template-string "{{{backlinks}}}")) ((foo "foo" "public") (bar "bar" "public")) (with-current-buffer foo - (seam-test-add-contents foo (concat "# " (seam-test-link-to-buffer bar)))) + (seam-test-add-contents foo (seam-test-link-to-buffer bar))) + (let ((delete-by-moving-to-trash nil)) + (seam-delete-note (buffer-file-name foo))) (with-temp-buffer (insert-file-contents "html/bar.html") - (re-search-forward "<a href=\"/foo.html\">")))))) + (buffer-string)))))) + +(ert-deftest seam-test-backlinks-draft () + "Test that linking to a note from a draft note does not create a +backlink." + (should + (equal + "" + (seam-test-with-notes ((seam-export-template-string "{{{backlinks}}}")) + ((foo "foo" "public" nil t) + (bar "bar" "public")) + (with-current-buffer foo + (seam-test-add-contents foo (seam-test-link-to-buffer bar))) + (with-temp-buffer + (insert-file-contents "html/bar.html") + (buffer-string)))))) (ert-deftest seam-test-set-type-private () - "Test that setting a public note to private will delete its HTML file and -update linking HTML files such that they no longer link to it." + "Test that setting a public note to private will delete its HTML +file and update linking HTML files such that they no longer link +to it." (should (equal '(nil ("html/foo.html" "private/bar.org" "public/foo.org")) @@ -412,6 +425,59 @@ update linking HTML files such that they link to it." ((foo "foo")) (seam-set-note-type (buffer-file-name foo) "invalid-type")))) +(ert-deftest seam-test-create-draft () + (should + (equal + '("public/-note.org") + (seam-test-with-notes ((seam-create-as-draft t)) + ((note "Note" "public")) + (seam-test-list-files))))) + +(ert-deftest seam-test-create-draft-override () + (should + (equal + '("public/-note.org") + (seam-test-with-notes ((seam-note-types + '(("public" :create-as-draft t)))) + ((note "Note" "public")) + (seam-test-list-files))))) + +(ert-deftest seam-test-set-draft () + "Test that toggling a note from non-draft to draft will delete its +HTML file and update linking HTML files such that they no longer +link to it." + (should + (equal + '(nil ("html/foo.html" "public/-bar.org" "public/foo.org")) + (seam-test-with-notes () + ((foo "foo" "public") + (bar "bar" "public")) + (with-current-buffer foo + (seam-test-add-contents foo (seam-test-link-to-buffer bar))) + (with-current-buffer bar + (call-interactively 'seam-toggle-draft)) + (list + (seam-test-links-from-html "html/foo.html") + (seam-test-list-files)))))) + +(ert-deftest seam-test-unset-draft () + "Test that toggling a note from draft to non-draft will export its +HTML file and update linking HTML files such that they link to +it." + (should + (equal + '(("bar.html") ("html/bar.html" "html/foo.html" "public/bar.org" "public/foo.org")) + (seam-test-with-notes () + ((foo "foo" "public") + (bar "bar" "public" nil t)) + (with-current-buffer foo + (seam-test-add-contents foo (seam-test-link-to-buffer bar))) + (with-current-buffer bar + (call-interactively 'seam-toggle-draft)) + (list + (seam-test-links-from-html "html/foo.html") + (seam-test-list-files)))))) + (ert-deftest seam-test-follow-link-existing () "Test that following a link to an existing note opens that note." (should @@ -427,7 +493,8 @@ update linking HTML files such that they link to it." (buffer-name)))))) (ert-deftest seam-test-follow-link-new () - "Test that following a link to an nonexistent note creates and opens that note." + "Test that following a link to an nonexistent note creates and +opens that note." (should (equal '("bar" ("private/bar.org" "private/foo.org")) @@ -444,16 +511,36 @@ update linking HTML files such that they link to it." (seam-test-list-files)) (kill-buffer))))))) +(ert-deftest seam-test-follow-link-new-draft () + "Test that following a link to an nonexistent draft note creates +and opens that note." + (should + (equal + '("-bar" ("private/-bar.org" "private/foo.org")) + (seam-test-with-notes () + ((foo "foo")) + (with-current-buffer foo + (seam-test-add-contents foo "[[seam:-bar]]") + (goto-char 1) + (org-next-link) + (org-open-at-point) + (unwind-protect + (list + (buffer-name) + (seam-test-list-files)) + (kill-buffer))))))) + (ert-deftest seam-test-escape-title () (should (equal - "“quotes” & <symbols>\n" - (seam-test-with-notes ((seam-export-template-string "{{title}}")) + "“quotes” & <symbols>\n“quotes” & <symbols>\n" + (seam-test-with-notes ((seam-export-template-string "{{title}}\n{{{raw-title}}}")) ((note "\"quotes\" & <symbols>" "public")) (seam-export--file-string "html/quotes-symbols.html"))))) (ert-deftest seam-test-custom-slug () - "Test that setting the SEAM_SLUG property saves and exports accordingly." + "Test that setting the SEAM_SLUG property saves and exports +accordingly." (should (equal '("html/c-vs-cpp.html" "public/c-vs-cpp.org") @@ -462,6 +549,37 @@ update linking HTML files such that they link to it." (seam-test-add-contents note ":PROPERTIES:\n:SEAM_SLUG: c-vs-cpp\n:END:") (seam-test-list-files))))) +(ert-deftest seam-test-removing-type-from-export-alist () + (should + (equal + '("public/note.org") + (seam-test-with-notes () + ((note "Note" "public")) + (setq seam-export-alist + `((,(file-name-concat seam-test-directory "html") + :types ("foo") + :root-path "/"))) + (seam-export-all-notes) + (seam-test-list-files))))) + +(ert-deftest seam-test-template-values () + "Test that custom variables can be used in templates, and that +existing ones can be overridden." + (should + (equal + "Qux\nhello, world\n" + (seam-test-with-notes + ((seam-export-template-values '(("title" . "Bar") + ("greeting" . "hello, world"))) + (seam-export-template-string "{{title}}\n{{greeting}}") + (seam-export-alist + `((,(file-name-concat seam-test-directory "html") + :types ("public") + :root-path "/" + :template-values (("title" . "Qux")))))) + ((foo "Foo" "public")) + (seam-export--file-string "html/foo.html"))))) + (provide 'seam-test) ;;; seam-test.el ends here diff --git a/lisp/seam.el b/lisp/seam.el index 9a4f744..eb3037e 100644 --- a/lisp/seam.el +++ b/lisp/seam.el @@ -33,6 +33,7 @@ ;;; Code: (require 'seam-export) +(require 'org) (require 'cl-lib) (require 'grep) @@ -52,13 +53,33 @@ :type 'string) (defcustom seam-note-types '("private" "public") - "Seam note types." + "List of valid Seam note types. Each element can either be a +string (the name of the type), or an alist. If using an alist, +the car should be the type name, and the cdr should be a plist +containing any number of these properties: + + `:create-as-draft' + + When this is non-nil, new Seam notes of this type will be + created as drafts. If this is missing, falls back to + `seam-create-as-draft'." + :group 'seam + :type '(repeat + (choice string + (alist :key-type string :value-type plist)))) + +(defcustom seam-create-as-draft nil + "When non-nil, new Seam notes will be created as drafts." :group 'seam - :type '(repeat string)) + :type 'boolean) -(defun seam-format-title-default (title type) - "Default Seam title formatter. Formats like this: \"TITLE (TYPE)\"." - (format "%s %s" title (propertize (format "(%s)" type) 'face 'font-lock-comment-face))) +(defun seam-format-title-default (title type draft-p) + "Default Seam title formatter. Formats like this: \"TITLE (TYPE[ draft])\"." + (format "%s %s" + title + (propertize + (format "(%s%s)" type (if draft-p " draft" "")) + 'face 'font-lock-comment-face))) (defcustom seam-title-formatter #'seam-format-title-default @@ -71,13 +92,20 @@ naming. Must be a function taking two arguments: TITLE and TYPE." (mapcar #'car seam-export-alist)) (defun seam-slugify (title) - (downcase (string-join (string-split title "\\W+" t) "-"))) + (setq title (string-replace "'" "" title)) + (setq title (string-split title "\\W+" t)) + (setq title (string-join title "-")) + (downcase title)) (defun seam-lookup-slug (slug) - (cl-dolist (type seam-note-types) - (let ((file (file-name-concat seam-note-directory type (concat slug ".org")))) - (when (file-exists-p file) - (cl-return (expand-file-name file)))))) + (cl-dolist (type (seam-get-all-note-type-names)) + (let ((file (file-name-concat seam-note-directory type (concat slug ".org"))) + (draft-file (file-name-concat seam-note-directory type (concat "-" slug ".org")))) + (cond + ((file-exists-p file) + (cl-return (expand-file-name file))) + ((file-exists-p draft-file) + (cl-return (expand-file-name draft-file))))))) (defun seam--check-conflict (slug) (when (seam-lookup-slug slug) @@ -87,7 +115,7 @@ naming. Must be a function taking two arguments: TITLE and TYPE." (org-mark-ring-push) (if-let ((file (seam-lookup-slug path))) (find-file file) - (seam-make-note path nil t)) + (seam-create-note path nil t (seam-draft-p path))) (seam-set-buffer-name)) (defvar seam-note-file-regexp "\\`[^.].+\\.org\\'") @@ -105,7 +133,7 @@ naming. Must be a function taking two arguments: TITLE and TYPE." (defun seam-ensure-note-subdirectories-exist () (unless seam-note-directory (error "Please set `seam-note-directory'")) - (cl-dolist (type seam-note-types) + (cl-dolist (type (seam-get-all-note-type-names)) (let ((dir (file-name-concat seam-note-directory type))) (seam-ensure-directory-exists dir)))) @@ -115,6 +143,9 @@ naming. Must be a function taking two arguments: TITLE and TYPE." :type '(choice (const :tag "Sort by title" title) (const :tag "Sort by modification date" modified))) +(defun seam-get-all-note-type-names () + (mapcar (lambda (x) (car (ensure-list x))) seam-note-types)) + (cl-defgeneric seam-get-all-notes (sort-by)) (cl-defmethod seam-get-all-notes ((sort-by (eql 't))) @@ -156,8 +187,7 @@ naming. Must be a function taking two arguments: TITLE and TYPE." (save-restriction (widen) (goto-char 1) - (ignore-errors - (re-search-forward (org-headline-re 1)) + (when (re-search-forward "^\\* " nil t) (let ((start (point))) (end-of-line) (let ((title (string-trim (buffer-substring-no-properties start (point))))) @@ -169,33 +199,41 @@ naming. Must be a function taking two arguments: TITLE and TYPE." (insert-file-contents file) (seam-get-title-from-buffer))) +(defun seam-get-slug-from-file-name (file) + (string-remove-prefix "-" (file-name-base file))) + (cl-defun seam-get-slug-from-buffer (&optional (buffer (current-buffer))) (or (with-current-buffer buffer (save-mark-and-excursion (save-restriction (widen) (goto-char 1) - (ignore-errors - (re-search-forward (org-headline-re 1)) + (when (re-search-forward "^\\* " nil t) (org-element-property :SEAM_SLUG (org-element-at-point)))))) (seam-slugify (seam-get-title-from-buffer buffer)))) -(defun seam-format-title (title type) - (funcall seam-title-formatter title type)) +(defun seam-format-title (title type draft-p) + (funcall seam-title-formatter title type draft-p)) (defun seam-validate-note-type (type) - (unless (member type seam-note-types) + (unless (member type (seam-get-all-note-type-names)) (error "`%s' is not a valid Seam note type" type))) -(defun seam-make-note (title &optional type select) +(cl-defun seam-create-note (title &optional type select (draft-p nil draft-supplied-p)) (unless type (setq type seam-default-note-type)) (seam-validate-note-type type) (seam-ensure-note-subdirectories-exist) (let* ((slug (seam-slugify title)) + (draft-p + (if draft-supplied-p + draft-p + (cl-getf (cdr (assoc type (mapcar #'ensure-list seam-note-types))) + :create-as-draft + seam-create-as-draft))) (file (file-name-concat seam-note-directory type - (concat slug ".org")))) + (concat (when draft-p "-") slug ".org")))) (when (string= "" slug) (error "Cannot create a note with an empty slug")) (seam--check-conflict slug) @@ -215,7 +253,11 @@ naming. Must be a function taking two arguments: TITLE and TYPE." :test #'equal) (and self (list self))))) (let ((files (cl-loop for (title . file) in notes - collect (cons (seam-format-title title (seam-get-note-type file)) file)))) + collect (cons (seam-format-title + title + (seam-get-note-type file) + (seam-draft-p file)) + file)))) (let ((completion (string-trim (funcall seam-completing-read-function prompt (mapcar #'car files))))) (or (assoc completion files) (cons completion nil))))))) @@ -223,10 +265,15 @@ naming. Must be a function taking two arguments: TITLE and TYPE." (defun seam--read-type (prompt arg &optional choices) (when arg (if (listp arg) - (let ((type (funcall seam-completing-read-function prompt (or choices seam-note-types) nil t))) + (let ((type (funcall seam-completing-read-function + prompt + (or choices (seam-get-all-note-type-names)) + nil + t))) (seam-validate-note-type type) type) - (nth (1- arg) seam-note-types)))) + (nth (1- arg) + (seam-get-all-note-type-names))))) ;;;###autoload (defun seam-find-note (arg) @@ -240,7 +287,7 @@ completion prompt is given to choose the type." (interactive "P") (let* ((type (seam--read-type "Type: " arg)) (seam--subset - (if type (list type) seam-note-types))) + (if type (list type) (seam-get-all-note-type-names)))) (cl-destructuring-bind (completion . file) (seam-read-title "Open note: ") (if file @@ -249,26 +296,31 @@ completion prompt is given to choose the type." ;; formatter function) (NOTE: Redundant if buffer wasn't ;; already open, as `seam-setup-buffer' does this too.) (seam-set-buffer-name)) - (seam-make-note (string-trim completion) (or type seam-default-note-type) t))))) + (seam-create-note (string-trim completion) (or type seam-default-note-type) t))))) (cl-defun seam-get-note-type (file &optional no-error) (when (and file (equal "org" (file-name-extension file))) (let ((type (cadr (nreverse (file-name-split file))))) - (when (member type seam-note-types) + (when (member type (seam-get-all-note-type-names)) (cl-return-from seam-get-note-type type)))) (unless no-error (error "%s is not a Seam note" file))) -(defun seam-make-file-name (slug type) +(defun seam-make-file-name (slug type &optional draft) (expand-file-name (file-name-concat seam-note-directory type - (concat slug ".org")))) + (concat (when draft "-") slug ".org")))) -(defun seam-get-links-to-file (file) +(defun seam-get-links-to-file (file &optional include-drafts) "Return filename of each note which links to FILE." - (remove (expand-file-name file) - (seam-note-files-containing-string (format "[[seam:%s]" (file-name-base file))))) + (cl-loop for file in (remove (expand-file-name file) + (seam-note-files-containing-string + (format "[[seam:%s]" (file-name-base file)))) + when (or include-drafts + seam-export--include-drafts + (not (seam-draft-p file))) + collect file)) (cl-defun seam-get-links-from-buffer (&optional (buffer (current-buffer))) "Return filename of each existing note which is linked to from BUFFER." @@ -293,18 +345,24 @@ completion prompt is given to choose the type." (seam-get-links-from-buffer))) (defun seam-delete-html-files-for-note (note-file) - (dolist (dir (seam-html-directories)) - (let ((html (file-name-concat dir (concat (file-name-base note-file) ".html")))) - (when (file-exists-p html) - (delete-file html) - (message "Deleted %s" html))))) + (let ((html-nd (concat (seam-get-slug-from-file-name note-file) ".html"))) + (dolist (dir (seam-html-directories)) + (let ((html (file-name-concat dir html-nd))) + (when (file-exists-p html) + (delete-file html) + (message "Deleted %s" html)))))) + +(defun seam--rename-file (old new interactive) + (rename-file old new) + (when interactive + (set-visited-file-name new nil t) + (seam-set-buffer-name)) + (seam-post-save-or-rename old new)) (defun seam-post-save-or-rename (old new &optional previous-links-from-file slug-or-title-changed) (unless (string= old new) - (seam-update-links old new) - (seam-delete-html-files-for-note old) - (dolist (dir (seam-html-directories)) - (delete-file (file-name-concat dir (concat (file-name-base old) ".html"))))) + (seam-update-links old new)) + (seam-delete-html-files-for-note old) (seam-export-note new) (let* ((current-links (seam-get-links-from-file new)) (added-links (cl-set-difference current-links @@ -334,14 +392,18 @@ completion prompt is given to choose the type." (when type-changed (seam-get-links-to-file new)))))))) +(defun seam-draft-p (file) + (string-prefix-p "-" (file-name-base file))) + (defun seam-save-buffer () (let* ((old (buffer-file-name)) - (type (seam-get-note-type old t))) + (type (seam-get-note-type old t)) + (draft-p (seam-draft-p old))) (when type (unless (seam-get-title-from-buffer) (error "Note must have a title")) (let* ((slug (seam-get-slug-from-buffer)) - (new (seam-make-file-name slug type)) + (new (seam-make-file-name slug type draft-p)) (newly-created-p (not (file-exists-p old))) (slug-changed-p (not (string= slug (file-name-base old)))) (title-changed-p (unless newly-created-p @@ -349,7 +411,7 @@ completion prompt is given to choose the type." (seam-get-title-from-file old)))))) (unless (string= old new) ;This is valid because ;`seam-save-buffer' cannot - ;change type. + ;change type or draft status. (seam--check-conflict slug) (rename-file old new) (set-visited-file-name new nil t)) @@ -367,13 +429,12 @@ completion prompt is given to choose the type." (seam-set-buffer-name) t))))) -(defun seam--set-note-type (file new-type) +(defun seam--set-note-type (file new-type interactive) (let ((old-type (seam-get-note-type file)) (new-file (seam-make-file-name (file-name-base file) new-type))) (if (string= new-type old-type) file - (rename-file file new-file) - (seam-post-save-or-rename file new-file) + (seam--rename-file file new-file interactive) new-file))) ;;;###autoload @@ -390,28 +451,38 @@ from 1). Otherwise a completion prompt is given for the desired type." (or (seam--read-type "New type: " ;; HACK: Treat nil prefix as C-u. (or current-prefix-arg '(4)) - (remove old-type seam-note-types)) + (remove old-type (seam-get-all-note-type-names))) old-type) t))) - (let ((new-file (seam--set-note-type file new-type))) - (when interactive - (set-visited-file-name new-file nil t) - (seam-set-buffer-name)))) + (seam--set-note-type file new-type interactive)) + +;;;###autoload +(defun seam-toggle-draft (file &optional interactive) + "Toggle the draft status of Seam note FILE." + (interactive (list (buffer-file-name) t)) + (seam-get-note-type file) ;Error if file isn't a Seam note. + (let* ((base (file-name-nondirectory file)) + (new-file (file-name-concat + (file-name-directory file) + (if (string-prefix-p "-" base) + (string-remove-prefix "-" base) + (concat "-" base))))) + (seam--rename-file file new-file interactive))) (defun seam-update-links (old new) - (let ((old-slug (file-name-base old)) - (new-slug (file-name-base new))) - (unless (string= old-slug new-slug) + (let* ((old-link (file-name-base old)) + (new-link (file-name-base new))) + (unless (string= old-link new-link) (let ((count (seam-replace-string-in-all-notes - (format "[[seam:%s]" old-slug) - (format "[[seam:%s]" new-slug) + (format "[[seam:%s]" old-link) + (format "[[seam:%s]" new-link) t))) (unless (zerop count) (message "Updated links in %d file%s" count (if (= count 1) "" "s"))))))) (defun seam--active-subset () - (or seam--subset seam-note-types)) + (or seam--subset (seam-get-all-note-type-names))) (defun seam-note-subdirectories () (cl-loop for type in (seam--active-subset) @@ -451,7 +522,7 @@ Otherwise, it's nil." find-program (string-join (mapcar (lambda (type) (shell-quote-argument (concat type "/"))) - seam-note-types) + (seam-get-all-note-type-names)) " ") (shell-quote-argument "*.org") (shell-quote-argument ".*") @@ -505,10 +576,13 @@ Otherwise, it's nil." update-count))) (cl-defun seam-set-buffer-name (&optional (buffer (current-buffer))) - (with-current-buffer buffer - (rename-buffer - (seam-format-title (seam-get-title-from-buffer) - (seam-get-note-type (buffer-file-name buffer)))))) + (when-let ((title (seam-get-title-from-buffer))) + (let ((file (buffer-file-name buffer))) + (with-current-buffer buffer + (rename-buffer + (seam-format-title title + (seam-get-note-type file) + (seam-draft-p file))))))) (defun seam-setup-buffer () "Setup hooks when loading a Seam file." @@ -546,7 +620,7 @@ buffer is killed after deletion." (let ((file (buffer-file-name))) (seam-get-note-type file) ;Error if file isn't a Seam note. (list - (let ((incoming (length (seam-get-links-to-file file)))) + (let ((incoming (length (seam-get-links-to-file file t)))) (and (yes-or-no-p (format "Really %s `%s' and kill buffer%s?" (if delete-by-moving-to-trash @@ -574,7 +648,7 @@ link will replace it." (cl-destructuring-bind (completion . file) (seam-read-title "Insert note link: ") (let* ((new-buffer (unless file - (seam-make-note completion seam-default-note-type nil))) + (seam-create-note completion seam-default-note-type nil))) (selection (when (use-region-p) (buffer-substring (region-beginning) @@ -597,7 +671,8 @@ link will replace it." "k" #'seam-delete-note "l" #'seam-insert-link "s" #'seam-search - "t" #'seam-set-note-type) + "t" #'seam-set-note-type + "d" #'seam-toggle-draft) (org-link-set-parameters "seam" :follow #'seam-link-open) |