@@ 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 -> <!--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 "<br>"))
- ;; 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_ -> <u>text</u>
- (goto-char (point-min))
- (while (re-search-forward "_\\([^_\n]+\\)_" nil t)
- (replace-match "<u>\\1</u>"))
- ;; Convert image links BEFORE other link conversions
- ;; [[file:path/image.png][alt]] or [[./path/image.png][alt]] → 
- (goto-char (point-min))
- (while (re-search-forward "\\[\\[\\(?:file:\\|\\.?/\\)?\\([^]]*\\.\\(png\\|jpg\\|jpeg\\|gif\\|webp\\|svg\\)\\)\\]\\[\\([^]]+\\)\\]\\]" nil t)
- (replace-match ""))
- ;; [[file:image.png]] or [[./image.png]] → 
- (goto-char (point-min))
- (while (re-search-forward "\\[\\[\\(?:file:\\|\\.?/\\)?\\([^]]*\\.\\(png\\|jpg\\|jpeg\\|gif\\|webp\\|svg\\)\\)\\]\\]" nil t)
- (replace-match ""))
- ;; Convert links: [[url][text]] -> [text](url)
- (goto-char (point-min))
- (while (re-search-forward "\\[\\[\\([^]]+\\)\\]\\[\\([^]]+\\)\\]\\]" nil t)
- (replace-match "[\\2](\\1)"))
- ;; Convert plain links: [[url]] -> <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 <u>
+ (let ((links '())
+ (link-counter 0))
+ ;; Convert image links: [[file:path/image.png][alt]] → 
+ (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 "<<<IMGLINK%d>>>" link-counter))
+ (md-link (format "" alt path)))
+ (push (cons placeholder md-link) links)
+ (replace-match placeholder)
+ (setq link-counter (1+ link-counter))))
+ ;; [[file:image.png]] or [[./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 "<<<IMGLINK%d>>>" link-counter))
+ (md-link (format "" 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%d>>>" 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]] -> <url>
+ (goto-char (point-min))
+ (while (re-search-forward "\\[\\[\\([^]]+\\)\\]\\]" nil t)
+ (let* ((url (match-string-no-properties 1))
+ (placeholder (format "<<<LINK%d>>>" 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%d>>>" 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%d>>>" 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%d>>>" 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%d>>>" 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}_ -> <u>text</u>
+ (goto-char (point-min))
+ (while (re-search-forward "_{\\([^}\n]+\\)}_" nil t)
+ (replace-match "<u>\\1</u>"))
+ ;; 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 "\\(\\*\\*\\|`\\|</u>\\) +\\(\\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\\|\\*\\*\\|`\\|</u>\\) +\\(\\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 "<<<GMICODEBLOCK%d>>>" 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 "<a id=\"%s\"></a>\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)