;;; pkg-blog.el --- Blog workflow for monthly posts -*- lexical-binding: t -*-
;; Copyright (C) 2026 Cytrogen
;; This file contains:
;; - Monthly blog post creation and management
;; - Refile to monthly functionality
;; - Export to Hexo markdown
;;; Commentary:
;; Implements a capture → refile → export workflow for monthly blog posts.
;; Monthly posts use Chinese calendar naming (天干地支 + 月份).
;;; Code:
(require 'org)
(require 'org-element)
;;; Configuration
(defgroup my/blog nil
"Blog workflow configuration."
:group 'org)
(defcustom my/blog-org-dir "~/Documents/Org/blog/"
"Directory for blog org source files."
:type 'directory
:group 'my/blog)
(defcustom my/blog-monthly-dir "monthly/"
"Subdirectory for monthly posts (relative to `my/blog-org-dir')."
:type 'string
:group 'my/blog)
(defcustom my/blog-export-dir "~/Projects/blog/source/_posts/"
"Directory for exported markdown files."
: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")
"File to store the user's Blog directories.")
(defun my/setup-blog-directories ()
"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
(insert-file-contents my/blog-dirs-config-file)
(goto-char (point-min))
(while (not (eobp))
(let ((line-start (point)))
(end-of-line)
(let ((line (buffer-substring-no-properties line-start (point))))
(cond
((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))))
((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. 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\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))
(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)
(defcustom my/blog-monthly-sections
'(("商业与社会" . "商业与社会")
("心理与关系" . "心理与关系")
("科学与自然" . "科学与自然")
("技术与创造" . "技术与创造")
("技术与创造/有趣项目" . "有趣项目")
("折腾博客" . "折腾博客")
("编程历程" . "编程历程")
("书籍" . "书籍")
("影视" . "影视")
("音乐" . "音乐")
("日记片段" . "日记片段")
("生活与文娱" . "生活与文娱"))
"Sections available in monthly posts. Format: ((display . headline) ...)."
:type '(alist :key-type string :value-type string)
:group 'my/blog)
;;; Chinese Calendar Names
(defconst my/blog--tiangan
["甲" "乙" "丙" "丁" "戊" "己" "庚" "辛" "壬" "癸"]
"天干 (Heavenly Stems).")
(defconst my/blog--dizhi
["子" "丑" "寅" "卯" "辰" "巳" "午" "未" "申" "酉" "戌" "亥"]
"地支 (Earthly Branches).")
(defconst my/blog--month-names
["正月" "二月" "三月" "四月" "五月" "六月"
"七月" "八月" "九月" "十月" "冬月" "腊月"]
"Traditional Chinese month names.")
(defconst my/blog--month-alt-names
'((1 . "正月") (2 . "杏月") (3 . "桃月") (4 . "槐月")
(5 . "蒲月") (6 . "荷月") (7 . "巧月") (8 . "桂月")
(9 . "菊月") (10 . "阳月") (11 . "冬月") (12 . "腊月"))
"Alternative traditional month names (花名).")
(defun my/blog--chinese-year (year)
"Convert YEAR to Chinese 天干地支 format."
(let* ((offset (- year 4)) ; 公元4年是甲子年
(tiangan-idx (mod offset 10))
(dizhi-idx (mod offset 12)))
(concat (aref my/blog--tiangan tiangan-idx)
(aref my/blog--dizhi dizhi-idx))))
(defun my/blog--chinese-month (month)
"Convert MONTH (1-12) to traditional Chinese name."
(aref my/blog--month-names (1- month)))
;;; Utility Functions
(defun my/blog--monthly-dir-full ()
"Return full path to monthly directory."
(expand-file-name my/blog-monthly-dir my/blog-org-dir))
(defun my/blog--ensure-directories ()
"Create blog directories if they don't exist."
(let ((monthly-dir (my/blog--monthly-dir-full)))
(unless (file-exists-p my/blog-org-dir)
(make-directory my/blog-org-dir t))
(unless (file-exists-p monthly-dir)
(make-directory monthly-dir t))))
(defun my/blog--monthly-filename (year month)
"Generate filename for monthly post. YEAR and MONTH are integers."
(format "%04d-%02d.org" year month))
(defun my/blog--monthly-filepath (year month)
"Return full path for monthly file."
(expand-file-name (my/blog--monthly-filename year month)
(my/blog--monthly-dir-full)))
(defun my/blog--current-monthly-file ()
"Return filepath for current month's monthly file."
(let ((now (decode-time)))
(my/blog--monthly-filepath (nth 5 now) (nth 4 now))))
(defun my/blog--slugify (text)
"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 "[[: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."
(let ((posts-dir (expand-file-name "_posts" (file-name-directory my/blog-export-dir)))
(target-prefix (format "%04d-%02d" year month))
(results '()))
(when (file-directory-p posts-dir)
(dolist (file (directory-files posts-dir t "\\.md$"))
(with-temp-buffer
(insert-file-contents file nil 0 1000) ; Read first 1000 chars for front matter
(goto-char (point-min))
(when (looking-at "---")
(forward-line 1)
(let ((fm-end (save-excursion
(when (re-search-forward "^---$" nil t)
(point))))
(title nil)
(abbrlink nil)
(date nil))
(when fm-end
;; Extract title
(goto-char (point-min))
(when (re-search-forward "^title: \\(.+\\)$" fm-end t)
(setq title (string-trim (match-string-no-properties 1))))
;; Extract abbrlink
(goto-char (point-min))
(when (re-search-forward "^abbrlink: \\(.+\\)$" fm-end t)
(setq abbrlink (string-trim (match-string-no-properties 1))))
;; Extract date
(goto-char (point-min))
(when (re-search-forward "^date: \\(.+\\)$" fm-end t)
(setq date (string-trim (match-string-no-properties 1))))
;; Check if date matches target month
(when (and title abbrlink date
(string-prefix-p target-prefix date)
;; Exclude monthly posts themselves
(not (string-match-p "想法在.*迭代" title)))
(push (cons title (format "/posts/%s.html" abbrlink))
results))))))))
(nreverse results)))
;;; Monthly Creation
(defun my/blog--monthly-template (year month chinese-year chinese-month)
"Generate org content for a new monthly post."
(format "#+TITLE: 想法在%s%s迭代
#+DATE: %04d-%02d-01
#+HUGO_BASE_DIR: ~/Projects/blog
#+HUGO_SECTION: _posts
#+CATEGORIES: 想法迭代
#+HUGO_CUSTOM_FRONT_MATTER: :lang zh :mathjax false :hidden false
开场白...
* 商业与社会
:PROPERTIES:
:CUSTOM_ID: 商业与社会
:END:
* 心理与关系
:PROPERTIES:
:CUSTOM_ID: 心理与关系
:END:
* 科学与自然
:PROPERTIES:
:CUSTOM_ID: 科学与自然
:END:
* 技术与创造
:PROPERTIES:
:CUSTOM_ID: 技术与创造
:END:
** 有趣项目
:PROPERTIES:
:CUSTOM_ID: 有趣项目
:END:
* 折腾博客
:PROPERTIES:
:CUSTOM_ID: 折腾博客
:END:
* 我写的文章
:PROPERTIES:
:CUSTOM_ID: 我写的文章
:END:
* 编程历程
:PROPERTIES:
:CUSTOM_ID: 编程历程
:END:
* 书籍
:PROPERTIES:
:CUSTOM_ID: 书籍
:END:
* 影视
:PROPERTIES:
:CUSTOM_ID: 影视
:END:
* 音乐
:PROPERTIES:
:CUSTOM_ID: 音乐
:END:
* 日记片段
:PROPERTIES:
:CUSTOM_ID: 日记片段
:END:
"
chinese-year chinese-month year month))
(defun my/blog-create-monthly ()
"Create a new monthly org file.
Prompts for month name and year."
(interactive)
(my/blog--ensure-directories)
(let* ((now (decode-time))
(default-year (nth 5 now))
(default-month (nth 4 now))
(chinese-month (read-string "月份名称 (如 腊月、冬月): "))
(year (read-number "年份: " default-year))
(month (read-number "月份数字 (1-12): " default-month))
(chinese-year (my/blog--chinese-year year))
(filepath (my/blog--monthly-filepath year month)))
(when (string-empty-p chinese-month)
(setq chinese-month (my/blog--chinese-month month)))
(if (file-exists-p filepath)
(progn
(find-file filepath)
(message "Monthly file already exists: %s" filepath))
(find-file filepath)
(insert (my/blog--monthly-template year month chinese-year chinese-month))
(save-buffer)
(message "Created monthly: 想法在%s%s迭代" chinese-year chinese-month))))
(defun my/blog-open-current-monthly ()
"Open the current month's monthly file, creating if needed."
(interactive)
(let ((filepath (my/blog--current-monthly-file)))
(if (file-exists-p filepath)
(find-file filepath)
(call-interactively 'my/blog-create-monthly))))
;;; Refile to Monthly
(defun my/blog-refile-to-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-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))
(target-headline (cdr (assoc target-selection my/blog-monthly-sections))))
;; Special handling for "有趣项目" - convert to list item
(if (string= target-headline "有趣项目")
(my/blog--refile-as-list-item monthly-file target-headline)
;; Normal refile for other sections
(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)))
(org-reverse-note-order t))
(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)))))))))
(defun my/blog--refile-as-list-item (file headline)
"Convert current entry to a list item and insert under HEADLINE in FILE."
(let* ((title (org-get-heading t t t t))
(url (org-entry-get nil "URL"))
(content (save-excursion
(org-back-to-heading t)
(let ((start (progn
(org-end-of-meta-data t)
(point)))
(end (org-end-of-subtree t t)))
(string-trim (buffer-substring-no-properties start end)))))
(list-item (if (and url (not (string-empty-p url)))
(if (string-empty-p content)
(format "- [[%s][%s]]" url title)
(format "- [[%s][%s]]: %s" url title content))
(if (string-empty-p content)
(format "- %s" title)
(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))
(if (re-search-forward (format "^\\*+ %s" (regexp-quote headline)) nil t)
(progn
(org-end-of-meta-data t)
;; Move to end of existing list items or end of section
(let ((section-end (save-excursion (org-end-of-subtree t t))))
(while (and (< (point) section-end)
(looking-at "^[ \t]*\\(-\\|$\\)"))
(forward-line 1))
;; Back up if we went past list items
(when (and (> (point) (point-min))
(not (looking-at "^[ \t]*-")))
(forward-line -1)
(end-of-line)))
(insert "\n" list-item)
(save-buffer)
(message "Added to %s: %s" headline title))
(error "Headline '%s' not found in %s" headline file)))))
;;; Export Functions
(defun my/blog--get-org-property (prop)
"Get PROP from current org buffer's keywords."
(save-excursion
(goto-char (point-min))
(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)."
(with-current-buffer buffer
(let ((result '())
(intro-text ""))
;; Get intro text (before first heading)
(save-excursion
(goto-char (point-min))
(when (re-search-forward "^\\*" nil t)
(let ((first-heading (line-beginning-position)))
(goto-char (point-min))
;; Skip keywords
(while (and (< (point) first-heading)
(looking-at "^#\\+"))
(forward-line 1))
;; Skip blank lines
(while (and (< (point) first-heading)
(looking-at "^[ \t]*$"))
(forward-line 1))
(when (< (point) first-heading)
(setq intro-text (string-trim
(buffer-substring-no-properties
(point) first-heading)))))))
;; Parse headings
(org-element-map (org-element-parse-buffer) 'headline
(lambda (hl)
(let* ((level (org-element-property :level hl))
(title (org-element-property :raw-value hl))
(begin (org-element-property :contents-begin hl))
(end (org-element-property :contents-end hl))
(props (org-entry-properties (org-element-property :begin hl)))
(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
(when (and begin end)
(save-excursion
(goto-char begin)
;; Skip PROPERTIES drawer if present
(when (looking-at "[ \t]*:PROPERTIES:")
(when (re-search-forward "^[ \t]*:END:" end t)
(forward-line 1)))
(let* ((content-start (point))
(content-end (if (re-search-forward "^\\*+ " end t)
(line-beginning-position)
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 (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)))))
(defun my/blog--generate-hexo-toc (sections)
"Generate Hexo-style TOC from SECTIONS."
(let ((toc "{% details 本期导读 %}\n\n")
(input-sections '("商业与社会" "心理与关系" "科学与自然" "技术与创造"))
;; Output sections (excluding 书籍/影视/音乐 which have special format)
(output-main-sections '("折腾博客" "我写的文章" "编程历程"))
(media-sections '("书籍" "影视" "音乐"))
(current-section nil)
(found-media nil))
;; Build 输入 section
(setq toc (concat toc "## 输入\n\n"))
(dolist (sec sections)
(let ((title (plist-get sec :title))
(level (plist-get sec :level))
(slug (plist-get sec :custom-id)))
(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" (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)
(let ((skippable '("折腾博客" "编程历程")))
(dolist (sec sections)
(let ((title (plist-get sec :title))
(level (plist-get sec :level))
(slug (plist-get sec :custom-id))
(content (plist-get sec :content))
(has-subsections nil))
(when (and (= level 1) (member title output-main-sections))
;; 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))
(not has-subsections))
(setq toc (concat toc (format "- [%s](#%s)\n" title slug))))))))
;; 书籍/影视/音乐 special format
(dolist (sec sections)
(when (and (= (plist-get sec :level) 1)
(member (plist-get sec :title) media-sections))
(setq found-media t)))
(when found-media
(setq toc (concat toc "- [书籍](#书籍) / [影视](#影视) / [音乐](#音乐)\n")))
;; 日记片段 -> 真生活
(dolist (sec sections)
(when (and (= (plist-get sec :level) 1)
(string= (plist-get sec :title) "日记片段"))
(setq toc (concat toc "- [真生活](#日记片段)\n"))))
(concat toc "\n{% enddetails %}\n")))
(defun my/blog--convert-org-to-md (content)
"Convert org CONTENT to markdown, preserving code block contents."
(with-temp-buffer
(insert content)
;; Step 1: Extract and protect code blocks with placeholders
(let ((code-blocks '())
(counter 0))
(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 "<<<CODEBLOCK%d>>>" counter))
(md-block (format "```%s\n%s```" lang block-content)))
(push (cons placeholder md-block) code-blocks)
(delete-region start end)
(goto-char start)
(insert placeholder)
(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)
(let* ((stars (match-string 1))
(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))
(while (re-search-forward "^#\\+MORE\\s-*$" nil t)
(replace-match "<!--more-->")))
;; Convert \\\\ -> <br> (line break within paragraph)
(goto-char (point-min))
(while (re-search-forward "\\\\\\\\\\s-*$" nil t)
(replace-match "<br>"))
;; 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 "^\\([ \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 "^[ \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" "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" "example"))
(replace-match (format "{%% end%s %%}" tag)))))
;; Remove any remaining PROPERTIES drawers
(goto-char (point-min))
(while (re-search-forward "^[ \t]*:PROPERTIES:[ \t]*\n\\(?:.*\n\\)*?[ \t]*:END:[ \t]*\n?" nil t)
(replace-match ""))
;; Step 2.5: Clean up spaces around CJK characters and style markers
;; Remove space between CJK char and opening style marker
(goto-char (point-min))
(while (re-search-forward "\\(\\cC\\) +\\(\\*\\*\\|`\\|<u>\\)" nil t)
(replace-match "\\1\\2"))
;; Remove space between closing style marker and CJK char
(goto-char (point-min))
(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"))
;; Remove space before CJK punctuation
(goto-char (point-min))
(while (re-search-forward "\\(\\cC\\|\\*\\*\\|`\\|</u>\\) +\\(\\cP\\)" nil t)
(replace-match "\\1\\2"))
;; Step 3: Restore code blocks
(dolist (block code-blocks)
(goto-char (point-min))
(when (search-forward (car block) nil t)
(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."
(interactive)
(let* ((org-file (or file
(when (and (buffer-file-name)
(string-suffix-p ".org" (buffer-file-name)))
(buffer-file-name))
(my/blog--current-monthly-file))))
;; Debug: show which file we're exporting
(message "Exporting: %s" org-file)
;; Read file contents directly
(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 %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 (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 (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
(when (not (string-empty-p intro))
(insert (my/blog--convert-org-to-md intro) "\n\n"))
;; More marker
(insert "<!--more-->\n\n")
;; TOC
(insert (my/blog--generate-hexo-toc sections) "\n")
;; Collect monthly posts for auto-fill
(let* ((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)))
;; Main content
(let ((skippable-sections '("折腾博客" "编程历程"))
(hr-inserted nil))
(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)
(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)
"Return capture target for SECTION in current monthly."
(let ((file (my/blog--current-monthly-file)))
;; Ensure file exists
(unless (file-exists-p file)
(my/blog-create-monthly))
`(file+headline ,file ,section)))
(defun my/blog-capture-to-monthly ()
"Capture an entry directly to the current monthly.
Prompts for section selection."
(interactive)
(let* ((sections (mapcar #'car my/blog-monthly-sections))
(section (completing-read "Section: " sections nil t))
(file (my/blog--current-monthly-file)))
;; Ensure monthly exists
(unless (file-exists-p file)
(my/blog-create-monthly))
;; Set up temporary capture template
(let ((org-capture-templates
`(("x" "Monthly Entry" entry
(file+headline ,file ,section)
"** %^{标题}\n:PROPERTIES:\n:CUSTOM_ID: %(my/blog--slugify (org-capture-get :annotation))\n:SOURCE: %^{URL}\n:END:\n\n%?\n\n%U"))))
(org-capture nil "x"))))
;; Add a simple menu entry for monthly capture
(defun my/blog--add-monthly-capture-templates ()
"Add monthly capture templates to `org-capture-templates'."
(add-to-list 'org-capture-templates
'("m" "Monthly (博客月刊)") t)
(add-to-list 'org-capture-templates
`("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
`("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)
(beginning-of-line)
(goto-char (point-max)))))
;; Add templates after org-capture is loaded
(with-eval-after-load 'org-capture
(run-with-idle-timer 1 nil #'my/blog--add-monthly-capture-templates))
;;; Regular Post Export
(defun my/blog-export-post (&optional file)
"Export regular org FILE to Hexo markdown.
If FILE is nil, use current buffer's file."
(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"))
(message "Exporting post: %s" org-file)
;; Read file contents
(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")))
(categories (or (my/blog--get-org-property "CATEGORIES") "未分类"))
(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") ""))
(export-file (expand-file-name
(concat (file-name-base org-file) ".md")
my/blog-export-dir))
;; Get main content (after properties)
(content (my/blog--get-post-body)))
;; Generate markdown
(with-temp-buffer
;; Front matter
(insert "---\n")
(insert (format "title: %s\n" title))
(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))
(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)))
(insert (format "date: %s\n"
(if (string-match ":" date) date (concat date " 00:00:00"))))
;; Format tags as YAML list if not empty
(if (and tags (not (string-empty-p tags)))
(progn
(insert "tags:\n")
(dolist (tag (split-string tags "," t "[ \t]+"))
(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
(when (and description (not (string-empty-p description)))
(insert description "\n\n"))
;; Main content (#+MORE in org will become <!--more--> via convert function)
(insert (my/blog--convert-org-to-md content))
;; Save
(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)))))
(defun my/blog--get-post-body ()
"Get the body content of the org file (excluding properties header and drawers)."
(save-excursion
(goto-char (point-min))
;; Skip past all #+KEYWORD lines and empty lines at beginning
(while (and (not (eobp))
(looking-at "^\\(#\\+\\|$\\)"))
(forward-line 1))
;; Skip any file-level drawers (PROPERTIES, LOGBOOK, etc.)
(while (and (not (eobp))
(looking-at "^[ \t]*:\\([A-Z]+\\):[ \t]*$"))
(if (re-search-forward "^[ \t]*:END:" nil t)
(forward-line 1)
(forward-line 1)))
;; Skip any blank lines after drawers
(while (and (not (eobp))
(looking-at "^[ \t]*$"))
(forward-line 1))
;; Get everything from here to end
(buffer-substring-no-properties (point) (point-max))))
;;; Convert Entry to Blog Post
(defun my/blog-create-post-from-entry ()
"Convert current org entry to a standalone blog post.
Creates a new org file in the blog posts directory with front matter."
(interactive)
(unless (derived-mode-p 'org-mode)
(error "Not in org-mode"))
;; Move to heading if not already there
(unless (org-at-heading-p)
(org-back-to-heading t))
(let* ((heading (org-get-heading t t t t))
(title (read-string "文章标题: " heading))
(slug (my/blog--slugify title))
(category (read-string "分类: " "技术"))
(date (format-time-string "%Y-%m-%d"))
(filename (concat slug ".org"))
(posts-dir (expand-file-name "posts" my/blog-org-dir))
(filepath (expand-file-name filename posts-dir))
;; Get entry content (without heading)
(content (save-excursion
(org-back-to-heading t)
(let ((start (progn (forward-line 1) (point)))
(end (org-end-of-subtree t t)))
(buffer-substring-no-properties start end)))))
;; Ensure posts directory exists
(unless (file-exists-p posts-dir)
(make-directory posts-dir t))
;; Check if file already exists
(when (file-exists-p filepath)
(unless (y-or-n-p (format "文件 %s 已存在，覆盖? " filename))
(error "已取消")))
;; Prompt for optional fields
(let ((tags (read-string "标签 (逗号分隔，可留空): "))
(description (read-string "描述 (可留空): ")))
;; Create new file with complete front matter
(with-temp-buffer
(insert (format "#+TITLE: %s\n" title))
(insert (format "#+DATE: %s\n" date))
(insert (format "#+CATEGORIES: %s\n" category))
(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)))
;; Clean up content (remove leading/trailing whitespace)
(insert (string-trim content))
(insert "\n")
(write-file filepath)))
;; Ask whether to delete original entry
(when (y-or-n-p "删除原条目? ")
(org-cut-subtree)
(save-buffer))
;; Open the new file
(find-file filepath)
(message "已创建博客文章: %s\n用 C-c b p 导出为 Markdown" filepath)))
;;; 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--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")
(url-request-extra-headers headers))
(with-current-buffer (url-retrieve-synchronously url t)
;; Skip HTTP headers
(goto-char (point-min))
(re-search-forward "\r?\n\r?\n" nil t)
;; Write binary content to file
(let ((coding-system-for-write 'binary))
(write-region (point) (point-max) target-file))
(kill-buffer))))
(defun my/blog-insert-image ()
"Insert an image link for blog post.
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 Immich URLs: auto-convert to API URL and download with auth."
(interactive)
(unless (buffer-file-name)
(error "Buffer must be visiting a file"))
(let* ((post-name (file-name-base (buffer-file-name)))
(target-dir (expand-file-name post-name my/blog-export-dir))
;; 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)))))
(read-string "Save as (e.g. photo.jpg): "
(if (string-match-p "\\." default-name) default-name "")))
(file-name-nondirectory source)))
(target-file (expand-file-name image-name target-dir))
(alt-text (read-string "Alt text (optional): ")))
;; 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)
(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))))
;; 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)
;;; pkg-blog.el ends here