~cytrogen/.emacs.d

504e0080a3f94c9824ac305b1a24b30c7d1fb051 — HallowDem 3 months ago 1c84b14
feat: 添加博客图片插入功能

- 添加图片链接导出转换,支持 [[./image.png]] 和 [[file:image.png]] 格式
- 新增 my/blog-insert-image 函数,支持本地文件和网络 URL
- 网络图片自动下载保存到文章资源目录
1 files changed, 162 insertions(+), 2 deletions(-)

M config/pkg-blog.el
M config/pkg-blog.el => config/pkg-blog.el +162 -2
@@ 38,6 38,60 @@
  :type 'directory
  :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)
        (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))))))
            (forward-line 1)))))
    
    ;; 2. Validate Source Dir
    (unless (and source-dir (file-directory-p source-dir))
      (setq source-dir (read-directory-name "请选择博客 Org 源码目录 (Select Blog Source Dir): " (bound-and-true-p org-directory)))
      (unless (file-directory-p source-dir)
        (make-directory source-dir t))
      (setq config-changed t))
      
    ;; 3. Validate Export Dir
    (unless (and export-dir (file-directory-p export-dir))
      (setq export-dir (read-directory-name "请选择博客发布目录 (Select Blog Export Dir, e.g. source/_posts): " "D:/"))
      (unless (file-directory-p export-dir)
        (make-directory export-dir t))
      (setq config-changed t))
      
    ;; 4. Save if changed
    (when config-changed
      (with-temp-file my/blog-dirs-config-file
        (insert (format "SOURCE=%s\nEXPORT=%s\n" source-dir export-dir))))
    
    ;; 5. Apply settings
    (setq my/blog-org-dir (file-name-as-directory source-dir))
    (setq my/blog-export-dir (file-name-as-directory export-dir))
    (message "Blog directories loaded.\nSource: %s\nExport: %s" my/blog-org-dir my/blog-export-dir)))

;; Execute setup immediately
(my/setup-blog-directories)

(defcustom my/blog-monthly-sections
  '(("商业与社会" . "商业与社会")
    ("心理与关系" . "心理与关系")


@@ 512,6 566,15 @@ Returns list of (level title properties content subsections)."
      (goto-char (point-min))
      (while (re-search-forward "_\\([^_\n]+\\)_" nil t)
        (replace-match "<u>\\1</u>"))
      ;; Convert image links BEFORE other link conversions
      ;; [[file:path/image.png][alt]] or [[./path/image.png][alt]] → ![alt](image.png)
      (goto-char (point-min))
      (while (re-search-forward "\\[\\[\\(?:file:\\|\\.?/\\)?\\([^]]*\\.\\(png\\|jpg\\|jpeg\\|gif\\|webp\\|svg\\)\\)\\]\\[\\([^]]+\\)\\]\\]" nil t)
        (replace-match "![\\3](\\1)"))
      ;; [[file:image.png]] or [[./image.png]] → ![](image.png)
      (goto-char (point-min))
      (while (re-search-forward "\\[\\[\\(?:file:\\|\\.?/\\)?\\([^]]*\\.\\(png\\|jpg\\|jpeg\\|gif\\|webp\\|svg\\)\\)\\]\\]" nil t)
        (replace-match "![](\\1)"))
      ;; Convert links: [[url][text]] -> [text](url)
      (goto-char (point-min))
      (while (re-search-forward "\\[\\[\\([^]]+\\)\\]\\[\\([^]]+\\)\\]\\]" nil t)


@@ 550,6 613,32 @@ Returns list of (level title properties content subsections)."
          (unless (member tag '("src" "quote"))
            (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 **
      (goto-char (point-min))
      (while (re-search-forward "\\(\\cC\\) +\\(\\*[^*]\\)" nil t)
        (replace-match "\\1\\2"))
      (goto-char (point-min))
      (while (re-search-forward "\\([^*]\\*\\) +\\(\\cC\\)" nil t)
        (replace-match "\\1\\2"))
      ;; Remove space before CJK punctuation
      (goto-char (point-min))
      (while (re-search-forward "\\(\\cC\\|\\*\\*\\|`\\|</u>\\) +\\(\\cP\\)" nil t)
        (replace-match "\\1\\2"))

      ;; Step 3: Restore code blocks
      (dolist (block code-blocks)
        (goto-char (point-min))


@@ 814,13 903,23 @@ If FILE is nil, use current buffer's file."
        (message "Exported to: %s" export-file)))))

(defun my/blog--get-post-body ()
  "Get the body content of the org file (excluding properties header)."
  "Get the body content of the org file (excluding properties header and drawers)."
  (save-excursion
    (goto-char (point-min))
    ;; Skip past all #+KEYWORD lines
    ;; 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))))



@@ 889,6 988,67 @@ Creates a new org file in the blog posts directory with front matter."
    (find-file filepath)
    (message "已创建博客文章: %s\n用 C-c b p 导出为 Markdown" filepath)))

;;; Image Insertion

(defun my/blog--url-p (string)
  "Return non-nil if STRING looks like a URL."
  (string-match-p "^https?://" string))

(defun my/blog--download-image (url target-file)
  "Download image from URL to TARGET-FILE."
  (require 'url)
  (let ((url-request-method "GET"))
    (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 both local files and web URLs.
For local files: select and copy to post's asset folder.
For web URLs: download and save with a specified filename."
  (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))
         ;; 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"))
    ;; Create target directory if needed
    (unless (file-directory-p target-dir)
      (make-directory target-dir t)
      (message "Created directory: %s" target-dir))
    ;; Download or copy image
    (unless (file-exists-p target-file)
      (if is-url
          (progn
            (message "Downloading %s..." source)
            (my/blog--download-image source target-file)
            (message "Downloaded to %s" target-file))
        (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)))))

;;; Provide

(provide 'pkg-blog)