From a4473bffc429eee3dc06eb71c1996ba575380766 Mon Sep 17 00:00:00 2001 From: Cytrogen Date: Wed, 11 Mar 2026 19:18:42 -0400 Subject: [PATCH] =?UTF-8?q?feat(blog):=20=E6=B7=BB=E5=8A=A0=E5=AE=8C?= =?UTF-8?q?=E6=95=B4=E5=8D=9A=E5=AE=A2=E5=B7=A5=E4=BD=9C=E6=B5=81=EF=BC=9A?= =?UTF-8?q?=E6=9C=88=E5=88=8A=E3=80=81=E5=A4=9A=E6=A0=BC=E5=BC=8F=E5=AF=BC?= =?UTF-8?q?=E5=87=BA=E3=80=81Webmention?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 月刊系统: 中国传统历法命名（天干地支 + 月份），自动创建/打开 当月文件，inbox 条目批量转入月刊 Hexo 导出: Org → Markdown 转换，自动生成目录，支持 Hexo 块标签 （{% note %}、{% em %}），图片插入与优化 Gemini 导出: Org → gemtext 转换，ASCII art 格式化，链接重排， Capsule 首页索引生成，Mastodon URL 集成 Webmention 集成: require webmention.el（显式路径加载）， 发布后通知被引用站点 内容处理: 标题 slugify、引用来源提取、结构解析、 自定义链接类型（em 着重号、ruby 注音） --- config/pkg-blog.el | 1265 ++++++++++++++++++++++++++++++++++++++------ 1 file changed, 1099 insertions(+), 166 deletions(-) diff --git a/config/pkg-blog.el b/config/pkg-blog.el index d1e9f1f7058857e8b2536da0a001a5ec607ad11e..ddee5f9791d62839f4bdde945be1daf345fa7167 100644 --- a/config/pkg-blog.el +++ b/config/pkg-blog.el @@ -1,6 +1,6 @@ ;;; pkg-blog.el --- Blog workflow for monthly posts -*- lexical-binding: t -*- -;; Copyright (C) 2024 Cytrogen +;; Copyright (C) 2026 Cytrogen ;; This file contains: ;; - Monthly blog post creation and management @@ -38,6 +38,16 @@ :type 'directory :group 'my/blog) +(defcustom my/blog-gemini-dir "~/Projects/gemini/" + "Directory for Gemini capsule files (.gmi)." + :type 'directory + :group 'my/blog) + +(defcustom my/blog-mastodon-url "https://m.otter.homes/@Cytrogen" + "Mastodon profile URL for Gemini diary section." + :type 'string + :group 'my/blog) + ;;; Dynamic Directory Setup (defvar my/blog-dirs-config-file (concat user-emacs-directory ".blog-dirs") @@ -47,8 +57,9 @@ "Load Blog directories from config file or prompt user." (let ((source-dir nil) (export-dir nil) + (gemini-dir nil) (config-changed nil)) - + ;; 1. Try to read from file (when (file-exists-p my/blog-dirs-config-file) (with-temp-buffer @@ -62,32 +73,42 @@ ((string-match "^SOURCE=\\(.*\\)" line) (setq source-dir (string-trim (match-string 1 line)))) ((string-match "^EXPORT=\\(.*\\)" line) - (setq export-dir (string-trim (match-string 1 line)))))) + (setq export-dir (string-trim (match-string 1 line)))) + ((string-match "^GEMINI=\\(.*\\)" line) + (setq gemini-dir (string-trim (match-string 1 line)))))) (forward-line 1))))) - + ;; 2. Validate Source Dir (unless (and source-dir (file-directory-p source-dir)) (setq source-dir (read-directory-name "请选择博客 Org 源码目录 (Select Blog Source Dir): " (bound-and-true-p org-directory))) (unless (file-directory-p source-dir) (make-directory source-dir t)) (setq config-changed t)) - + ;; 3. Validate Export Dir (unless (and export-dir (file-directory-p export-dir)) (setq export-dir (read-directory-name "请选择博客发布目录 (Select Blog Export Dir, e.g. source/_posts): " "D:/")) (unless (file-directory-p export-dir) (make-directory export-dir t)) (setq config-changed t)) - - ;; 4. Save if changed + + ;; 4. Validate Gemini Dir + (unless (and gemini-dir (file-directory-p gemini-dir)) + (setq gemini-dir (read-directory-name "请选择 Gemini capsule 目录 (Select Gemini Dir): " "~/Projects/")) + (unless (file-directory-p gemini-dir) + (make-directory gemini-dir t)) + (setq config-changed t)) + + ;; 5. Save if changed (when config-changed (with-temp-file my/blog-dirs-config-file - (insert (format "SOURCE=%s\nEXPORT=%s\n" source-dir export-dir)))) - - ;; 5. Apply settings + (insert (format "SOURCE=%s\nEXPORT=%s\nGEMINI=%s\n" source-dir export-dir gemini-dir)))) + + ;; 6. Apply settings (setq my/blog-org-dir (file-name-as-directory source-dir)) (setq my/blog-export-dir (file-name-as-directory export-dir)) - (message "Blog directories loaded.\nSource: %s\nExport: %s" my/blog-org-dir my/blog-export-dir))) + (setq my/blog-gemini-dir (file-name-as-directory gemini-dir)) + (message "Blog directories loaded.\nSource: %s\nExport: %s\nGemini: %s" my/blog-org-dir my/blog-export-dir my/blog-gemini-dir))) ;; Execute setup immediately (my/setup-blog-directories) @@ -95,8 +116,15 @@ (defcustom my/blog-monthly-sections '(("商业与社会" . "商业与社会") ("心理与关系" . "心理与关系") + ("科学与自然" . "科学与自然") ("技术与创造" . "技术与创造") ("技术与创造/有趣项目" . "有趣项目") + ("折腾博客" . "折腾博客") + ("编程历程" . "编程历程") + ("书籍" . "书籍") + ("影视" . "影视") + ("音乐" . "音乐") + ("日记片段" . "日记片段") ("生活与文娱" . "生活与文娱")) "Sections available in monthly posts. Format: ((display . headline) ...)." :type '(alist :key-type string :value-type string) @@ -167,10 +195,32 @@ "Convert TEXT to URL-friendly slug." (let ((slug text)) (setq slug (replace-regexp-in-string "[《》「」『』【】]" "" slug)) - (setq slug (replace-regexp-in-string "[[:punct:]]" "" slug)) + (setq slug (replace-regexp-in-string "[[:punct:]]" " " slug)) (setq slug (replace-regexp-in-string "[[:space:]]+" "-" slug)) + (setq slug (replace-regexp-in-string "\\`-\\|-\\'" "" slug)) (downcase slug))) +(defun my/blog--clean-title-for-md (title) + "Convert org inline markup in TITLE for markdown display." + (let ((result title)) + ;; Single pass: =...= and ~...~ → backtick (first marker wins) + (while (string-match "\\(?:=\\([^ =\n]\\(?:[^=\n]*[^ =\n]\\)?\\)=\\)\\|\\(?:~\\([^ ~\n]\\(?:[^~\n]*[^ ~\n]\\)?\\)~\\)" result) + (let ((text (or (match-string 1 result) (match-string 2 result)))) + (setq result (replace-match (format "`%s`" text) t t result)))) + result)) + +(defun my/blog--clean-title-for-gmi (title) + "Strip org inline markup from TITLE for gemtext display." + (let ((result title)) + ;; Single pass: =...= and ~...~ → plain text (first marker wins) + (while (string-match "\\(?:=\\([^ =\n]\\(?:[^=\n]*[^ =\n]\\)?\\)=\\)\\|\\(?:~\\([^ ~\n]\\(?:[^~\n]*[^ ~\n]\\)?\\)~\\)" result) + (let ((text (or (match-string 1 result) (match-string 2 result)))) + (setq result (replace-match text t t result)))) + (setq result (replace-regexp-in-string "\\*\\([^ *\n]\\(?:[^*\n]*[^ *\n]\\)?\\)\\*" "\\1" result)) + (setq result (replace-regexp-in-string "/\\([^ /\n]\\(?:[^/\n]*[^ /\n]\\)?\\)/" "\\1" result)) + (setq result (replace-regexp-in-string "_{\\([^}\n]+\\)}_" "\\1" result)) + result)) + (defun my/blog--collect-monthly-posts (year month) "Scan _posts directory and return posts from YEAR-MONTH. Returns list of (title . url) pairs." @@ -324,21 +374,21 @@ Prompts for month name and year." ;;; Refile to Monthly (defun my/blog-refile-to-monthly () - "Refile current org entry to a section in the current monthly." + "Refile current org entry to a section in a monthly file. +Prompts for target monthly file and section." (interactive) (unless (org-at-heading-p) (org-back-to-heading t)) - (let* ((monthly-file (my/blog--current-monthly-file)) + (let* ((monthly-dir (my/blog--monthly-dir-full)) + (files (and (file-directory-p monthly-dir) + (directory-files monthly-dir nil "^[0-9]\\{4\\}-[0-9]\\{2\\}\\.org$"))) + (choice (completing-read "Monthly file: " (reverse files) nil t)) + (monthly-file (expand-file-name choice monthly-dir)) (sections (mapcar #'car my/blog-monthly-sections)) (target-selection (completing-read "Refile to section: " sections nil t)) - ;; Get the actual headline from the alist (handles paths like "技术与创造/有趣项目") (target-headline (cdr (assoc target-selection my/blog-monthly-sections)))) - ;; Ensure monthly file exists - (unless (file-exists-p monthly-file) - (my/blog-create-monthly)) - ;; Special handling for "有趣项目" - convert to list item (if (string= target-headline "有趣项目") (my/blog--refile-as-list-item monthly-file target-headline) @@ -346,7 +396,8 @@ Prompts for month name and year." (let* ((entry-title (org-get-heading t t t t)) (custom-id (my/blog--slugify entry-title))) (org-set-property "CUSTOM_ID" custom-id) - (let ((org-refile-targets `((,monthly-file :maxlevel . 3)))) + (let ((org-refile-targets `((,monthly-file :maxlevel . 3))) + (org-reverse-note-order t)) (org-refile nil nil (list target-headline monthly-file nil (with-current-buffer (find-file-noselect monthly-file) @@ -372,6 +423,7 @@ Prompts for month name and year." (format "- %s: %s" title content))))) ;; Delete original entry (org-cut-subtree) + (save-buffer) ;; Insert as list item in target (with-current-buffer (find-file-noselect file) (goto-char (point-min)) @@ -402,6 +454,34 @@ Prompts for month name and year." (when (re-search-forward (format "^#\\+%s:[ \t]*\\(.*\\)$" prop) nil t) (string-trim (match-string-no-properties 1))))) +(defun my/blog--extract-source-from-content (content) + "Extract source URL and date from CONTENT end. +Returns plist (:source URL :date DATE) or nil if not found." + (let ((source nil) + (date nil)) + ;; Match source: URL at end of content + (when (string-match "source:\\s-*\\(https?://[^\n]+\\)\\s-*$" content) + (setq source (string-trim (match-string 1 content)))) + ;; Match org timestamp [YYYY-MM-DD ...] + (when (string-match "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^]]*\\)\\]\\s-*$" content) + (setq date (match-string 1 content))) + (when (or source date) + (list :source source :date date)))) + +(defun my/blog--strip-source-from-content (content) + "Remove source line and date line from CONTENT end. +Returns cleaned content string." + (let ((result (string-trim-right content))) + ;; Remove org timestamp line at end (e.g. [2026-01-25 Sun 01:13]) + (setq result (replace-regexp-in-string + "[\n\r]*\\[?[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^]\n]*\\]?[ \t]*\\'" + "" result)) + ;; Remove source: URL line at end + (setq result (replace-regexp-in-string + "[\n\r]*source:[ \t]*https?://[^\n]+[ \t]*\\'" + "" result)) + (string-trim result))) + (defun my/blog--collect-structure (buffer) "Collect document structure from org BUFFER. Returns list of (level title properties content subsections)." @@ -434,8 +514,14 @@ Returns list of (level title properties content subsections)." (begin (org-element-property :contents-begin hl)) (end (org-element-property :contents-end hl)) (props (org-entry-properties (org-element-property :begin hl))) - (source (cdr (assoc "SOURCE" props))) - (custom-id (cdr (assoc "CUSTOM_ID" props))) + (source (let ((s (or (cdr (assoc "SOURCE" props)) + (cdr (assoc "URL" props))))) + (when (and s (not (string-empty-p s))) s))) + (custom-id (let ((id (cdr (assoc "CUSTOM_ID" props)))) + (when id + (let ((cleaned (string-trim + (replace-regexp-in-string "[[:cntrl:]]" "" id)))) + (unless (string-empty-p cleaned) cleaned))))) (content "")) ;; Get content (only direct content, not sub-headlines) ;; Skip PROPERTIES drawer @@ -452,10 +538,18 @@ Returns list of (level title properties content subsections)." end))) (setq content (string-trim (buffer-substring-no-properties content-start content-end)))))) + ;; For Level 2 headings: extract source from content if no SOURCE property + (when (and (= level 2) (not source) (not (string-empty-p content))) + (let ((extracted (my/blog--extract-source-from-content content))) + (when extracted + (setq source (plist-get extracted :source)) + (setq content (my/blog--strip-source-from-content content))))) (push (list :level level :title title :source source - :custom-id (or custom-id (my/blog--slugify title)) + :custom-id (if (and custom-id (not (string-empty-p custom-id))) + custom-id + (my/blog--slugify title)) :content content) result)))) (list :intro intro-text :sections (reverse result))))) @@ -475,11 +569,14 @@ Returns list of (level title properties content subsections)." (let ((title (plist-get sec :title)) (level (plist-get sec :level)) (slug (plist-get sec :custom-id))) - (when (and (= level 1) (member title input-sections)) - (setq current-section title) - (setq toc (concat toc (format "#### %s\n\n" title)))) + (when (= level 1) + (if (member title input-sections) + (progn + (setq current-section title) + (setq toc (concat toc (format "\n#### %s\n\n" title)))) + (setq current-section nil))) (when (and (= level 2) current-section (member current-section input-sections)) - (setq toc (concat toc (format "- [%s](#%s)\n" title slug)))))) + (setq toc (concat toc (format "- [%s](#%s)\n" (my/blog--clean-title-for-md title) slug)))))) ;; Build 输出 section (setq toc (concat toc "\n## 输出\n\n")) ;; Main output sections (skip empty ones except 我写的文章 which has auto-fill) @@ -488,11 +585,20 @@ Returns list of (level title properties content subsections)." (let ((title (plist-get sec :title)) (level (plist-get sec :level)) (slug (plist-get sec :custom-id)) - (content (plist-get sec :content))) + (content (plist-get sec :content)) + (has-subsections nil)) (when (and (= level 1) (member title output-main-sections)) - ;; Skip if it's skippable and empty + ;; Check if this section has subsections with content + (let ((sec-idx (cl-position sec sections))) + (cl-loop for i from (1+ sec-idx) below (length sections) + for next-sec = (nth i sections) + while (> (plist-get next-sec :level) 1) + when (not (string-empty-p (or (plist-get next-sec :content) ""))) + do (setq has-subsections t))) + ;; Skip if it's skippable, empty, and has no subsections (unless (and (member title skippable) - (or (null content) (string-empty-p content))) + (or (null content) (string-empty-p content)) + (not has-subsections)) (setq toc (concat toc (format "- [%s](#%s)\n" title slug)))))))) ;; 书籍/影视/音乐 special format (dolist (sec sections) @@ -538,6 +644,17 @@ Returns list of (level title properties content subsections)." (setq counter (1+ counter)))))) ;; Step 2: All conversions on non-code content + ;; Remove standalone timestamp lines (e.g. [2026-01-11 Sun 20:03]) + (goto-char (point-min)) + (while (re-search-forward + "^[ \t]*\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)\\( [A-Za-z]\\{2,3\\}\\)?\\( [0-9]\\{2\\}:[0-9]\\{2\\}\\)?\\][ \t]*\n?" nil t) + (replace-match "")) + + ;; Remove #+RESULTS lines (content is wrapped in BEGIN_EXAMPLE) + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*#\\+RESULTS\\(?:\\[.*\\]\\)?:?[ \t]*\n" nil t) + (replace-match "")) + ;; Convert org headings to markdown headings (goto-char (point-min)) (while (re-search-forward "^\\(\\*+\\) " nil t) @@ -545,6 +662,40 @@ Returns list of (level title properties content subsections)." (level (length stars)) (hashes (make-string level ?#))) (replace-match (concat hashes " ")))) + ;; Convert org table separator lines: |---+---| -> |---|---| + (goto-char (point-min)) + (while (re-search-forward "^\\([ \t]*\\)|\\([-+|]+\\)|[ \t]*$" nil t) + (let ((indent (match-string 1)) + (sep (match-string 2))) + (when (string-match-p "+" sep) + (replace-match (concat indent "|" (replace-regexp-in-string "+" "|" sep) "|"))))) + ;; Ensure markdown tables have separator line after header row + (goto-char (point-min)) + (while (not (eobp)) + (if (looking-at "^\\([ \t]*\\)\\(|.*|\\)[ \t]*$") + (let ((indent (match-string 1)) + (header (match-string 2))) + (forward-line 1) + (let ((is-sep (and (looking-at "^[ \t]*\\(|[-| \t:]\\+|\\)[ \t]*$") + (string-match-p "-" (match-string 1))))) + (if is-sep + (forward-line 1) + ;; Count columns and insert separator + (let ((col-count 0) + (pos 0) + (content (substring header 1 -1))) + (while (string-match "|" content pos) + (setq col-count (1+ col-count) + pos (match-end 0))) + (setq col-count (1+ col-count)) + (insert indent "|" + (mapconcat (lambda (_) "---|") (number-sequence 1 col-count) "") + "\n")))) + ;; Skip rest of table rows + (while (and (not (eobp)) + (looking-at "^[ \t]*|.*|[ \t]*$")) + (forward-line 1))) + (forward-line 1))) ;; Convert #+MORE -> (case insensitive) (goto-char (point-min)) (let ((case-fold-search t)) @@ -554,63 +705,187 @@ Returns list of (level title properties content subsections)." (goto-char (point-min)) (while (re-search-forward "\\\\\\\\\\s-*$" nil t) (replace-match "
")) - ;; Convert bold: *text* -> **text** - (goto-char (point-min)) - (while (re-search-forward "\\*\\([^*\n]+\\)\\*" nil t) - (replace-match "**\\1**")) - ;; Convert italic: /text/ -> *text* - (goto-char (point-min)) - (while (re-search-forward "/\\([^/\n]+\\)/" nil t) - (replace-match "*\\1*")) - ;; Convert underline: _text_ -> text - (goto-char (point-min)) - (while (re-search-forward "_\\([^_\n]+\\)_" nil t) - (replace-match "\\1")) - ;; Convert image links BEFORE other link conversions - ;; [[file:path/image.png][alt]] or [[./path/image.png][alt]] → ![alt](image.png) - (goto-char (point-min)) - (while (re-search-forward "\\[\\[\\(?:file:\\|\\.?/\\)?\\([^]]*\\.\\(png\\|jpg\\|jpeg\\|gif\\|webp\\|svg\\)\\)\\]\\[\\([^]]+\\)\\]\\]" nil t) - (replace-match "![\\3](\\1)")) - ;; [[file:image.png]] or [[./image.png]] → ![](image.png) - (goto-char (point-min)) - (while (re-search-forward "\\[\\[\\(?:file:\\|\\.?/\\)?\\([^]]*\\.\\(png\\|jpg\\|jpeg\\|gif\\|webp\\|svg\\)\\)\\]\\]" nil t) - (replace-match "![](\\1)")) - ;; Convert links: [[url][text]] -> [text](url) - (goto-char (point-min)) - (while (re-search-forward "\\[\\[\\([^]]+\\)\\]\\[\\([^]]+\\)\\]\\]" nil t) - (replace-match "[\\2](\\1)")) - ;; Convert plain links: [[url]] -> - (goto-char (point-min)) - (while (re-search-forward "\\[\\[\\([^]]+\\)\\]\\]" nil t) - (replace-match "<\\1>")) - ;; Convert code: ~text~ -> `text` - (goto-char (point-min)) - (while (re-search-forward "~\\([^~\n]+\\)~" nil t) - (replace-match "`\\1`")) - ;; Convert verbatim: =text= -> `text` - (goto-char (point-min)) - (while (re-search-forward "=\\([^=\n]+\\)=" nil t) - (replace-match "`\\1`")) - ;; Convert BEGIN_QUOTE blocks + ;; Step 1.5: Convert and protect links BEFORE text formatting + ;; This prevents underscores in filenames from being converted to + (let ((links '()) + (link-counter 0)) + ;; Convert image links: [[file:path/image.png][alt]] → ![alt](image.png) + (goto-char (point-min)) + (while (re-search-forward "\\[\\[\\(?:file:\\|\\.?/\\)?\\([^]]*\\.\\(png\\|jpg\\|jpeg\\|gif\\|webp\\|svg\\)\\)\\]\\[\\([^]]+\\)\\]\\]" nil t) + (let* ((path (match-string-no-properties 1)) + (alt (match-string-no-properties 3)) + (placeholder (format "<<>>" link-counter)) + (md-link (format "![%s](%s)" alt path))) + (push (cons placeholder md-link) links) + (replace-match placeholder) + (setq link-counter (1+ link-counter)))) + ;; [[file:image.png]] or [[./image.png]] → ![](image.png) + (goto-char (point-min)) + (while (re-search-forward "\\[\\[\\(?:file:\\|\\.?/\\)?\\([^]]*\\.\\(png\\|jpg\\|jpeg\\|gif\\|webp\\|svg\\)\\)\\]\\]" nil t) + (let* ((path (match-string-no-properties 1)) + (placeholder (format "<<>>" link-counter)) + (md-link (format "![](%s)" path))) + (push (cons placeholder md-link) links) + (replace-match placeholder) + (setq link-counter (1+ link-counter)))) + ;; Convert ruby links: [[ruby:reading][text]] -> {% ruby reading %}text{% endruby %} + ;; Must be before general link conversion + (goto-char (point-min)) + (while (re-search-forward "\\[\\[ruby:\\([^]]+\\)\\]\\[\\([^]]+\\)\\]\\]" nil t) + (replace-match "{% ruby \\1 %}\\2{% endruby %}")) + + ;; Convert em links: [[em:text]] -> {% em %}text{% endem %} + ;; Must be before general link conversion + (goto-char (point-min)) + (while (re-search-forward "\\[\\[em:\\([^]]+\\)\\]\\]" nil t) + (replace-match "{% em %}\\1{% endem %}")) + + ;; Convert links: [[url][text]] -> [text](url) + (goto-char (point-min)) + (while (re-search-forward "\\[\\[\\([^]]+\\)\\]\\[\\([^]]+\\)\\]\\]" nil t) + (let* ((url (match-string-no-properties 1)) + (text (match-string-no-properties 2)) + (placeholder (format "<<>>" link-counter)) + (md-link (format "[%s](%s)" text url))) + (push (cons placeholder md-link) links) + (replace-match placeholder) + (setq link-counter (1+ link-counter)))) + + ;; Convert plain links: [[url]] -> + (goto-char (point-min)) + (while (re-search-forward "\\[\\[\\([^]]+\\)\\]\\]" nil t) + (let* ((url (match-string-no-properties 1)) + (placeholder (format "<<>>" link-counter)) + (md-link (format "<%s>" url))) + (push (cons placeholder md-link) links) + (replace-match placeholder) + (setq link-counter (1+ link-counter)))) + + ;; Protect bare URLs and wrap in <> (Markdown autolink) + ;; Strip trailing CJK punctuation that is not part of the URL + (goto-char (point-min)) + (while (re-search-forward "https?://[^] \n\t>)]+" nil t) + (let* ((raw (match-string-no-properties 0)) + (url (replace-regexp-in-string "[。，、；：！？）」』】〉》]+$" "" raw)) + (placeholder (format "<<>>" link-counter)) + (md-link (format "<%s>" url))) + ;; Only replace the URL portion, leave trailing punctuation in place + (replace-match (concat placeholder (substring raw (length url))) t t) + (push (cons placeholder md-link) links) + (setq link-counter (1+ link-counter)))) + + ;; Now do text formatting (links are protected) + ;; Protect code/verbatim with placeholders (like links) + (let ((inline-codes '()) + (code-counter 0) + (math-exprs '()) + (math-counter 0)) + ;; Convert and protect code/verbatim: =text= and ~text~ -> placeholder + ;; Single pass so whichever marker appears first wins (handles ~ inside =...=) + ;; Content must not start/end with space (org emphasis rule) + (goto-char (point-min)) + (while (re-search-forward "\\(?:=\\([^ =\n]\\(?:[^=\n]*[^ =\n]\\)?\\)=\\)\\|\\(?:~\\([^ ~\n]\\(?:[^~\n]*[^ ~\n]\\)?\\)~\\)" nil t) + (let* ((raw-text (or (match-string-no-properties 1) (match-string-no-properties 2))) + (text (replace-regexp-in-string "\\\\slash{}" "/" raw-text)) + (placeholder (format "<<>>" code-counter)) + (md-code (format "`%s`" text))) + (push (cons placeholder md-code) inline-codes) + (replace-match placeholder) + (setq code-counter (1+ code-counter)))) + ;; Protect display math ($$...$$) from text formatting + (goto-char (point-min)) + (while (search-forward "$$" nil t) + (let ((start (- (point) 2))) + (when (search-forward "$$" nil t) + (let* ((end (point)) + (math-text (buffer-substring-no-properties start end)) + (placeholder (format "<<>>" math-counter))) + (push (cons placeholder math-text) math-exprs) + (delete-region start end) + (goto-char start) + (insert placeholder) + (setq math-counter (1+ math-counter)))))) + ;; Protect inline math ($...$) from text formatting + (goto-char (point-min)) + (while (re-search-forward "\\$\\([^$\n]+\\)\\$" nil t) + (let* ((math-text (match-string-no-properties 0)) + (placeholder (format "<<>>" math-counter))) + (push (cons placeholder math-text) math-exprs) + (replace-match placeholder t t) + (setq math-counter (1+ math-counter)))) + ;; Convert bold: *text* -> **text** + (goto-char (point-min)) + (while (re-search-forward "\\*\\([^ *\n]\\(?:[^*\n]*[^ *\n]\\)?\\)\\*" nil t) + (replace-match "**\\1**")) + ;; Convert italic: /text/ -> *text* + (goto-char (point-min)) + (while (re-search-forward "/\\([^ /\n]\\(?:[^/\n]*[^ /\n]\\)?\\)/" nil t) + (replace-match "*\\1*")) + ;; Convert org entity \slash{} -> / (after italic to avoid /text/ false matches) + (goto-char (point-min)) + (while (search-forward "\\slash{}" nil t) + (replace-match "/" t t)) + ;; Convert underline: _{text}_ -> text + (goto-char (point-min)) + (while (re-search-forward "_{\\([^}\n]+\\)}_" nil t) + (replace-match "\\1")) + ;; Restore math expressions + (dolist (math math-exprs) + (goto-char (point-min)) + (when (search-forward (car math) nil t) + (replace-match (cdr math) t t))) + ;; Restore inline codes + (dolist (code inline-codes) + (goto-char (point-min)) + (when (search-forward (car code) nil t) + (replace-match (cdr code) t t)))) + + ;; Restore links + (dolist (link links) + (goto-char (point-min)) + (when (search-forward (car link) nil t) + (replace-match (cdr link) t t)))) + ;; Convert BEGIN_QUOTE blocks to markdown blockquote (supports indented blocks) (goto-char (point-min)) - (while (re-search-forward "^#\\+BEGIN_QUOTE" nil t) - (replace-match "")) + (while (re-search-forward "^\\([ \t]*\\)#\\+BEGIN_QUOTE[ \t]*\n" nil t) + (let ((indent (match-string 1)) + (indent-len (length (match-string 1)))) + (replace-match "") + (let ((start (point))) + (when (re-search-forward (concat "^" (regexp-quote indent) "#\\+END_QUOTE") nil t) + (let ((end (match-beginning 0))) + (save-excursion + (goto-char start) + (while (< (point) end) + ;; Insert "> " after the indent (skip past indent first) + (when (looking-at (regexp-quote indent)) + (goto-char (match-end 0))) + (insert "> ") + (setq end (+ end 2)) + (forward-line 1))) + (goto-char end) + (delete-region (point) (line-end-position)) + (when (looking-at "\n") + (delete-char 1))))))) + ;; Convert BEGIN_EXAMPLE blocks to markdown code blocks (goto-char (point-min)) - (while (re-search-forward "^#\\+END_QUOTE" nil t) - (replace-match "")) - ;; Convert other special blocks to Hexo tags (but not SRC/QUOTE) + (while (re-search-forward "^[ \t]*#\\+BEGIN_EXAMPLE[ \t]*\n" nil t) + (replace-match "```\n") + (when (re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" nil t) + (replace-match "```"))) + ;; Convert other special blocks to Hexo tags (but not SRC/QUOTE/EXAMPLE) (goto-char (point-min)) (while (re-search-forward "^#\\+BEGIN_\\([A-Za-z]+\\)\\(.*\\)$" nil t) (let ((tag (downcase (match-string-no-properties 1))) (args (string-trim (or (match-string-no-properties 2) "")))) - (unless (member tag '("src" "quote")) + (unless (member tag '("src" "quote" "example")) (replace-match (if (string-empty-p args) (format "{%% %s %%}" tag) (format "{%% %s %s %%}" tag args)))))) (goto-char (point-min)) (while (re-search-forward "^#\\+END_\\([A-Za-z]+\\)" nil t) (let ((tag (downcase (match-string-no-properties 1)))) - (unless (member tag '("src" "quote")) + (unless (member tag '("src" "quote" "example")) (replace-match (format "{%% end%s %%}" tag))))) ;; Remove any remaining PROPERTIES drawers @@ -628,12 +903,10 @@ Returns list of (level title properties content subsections)." (while (re-search-forward "\\(\\*\\*\\|`\\|\\) +\\(\\cC\\)" nil t) (replace-match "\\1\\2")) ;; Handle single * (italic) separately to avoid conflict with ** + ;; Remove space between CJK char and opening italic * (goto-char (point-min)) (while (re-search-forward "\\(\\cC\\) +\\(\\*[^*]\\)" nil t) (replace-match "\\1\\2")) - (goto-char (point-min)) - (while (re-search-forward "\\([^*]\\*\\) +\\(\\cC\\)" nil t) - (replace-match "\\1\\2")) ;; Remove space before CJK punctuation (goto-char (point-min)) (while (re-search-forward "\\(\\cC\\|\\*\\*\\|`\\|\\) +\\(\\cP\\)" nil t) @@ -646,6 +919,194 @@ Returns list of (level title properties content subsections)." (replace-match (cdr block) t t)))) (buffer-string))) +(defun my/blog--convert-org-to-gmi (content) + "Convert org CONTENT to gemtext. +Returns (TEXT . LINKS) where TEXT is the gemtext body and +LINKS is a list of (url . label) pairs for => lines." + (with-temp-buffer + (insert content) + (let ((code-blocks '()) + (counter 0) + (collected-links '())) + ;; Step 1: Protect code blocks with placeholders + (goto-char (point-min)) + (while (re-search-forward "^#\\+BEGIN_SRC\\s-*\\(.*\\)$" nil t) + (let ((lang (string-trim (match-string-no-properties 1))) + (start (match-beginning 0))) + (when (re-search-forward "^#\\+END_SRC" nil t) + (let* ((end (match-end 0)) + (block-content (buffer-substring + (save-excursion + (goto-char start) + (forward-line 1) + (point)) + (save-excursion + (goto-char end) + (beginning-of-line) + (point)))) + (placeholder (format "<<>>" counter)) + (gmi-block (format "```%s\n%s```" lang block-content))) + (push (cons placeholder gmi-block) code-blocks) + (delete-region start end) + (goto-char start) + (insert placeholder) + (setq counter (1+ counter)))))) + + ;; Step 2: Delete standalone timestamp lines + (goto-char (point-min)) + (while (re-search-forward + "^[ \t]*\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)\\( [A-Za-z]\\{2,3\\}\\)?\\( [0-9]\\{2\\}:[0-9]\\{2\\}\\)?\\][ \t]*\n?" nil t) + (replace-match "")) + + ;; Step 3: Delete #+RESULTS lines + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*#\\+RESULTS\\(?:\\[.*\\]\\)?:?[ \t]*\n" nil t) + (replace-match "")) + + ;; Step 4: Convert sub-headings (* → ##, ** → ###, deeper → ###) + (goto-char (point-min)) + (while (re-search-forward "^\\(\\*+\\) " nil t) + (let* ((stars (match-string 1)) + (level (length stars)) + (hashes (make-string (min (1+ level) 3) ?#))) + (replace-match (concat hashes " ")))) + + ;; Step 5: Link handling + ;; 5a: ruby links: [[ruby:reading][text]] → text（reading） + (goto-char (point-min)) + (while (re-search-forward "\\[\\[ruby:\\([^]]+\\)\\]\\[\\([^]]+\\)\\]\\]" nil t) + (replace-match "\\2（\\1）")) + + ;; 5b: em links: [[em:text]] → text + (goto-char (point-min)) + (while (re-search-forward "\\[\\[em:\\([^]]+\\)\\]\\]" nil t) + (replace-match "\\1")) + + ;; 5c: Image links with alt → just alt text + (goto-char (point-min)) + (while (re-search-forward "\\[\\[\\(?:file:\\|\\.?/\\)?[^]]*\\.\\(png\\|jpg\\|jpeg\\|gif\\|webp\\|svg\\)\\]\\[\\([^]]+\\)\\]\\]" nil t) + (replace-match "\\2")) + + ;; 5c2: Image links without alt → remove + (goto-char (point-min)) + (while (re-search-forward "\\[\\[\\(?:file:\\|\\.?/\\)?[^]]*\\.\\(png\\|jpg\\|jpeg\\|gif\\|webp\\|svg\\)\\]\\]" nil t) + (replace-match "")) + + ;; 5d: External links with text: [[https://...][text]] → text, collect link + (goto-char (point-min)) + (while (re-search-forward "\\[\\[\\(https?://[^]]+\\)\\]\\[\\([^]]+\\)\\]\\]" nil t) + (let ((url (match-string-no-properties 1)) + (text (match-string-no-properties 2))) + (push (cons url text) collected-links) + (replace-match text t t))) + + ;; 5e: External links without text: [[https://...]] → remove, collect link + (goto-char (point-min)) + (while (re-search-forward "\\[\\[\\(https?://[^]]+\\)\\]\\]" nil t) + (let ((url (match-string-no-properties 1))) + (push (cons url url) collected-links) + (replace-match "" t t))) + + ;; 5f: Internal path links with text: [[/posts/...][text]] → plain text + (goto-char (point-min)) + (while (re-search-forward "\\[\\[/[^]]+\\]\\[\\([^]]+\\)\\]\\]" nil t) + (replace-match "\\1")) + + ;; 5g: Any remaining internal links: [[something]] → plain text + (goto-char (point-min)) + (while (re-search-forward "\\[\\[\\([^]]+\\)\\]\\]" nil t) + (replace-match "\\1")) + + ;; 5h: Remaining described links: [[something][text]] → plain text + (goto-char (point-min)) + (while (re-search-forward "\\[\\[\\([^]]+\\)\\]\\[\\([^]]+\\)\\]\\]" nil t) + (replace-match "\\2")) + + ;; Step 6: Strip emphasis markers + ;; Content must not start/end with space (org emphasis rule) + ;; =verbatim= / ~code~ → plain text (single pass, first marker wins) + (goto-char (point-min)) + (while (re-search-forward "\\(?:=\\([^ =\n]\\(?:[^=\n]*[^ =\n]\\)?\\)=\\)\\|\\(?:~\\([^ ~\n]\\(?:[^~\n]*[^ ~\n]\\)?\\)~\\)" nil t) + (let ((text (or (match-string-no-properties 1) (match-string-no-properties 2)))) + (replace-match text t t))) + ;; *bold* → bold + (goto-char (point-min)) + (while (re-search-forward "\\*\\([^ *\n]\\(?:[^*\n]*[^ *\n]\\)?\\)\\*" nil t) + (replace-match "\\1")) + ;; /italic/ → italic + (goto-char (point-min)) + (while (re-search-forward "/\\([^ /\n]\\(?:[^/\n]*[^ /\n]\\)?\\)/" nil t) + (replace-match "\\1")) + ;; _{underline}_ → underline + (goto-char (point-min)) + (while (re-search-forward "_{\\([^}\n]+\\)}_" nil t) + (replace-match "\\1")) + + ;; Step 7: Quote blocks → > prefix + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*#\\+BEGIN_QUOTE[ \t]*\n" nil t) + (replace-match "") + (let ((start (point))) + (when (re-search-forward "^[ \t]*#\\+END_QUOTE[ \t]*\n?" nil t) + (replace-match "") + (let ((end (point))) + (save-excursion + (goto-char start) + (while (< (point) end) + (insert "> ") + (setq end (+ end 2)) + (forward-line 1))))))) + + ;; Step 8: Example blocks → ``` fences + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*#\\+BEGIN_EXAMPLE[ \t]*\n" nil t) + (replace-match "```\n") + (when (re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" nil t) + (replace-match "```"))) + + ;; Step 9: Other blocks → strip markers, keep content + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*#\\+BEGIN_[A-Za-z]+.*\n" nil t) + (replace-match "")) + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*#\\+END_[A-Za-z]+[ \t]*\n?" nil t) + (replace-match "")) + + ;; Step 10: Remove PROPERTIES drawers + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*:PROPERTIES:[ \t]*\n\\(?:.*\n\\)*?[ \t]*:END:[ \t]*\n?" nil t) + (replace-match "")) + + ;; Step 11: Remove #+MORE + (goto-char (point-min)) + (let ((case-fold-search t)) + (while (re-search-forward "^#\\+MORE\\s-*\n?" nil t) + (replace-match ""))) + + ;; Step 12: List items: - item → * item (Gemini format) + (goto-char (point-min)) + (while (re-search-forward "^\\([ \t]*\\)- " nil t) + (replace-match "* ")) + + ;; Step 13: Restore code blocks + (dolist (block code-blocks) + (goto-char (point-min)) + (when (search-forward (car block) nil t) + (replace-match (cdr block) t t))) + + ;; Step 14: Deduplicate links (keep first occurrence) + (setq collected-links (nreverse collected-links)) + (let ((seen (make-hash-table :test 'equal)) + (unique '())) + (dolist (link collected-links) + (unless (gethash (car link) seen) + (puthash (car link) t seen) + (push link unique))) + (setq collected-links (nreverse unique))) + + ;; Step 15: Return (text . links) + (cons (string-trim (buffer-string)) collected-links)))) + (defun my/blog-export-monthly (&optional file) "Export monthly org FILE to Hexo markdown. If FILE is nil, use current buffer's file or current monthly." @@ -666,28 +1127,40 @@ If FILE is nil, use current buffer's file or current monthly." (let* ((title (my/blog--get-org-property "TITLE")) (date (or (my/blog--get-org-property "DATE") (format-time-string "%Y-%m-%d %H:%M:%S"))) + (custom-fm (my/blog--get-org-property "HUGO_CUSTOM_FRONT_MATTER")) + (lang (if (and custom-fm (string-match ":lang \\([^ ]+\\)" custom-fm)) + (match-string 1 custom-fm) "zh")) + (mathjax (if (and custom-fm (string-match ":mathjax \\([^ ]+\\)" custom-fm)) + (match-string 1 custom-fm) "false")) + (hidden (if (and custom-fm (string-match ":hidden \\([^ ]+\\)" custom-fm)) + (match-string 1 custom-fm) "false")) + (categories (or (my/blog--get-org-property "CATEGORIES") "想法迭代")) (structure (my/blog--collect-structure (current-buffer))) (intro (plist-get structure :intro)) (sections (plist-get structure :sections)) (export-file (expand-file-name (concat title ".md") my/blog-export-dir)) - (year-month (if (string-match "\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)" date) - (format "%s-%s" (match-string 1 date) (match-string-no-properties 2 date)) - (format-time-string "%Y-%m")))) + (year-month (or (my/blog--get-org-property "DIARY_MONTH") + (if (string-match "\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)" date) + (format "%s-%s" (match-string 1 date) (match-string-no-properties 2 date)) + (format-time-string "%Y-%m"))))) ;; Generate markdown content (with-temp-buffer ;; Front matter (insert "---\n") (insert (format "title: %s\n" title)) - (insert "lang: zh\n") - (insert "categories:\n - 想法迭代\n") - (insert "mathjax: false\n") - (insert "hidden: false\n") + (insert (format "lang: %s\n" lang)) + (insert (format "categories:\n - %s\n" categories)) + (insert (format "mathjax: %s\n" mathjax)) + (insert (format "hidden: %s\n" hidden)) ;; Don't include abbrlink - let hexo-abbrlink auto-generate it (insert (format "date: %s\n" (if (string-match ":" date) date (concat date " 00:00:00")))) (insert (format "diary_month: %s\n" year-month)) + (insert (format "neodb_month: %s\n" year-month)) (insert "tags:\n") (insert "description:\n") + (insert "syndicate: true\n") + (insert "in_reply_to: true\n") (insert "---\n\n") ;; Intro @@ -709,62 +1182,246 @@ If FILE is nil, use current buffer's file or current monthly." ;; Main content (let ((skippable-sections '("折腾博客" "编程历程")) (hr-inserted nil)) - (dolist (sec sections) - (let ((level (plist-get sec :level)) - (title (plist-get sec :title)) - (source (plist-get sec :source)) - (content (plist-get sec :content)) - (has-subsections nil)) - ;; Check if this section has subsections with content - (when (= level 1) - (let ((sec-idx (cl-position sec sections))) - (cl-loop for i from (1+ sec-idx) below (length sections) - for next-sec = (nth i sections) - while (> (plist-get next-sec :level) 1) - when (not (string-empty-p (or (plist-get next-sec :content) ""))) - do (setq has-subsections t)))) - ;; Special handling for 我写的文章 - (when (and (= level 1) - (string= title "我写的文章") - (or (null content) (string-empty-p content)) - (not has-subsections) - monthly-posts) - ;; Auto-fill with scanned posts - (setq content (mapconcat - (lambda (post) - (format "- [《%s》](%s)\n" (car post) (cdr post))) - monthly-posts - ""))) - ;; Skip empty skippable sections (no content and no subsections) - (unless (and (= level 1) - (member title skippable-sections) - (or (null content) (string-empty-p content)) - (not has-subsections)) - ;; Insert hr before first output section + (let ((pending-neodb-tag nil) + (pending-diary-tag nil)) + (dolist (sec sections) + (let ((level (plist-get sec :level)) + (title (plist-get sec :title)) + (source (plist-get sec :source)) + (content (plist-get sec :content)) + (has-subsections nil)) + ;; When encountering a new Level 1 section, insert pending tags first + (when (= level 1) + (when pending-diary-tag + (insert pending-diary-tag) + (setq pending-diary-tag nil)) + (when pending-neodb-tag + (insert pending-neodb-tag) + (setq pending-neodb-tag nil))) + ;; Check if this section has subsections with content + (when (= level 1) + (let ((sec-idx (cl-position sec sections))) + (cl-loop for i from (1+ sec-idx) below (length sections) + for next-sec = (nth i sections) + while (> (plist-get next-sec :level) 1) + when (not (string-empty-p (or (plist-get next-sec :content) ""))) + do (setq has-subsections t)))) + ;; Special handling for 我写的文章 (when (and (= level 1) - (not hr-inserted) - (not (member title '("商业与社会" "心理与关系" "科学与自然" "技术与创造")))) - (insert "\n---\n") - (setq hr-inserted t)) - (cond - ;; Level 1 -> ## heading - ((= level 1) - (insert (format "\n## %s\n\n" title))) - ;; Level 2 -> #### heading (with optional link) - ((= level 2) - (if source - (insert (format "#### [《%s》](%s)\n\n" title source)) - (insert (format "#### %s\n\n" title))))) - ;; Content - (when (and content (not (string-empty-p content))) - (insert (my/blog--convert-org-to-md content) "\n\n"))))))) + (string= title "我写的文章") + (or (null content) (string-empty-p content)) + (not has-subsections) + monthly-posts) + ;; Auto-fill with scanned posts + (setq content (mapconcat + (lambda (post) + (format "- [《%s》](%s)\n" (car post) (cdr post))) + monthly-posts + ""))) + ;; Skip empty skippable sections (no content and no subsections) + (unless (and (= level 1) + (member title skippable-sections) + (or (null content) (string-empty-p content)) + (not has-subsections)) + ;; Insert hr before first output section + (when (and (= level 1) + (not hr-inserted) + (not (member title '("商业与社会" "心理与关系" "科学与自然" "技术与创造")))) + (insert "\n---\n") + (setq hr-inserted t)) + (cond + ;; Level 1 -> ## heading + ((= level 1) + (insert (format "\n## %s\n\n" title)) + ;; Set pending diary tags for 日记片段 section (inserted before next Level 1) + (when (string= title "日记片段") + (setq pending-diary-tag "{% details_toggle diary_sections %}\n\n{% diary_aggregator %}\n\n"))) + ;; Level 2 -> #### heading (with optional link) + ((= level 2) + (let ((clean-title (my/blog--clean-title-for-md title)) + (slug (plist-get sec :custom-id))) + (insert (format "\n\n" slug)) + (if source + (insert (format "#### [《%s》](%s)\n\n" clean-title source)) + (insert (format "#### %s\n\n" clean-title))))) + ;; Level 3 -> ##### subheading + ((= level 3) + (insert (format "##### %s\n\n" title)))) + ;; Content + (when (and content (not (string-empty-p content))) + (insert (my/blog--convert-org-to-md content) "\n\n")) + ;; Set pending neodb_aggregator for media sections (inserted before next Level 1) + (when (= level 1) + (cond + ((string= title "书籍") + (setq pending-neodb-tag "#### 其他评价\n\n{% neodb_aggregator 书籍 %}\n\n")) + ((string= title "音乐") + (setq pending-neodb-tag "#### 其他评价\n\n{% neodb_aggregator 音乐 %}\n\n")) + ((string= title "影视") + (setq pending-neodb-tag "#### 其他评价\n\n{% neodb_aggregator 影视 %}\n\n"))))))) + ;; Insert the last pending tags after loop ends + (when pending-diary-tag + (insert pending-diary-tag)) + (when pending-neodb-tag + (insert pending-neodb-tag))))) ;; Write to file (write-region (point-min) (point-max) export-file)) (message "Exported to: %s" export-file) + ;; Also export to Gemini + (my/blog--export-to-gemini org-file) (find-file export-file))))) +;;; Update Monthly Posts List + +(defun my/blog--collect-posts-by-diary-month (year-month) + "Scan markdown files in export dir for articles with date matching YEAR-MONTH. +YEAR-MONTH should be in format \"YYYY-MM\". +Returns list of (title . url) pairs." + (let ((results '())) + (when (and my/blog-export-dir (file-directory-p my/blog-export-dir)) + (dolist (file (directory-files my/blog-export-dir t "\\.md$")) + ;; Skip monthly posts (they have year-month pattern in filename) + (unless (string-match-p "[0-9]\\{4\\}-[0-9]\\{2\\}\\.md$" file) + (with-temp-buffer + (insert-file-contents file nil 0 800) ; Read front matter + (goto-char (point-min)) + (when (looking-at "---") + (let ((date nil) + (title nil) + (abbrlink nil)) + ;; Extract date (YAML format: date: 2026-01-19 or date: 2026-01-19 12:00:00) + (when (re-search-forward "^date:\\s-*\\([0-9-]+\\)" nil t) + (setq date (match-string-no-properties 1))) + ;; Extract title + (goto-char (point-min)) + (when (re-search-forward "^title:\\s-*\\(.+\\)$" nil t) + (setq title (string-trim (match-string-no-properties 1)))) + ;; Extract abbrlink (remove quotes if present) + (goto-char (point-min)) + (when (re-search-forward "^abbrlink:\\s-*\\(.+\\)$" nil t) + (setq abbrlink (string-trim (match-string-no-properties 1) "[\"']" "[\"']"))) + ;; Check if date's year-month matches + (when (and date title abbrlink + (string-prefix-p year-month date)) + (push (cons title (format "/posts/%s/" abbrlink)) results)))))))) + (nreverse results))) + +(defun my/blog--get-monthly-year-month () + "Get year-month string from current monthly org file. +Returns string like \"2026-01\" or nil if not in a monthly file." + (let ((filename (buffer-file-name))) + (when (and filename + (string-match "\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)\\.org$" filename)) + (format "%s-%s" (match-string 1 filename) (match-string 2 filename))))) + +(defun my/blog-update-monthly-posts () + "Update the \"我写的文章\" section in current monthly with matching posts. +Scans posts/*.org for articles with DIARY_MONTH matching current monthly." + (interactive) + (unless (derived-mode-p 'org-mode) + (error "Not in org-mode")) + (let ((year-month (my/blog--get-monthly-year-month))) + (unless year-month + (error "Not in a monthly file (expected filename like YYYY-MM.org)")) + (let ((posts (my/blog--collect-posts-by-diary-month year-month))) + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "^\\* 我写的文章" nil t) + (progn + ;; Move past the heading and PROPERTIES drawer + (org-end-of-meta-data t) + (let ((content-start (point)) + (content-end (save-excursion + (if (re-search-forward "^\\* " nil t) + (line-beginning-position) + (point-max))))) + ;; Delete existing content + (delete-region content-start content-end) + ;; Insert new content + (goto-char content-start) + (if posts + (progn + (insert "\n") + (dolist (post posts) + (insert (format "- [[%s][《%s》]]\n" (cdr post) (car post)))) + (insert "\n") + (message "Updated \"我写的文章\" with %d posts" (length posts))) + (insert "\n\n") + (message "No posts found for %s" year-month)))) + (error "Section \"我写的文章\" not found")))))) + +;;; Inbox for Topic Entries (no source link) + +(defun my/blog--create-inbox-file (file) + "Create blog-inbox.org with section headings." + (with-temp-file file + (insert "#+TITLE: 月刊条目收集\n\n") + (dolist (sec my/blog-monthly-sections) + (insert (format "* %s\n\n" (cdr sec)))))) + +(defun my/blog--goto-inbox-section () + "Prompt for section and go there in blog-inbox.org." + (let* ((sections (mapcar #'car my/blog-monthly-sections)) + (section (completing-read "Section: " sections nil t)) + (headline (cdr (assoc section my/blog-monthly-sections))) + (file (expand-file-name "blog-inbox.org" my/blog-org-dir))) + (unless (file-exists-p file) + (my/blog--create-inbox-file file)) + (set-buffer (org-capture-target-buffer file)) + (goto-char (point-min)) + (if (re-search-forward (format "^\\* %s" (regexp-quote headline)) nil t) + (beginning-of-line) + (goto-char (point-max))))) + +(defun my/blog-batch-refile-inbox () + "Refile all entries from blog-inbox.org to current monthly by section." + (interactive) + (let* ((inbox-file (expand-file-name "blog-inbox.org" my/blog-org-dir)) + (monthly-file (my/blog--current-monthly-file)) + (count 0)) + (unless (file-exists-p inbox-file) + (error "No inbox file: %s" inbox-file)) + (unless (file-exists-p monthly-file) + (error "No current monthly file: %s" monthly-file)) + (with-current-buffer (find-file-noselect inbox-file) + (org-map-entries + (lambda () + (when (= (org-current-level) 1) + (let ((section-name (org-get-heading t t t t))) + ;; Process each level-2 child under this section + (save-excursion + (let ((section-end (save-excursion (org-end-of-subtree t t)))) + (org-forward-heading-same-level 0 t) + (when (outline-next-heading) + (while (and (<= (point) section-end) + (= (org-current-level) 2)) + ;; Determine target headline in monthly + (let* ((target-headline section-name) + (is-project (string= target-headline "技术与创造"))) + ;; Refile this entry + (if (and is-project + (string= (org-get-heading t t t t) "有趣项目")) + ;; Skip "有趣项目" sub-entries - handle differently + (outline-next-heading) + (let ((custom-id (org-entry-get nil "CUSTOM_ID"))) + (unless custom-id + (org-set-property "CUSTOM_ID" + (my/blog--slugify (org-get-heading t t t t)))) + (let ((org-refile-targets `((,monthly-file :maxlevel . 3)))) + (org-refile nil nil + (list target-headline monthly-file nil + (with-current-buffer (find-file-noselect monthly-file) + (org-find-exact-headline-in-buffer target-headline))))) + (setq count (1+ count)))))))))))) + nil 'file)) + (with-current-buffer (find-file-noselect inbox-file) + (save-buffer)) + (with-current-buffer (find-file-noselect monthly-file) + (save-buffer)) + (message "Refiled %d entries from inbox to monthly." count))) + ;;; Capture Templates for Monthly (defun my/blog--capture-target-monthly (section) @@ -795,36 +1452,40 @@ Prompts for section selection." ;; Add a simple menu entry for monthly capture (defun my/blog--add-monthly-capture-templates () "Add monthly capture templates to `org-capture-templates'." - ;; We use function-based targets for dynamic file resolution (add-to-list 'org-capture-templates '("m" "Monthly (博客月刊)") t) (add-to-list 'org-capture-templates - `("ma" "→ 商业与社会" entry - (function (lambda () (my/blog--goto-monthly-section "商业与社会"))) - "** %^{标题}\n:PROPERTIES:\n:CUSTOM_ID: %(my/blog--slugify \"%\\1\")\n:SOURCE: %^{URL}\n:END:\n\n%?\n\n%U") t) - (add-to-list 'org-capture-templates - `("mb" "→ 心理与关系" entry - (function (lambda () (my/blog--goto-monthly-section "心理与关系"))) + `("mm" "→ 月刊条目 (有链接)" entry + (function my/blog--goto-monthly-section-prompt) "** %^{标题}\n:PROPERTIES:\n:CUSTOM_ID: %(my/blog--slugify \"%\\1\")\n:SOURCE: %^{URL}\n:END:\n\n%?\n\n%U") t) (add-to-list 'org-capture-templates - `("mc" "→ 技术与创造" entry - (function (lambda () (my/blog--goto-monthly-section "技术与创造"))) - "** %^{标题}\n:PROPERTIES:\n:CUSTOM_ID: %(my/blog--slugify \"%\\1\")\n:SOURCE: %^{URL}\n:END:\n\n%?\n\n%U") t) - (add-to-list 'org-capture-templates - `("md" "→ 生活与文娱" entry - (function (lambda () (my/blog--goto-monthly-section "生活与文娱"))) - "** %^{标题}\n:PROPERTIES:\n:CUSTOM_ID: %(my/blog--slugify \"%\\1\")\n:SOURCE: %^{URL}\n:END:\n\n%?\n\n%U") t)) - -(defun my/blog--goto-monthly-section (section) - "Go to SECTION in current monthly file for capture." - (let ((file (my/blog--current-monthly-file))) + `("mt" "→ 话题条目 (无链接)" entry + (function my/blog--goto-inbox-section) + "** %^{标题}\n:PROPERTIES:\n:CUSTOM_ID: %(my/blog--slugify \"%\\1\")\n:END:\n\n%?\n\n%U") t)) + +(defun my/blog--goto-monthly-section-prompt () + "Prompt for monthly file and section, then go there." + (let* ((monthly-dir (my/blog--monthly-dir-full)) + (files (and (file-directory-p monthly-dir) + (directory-files monthly-dir nil "^[0-9]\\{4\\}-[0-9]\\{2\\}\\.org$"))) + (choice (completing-read "Monthly file: " (reverse files) nil t)) + (sections (mapcar #'car my/blog-monthly-sections)) + (section (completing-read "Section: " sections nil t)) + (headline (cdr (assoc section my/blog-monthly-sections)))) + (my/blog--goto-monthly-section headline + (expand-file-name choice monthly-dir)))) + +(defun my/blog--goto-monthly-section (section &optional file) + "Go to SECTION in monthly FILE for capture. +If FILE is nil, use current monthly file." + (let ((file (or file (my/blog--current-monthly-file)))) ;; Ensure monthly exists (unless (file-exists-p file) (my/blog-create-monthly)) (set-buffer (org-capture-target-buffer file)) (goto-char (point-min)) - (if (re-search-forward (format "^\\* %s" (regexp-quote section)) nil t) - (org-end-of-subtree) + (if (re-search-forward (format "^\\*+ %s" (regexp-quote section)) nil t) + (beginning-of-line) (goto-char (point-max))))) ;; Add templates after org-capture is loaded @@ -857,6 +1518,8 @@ If FILE is nil, use current buffer's file." (lang (or (my/blog--get-org-property "LANG") "zh")) (mathjax (or (my/blog--get-org-property "MATHJAX") "false")) (hidden (or (my/blog--get-org-property "HIDDEN") "false")) + (syndicate (my/blog--get-org-property "SYNDICATE")) + (syndication (my/blog--get-org-property "SYNDICATION")) (abbrlink (or (my/blog--get-org-property "ABBRLINK") "")) (tags (or (my/blog--get-org-property "TAGS") "")) (description (or (my/blog--get-org-property "DESCRIPTION") "")) @@ -875,6 +1538,11 @@ If FILE is nil, use current buffer's file." (insert (format "categories:\n - %s\n" categories)) (insert (format "mathjax: %s\n" mathjax)) (insert (format "hidden: %s\n" hidden)) + (cond + (syndication + (insert (format "syndication: %s\n" syndication))) + (syndicate + (insert (format "syndicate: %s\n" syndicate)))) ;; Only include abbrlink if explicitly set (let hexo-abbrlink auto-generate if empty) (when (and abbrlink (not (string-empty-p abbrlink))) (insert (format "abbrlink: %s\n" abbrlink))) @@ -888,6 +1556,7 @@ If FILE is nil, use current buffer's file." (insert (format " - %s\n" tag)))) (insert "tags:\n")) (insert (format "description: %s\n" description)) + (insert "in_reply_to: true\n") (insert "---\n\n") ;; Description/excerpt if provided @@ -900,7 +1569,9 @@ If FILE is nil, use current buffer's file." ;; Save (write-region (point-min) (point-max) export-file)) - (message "Exported to: %s" export-file))))) + (message "Exported to: %s" export-file) + ;; Also export to Gemini + (my/blog--export-to-gemini org-file))))) (defun my/blog--get-post-body () "Get the body content of the org file (excluding properties header and drawers)." @@ -972,6 +1643,7 @@ Creates a new org file in the blog posts directory with front matter." (insert "#+LANG: zh\n") (insert "#+MATHJAX: false\n") (insert "#+HIDDEN: false\n") + (insert "#+SYNDICATE: true\n") (insert "#+ABBRLINK:\n") (insert (format "#+TAGS: %s\n" (if (string-empty-p tags) "" tags))) (insert (format "#+DESCRIPTION: %s\n\n" (if (string-empty-p description) "" description))) @@ -982,7 +1654,8 @@ Creates a new org file in the blog posts directory with front matter." ;; Ask whether to delete original entry (when (y-or-n-p "删除原条目? ") - (org-cut-subtree)) + (org-cut-subtree) + (save-buffer)) ;; Open the new file (find-file filepath) @@ -990,14 +1663,43 @@ Creates a new org file in the blog posts directory with front matter." ;;; Image Insertion +;; Immich configuration +(defcustom my/blog-immich-host nil + "Immich server host (e.g. \"http://192.168.1.119:12283\")." + :type '(choice (const nil) string) + :group 'my/blog) + +(defcustom my/blog-immich-api-key nil + "Immich API key for downloading images." + :type '(choice (const nil) string) + :group 'my/blog) + (defun my/blog--url-p (string) "Return non-nil if STRING looks like a URL." (string-match-p "^https?://" string)) -(defun my/blog--download-image (url target-file) - "Download image from URL to TARGET-FILE." +(defun my/blog--immich-url-p (url) + "Return non-nil if URL is an Immich photo page URL." + (and my/blog-immich-host + (string-prefix-p my/blog-immich-host url) + (string-match-p "/photos/[a-f0-9-]+" url))) + +(defun my/blog--immich-extract-asset-id (url) + "Extract asset ID from Immich URL." + (when (string-match "/photos/\\([a-f0-9-]+\\)" url) + (match-string 1 url))) + +(defun my/blog--immich-to-direct-url (url) + "Convert Immich photo page URL to direct download API URL." + (let ((asset-id (my/blog--immich-extract-asset-id url))) + (when asset-id + (format "%s/api/assets/%s/original" my/blog-immich-host asset-id)))) + +(defun my/blog--download-image (url target-file &optional headers) + "Download image from URL to TARGET-FILE with optional HEADERS." (require 'url) - (let ((url-request-method "GET")) + (let ((url-request-method "GET") + (url-request-extra-headers headers)) (with-current-buffer (url-retrieve-synchronously url t) ;; Skip HTTP headers (goto-char (point-min)) @@ -1009,9 +1711,10 @@ Creates a new org file in the blog posts directory with front matter." (defun my/blog-insert-image () "Insert an image link for blog post. -Supports both local files and web URLs. +Supports local files, web URLs, and Immich photo page URLs. For local files: select and copy to post's asset folder. -For web URLs: download and save with a specified filename." +For web URLs: download and save with a specified filename. +For Immich URLs: auto-convert to API URL and download with auth." (interactive) (unless (buffer-file-name) (error "Buffer must be visiting a file")) @@ -1020,6 +1723,8 @@ For web URLs: download and save with a specified filename." ;; Get source: can be file path or URL (source (read-string "Image file or URL: ")) (is-url (my/blog--url-p source)) + (source (if is-url source (expand-file-name source))) + (is-immich (and is-url (my/blog--immich-url-p source))) ;; For URLs without extension, ask for filename; for local files, use original name (image-name (if is-url (let ((default-name (file-name-nondirectory (url-filename (url-generic-parse-url source))))) @@ -1031,24 +1736,252 @@ For web URLs: download and save with a specified filename." ;; Validate filename for URLs (when (and is-url (string-empty-p image-name)) (error "Filename is required for web images")) + ;; Validate Immich config + (when (and is-immich (not my/blog-immich-api-key)) + (error "Immich API key not configured. Set `my/blog-immich-api-key'")) ;; Create target directory if needed (unless (file-directory-p target-dir) (make-directory target-dir t) (message "Created directory: %s" target-dir)) ;; Download or copy image (unless (file-exists-p target-file) - (if is-url - (progn - (message "Downloading %s..." source) - (my/blog--download-image source target-file) - (message "Downloaded to %s" target-file)) + (cond + ;; Immich URL: convert and download with API key + (is-immich + (let ((direct-url (my/blog--immich-to-direct-url source)) + (headers `(("x-api-key" . ,my/blog-immich-api-key)))) + (message "Downloading from Immich: %s..." (my/blog--immich-extract-asset-id source)) + (my/blog--download-image direct-url target-file headers) + (message "Downloaded to %s" target-file))) + ;; Regular URL + (is-url + (message "Downloading %s..." source) + (my/blog--download-image source target-file) + (message "Downloaded to %s" target-file)) + ;; Local file + (t (copy-file source target-file) - (message "Copied %s to %s" image-name target-dir))) + (message "Copied %s to %s" image-name target-dir)))) ;; Insert org link (if (string-empty-p alt-text) (insert (format "[[./%s]]" image-name)) (insert (format "[[./%s][%s]]" image-name alt-text))))) +;;; Gemini Export + +(defun my/blog--export-to-gemini (org-file) + "Export ORG-FILE to gemtext (.gmi). +Dispatches to monthly or post exporter based on filename." + (let* ((base-name (file-name-nondirectory org-file)) + (is-monthly (string-match-p "^[0-9]\\{4\\}-[0-9]\\{2\\}\\.org$" base-name))) + (if is-monthly + (my/blog--export-monthly-to-gmi org-file) + (my/blog--export-post-to-gmi org-file)))) + +(defun my/blog--export-monthly-to-gmi (org-file) + "Export monthly ORG-FILE to gemtext using collect-structure." + (let* ((gemini-posts-dir (expand-file-name "posts" my/blog-gemini-dir)) + (base-name (file-name-base org-file)) + (gmi-file (expand-file-name (concat base-name ".gmi") gemini-posts-dir))) + (unless (file-directory-p gemini-posts-dir) + (make-directory gemini-posts-dir t)) + (with-temp-buffer + (insert-file-contents org-file) + (org-mode) + (let* ((title (my/blog--get-org-property "TITLE")) + (date (or (my/blog--get-org-property "DATE") + (format-time-string "%Y-%m-%d"))) + (structure (my/blog--collect-structure (current-buffer))) + (intro (plist-get structure :intro)) + (sections (plist-get structure :sections)) + ;; Collect monthly posts for 我写的文章 + (date-parts (split-string date "-")) + (export-year (string-to-number (nth 0 date-parts))) + (export-month (string-to-number (nth 1 date-parts))) + (monthly-posts (my/blog--collect-monthly-posts export-year export-month))) + (with-temp-buffer + ;; Title + date + (insert (format "# %s\n%s\n\n" title date)) + ;; Intro + (when (and intro (not (string-empty-p intro))) + (let ((result (my/blog--convert-org-to-gmi intro))) + (insert (car result) "\n") + (dolist (link (cdr result)) + (insert (format "=> %s %s\n" (car link) (cdr link)))) + (insert "\n"))) + ;; Sections + (let ((skippable-sections '("折腾博客" "编程历程"))) + (dolist (sec sections) + (let ((level (plist-get sec :level)) + (sec-title (plist-get sec :title)) + (source (plist-get sec :source)) + (content (plist-get sec :content)) + (has-subsections nil)) + ;; Check if this L1 section has subsections with content + (when (= level 1) + (let ((sec-idx (cl-position sec sections))) + (cl-loop for i from (1+ sec-idx) below (length sections) + for next-sec = (nth i sections) + while (> (plist-get next-sec :level) 1) + when (not (string-empty-p (or (plist-get next-sec :content) ""))) + do (setq has-subsections t)))) + (cond + ;; 日记片段 → Mastodon link + ((and (= level 1) (string= sec-title "日记片段")) + (insert (format "## %s\n\n" sec-title)) + (insert "日记片段发布在 Mastodon 上。\n\n") + (insert (format "=> %s 在 Mastodon 阅读日记片段\n\n" my/blog-mastodon-url))) + ;; 我写的文章 → .gmi links + ((and (= level 1) (string= sec-title "我写的文章")) + (when monthly-posts + (insert (format "## %s\n\n" sec-title)) + (dolist (post monthly-posts) + (let ((slug (my/blog--slugify (car post)))) + (insert (format "=> %s.gmi 《%s》\n" slug (car post))))) + (insert "\n"))) + ;; Level 1 category heading + ((= level 1) + ;; Skip empty skippable sections + (unless (and (member sec-title skippable-sections) + (or (null content) (string-empty-p content)) + (not has-subsections)) + ;; Skip sections with no content and no subsections + (unless (and (or (null content) (string-empty-p content)) + (not has-subsections)) + (insert (format "## %s\n\n" sec-title)) + (when (and content (not (string-empty-p content))) + (let ((result (my/blog--convert-org-to-gmi content))) + (insert (car result) "\n") + (dolist (link (cdr result)) + (insert (format "=> %s %s\n" (car link) (cdr link)))) + (insert "\n")))))) + ;; Level 2 article heading + ((= level 2) + (insert (format "### %s\n\n" (my/blog--clean-title-for-gmi sec-title))) + (when (and content (not (string-empty-p content))) + (let ((result (my/blog--convert-org-to-gmi content))) + (insert (car result) "\n") + ;; Source link first + (when source + (insert (format "=> %s 原文\n" source))) + ;; Collected links + (dolist (link (cdr result)) + (insert (format "=> %s %s\n" (car link) (cdr link)))) + (insert "\n"))) + (when (and (or (null content) (string-empty-p content)) source) + (insert (format "=> %s 原文\n\n" source)))))))) + (write-region (point-min) (point-max) gmi-file)))) + (message "Gemini: %s" gmi-file) + gmi-file)) + +(defun my/blog--export-post-to-gmi (org-file) + "Export standalone post ORG-FILE to gemtext." + (let* ((gemini-posts-dir (expand-file-name "posts" my/blog-gemini-dir)) + (base-name (file-name-base org-file)) + (gmi-file (expand-file-name (concat base-name ".gmi") gemini-posts-dir))) + (unless (file-directory-p gemini-posts-dir) + (make-directory gemini-posts-dir t)) + (with-temp-buffer + (insert-file-contents org-file) + (org-mode) + (let* ((title (my/blog--get-org-property "TITLE")) + (date (or (my/blog--get-org-property "DATE") + (format-time-string "%Y-%m-%d"))) + (body (my/blog--get-post-body)) + (result (my/blog--convert-org-to-gmi body))) + (with-temp-buffer + ;; Title + date + (insert (format "# %s\n%s\n\n" title date)) + ;; Body + (insert (car result) "\n") + ;; Links + (when (cdr result) + (insert "\n## 链接\n\n") + (dolist (link (cdr result)) + (insert (format "=> %s %s\n" (car link) (cdr link))))) + (write-region (point-min) (point-max) gmi-file)))) + (message "Gemini: %s" gmi-file) + gmi-file)) + +(defun my/blog-export-post-gemini (&optional file) + "Export current org file to gemtext (.gmi)." + (interactive) + (let ((org-file (or file + (when (and (buffer-file-name) + (string-suffix-p ".org" (buffer-file-name))) + (buffer-file-name))))) + (unless org-file (error "No org file specified")) + (my/blog--export-to-gemini org-file))) + +(defun my/blog-gemini-export-all () + "Export all blog org files to gemtext (.gmi) and generate index." + (interactive) + (let ((org-files (append + (directory-files (expand-file-name "posts" my/blog-org-dir) t "\\.org$") + (directory-files (expand-file-name my/blog-monthly-dir my/blog-org-dir) t "\\.org$"))) + (count 0)) + (dolist (file org-files) + (condition-case err + (progn + (my/blog--export-to-gemini file) + (setq count (1+ count))) + (error (message "Failed to export %s: %s" (file-name-nondirectory file) err)))) + (my/blog-gemini-generate-index) + (message "Exported %d files to Gemini and generated index." count))) + +(defun my/blog-gemini-generate-index () + "Generate index.gmi for Gemini capsule." + (interactive) + (let* ((posts-dir (expand-file-name "posts" my/blog-gemini-dir)) + (gmi-files (directory-files posts-dir t "\\.gmi$")) + (entries '())) + ;; 提取每篇文章的标题和日期 + (dolist (file gmi-files) + (unless (string= (file-name-nondirectory file) "index.gmi") + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (when (re-search-forward "^# \\(.+\\)" nil t) + (let ((title (match-string 1)) + (date "")) + ;; 日期在标题的下一行 + (forward-line 1) + (when (looking-at "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)") + (setq date (match-string 1))) + (push (list title (file-name-nondirectory file) date) entries)))))) + ;; 按日期降序排列 + (setq entries (sort entries (lambda (a b) (string> (nth 2 a) (nth 2 b))))) + ;; 生成 posts/index.gmi + (with-temp-file (expand-file-name "index.gmi" posts-dir) + (insert "# 文章列表\n\n") + (dolist (entry entries) + (insert (format "=> %s %s\n" (nth 1 entry) (nth 0 entry)))) + (insert "\n=> /index.gmi 返回大厅\n")) + ;; 生成根 index.gmi + (with-temp-file (expand-file-name "index.gmi" my/blog-gemini-dir) + (insert "# Cytrogen 的胶囊旅馆\n\n") + (insert "欢迎入住。这里是领地在 Gemini 空间的一间胶囊旅馆，供旅人歇息、阅读。\n\n") + (insert "## 近期文章\n\n") + (let ((recent (seq-take entries 10))) + (dolist (entry recent) + (insert (format "=> /posts/%s %s\n" (nth 1 entry) (nth 0 entry))))) + (insert "\n=> /posts/index.gmi 所有文章\n\n") + (insert "## 导航\n\n") + (insert "=> /about.gmi 关于旅馆主人\n") + (insert "=> /feed.gmi 订阅\n") + (insert "=> https://cytrogen.icu 前往领地（Web）\n")) + ;; 生成 feed.gmi + (with-temp-file (expand-file-name "feed.gmi" my/blog-gemini-dir) + (insert "# Cytrogen 的胶囊旅馆\n\n") + (dolist (entry entries) + (let ((date (nth 2 entry))) + (when (not (string-empty-p date)) + (insert (format "=> /posts/%s %s %s\n" (nth 1 entry) date (nth 0 entry))))))) + (message "Generated capsule index + feed (%d posts)" (length entries)))) + +;;; Webmention support +(require 'webmention (expand-file-name "webmention.el" user-emacs-directory)) + ;;; Provide (provide 'pkg-blog)