A config/pkg-blog.el => config/pkg-blog.el +895 -0
@@ 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 "<<<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
+ ;; 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 -> <!--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>"))
+ ;; Convert bold: *text* -> **text**
+ (goto-char (point-min))
+ (while (re-search-forward "\\*\\([^*\n]+\\)\\*" nil t)
+ (replace-match "**\\1**"))
+ ;; Convert italic: /text/ -> *text*
+ (goto-char (point-min))
+ (while (re-search-forward "/\\([^/\n]+\\)/" nil t)
+ (replace-match "*\\1*"))
+ ;; Convert underline: _text_ -> <u>text</u>
+ (goto-char (point-min))
+ (while (re-search-forward "_\\([^_\n]+\\)_" nil t)
+ (replace-match "<u>\\1</u>"))
+ ;; Convert links: [[url][text]] -> [text](url)
+ (goto-char (point-min))
+ (while (re-search-forward "\\[\\[\\([^]]+\\)\\]\\[\\([^]]+\\)\\]\\]" nil t)
+ (replace-match "[\\2](\\1)"))
+ ;; Convert plain links: [[url]] -> <url>
+ (goto-char (point-min))
+ (while (re-search-forward "\\[\\[\\([^]]+\\)\\]\\]" nil t)
+ (replace-match "<\\1>"))
+ ;; Convert code: ~text~ -> `text`
+ (goto-char (point-min))
+ (while (re-search-forward "~\\([^~\n]+\\)~" nil t)
+ (replace-match "`\\1`"))
+ ;; Convert verbatim: =text= -> `text`
+ (goto-char (point-min))
+ (while (re-search-forward "=\\([^=\n]+\\)=" nil t)
+ (replace-match "`\\1`"))
+ ;; Convert BEGIN_QUOTE blocks
+ (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 "<!--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))
+ (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 <!--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)))))
+
+(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
M config/pkg-org.el => config/pkg-org.el +46 -16
@@ 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.")))
M org-structure.org => org-structure.org +8 -2
@@ 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: