mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

chore(users/sterni/mblog): rename apple-note to mail-note

Browse source 
The type identifier Apple uses is com.apple.mail-note, so “Mail Note” is
actually the best way to refer to this format. Not only doesn't it
include a trademark, but it's also more accurate. The iOS and macOS
Notes.app(s) allow authoring Notes to be saved in iCloud which seems to
use a different API and/or storage format (at least these notes are no
longer accessible via IMAP). In this sense they are “Apple Notes”, but
not “Mail Notes”.

Change-Id: I2fd3d3bd253ed39adf7965008290f7d1e622831d
Reviewed-on: https://cl.tvl.fyi/c/depot/+/12815
Autosubmit: sterni <sternenseemann@systemli.org>
Tested-by: BuildkiteCI
Reviewed-by: sterni <sternenseemann@systemli.org>
This commit is contained in:
sterni 2024-12-25 23:01:07 +01:00 • committed by clbot
parent b8e4da856f
commit 0ead86ec89
6 changed files with 60 additions and 60 deletions
Download patch file Download diff file Expand all files Collapse all files

6
users/sterni/mblog/cli.lisp
View file

@ -1,5 +1,5 @@
;; SPDX-License-Identifier: GPL-3.0-only ;; SPDX-License-Identifier: GPL-3.0-only
;; SPDX-FileCopyrightText: Copyright (C) 2022-2023 by sterni ;; SPDX-FileCopyrightText: Copyright (C) 2022-2024 by sterni
(in-package :cli) (in-package :cli)
(declaim (optimize (safety 3))) (declaim (optimize (safety 3)))
@ -24,8 +24,8 @@
"Convert all note mime messages given as ARGS to HTML fragments." "Convert all note mime messages given as ARGS to HTML fragments."
(declare (ignore name flags)) (declare (ignore name flags))
(loop for arg in args (loop for arg in args
do (note:apple-note-html-fragment do (mail-note-html-fragment
(note:make-apple-note (mime:mime-message (pathname arg))) (make-mail-note (mime:mime-message (pathname arg)))
*standard-output*))) *standard-output*)))
(defun mblog (name flags maildir outdir) (defun mblog (name flags maildir outdir)

6
users/sterni/mblog/default.nix
View file

@ -1,5 +1,5 @@
# SPDX-License-Identifier: GPL-3.0-only # SPDX-License-Identifier: GPL-3.0-only
# SPDX-FileCopyrightText: Copyright (C) 2022-2023 by sterni # SPDX-FileCopyrightText: Copyright (C) 2022-2024 by sterni
{ depot, pkgs, ... }: { depot, pkgs, ... }:
(depot.nix.buildLisp.program { (depot.nix.buildLisp.program {
@ -9,8 +9,8 @@
./packages.lisp ./packages.lisp
./config.lisp ./config.lisp
./maildir.lisp ./maildir.lisp
./transformer.lisp ./mail-note/html-transformer.lisp
./note.lisp ./mail-note/note.lisp
./mblog.lisp ./mblog.lisp
./cli.lisp ./cli.lisp
]; ];

12
users/sterni/mblog/transformer.lisp → users/sterni/mblog/mail-note/html-transformer.lisp
View file

@ -1,7 +1,7 @@
;; SPDX-License-Identifier: GPL-3.0-only ;; SPDX-License-Identifier: GPL-3.0-only
;; SPDX-FileCopyrightText: Copyright (C) 2022 by sterni ;; SPDX-FileCopyrightText: Copyright (C) 2022, 2024 by sterni
(in-package :note) (in-package :mail-note)
(declaim (optimize (safety 3))) (declaim (optimize (safety 3)))
;; Throw away these tags and all of their children ;; Throw away these tags and all of their children
@ -32,7 +32,7 @@
(def-proxy-handler hax:unescaped (data)) (def-proxy-handler hax:unescaped (data))
(def-proxy-handler hax:comment (data))) (def-proxy-handler hax:comment (data)))
(defclass apple-note-transformer (hax-proxy-handler) (defclass mail-note-transformer (hax-proxy-handler)
((cid-lookup ((cid-lookup
:initarg :cid-lookup :initarg :cid-lookup
:initform (lambda (cid) nil) :initform (lambda (cid) nil)
@ -52,7 +52,7 @@
;; Define the “boring” handlers which just call the next method (i. e. the next ;; Define the “boring” handlers which just call the next method (i. e. the next
;; handler) unless discard-until is not nil in which case the event is dropped. ;; handler) unless discard-until is not nil in which case the event is dropped.
(macrolet ((def-filter-handler (name (&rest args)) (macrolet ((def-filter-handler (name (&rest args))
`(defmethod ,name ((h apple-note-transformer) ,@args) `(defmethod ,name ((h mail-note-transformer) ,@args)
(when (not (transformer-discard-until h)) (when (not (transformer-discard-until h))
(call-next-method))))) (call-next-method)))))
(def-filter-handler hax:start-document (name p-id s-id)) (def-filter-handler hax:start-document (name p-id s-id))
@ -70,7 +70,7 @@
:return-suffix t :test #'char=) :return-suffix t :test #'char=)
(if starts-with-cid-p suffix data)))) (if starts-with-cid-p suffix data))))
(defmethod hax:start-element ((handler apple-note-transformer) name attrs) (defmethod hax:start-element ((handler mail-note-transformer) name attrs)
(with-accessors ((discard-until transformer-discard-until) (with-accessors ((discard-until transformer-discard-until)
(next-handler proxy-next-handler) (next-handler proxy-next-handler)
(cid-lookup transformer-cid-lookup) (cid-lookup transformer-cid-lookup)
@ -109,7 +109,7 @@
(t (call-next-method))) (t (call-next-method)))
(setf depth (1+ depth)))) (setf depth (1+ depth))))
(defmethod hax:end-element ((handler apple-note-transformer) name) (defmethod hax:end-element ((handler mail-note-transformer) name)
(with-accessors ((discard-until transformer-discard-until) (with-accessors ((discard-until transformer-discard-until)
(depth transformer-depth)) (depth transformer-depth))
handler handler

54
users/sterni/mblog/note.lisp → users/sterni/mblog/mail-note/note.lisp
View file

@ -1,7 +1,7 @@
;; SPDX-License-Identifier: GPL-3.0-only ;; SPDX-License-Identifier: GPL-3.0-only
;; SPDX-FileCopyrightText: Copyright (C) 2022-2023 by sterni ;; SPDX-FileCopyrightText: Copyright (C) 2022-2024 by sterni
(in-package :note) (in-package :mail-note)
(declaim (optimize (safety 3))) (declaim (optimize (safety 3)))
;;; util ;;; util
@ -15,7 +15,7 @@
do (write-string (who:escape-string-minimal (subseq buf 0 len)) out)))) do (write-string (who:escape-string-minimal (subseq buf 0 len)) out))))
(defun cid-header-value (cid) (defun cid-header-value (cid)
"Takes a Content-ID as present in Apple Notes' <object> tags and properly "Takes a Content-ID as present in Mail Notes' <object> tags and properly
surrounds them with angle brackets for a MIME header" surrounds them with angle brackets for a MIME header"
(concatenate 'string "<" cid ">")) (concatenate 'string "<" cid ">"))
@ -25,49 +25,49 @@
;;; main implementation ;;; main implementation
(defun apple-note-mime-subtype-p (x) (defun mail-note-mime-subtype-p (x)
(member x '("plain" "html") :test #'string-equal)) (member x '("plain" "html") :test #'string-equal))
(deftype apple-note-mime-subtype () (deftype mail-note-mime-subtype ()
'(satisfies apple-note-mime-subtype-p)) '(satisfies mail-note-mime-subtype-p))
(defclass apple-note (mime:mime-message) (defclass mail-note (mime:mime-message)
((text-part ((text-part
:type mime:mime-text :type mime:mime-text
:initarg :text-part :initarg :text-part
:reader apple-note-text-part) :reader mail-note-text-part)
(subject (subject
:type string :type string
:initarg :subject :initarg :subject
:reader apple-note-subject) :reader mail-note-subject)
(uuid (uuid
:type string :type string
:initarg :uuid :initarg :uuid
:reader apple-note-uuid) :reader mail-note-uuid)
(time (time
:type integer :type integer
:initarg :time :initarg :time
:reader apple-note-time) :reader mail-note-time)
(mime-subtype (mime-subtype
:type apple-note-mime-subtype :type mail-note-mime-subtype
:initarg :mime-subtype :initarg :mime-subtype
:reader apple-note-mime-subtype)) :reader mail-note-mime-subtype))
(:documentation (:documentation
"Representation of a Note created using Apple's Notes via the IMAP backend")) "Representation of a Mail Note, e.g. created using Apple's Notes App via the IMAP backend"))
(defun apple-note-p (msg) (defun mail-note-p (msg)
"Checks X-Uniform-Type-Identifier of a MIME:MIME-MESSAGE "Checks X-Uniform-Type-Identifier of a MIME:MIME-MESSAGE
to determine if a given mime message claims to be an Apple Note." to determine if a given mime message claims to be an (Apple) Mail Note."
(when-let (uniform-id (car (mime:mime-message-header-values (when-let (uniform-id (car (mime:mime-message-header-values
"X-Uniform-Type-Identifier" "X-Uniform-Type-Identifier"
msg))) msg)))
(string-equal uniform-id "com.apple.mail-note"))) (string-equal uniform-id "com.apple.mail-note")))
(defun make-apple-note (msg) (defun make-mail-note (msg)
(check-type msg mime-message) (check-type msg mime-message)
(unless (apple-note-p msg) (unless (mail-note-p msg)
(error "Passed message is not an Apple Note according to headers")) (error "Passed message is not a Mail Note according to headers"))
(let ((text-part (mime:find-mime-text-part msg)) (let ((text-part (mime:find-mime-text-part msg))
(subject (car (mime:mime-message-header-values "Subject" msg :decode t))) (subject (car (mime:mime-message-header-values "Subject" msg :decode t)))
@ -78,16 +78,16 @@
(time (find-mime-message-date msg))) (time (find-mime-message-date msg)))
;; The idea here is that we don't need to check a lot manually, instead ;; The idea here is that we don't need to check a lot manually, instead
;; the type annotation are going to do this for us (with sufficient safety?) ;; the type annotation are going to do this for us (with sufficient safety?)
(change-class msg 'apple-note (change-class msg 'mail-note
:text-part text-part :text-part text-part
:subject subject :subject subject
:uuid uuid :uuid uuid
:time time :time time
:mime-subtype (mime:mime-subtype text-part)))) :mime-subtype (mime:mime-subtype text-part))))
(defgeneric apple-note-html-fragment (note out) (defgeneric mail-note-html-fragment (note out)
(:documentation (:documentation
"Takes an APPLE-NOTE and writes its text content as HTML to "Takes an MAIL-NOTE and writes its text content as HTML to
the OUT stream. The <object> tags are resolved to <img> which the OUT stream. The <object> tags are resolved to <img> which
refer to the respective attachment's filename as a relative path, refer to the respective attachment's filename as a relative path,
but extraction of the attachments must be done separately. The but extraction of the attachments must be done separately. The
@ -95,19 +95,19 @@
discarded completely, so only a fragment which can be included discarded completely, so only a fragment which can be included
in custom templates remains.")) in custom templates remains."))
(defmethod apple-note-html-fragment ((note apple-note) (out stream)) (defmethod mail-note-html-fragment ((note mail-note) (out stream))
(let ((text (apple-note-text-part note))) (let ((text (mail-note-text-part note)))
(cond (cond
;; notemap creates text/plain notes we need to handle properly. ;; notemap creates text/plain notes we need to handle properly.
;; Additionally we *could* check X-Mailer which notemap sets ;; Additionally we *could* check X-Mailer which notemap sets
((string-equal (apple-note-mime-subtype note) "plain") ((string-equal (mail-note-mime-subtype note) "plain")
(html-escape-stream (mime:mime-body-stream text) out)) (html-escape-stream (mime:mime-body-stream text) out))
;; Notes.app creates text/html parts ;; Notes.app creates text/html parts
((string-equal (apple-note-mime-subtype note) "html") ((string-equal (mail-note-mime-subtype note) "html")
(closure-html:parse (closure-html:parse
(mime:mime-body-stream text) (mime:mime-body-stream text)
(make-instance (make-instance
'apple-note-transformer 'mail-note-transformer
:cid-lookup :cid-lookup
(lambda (cid) (lambda (cid)
(when-let* ((part (mime:find-mime-part-by-id note (cid-header-value cid))) (when-let* ((part (mime:find-mime-part-by-id note (cid-header-value cid)))

20
users/sterni/mblog/mblog.lisp
View file

@ -1,5 +1,5 @@
;; SPDX-License-Identifier: GPL-3.0-only ;; SPDX-License-Identifier: GPL-3.0-only
;; SPDX-FileCopyrightText: Copyright (C) 2022-2023 by sterni ;; SPDX-FileCopyrightText: Copyright (C) 2022-2024 by sterni
;; SPDX-FileCopyrightText: Copyright (C) 2006-2010 by Walter C. Pelissero ;; SPDX-FileCopyrightText: Copyright (C) 2006-2010 by Walter C. Pelissero
(in-package :mblog) (in-package :mblog)
@ -73,13 +73,13 @@ a:link, a:visited {
"Convert NOTE to HTML and write it to index.html in NOTE-DIR alongside any "Convert NOTE to HTML and write it to index.html in NOTE-DIR alongside any
extra attachments NOTE contains." extra attachments NOTE contains."
(with-overwrite-file (html-stream (merge-pathnames "index.html" note-dir)) (with-overwrite-file (html-stream (merge-pathnames "index.html" note-dir))
(render-page (html-stream (apple-note-subject note)) (render-page (html-stream (mail-note-subject note))
(:article (:article
(apple-note-html-fragment note html-stream)))) (mail-note-html-fragment note html-stream))))
(mime:do-parts (part note) (mime:do-parts (part note)
(unless (string= (mime:mime-id part) (unless (string= (mime:mime-id part)
(mime:mime-id (note:apple-note-text-part note))) (mime:mime-id (mail-note-text-part note)))
(let ((attachment-in (mime:mime-body-stream part)) (let ((attachment-in (mime:mime-body-stream part))
(attachment-dst (merge-pathnames (attachment-dst (merge-pathnames
(mime:mime-part-file-name part) (mime:mime-part-file-name part)
@ -106,11 +106,11 @@ a:link, a:visited {
(dolist (note notes-list) (dolist (note notes-list)
(who:htm (who:htm
(:tr (:tr
(:td (:a :href (who:escape-string (apple-note-uuid note)) (:td (:a :href (who:escape-string (mail-note-uuid note))
(who:esc (apple-note-subject note)))) (who:esc (mail-note-subject note))))
(:td (who:esc (:td (who:esc
(klatre:format-dottime (klatre:format-dottime
(universal-to-timestamp (apple-note-time note))))))))))) (universal-to-timestamp (mail-note-time note)))))))))))
(values)) (values))
(defun build-mblog (notes-dir html-dir) (defun build-mblog (notes-dir html-dir)
@ -124,10 +124,10 @@ a:link, a:visited {
(let ((all-notes '())) (let ((all-notes '()))
(dolist (message-path (maildir:list notes-dir)) (dolist (message-path (maildir:list notes-dir))
(let* ((note (make-apple-note (mime:mime-message message-path))) (let* ((note (make-mail-note (mime:mime-message message-path)))
(note-dir (merge-pathnames (make-pathname (note-dir (merge-pathnames (make-pathname
:directory :directory
`(:relative ,(apple-note-uuid note))) `(:relative ,(mail-note-uuid note)))
html-dir))) html-dir)))
(format *error-output* "Writing note message ~A to ~A~%" (format *error-output* "Writing note message ~A to ~A~%"
@ -137,7 +137,7 @@ a:link, a:visited {
(push note all-notes))) (push note all-notes)))
;; reverse sort the entries by time for the index page ;; reverse sort the entries by time for the index page
(setf all-notes (sort all-notes #'> :key #'apple-note-time)) (setf all-notes (sort all-notes #'> :key #'mail-note-time))
(build-index-page all-notes (merge-pathnames "index.html" html-dir)) (build-index-page all-notes (merge-pathnames "index.html" html-dir))

22
users/sterni/mblog/packages.lisp
View file

@ -1,5 +1,5 @@
;; SPDX-License-Identifier: GPL-3.0-only ;; SPDX-License-Identifier: GPL-3.0-only
;; SPDX-FileCopyrightText: Copyright (C) 2022-2023 by sterni ;; SPDX-FileCopyrightText: Copyright (C) 2022-2024 by sterni
(defpackage :maildir (defpackage :maildir
(:use :common-lisp) (:use :common-lisp)
@ -17,7 +17,7 @@
:init-from-env :init-from-env
:*general-buffer-size*)) :*general-buffer-size*))
(defpackage :note (defpackage :mail-note
(:use (:use
:common-lisp :common-lisp
:closure-html :closure-html
@ -32,13 +32,13 @@
:ends-with-subseq) :ends-with-subseq)
(:import-from :who :escape-string-minimal) (:import-from :who :escape-string-minimal)
(:export (:export
:apple-note :mail-note
:apple-note-uuid :mail-note-uuid
:apple-note-subject :mail-note-subject
:apple-note-time :mail-note-time
:apple-note-text-part :mail-note-text-part
:make-apple-note :make-mail-note
:apple-note-html-fragment)) :mail-note-html-fragment))
(defpackage :mblog (defpackage :mblog
(:use (:use
@ -46,7 +46,7 @@
:klatre :klatre
:who :who
:maildir :maildir
:note :mail-note
:config) :config)
(:export :build-mblog) (:export :build-mblog)
(:import-from :local-time :universal-to-timestamp) (:import-from :local-time :universal-to-timestamp)
@ -57,7 +57,7 @@
(:use (:use
:common-lisp :common-lisp
:uiop :uiop
:note :mail-note
:config :config
:mblog) :mblog)
(:import-from :alexandria :starts-with) (:import-from :alexandria :starts-with)