diff options
| -rw-r--r-- | CHANGELOG.org | 102 | ||||
| -rw-r--r-- | README.md | 13 | ||||
| -rw-r--r-- | README.org | 59 | ||||
| -rw-r--r-- | lisp/seam-export.el | 490 | ||||
| -rw-r--r-- | lisp/seam-html.el (renamed from seam-html.el) | 49 | ||||
| -rw-r--r-- | lisp/seam-test.el (renamed from seam-test.el) | 276 | ||||
| -rw-r--r-- | lisp/seam.el (renamed from seam.el) | 341 | ||||
| -rw-r--r-- | seam-export.el | 321 |
8 files changed, 1125 insertions, 526 deletions
diff --git a/CHANGELOG.org b/CHANGELOG.org new file mode 100644 index 0000000..bdc6833 --- /dev/null +++ b/CHANGELOG.org @@ -0,0 +1,102 @@ +** Changes since 0.1.0 + +*** Breaking changes + +- Seam's code has been moved to the =lisp/= subdirectory, where it + should have been all along. Make sure to update your =init.el= + accordingly. + +- Seam now uses [[https://github.com/Wilfred/mustache.el][mustache.el]] for templating. In Mustache, + double-bracketed variables are escaped, so you must use + triple-brackets for variables that include raw HTML. Please see the + updated =seam-export-default-template-string= for reference. + +- Your =seam-title-formatter= function should now take three arguments + instead of two: the third arg (=draft-p=) will be non-nil if the + note is a draft. + +**** Renamed variables + +- =seam-export-time-format-datetime= is now + =seam-export-time-format-dt=. + +**** Renamed functions + +- =seam-make-note= is now =seam-create-note=. + +- =seam-replace-string-in-notes= is now + =seam-replace-string-in-all-notes=. + +- =seam-visited-files= is now =seam-visited-notes=. + +*** New features + +- Notes can now be set as drafts for finer-grained control over + exporting. If =seam-create-as-draft= is non-nil, new notes will be + created as drafts. See =seam-note-types= for info on overriding + this per type. A note's draft status can be toggled with the new + command =seam-toggle-draft=. A new =seam-export-alist= option, + =:include-drafts=, controls whether drafts are included in a given + export profile. + +- Custom template variables can now be defined, and built-in ones + overridden. This is done globally with + =seam-export-template-values=, or per profile with + =:template-values=. + +- An option has been added to export internal links with a custom CSS + class. The default is set by =seam-export-internal-link-class=, and + can overridden per profile using =:internal-link-class=. + +- Custom slugs can now be set by adding the =SEAM_SLUG= property to a + note's title headline. + +- Creation and modification date can now be set explicitly using the + =SEAM_CREATED= and =SEAM_MODIFIED= properties. These dates can be + accessed within templates. The ={{#modified?}}= block tests whether + the two dates are unequal, and the behavior of this can be + customized with =seam-export-ignore-same-day-modifications= and + =:ignore-same-day-modifications=. + +*** Improvements + +- Notes are no longer re-exported unnecessarily whenever a linked note + is changed. + +- In HTML templates, ={{title}}= now strips out formatting, so that it + is more suitable for use in =<title>= tags. To get a raw + HTML-formatted title for =<h1>= tags and the like, you should use + the new ={{{raw-title}}}=. As mentioned above, triple brackets are + the Mustache syntax for interpolating raw HTML. + +- When invoking =seam-delete-note=, the note's title is now mentioned. + This is to reduce the risk of deleting the wrong note by mistake. + +- Completion support is somewhat improved. =ido-completing-read= now + works properly, and Seam no longer binds =completion-ignore-case=. + +- Changes to =seam-export-alist= are now respected when forcibly + re-exporting (e.g. with =seam-export-all-notes=). This is done by + always deleting old HTML files before exporting, thus avoiding the + situation where notes of no-longer-exported types still have files + hanging around. + +*** Bugfixes + +- Notes with single quotes in the name (') are no longer broken. + +- =seam-visited-notes= no longer returns buffers that visit non-note + files within =seam-note-directory=. This could have resulted in + Seam inappropriately modifying those files (e.g. updating links). + +- Buffer titles are now set correctly from narrowed buffers. + +- An issue with regexp escape sequences being interpreted in template + variable replacements has been fixed. + +- Seam now validates note types entered with =C-u seam-set-note-type=, + averting any mishaps if an invalid type is entered. + +- It is no longer possible to create a note with an empty slug. + +- Per-profile export options now override global options in all cases. diff --git a/README.md b/README.md deleted file mode 100644 index a3f75e4..0000000 --- a/README.md +++ /dev/null @@ -1,13 +0,0 @@ -[Seam](https://wiki.plexwave.org/seam) is a personal wiki system based -on [Org mode](https://orgmode.org/). - -# Installation -Clone this repo and add it to your load path. As long as your system -has `find` and `grep` installed, no further setup should be required. - -# Documentation -For now, the best way to learn about Seam is the [project -page](https://wiki.plexwave.org/seam) and the -[tutorial](https://wiki.plexwave.org/seam-tutorial). I have -endeavored to make Seam fairly self-documenting, so also see the -docstrings and the Seam customization group. @@ -1,10 +1,53 @@ -[[https://wiki.plexwave.org/seam][Seam]] is a personal wiki system based on [[https://orgmode.org/][Org mode]]. +** A personal wiki toolkit for Emacs -* Installation -Clone this repo and add it to your load path. As long as your system -has =find= and =grep= installed, no further setup should be required. +[[https://wiki.plexwave.org/seam][Seam]] leverages the power of [[https://orgmode.org/][Org mode]] to make creating, linking, and +publishing your notes easier. It is geared particularly towards +creating a personal wiki — a place where you can share some portion of +your notes with the world. It takes inspiration from the likes of +[[https://obsidian.md/][Obsidian]] and [[https://www.mediawiki.org/wiki/MediaWiki][MediaWiki]]. -* Documentation -For now, the best way to learn about Seam is the [[https://wiki.plexwave.org/seam][project page]] and the -[[https://wiki.plexwave.org/seam-tutorial][tutorial]]. I have endeavored to make Seam fairly self-documenting, so -also see the docstrings and the Seam customization group. +Three of Seam's key design tenets are: + +- Org files and their resultant HTML files should always be kept in + sync. + +- It should be easy to create multiple sites using different subsets + of the same note collection. + +- Notes should not be unnecessarily clouded with metadata. + +Be aware that Seam is a fully self-contained package, and is not +likely to be compatible with things like [[https://www.orgroam.com/][Org-roam]] due to its vastly +different approach. + +*Note:* Requires Emacs 29+, Org 9.6+, and [[https://github.com/Wilfred/mustache.el][mustache.el]]. + +*** Getting started + +The easiest way to begin is to follow the brief [[https://wiki.plexwave.org/seam-tutorial][tutorial]]. + +*** Documentation + +Seam's manual is still being written. In the meantime, the [[https://wiki.plexwave.org/seam][project +page]] contains some more tidbits you might find useful. + +I have endeavored to make Seam fairly self-documenting, so check the +docstrings and the Seam customization group when in any doubt. + +*** Known issues + +- =find-file= does not create notes properly. You should use + =seam-find-note= instead. + +- Commented-out links are not ignored, e.g. for determining backlinks. + +- Tags in note title headlines are not ignored; they are treated as + part of the title. + +- =seam:= links /must/ have a description. Bare links are not + supported. + +*** Upgrading + +As a new project, Seam is very much in flux. Whenever you upgrade it, +please see the [[file:CHANGELOG.org][changelog]] for breaking changes, new features, etc. diff --git a/lisp/seam-export.el b/lisp/seam-export.el new file mode 100644 index 0000000..549eeca --- /dev/null +++ b/lisp/seam-export.el @@ -0,0 +1,490 @@ +;;; seam-export.el --- Seam HTML exporter -*- lexical-binding: t -*- + +;; Copyright (C) 2025 Spencer Williams + +;; Author: Spencer Williams <spnw@plexwave.org> + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is not part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Frontend for Seam's HTML exporter. + +;;; Code: + +(require 'cl-lib) +(require 'mustache) +(require 'ox-ascii) +(require 'ox-org) +(require 'time-date) +(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--ignore-same-day-modifications nil) +(defvar seam-export--internal-link-class nil) +(defvar seam-export--backend-options nil) + +(defgroup seam-export nil + "Options for Seam exporter." + :tag "Seam Export" + :group 'seam) + +(defcustom seam-export-alist nil + "Association list used by Seam to determine how to export notes. + +The car of each element is an HTML directory to which Seam will export a +subset of notes. The cdr is a plist containing any number of these +properties: + + `:types' + + List of note types to export to this directory. Required. + + `: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. + + `: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. + + `: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'. + + `:ignore-same-day-modifications' + + Whether the `modified?' template variable should be false if + creation and modification date are on the same day. Defaults + to the value of `seam-export-ignore-same-day-modifications'. + + `:internal-link-class' + + CSS class name for internal links. Defaults to the value of + `seam-export-internal-link-class'. + + `:backend-options' + + A plist of extra options passed to the Org HTML backend. This can be + used to override any of the defaults set in + `seam-export-backend-options'." + :group 'seam-export + :type '(alist :key-type string :value-type plist)) + +(defcustom seam-export-template-file nil + "The HTML template file to be used by the exporter. The template format +is documented at `seam-export-default-template-string'. + +See `seam-export-alist' for more information about specifying templates." + :group 'seam-export + :type '(choice file (const nil))) + +(defvar seam-export-default-template-string + "<!doctype html> +<html lang=\"en\"> +<head> +<meta charset=\"utf-8\" /> +<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\" /> +<title>{{title}}</title> +</head> +<body> +<main> +<header> +<h1>{{{raw-title}}}</h1> +<p class=\"modified\">Last modified: <time datetime=\"{{modified-dt}}\">{{modified}}</time></p> +</header> +{{{contents}}} +<section class=\"backlinks\"> +<h1>Backlinks</h1> +{{{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 Mustache bracket syntax. {{variable}} +will HTML-escape the interpolated text, while {{{variable}}} will +interpolate it as-is. + + `contents' + + The full HTML contents of the note, sans the title header. + + `title' + + 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. + + `slug' + + The note's slug (that is, its filename without any extension). + + `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 + `seam-export-time-format'. + + `modified-dt' + + The machine-readable date that the note was last modified. + See `seam-export-time-format-dt'. + + `modified?' + + When used as a block, this will render only when the creation + and modification dates are not the same.") + +(defcustom seam-export-template-string seam-export-default-template-string + "The HTML template string to be used by the exporter. The template +format is documented at `seam-export-default-template-string'. + +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-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 + :type 'string) + +(defcustom seam-export-time-zone t + "Time zone used for template time strings. Passed to +`format-time-string'." + :group 'seam-export + :type 'sexp) + +(defcustom seam-export-ignore-same-day-modifications t + "When non-nil, the `modified?' template variable will evaluate to +false if creation and modification date are on the same day.") + +(defcustom seam-export-internal-link-class nil + "CSS class name to use for internal links (i.e., links to other Seam +notes)." + :group 'seam-export + :type 'string) + +(defvar seam-export-backend-options + (list + :html-container "article" + :html-doctype "html5" + :html-html5-fancy t + :html-text-markup-alist + '((bold . "<strong>%s</strong>") + (code . "<code>%s</code>") + (italic . "<em>%s</em>") + (strike-through . "<s>%s</s>") + (underline . "<span class=\"underline\">%s</span>") + (verbatim . "<code>%s</code>")) + :html-toplevel-hlevel 1 + :html-use-infojs nil + :section-numbers nil + :time-stamp-file nil + :with-smart-quotes t + :with-toc nil)) + +(cl-defmacro seam-export--export-to-string ((&key backend) &rest body) + (declare (indent 1)) + (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-export-to-buffer ,backend ,buf nil nil nil t seam-export--backend-options nil))) + (with-current-buffer ,buf + (buffer-string))) + (kill-buffer ,buf))))) + +(defun seam-export--convert-string (backend s) + "Export Org string using the given Org exporter backend." + (seam-export--export-to-string (:backend backend) + (insert s))) + +(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--convert-string 'seam s)))) + +(defun seam-export--org-to-text (s) + "Convert single-line Org string to plain text via Org exporter." + (string-chop-newline + (let ((org-ascii-charset 'utf-8)) + (seam-export--convert-string 'ascii 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--export-to-string (:backend 'seam) + (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))) + #'string< + :key #'car))) + (when files + (cl-loop for (title . file) in files + do (insert (format "- [[seam:%s][%s]]\n" (file-name-base file) title))))))) + +;;; This was copied from time-date.el, with the addition of a ZONE +;;; argument. +(defun seam-export--time-to-days (time &optional zone) + "The absolute pseudo-Gregorian date for TIME, a time value. +The absolute date is the number of days elapsed since the imaginary +Gregorian date Sunday, December 31, 1 BC." + (let* ((tim (decode-time time zone)) + (year (decoded-time-year tim))) + (+ (time-date--day-in-year tim) ; Days this year + (* 365 (1- year)) ; + Days in prior years + (/ (1- year) 4) ; + Julian leap years + (- (/ (1- year) 100)) ; - century years + (/ (1- year) 400)))) + +(defun seam-export--note-to-html (note-file html-directory) + (seam-ensure-directory-exists html-directory) + (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))) + ("slug" . + ,(seam-get-slug-from-file-name 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 (cond + (seam-export--ignore-same-day-modifications + (= (seam-export--time-to-days + created + seam-export--time-zone) + (seam-export--time-to-days + modified + seam-export--time-zone))) + (t + (equal created modified))) + (mustache-render template context)))) + ("contents" . + ,(seam-export--export-to-string (:backend 'seam) + (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 + (insert-file-contents file) + (buffer-string))) + +(defun seam-export-note (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-values (plist-get plist :template-values))) + (unless types + (error "You must specify :types for export")) + (let ((template + (cond + (template-file (seam-export--file-string template-file)) + (template-string template-string) + (seam-export-template-file (seam-export--file-string + 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 (and (member type types) + (or (not (seam-draft-p file)) + (plist-get plist :include-drafts))) + (let ((seam-export--types types) + (seam-export--root-path (cl-getf 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 + (cl-getf plist + :time-format + seam-export-time-format)) + (seam-export--time-format-dt + (cl-getf plist + :time-format-dt + seam-export-time-format-dt)) + (seam-export--time-zone + (cl-getf plist + :time-zone + seam-export-time-zone)) + (seam-export--ignore-same-day-modifications + (cl-getf plist + :ignore-same-day-modifications + seam-export-ignore-same-day-modifications)) + (seam-export--internal-link-class + (cl-getf plist + :internal-link-class + seam-export-internal-link-class)) + (seam-export--backend-options + (org-combine-plists + seam-export-backend-options + (plist-get plist :backend-options)))) + (seam-export--note-to-html file dir)))))))) + +(defun seam-export-all-notes () + "Export all note files as HTML." + (interactive) + (unless seam-export-alist + (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) + +;;; seam-export.el ends here diff --git a/seam-html.el b/lisp/seam-html.el index 018e56f..57cd9b9 100644 --- a/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/seam-test.el b/lisp/seam-test.el index 7d10f94..5bae015 100644 --- a/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,9 +228,23 @@ (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 () + "Test that updating the contents of a note does not unnecessarily +re-export note to which it links." + (should-not + (member + "html/bar.html" + (seam-test-with-notes () + ((foo "foo" "public") + (bar "bar" "public")) + (seam-test-add-contents foo (seam-test-link-to-buffer bar)) + (delete-file "html/bar.html") + (seam-test-add-contents foo "hello") + (seam-test-list-files))))) + (ert-deftest seam-test-link-to-private () "Test that a private link does not get exported in HTML." (should-error @@ -238,8 +258,8 @@ (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 @@ -256,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")) @@ -283,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")) @@ -305,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 @@ -320,33 +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\">"))))) + (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 (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") + (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")) @@ -384,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 @@ -399,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")) @@ -416,14 +511,75 @@ 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." + (should + (equal + '("html/c-vs-cpp.html" "public/c-vs-cpp.org") + (seam-test-with-notes () + ((note "C vs C++" "public")) + (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 @@ -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 string)) + :type '(repeat + (choice string + (alist :key-type string :value-type plist)))) -(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))) +(defcustom seam-create-as-draft nil + "When non-nil, new Seam notes will be created as drafts." + :group 'seam + :type 'boolean) + +(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 @@ -70,21 +91,31 @@ naming. Must be a function taking two arguments: TITLE and TYPE." (defun seam-html-directories () (mapcar #'car seam-export-alist)) -(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)))))) +(defun seam-slugify (title) + (setq title (string-replace "'" "" title)) + (setq title (string-split title "\\W+" t)) + (setq title (string-join title "-")) + (downcase title)) -(defun seam--check-conflict (title) - (when (seam-lookup-slug (seam-slugify title)) - (error "`%s' would conflict with an existing note" title))) +(defun seam-lookup-slug (slug) + (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) + (error "A note called `%s.org' already exists" slug))) (defun seam-link-open (path _prefix) (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\\'") @@ -102,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)))) @@ -112,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))) @@ -153,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))))) @@ -166,26 +199,44 @@ naming. Must be a function taking two arguments: TITLE and TYPE." (insert-file-contents file) (seam-get-title-from-buffer))) -(defun seam-format-title (title type) - (funcall seam-title-formatter title type)) +(defun seam-get-slug-from-file-name (file) + (string-remove-prefix "-" (file-name-base file))) -(defun seam--completing-read (&rest args) - (let ((completion-ignore-case t)) - (apply seam-completing-read-function args))) +(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) + (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-slugify (title) - (downcase (string-join (string-split title "\\W+" t) "-"))) +(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-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)) - (unless (member type seam-note-types) - (error "`%s' is not a valid Seam note type" type)) + (seam-validate-note-type type) (seam-ensure-note-subdirectories-exist) - (let ((file (file-name-concat seam-note-directory - type - (concat (seam-slugify title) ".org")))) - (seam--check-conflict title) + (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 (when draft-p "-") slug ".org")))) + (when (string= "" slug) + (error "Cannot create a note with an empty slug")) + (seam--check-conflict slug) (let ((buffer (funcall (if select #'find-file #'find-file-noselect) file))) (with-current-buffer buffer (insert (format "* %s\n" title)) @@ -202,16 +253,27 @@ 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)))) - (let ((completion (string-trim (seam--completing-read prompt files)))) + 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))))))) (defun seam--read-type (prompt arg &optional choices) (when arg (if (listp arg) - (seam--completing-read prompt (or choices seam-note-types) nil t) - (nth (1- arg) seam-note-types)))) + (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-get-all-note-type-names))))) ;;;###autoload (defun seam-find-note (arg) @@ -225,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 @@ -234,101 +296,145 @@ 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." + (let ((links (with-current-buffer buffer + (save-mark-and-excursion + (save-restriction + (widen) + (goto-char 1) + (delete-dups + (cl-loop for ret = (re-search-forward "\\[\\[seam:\\(.*?\\)\\]" nil t) + while ret collect (match-string 1)))))))) + (let ((file (buffer-file-name buffer))) + (remove (and file (expand-file-name file)) + (cl-loop for link in links + as f = (seam-lookup-slug link) + when f collect f))))) (defun seam-get-links-from-file (file) "Return filename of each existing note which is linked to from FILE." - (let ((links - (with-temp-buffer - (insert-file-contents file) - (delete-dups - (cl-loop for ret = (re-search-forward "\\[\\[seam:\\(.*?\\)\\]" nil t) - while ret collect (match-string 1)))))) - (remove (expand-file-name file) - (cl-loop for link in links - as f = (seam-lookup-slug link) - when f collect f)))) + (with-temp-buffer + (insert-file-contents file) + (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))))) - -(defun seam-post-save-or-rename (old new &optional previous-links-from-file) - (unless (string= old new) - (seam-update-links old new) - (seam-delete-html-files-for-note old) + (let ((html-nd (concat (seam-get-slug-from-file-name note-file) ".html"))) (dolist (dir (seam-html-directories)) - (delete-file (file-name-concat dir (concat (file-name-base old) ".html"))))) + (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) (seam-export-note new) - (let ((removed-links (cl-set-difference previous-links-from-file - (seam-get-links-from-file new) - :test #'string=))) - (mapc #'seam-export-note - (delete-dups - (append removed-links - (seam-get-links-from-file new) - ;; If our type changes, we cannot rely on - ;; `seam-update-links' to trigger a re-render of - ;; the pages that link to us, as types are not - ;; encoded in the link. - (unless (string= (seam-get-note-type old) - (seam-get-note-type new)) - (seam-get-links-to-file new))))))) + (let* ((current-links (seam-get-links-from-file new)) + (added-links (cl-set-difference current-links + previous-links-from-file + :test #'string=)) + (removed-links (cl-set-difference previous-links-from-file + current-links + :test #'string=))) + (let ((type-changed + (not (string= (seam-get-note-type old) + (seam-get-note-type new))))) + (mapc #'seam-export-note + (delete-dups + (append + removed-links + + ;; Backlinks sections must be updated when either + ;; slug or title changes. + (if slug-or-title-changed + current-links + added-links) + + ;; `seam-update-links' inherently triggers + ;; re-exporting of notes when links change. + ;; However, note type is not encoded in the link, + ;; so we must handle that case manually. + (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 - (let* ((title (or (seam-get-title-from-buffer) - (error "Note must have a title"))) - (slug (seam-slugify title)) - (new (seam-make-file-name slug 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 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 + (not (string= (seam-get-title-from-buffer) + (seam-get-title-from-file old)))))) (unless (string= old new) ;This is valid because ;`seam-save-buffer' cannot - ;change type. - (seam--check-conflict title) + ;change type or draft status. + (seam--check-conflict slug) (rename-file old new) (set-visited-file-name new nil t)) (let ((previous-links-from-file ;; If we've yet to create the file, don't check it. - (when (file-exists-p new) + (unless newly-created-p (seam-get-links-from-file new)))) (let ((write-contents-functions (remove 'seam-save-buffer write-contents-functions))) (save-buffer)) - (seam-post-save-or-rename old new previous-links-from-file) + (seam-post-save-or-rename old + new + previous-links-from-file + (or slug-changed-p title-changed-p)) (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 @@ -345,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) @@ -406,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 ".*") @@ -460,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." @@ -501,12 +620,13 @@ 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 file and kill buffer%s?" + (format "Really %s `%s' and kill buffer%s?" (if delete-by-moving-to-trash "trash" "delete") + (seam-get-title-from-buffer) (if (> incoming 0) (format " (breaking links from %d note%s)" incoming @@ -528,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) @@ -551,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) diff --git a/seam-export.el b/seam-export.el deleted file mode 100644 index c36f97c..0000000 --- a/seam-export.el +++ /dev/null @@ -1,321 +0,0 @@ -;;; seam-export.el --- Seam HTML exporter -*- lexical-binding: t -*- - -;; Copyright (C) 2025 Spencer Williams - -;; Author: Spencer Williams <spnw@plexwave.org> - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is not part of GNU Emacs. - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Frontend for Seam's HTML exporter. - -;;; Code: - -(require 'cl-lib) -(require 'seam-html) - -(defvar seam-export--types nil) -(defvar seam-export--template nil) -(defvar seam-export--root-path nil) -(defvar seam-export--no-extension nil) -(defvar seam-export--internal-link-class nil) -(defvar seam-export--options nil) - -(defgroup seam-export nil - "Options for Seam exporter." - :tag "Seam Export" - :group 'seam) - -(defcustom seam-export-alist nil - "Association list used by Seam to determine how to export notes. - -The car of each element is an HTML directory to which Seam will export a -subset of notes. The cdr is a plist containing any number of these -properties: - - `:types' - - List of note types to export to this directory. Required. - - `: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. - - `: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. - - `:root-path' - - The root path used for rendering internal links. Defaults to \"\", - which means all paths are relative. - - `:no-extension' - - Whether to drop the \".html\" file extension in links. Defaults to - nil. - - `:internal-link-class' - - CSS class name for internal links. Defaults to the value of - `seam-export-internal-link-class'. - - `:backend-options' - - A plist of extra options passed to the Org HTML backend. This can be - used to override any of the defaults set in - `seam-export-backend-options'." - :group 'seam-export - :type '(alist :key-type string :value-type plist)) - -(defcustom seam-export-template-file nil - "The HTML template file to be used by the exporter. The template format -is documented at `seam-export-default-template-string'. - -See `seam-export-alist' for more information about specifying templates." - :group 'seam-export - :type '(choice file (const nil))) - -(defvar seam-export-default-template-string - "<!doctype html> -<html lang=\"en\"> -<head> -<meta charset=\"utf-8\" /> -<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\" /> -<title>{{title}}</title> -</head> -<body> -<main> -<header> -<h1>{{title}}</h1> -<p class=\"modified\">Last modified: <time datetime=\"{{modified-dt}}\">{{modified}}</time></p> -</header> -{{contents}} -<section class=\"backlinks\"> -<h1>Backlinks</h1> -{{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: - - `contents' - - The full HTML contents of the note, sans the title header. - - `title' - - The note's title (HTML-escaped). - - `backlinks' - - A list (<ul>) of notes that link to the given note. - - `modified' - - The human-readable date that the note was last modified. See - `seam-export-time-format'. - - `modified-dt' - - The machine-readable date that the note was last modified. See - `seam-export-time-format-datetime'.") - -(defcustom seam-export-template-string seam-export-default-template-string - "The HTML template string to be used by the exporter. The template -format is documented at `seam-export-default-template-string'. - -See `seam-export-alist' for more information about specifying templates." - :group 'seam-export - :type '(choice string (const nil))) - -(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" - "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 - :type 'string) - -(defcustom seam-export-time-zone t - "Time zone used for template time strings. Passed to -`format-time-string'." - :group 'seam-export - :type 'sexp) - -(defcustom seam-export-internal-link-class nil - "CSS class name to use for internal links (i.e., links to other Seam -notes)." - :group 'seam-export - :type 'string) - -(defvar seam-export-backend-options - (list - :html-container "article" - :html-doctype "html5" - :html-html5-fancy t - :html-text-markup-alist - '((bold . "<strong>%s</strong>") - (code . "<code>%s</code>") - (italic . "<em>%s</em>") - (strike-through . "<s>%s</s>") - (underline . "<span class=\"underline\">%s</span>") - (verbatim . "<code>%s</code>")) - :html-toplevel-hlevel 1 - :html-use-infojs nil - :section-numbers nil - :time-stamp-file nil - :with-smart-quotes t - :with-toc nil)) - -(defmacro seam-export--to-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-export-to-buffer 'seam ,buf nil nil nil t seam-export--options nil))) - (with-current-buffer ,buf - (buffer-string))) - (kill-buffer ,buf))))) - -;;; Some HACK-ery to get fully escaped and smartquote-ized string. -(defun seam-export--escape-string (s) - (string-remove-prefix - "<p>\n" - (string-remove-suffix - "</p>\n" - (seam-export--to-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))) - -(defun seam-export--generate-backlinks (file) - (seam-export--to-string - (let ((files (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<))) - (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)))) - -(defun seam-export--file-string (file) - (with-temp-buffer - (insert-file-contents file) - (buffer-string))) - -(defun seam-export-note (file) - (let ((type (seam-get-note-type 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))) - (unless types - (error "You must specify :types for export")) - (let ((template - (cond - (template-file (seam-export--file-string template-file)) - (template-string template-string) - (seam-export-template-file (seam-export--file-string - 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) - (let ((seam-export--types types) - (seam-export--root-path (or (plist-get plist :root-path) "")) - (seam-export--no-extension (plist-get plist :no-extension)) - (seam-export--template template) - (seam-export--internal-link-class - (or (plist-get plist :internal-link-class) - seam-export-internal-link-class)) - (seam-export--options (org-combine-plists - seam-export-backend-options - (plist-get plist :backend-options)))) - (seam-export--note-to-html file dir)))))))) - -(defun seam-export-all-notes () - "Export all note files as HTML." - (interactive) - (unless seam-export-alist - (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-export-note file)))) - -(provide 'seam-export) - -;;; seam-export.el ends here |