我之前看到混用 org-ql、columnview、org-roam、org-capture、org-super-links 塑造我的笔记流程里面yibie用到dynamic block的功能,自己去试了试,做了一个物品管理数据库。我的使用场景中在包括物品的名称和物品的使用场景引用的几个field里可能会变很长,所以我希望能够固定列宽。但是复制yibie的写法并不能固定列宽(虽然他还有暗无天日的文章里都有设置列宽的方法)。
我稍微搜索和试验了一下,发现emacs-exchange上有一个一样的问题,没有有效解答,其他就没有什么先例的痕迹。
我看了下代码,columns和columnview :format会把相关的width会被储存到一些org-columns-*的变量,org-table-shrink没有检查这些变量,好像只有检查<N>
,所以需要一个patch把width信息从org-columns-current-fmt-compiled或者org-columns-current-maxwidths里接到输出的org-table里面,做一行<N>
出来。
我把org-dblock-write:columnview稍微改了一下。如果设置:vline t的话,这个函数本来就会在底部加一行<>,但是里面没有东西。我把它拿出来做了一个:width的param,专门在底部加<N>
。
我看见好像几个版本前有一个:width t的param可以设置生成的org-table的列宽,不知道我是不是给它改回去了。
(after! org
(defun hermanhel/org-dblock-write:columnview (params)
"Write the column view table.
PARAMS is a property list of parameters:
`:id' (mandatory)
The ID property of the entry where the columns view should be
built. When the symbol `local', call locally. When `global'
call column view with the cursor at the beginning of the
buffer (usually this means that the whole buffer switches to
column view). When \"file:path/to/file.org\", invoke column
view at the start of that file. Otherwise, the ID is located
using `org-id-find'.
`:exclude-tags'
List of tags to exclude from column view table.
`:format'
When non-nil, specify the column view format to use.
`:hlines'
When non-nil, insert a hline before each item. When
a number, insert a hline before each level inferior or equal
to that number.
`:indent'
When non-nil, indent each ITEM field according to its level.
`:match'
When set to a string, use this as a tags/property match filter.
`:maxlevel'
When set to a number, don't capture headlines below this level.
`:skip-empty-rows'
When non-nil, skip rows where all specifiers other than ITEM
are empty.
`:vlines'
When non-nil, make each column a column group to enforce
vertical lines.
`:width'
When non-nil, add a row of <N> at the bottom. N is the
widths set in the format."
(let ((table
(let ((id (plist-get params :id))
view-file view-pos)
(pcase id
(`global nil)
((or `local `nil) (setq view-pos (point)))
((and (let id-string (format "%s" id))
(guard (string-match "^file:\\(.*\\)" id-string)))
(setq view-file (match-string-no-properties 1 id-string))
(unless (file-exists-p view-file)
(user-error "No such file: %S" id-string)))
((and (let idpos (org-find-entry-with-id id)) (guard idpos))
(setq view-pos idpos))
((let `(,filename . ,position) (org-id-find id))
(setq view-file filename)
(setq view-pos position))
(_ (user-error "Cannot find entry with :ID: %s" id)))
(with-current-buffer (if view-file (get-file-buffer view-file)
(current-buffer))
(org-with-wide-buffer
(when view-pos (goto-char view-pos))
(org-columns--capture-view (plist-get params :maxlevel)
(plist-get params :match)
(plist-get params :skip-empty-rows)
(plist-get params :exclude-tags)
(plist-get params :format)
view-pos))))))
(when table
;; Prune level information from the table. Also normalize
;; headings: remove stars, add indentation entities, if
;; required, and possibly precede some of them with a horizontal
;; rule.
(let ((item-index
(let ((p (assoc "ITEM" org-columns-current-fmt-compiled)))
(and p (cl-position p
org-columns-current-fmt-compiled
:test #'equal))))
(hlines (plist-get params :hlines))
(indent (plist-get params :indent))
new-table)
;; Copy header and first rule.
(push (pop table) new-table)
(push (pop table) new-table)
(dolist (row table (setq table (nreverse new-table)))
(let ((level (car row)))
(when (and (not (eq (car new-table) 'hline))
(or (eq hlines t)
(and (numberp hlines) (<= level hlines))))
(push 'hline new-table))
(when item-index
(let ((item (org-columns--clean-item (nth item-index (cdr row)))))
(setf (nth item-index (cdr row))
(if (and indent (> level 1))
(concat "\\_" (make-string (* 2 (1- level)) ?\s) item)
item))))
(push (cdr row) new-table))))
(when (plist-get params :vlines)
(setq table
(let ((size (length org-columns-current-fmt-compiled)))
(append (mapcar (lambda (x) (if (eq 'hline x) x (cons "" x)))
table)
(list (cons
"/"
;; (make-list size "<>") ;;我改了的地方
(reverse (cl-reduce (lambda (result newelt) (cons (format "<%s>" (nth 2 newelt)) result)) org-columns-current-fmt-compiled :initial-value '() ))
))
))))
;; add a line of <N> at bottom to convert columnsview column widths to org-table wolumn widths ;;还有这里
(when (and (not (plist-get params :vlines)) (plist-get params :width) )(setq table (append table
(list
;; (make-list size "<>")
(reverse (cl-reduce (lambda (result newelt) (cons (format "<%s>" (nth 2 newelt)) result)) org-columns-current-fmt-compiled :initial-value '() ))
))))
(let ((content-lines (org-split-string (plist-get params :content) "\n"))
recalc)
;; Insert affiliated keywords before the table.
(when content-lines
(while (string-match-p "\\`[ \t]*#\\+" (car content-lines))
(insert (pop content-lines) "\n")))
(save-excursion
;; Insert table at point.
(insert
(mapconcat (lambda (row)
(if (eq row 'hline) "|-|"
(format "|%s|" (mapconcat #'identity row "|"))))
table
"\n"))
;; Insert TBLFM lines following table.
(let ((case-fold-search t))
(dolist (line content-lines)
(when (string-match-p "\\`[ \t]*#\\+TBLFM:" line)
(insert "\n" line)
(unless recalc (setq recalc t))))))
(when recalc (org-table-recalculate 'all t))
(org-table-align)
(org-table-shrink)))))
(defun org-dblock-write:columnview (params)
(hermanhel/org-dblock-write:columnview params)
)
)