分享几个关于Org-link的函数

Org-mode
1

用org-toggle-inline-images显示Org文档的图片时，如果图片过多，会明显感觉到卡顿，因此我写了个小函数来只切换当前subtree下的图片。

(defun org-display-subtree-inline-images ()
  "Toggle the display of inline images.
INCLUDE-LINKED is passed to `org-display-inline-images'."
  (interactive)
  (save-excursion
    (save-restriction
      (org-narrow-to-subtree)
      (let* ((beg (point-min))
             (end (point-max))
             (image-overlays (cl-intersection
                              org-inline-image-overlays
                              (overlays-in beg end))))
        (if image-overlays
            (progn
              (org-remove-inline-images)
              (message "Inline image display turned off"))
          (org-display-inline-images t t beg end)
          (setq image-overlays (cl-intersection
                                org-inline-image-overlays
                                (overlays-in beg end)))
          (if (and (org-called-interactively-p) image-overlays)
              (message "%d images displayed inline"
                       (length image-overlays))))))))

还有，有时候需要调换相邻图片链接的位置，下面的两个函数可以提供该功能。

(defun org-move-link-left ()
  "Move link at point to left."
  (interactive)
  (let ((point (point))
        (eop (org-element-context)))
    (when (eq 'link (car eop))
      (let* ((start (org-element-property :begin eop))
             (end (org-element-property :end eop))
             (contents (buffer-substring start end)))
        (goto-char start)
        (skip-chars-backward "[ \t]+")
        (let ((leop (org-element-context)))
          (if (eq 'link (car leop))
              (let* ((left-start (org-element-property :begin leop))
                     (left-end (org-element-property :end leop))
                     (left-contents (buffer-substring left-start left-end)))
                (setf (buffer-substring start end) left-contents)
                (setf (buffer-substring left-start left-end)
                      (if (= (org-element-property :post-blank eop) 0)
                          (concat contents " ")
                        contents))
                (goto-char (+ left-start (- point start))))
            (message "No link found on the left")))))))

(add-hook 'org-metaleft-hook #'org-move-link-left)

(defun org-move-link-right ()
  "Move link at point to right."
  (interactive)
  (let ((point (point))
        (eop (org-element-context)))
    (when (eq 'link (car eop))
      (let* ((start (org-element-property :begin eop))
             (end (org-element-property :end eop))
             (contents (buffer-substring start end)))
        (goto-char end)
        (skip-chars-forward "[ \t]+")
        (let ((reop (org-element-context)))
          (if (eq 'link (car reop))
              (let* ((right-start (org-element-property :begin reop))
                     (right-end (org-element-property :end reop))
                     (blanks (org-element-property :post-blank reop))
                     (right-contents (buffer-substring right-start right-end)))
                (setf (buffer-substring right-start right-end) contents)
                (setf (buffer-substring start end) right-contents)
                ;; (org-display-subtree-inline-images)
                (goto-char (+ point (- right-end right-start))))
            (message "No link found on the right")))))))

(add-hook 'org-metaright-hook #'org-move-link-right)
7 个赞
2

第一个函数对我很有用，感谢

3

另外我觉得第一个函数应该贡献到Org Mode, 这样的功能应该内置进去。WDYT?

4

很高兴对你有用。我也很奇怪为什么没有这个功能。
真要优美的实现的话就需要硬改org-display-inline-images，这个函数只是曲线实现了功能而已。 大家谁有更好的建议欢迎提出来。

5

我已经给Org Mode 邮件列表发了邮件，希望添加一个功能，就是 按键加上前置 C-u universal prefix 的时候，只显示 subtree 下的图片.

1 个赞
6

在原有代码的基础上更进一步，能够在按Tab展开headline后自动显示当前subtree的图片。

;;; Only display inline images under current subtree.
(defun org-display-subtree-inline-images (&optional state)
  "Toggle the display of inline images under current subtree.
INCLUDE-LINKED is passed to `org-display-inline-images'."
  (interactive)
  (save-excursion
    (save-restriction
      (org-narrow-to-subtree)
      (let* ((beg (point-min))
             (end (point-max))
             (image-overlays (cl-intersection
                              org-inline-image-overlays
                              (overlays-in beg end)))
             (display-inline-images-local
              (lambda ()
                (org-display-inline-images t t beg end)
                (setq image-overlays (cl-intersection
                                      org-inline-image-overlays
                                      (overlays-in beg end)))
                (if (and (org-called-interactively-p) image-overlays)
                    (message "%d images displayed inline"
                             (length image-overlays)))))
             (hide-inline-images-local
              (lambda ()
                (org-remove-inline-images)
                (message "Inline image display turned off"))))
        (if state
            (pcase state
              ('subtree
               (funcall display-inline-images-local))
              ('folded
               (funcall hide-inline-images-local)))
          (if image-overlays
              (funcall display-inline-images-local)
            (funcall hide-inline-images-local)))))))

(define-key org-mode-map (kbd "C-c C-x C-v") 'org-display-subtree-inline-images)

;;; auto display inline images on Org TAB cycle expand headlines.
(add-hook 'org-cycle-hook #'org-display-subtree-inline-images)
3 个赞
7

@stardiviner 很棒！赞一个。