From d2d4752f1014a261446acc88c0af9bfa352a5e07 Mon Sep 17 00:00:00 2001 From: Cytrogen Date: Tue, 13 Jan 2026 23:03:27 -0500 Subject: [PATCH] =?UTF-8?q?feat:=20=E6=B7=BB=E5=8A=A0=E5=88=86=E4=BA=AB?= =?UTF-8?q?=E9=A1=B9=E7=9B=AE/=E5=B7=A5=E5=85=B7=E7=9A=84=20capture=20?= =?UTF-8?q?=E6=A8=A1=E6=9D=BF=E5=92=8C=20monthly=20refile=20=E6=94=AF?= =?UTF-8?q?=E6=8C=81?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - org-structure.org: 添加"分享"子类到 Inbox，用于捕获项目/工具分享 - pkg-org.el: 修复属性解析器处理包含 :END: 的模板值，支持 TYPE 属性 - pkg-blog.el: 添加"有趣项目"栏目到 monthly 模板，支持 refile 时转换为无序列表 --- config/pkg-blog.el | 895 +++++++++++++++++++++++++++++++++++++++++++++ config/pkg-org.el | 62 +++- org-structure.org | 10 +- 3 files changed, 949 insertions(+), 18 deletions(-) create mode 100644 config/pkg-blog.el diff --git a/config/pkg-blog.el b/config/pkg-blog.el new file mode 100644 index 0000000000000000000000000000000000000000..fce793c1f66abc3fa5c232bd3e6521ede55861e1 --- /dev/null +++ b/config/pkg-blog.el @@ -0,0 +1,895 @@ +;;; pkg-blog.el --- Blog workflow for monthly posts -*- lexical-binding: t -*- + +;; Copyright (C) 2024 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-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)) + (downcase slug))) + +(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 the current monthly." + (interactive) + (unless (org-at-heading-p) + (org-back-to-heading t)) + + (let* ((monthly-file (my/blog--current-monthly-file)) + (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) + ;; 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-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) + ;; 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--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 (cdr (assoc "SOURCE" props))) + (custom-id (cdr (assoc "CUSTOM_ID" props))) + (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)))))) + (push (list :level level + :title title + :source source + :custom-id (or 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 (and (= level 1) (member title input-sections)) + (setq current-section title) + (setq toc (concat toc (format "#### %s\n\n" title)))) + (when (and (= level 2) current-section (member current-section input-sections)) + (setq toc (concat toc (format "- [%s](#%s)\n" 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))) + (when (and (= level 1) (member title output-main-sections)) + ;; Skip if it's skippable and empty + (unless (and (member title skippable) + (or (null content) (string-empty-p content))) + (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 "<<>>" 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 + ;; 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 #+MORE -> (case insensitive) + (goto-char (point-min)) + (let ((case-fold-search t)) + (while (re-search-forward "^#\\+MORE\\s-*$" nil t) + (replace-match ""))) + ;; Convert \\\\ ->
(line break within paragraph) + (goto-char (point-min)) + (while (re-search-forward "\\\\\\\\\\s-*$" nil t) + (replace-match "
")) + ;; Convert bold: *text* -> **text** + (goto-char (point-min)) + (while (re-search-forward "\\*\\([^*\n]+\\)\\*" nil t) + (replace-match "**\\1**")) + ;; Convert italic: /text/ -> *text* + (goto-char (point-min)) + (while (re-search-forward "/\\([^/\n]+\\)/" nil t) + (replace-match "*\\1*")) + ;; Convert underline: _text_ -> text + (goto-char (point-min)) + (while (re-search-forward "_\\([^_\n]+\\)_" nil t) + (replace-match "\\1")) + ;; Convert links: [[url][text]] -> [text](url) + (goto-char (point-min)) + (while (re-search-forward "\\[\\[\\([^]]+\\)\\]\\[\\([^]]+\\)\\]\\]" nil t) + (replace-match "[\\2](\\1)")) + ;; Convert plain links: [[url]] -> + (goto-char (point-min)) + (while (re-search-forward "\\[\\[\\([^]]+\\)\\]\\]" nil t) + (replace-match "<\\1>")) + ;; Convert code: ~text~ -> `text` + (goto-char (point-min)) + (while (re-search-forward "~\\([^~\n]+\\)~" nil t) + (replace-match "`\\1`")) + ;; Convert verbatim: =text= -> `text` + (goto-char (point-min)) + (while (re-search-forward "=\\([^=\n]+\\)=" nil t) + (replace-match "`\\1`")) + ;; Convert BEGIN_QUOTE blocks + (goto-char (point-min)) + (while (re-search-forward "^#\\+BEGIN_QUOTE" nil t) + (replace-match "")) + (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) + (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")) + (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")) + (replace-match (format "{%% end%s %%}" tag))))) + + ;; 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-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"))) + (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")))) + + ;; 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") + ;; 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 "tags:\n") + (insert "description:\n") + (insert "---\n\n") + + ;; Intro + (when (not (string-empty-p intro)) + (insert (my/blog--convert-org-to-md intro) "\n\n")) + + ;; More marker + (insert "\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)) + (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 + (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"))))))) + + ;; Write to file + (write-region (point-min) (point-max) export-file)) + + (message "Exported to: %s" export-file) + (find-file export-file))))) + +;;; 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'." + ;; 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 "心理与关系"))) + "** %^{标题}\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))) + ;; 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) + (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")) + (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)) + ;; 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 "---\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 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))))) + +(defun my/blog--get-post-body () + "Get the body content of the org file (excluding properties header)." + (save-excursion + (goto-char (point-min)) + ;; Skip past all #+KEYWORD lines + (while (and (not (eobp)) + (looking-at "^\\(#\\+\\|$\\)")) + (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 "#+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)) + + ;; Open the new file + (find-file filepath) + (message "已创建博客文章: %s\n用 C-c b p 导出为 Markdown" filepath))) + +;;; Provide + +(provide 'pkg-blog) +;;; pkg-blog.el ends here diff --git a/config/pkg-org.el b/config/pkg-org.el index 534e556ea647b14d8caf165f301a4699c71e6119..9e307c66406337bcab70648c73260ffd68f039bc 100644 --- a/config/pkg-org.el +++ b/config/pkg-org.el @@ -77,7 +77,7 @@ ;; Look for properties drawer after the headline (when (re-search-forward ":PROPERTIES:" (line-end-position 10) t) (let ((props-start (point))) - (when (re-search-forward ":END:" nil t) + (when (re-search-forward "^[ \t]*:END:" nil t) (let ((props-end (match-beginning 0))) (goto-char props-start) (while (re-search-forward "^[ \t]*:\\([^:]+\\):[ \t]*\\(.*\\)$" props-end t) @@ -119,11 +119,18 @@ Format: ((key label file ((subkey sublabel headline template override-file) ...) ((and (= level 2) current-main) (let* ((key (cdr (assoc "KEY" props))) (headline (cdr (assoc "HEADLINE" props))) - (template (cdr (assoc "TEMPLATE" props))) + (raw-template (cdr (assoc "TEMPLATE" props))) + ;; Convert literal \n to actual newlines + (template (when raw-template + (replace-regexp-in-string (regexp-quote "\\n") "\n" raw-template))) (file-override (cdr (assoc "FILE" props))) + (type-str (cdr (assoc "TYPE" props))) + (type (if (and type-str (not (string-empty-p type-str))) + (intern type-str) + 'entry)) (sub-list (nth 3 current-main))) (when key - (let ((entry (list key title headline template file-override))) + (let ((entry (list key title headline template file-override type))) (setf (nth 3 current-main) (append sub-list (list entry)))))))))) (setq my/parsed-org-structure (reverse result)) (message "Org structure loaded with %d main categories." (length result)))) @@ -136,7 +143,19 @@ Format: ((key label file ((subkey sublabel headline template override-file) ...) ;; 强化 Refile 功能，允许将条目移动到项目或分类的具体标题下 (setq org-refile-use-outline-path 'file) (setq org-outline-path-complete-in-steps nil) - (setq org-refile-allow-creating-parent-nodes 'confirm)) + (setq org-refile-allow-creating-parent-nodes 'confirm) + + ;; --- Source Block Editing Configuration --- + ;; 让 TAB 在源代码块中按语言原生方式工作 + (setq org-src-tab-acts-natively t) + ;; 保留源代码块的缩进，不自动调整 + (setq org-src-preserve-indentation t) + ;; 源代码块内容不额外缩进（相对于 #+BEGIN_SRC） + (setq org-edit-src-content-indentation 0) + ;; 在当前窗口编辑源代码块（避免分割窗口） + (setq org-src-window-setup 'current-window) + ;; 禁用返回编辑 buffer 时的确认提示 + (setq org-src-ask-before-returning-to-edit-buffer nil)) ;; Custom Org Functions ;; Helper functions for enhanced workflow @@ -157,33 +176,44 @@ Format: ((key label file ((subkey sublabel headline template override-file) ...) (interactive) (unless my/parsed-org-structure (my/load-org-structure)) - + (let ((templates '())) (dolist (main my/parsed-org-structure) - (let ((main-file (nth 2 main)) + (let ((main-key (nth 0 main)) + (main-label (nth 1 main)) + (main-file (nth 2 main)) (sub-cats (nth 3 main))) + + ;; 只添加有效的一级菜单项（有子分类的） + (when sub-cats + (push (list main-key main-label) templates)) + + ;; 添加二级模板项（使用组合键） (dolist (sub sub-cats) - (let* ((key (nth 0 sub)) + (let* ((sub-key (nth 0 sub)) + (combined-key (concat main-key sub-key)) (label (nth 1 sub)) (headline (nth 2 sub)) (template (nth 3 sub)) (file-ov (nth 4 sub)) + (type (or (nth 5 sub) 'entry)) (target-file (expand-file-name (or file-ov main-file) org-directory)) - (capture-target + (capture-target (cond ((and headline (string= headline "datetree")) (list 'file+olp+datetree target-file)) ((and headline (not (string-empty-p headline))) (list 'file+headline target-file headline)) - (t - (list 'file target-file))))) ; Default to file end if no headline - - ;; Use default template if missing + (t + (list 'file target-file))))) + (unless template - (setq template "* TODO %?\n %U")) - - (push (list key label 'entry capture-target template) templates))))) - + (setq template (if (eq type 'item) + "- %?" + "* TODO %?\n %U"))) + + (push (list combined-key label type capture-target template) templates))))) + (setq org-capture-templates (reverse templates)) (message "Org capture templates updated."))) diff --git a/org-structure.org b/org-structure.org index fcf8eb78df302cb3343a9c58ede6b7fa9deced8d..6b978247348264e659435aa86b33c6ee062a9427 100644 --- a/org-structure.org +++ b/org-structure.org @@ -44,6 +44,12 @@ :HEADLINE: Someday/Maybe :TEMPLATE: * %? \n %U :END: +** 分享 + :PROPERTIES: + :KEY: S + :HEADLINE: 分享 + :TEMPLATE: ** %^{名称}\n:PROPERTIES:\n:URL: %^{URL}\n:END:\n%? + :END: * Tech :PROPERTIES: @@ -180,7 +186,7 @@ :PROPERTIES: :KEY: b :HEADLINE: 书籍笔记 - :TEMPLATE: * %? \n %U + :TEMPLATE: ** 《%^{书名}》笔记 %^{序号}: %^{标题}\n%U\n\n%? :END: ** 课程笔记 :PROPERTIES: @@ -192,7 +198,7 @@ :PROPERTIES: :KEY: a :HEADLINE: 文章笔记 - :TEMPLATE: * %? \n %U + :TEMPLATE: ** %^{标题}\n%?\nsource: %^{URL}\n%U :END: ** 视频笔记 :PROPERTIES: