forked from mirrors/org-mode
Small refactoring
* lisp/org.el (org-set-tags): Small refactoring.
This commit is contained in:
parent
a70604eb63
commit
271ecd090a
178
lisp/org.el
178
lisp/org.el
|
@ -14948,110 +14948,108 @@ When JUST-ALIGN is non-nil, only align tags."
|
||||||
(interactive "P")
|
(interactive "P")
|
||||||
(if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
|
(if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
|
||||||
(let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
|
(let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
|
||||||
'region-start-level 'region))
|
'region-start-level
|
||||||
|
'region))
|
||||||
org-loop-over-headlines-in-active-region)
|
org-loop-over-headlines-in-active-region)
|
||||||
(org-map-entries
|
(org-map-entries
|
||||||
;; We don't use ARG and JUST-ALIGN here because these args
|
;; We don't use ARG and JUST-ALIGN here because these args
|
||||||
;; are not useful when looping over headlines.
|
;; are not useful when looping over headlines.
|
||||||
`(org-set-tags)
|
#'org-set-tags
|
||||||
org-loop-over-headlines-in-active-region
|
org-loop-over-headlines-in-active-region
|
||||||
cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
|
cl
|
||||||
(let* ((re org-outline-regexp-bol)
|
'(when (outline-invisible-p) (org-end-of-subtree nil t))))
|
||||||
(current (unless arg (org-get-tags-string)))
|
(let ((org-setting-tags t))
|
||||||
(col (current-column))
|
|
||||||
(org-setting-tags t)
|
|
||||||
;; computed below when needed
|
|
||||||
tags
|
|
||||||
level)
|
|
||||||
(if arg
|
(if arg
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(let ((buffer-invisibility-spec (org-inhibit-invisibility)))
|
(let ((buffer-invisibility-spec (org-inhibit-invisibility)))
|
||||||
(while (re-search-forward re nil t)
|
(while (re-search-forward org-outline-regexp-bol nil t)
|
||||||
(org-set-tags nil t)
|
(org-set-tags nil t)
|
||||||
(end-of-line 1)))
|
(end-of-line)))
|
||||||
(message "All tags realigned to column %d" org-tags-column))
|
(message "All tags realigned to column %d" org-tags-column))
|
||||||
(if just-align
|
(let* ((current (org-get-tags-string))
|
||||||
(setq tags current)
|
(col (current-column))
|
||||||
;; Get a new set of tags from the user
|
(tags
|
||||||
(save-excursion
|
(if just-align current
|
||||||
(let* ((table (setq org-last-tags-completion-table
|
;; Get a new set of tags from the user.
|
||||||
(append org-tag-persistent-alist
|
(save-excursion
|
||||||
(or org-tag-alist (org-get-buffer-tags))
|
(let* ((table
|
||||||
(and
|
(setq
|
||||||
org-complete-tags-always-offer-all-agenda-tags
|
org-last-tags-completion-table
|
||||||
(org-global-tags-completion-table
|
(append
|
||||||
(org-agenda-files))))))
|
org-tag-persistent-alist
|
||||||
(current-tags (org-split-string current ":"))
|
(or org-tag-alist (org-get-buffer-tags))
|
||||||
(inherited-tags (nreverse
|
(and
|
||||||
(nthcdr (length current-tags)
|
org-complete-tags-always-offer-all-agenda-tags
|
||||||
(nreverse (org-get-tags-at))))))
|
(org-global-tags-completion-table
|
||||||
(setq tags
|
(org-agenda-files))))))
|
||||||
(if (or (eq t org-use-fast-tag-selection)
|
(current-tags (org-split-string current ":"))
|
||||||
(and org-use-fast-tag-selection
|
(inherited-tags
|
||||||
(delq nil (mapcar 'cdr table))))
|
(nreverse (nthcdr (length current-tags)
|
||||||
(org-fast-tag-selection
|
(nreverse (org-get-tags-at))))))
|
||||||
current-tags inherited-tags table
|
(replace-regexp-in-string
|
||||||
(if org-fast-tag-selection-include-todo
|
"\\([-+&]+\\|,\\)"
|
||||||
org-todo-key-alist))
|
":"
|
||||||
(let ((org-add-colon-after-tag-completion (< 1 (length table))))
|
(if (or (eq t org-use-fast-tag-selection)
|
||||||
(org-trim
|
(and org-use-fast-tag-selection
|
||||||
(org-icompleting-read "Tags: "
|
(delq nil (mapcar #'cdr table))))
|
||||||
'org-tags-completion-function
|
(org-fast-tag-selection
|
||||||
nil nil current 'org-tags-history)))))))
|
current-tags inherited-tags table
|
||||||
(while (string-match "[-+&]+" tags)
|
(and org-fast-tag-selection-include-todo
|
||||||
;; No boolean logic, just a list
|
org-todo-key-alist))
|
||||||
(setq tags (replace-match ":" t t tags))))
|
(let ((org-add-colon-after-tag-completion
|
||||||
|
(< 1 (length table))))
|
||||||
|
(org-trim
|
||||||
|
(completing-read
|
||||||
|
"Tags: "
|
||||||
|
#'org-tags-completion-function
|
||||||
|
nil nil current 'org-tags-history))))))))))
|
||||||
|
|
||||||
(setq tags (replace-regexp-in-string "[,]" ":" tags))
|
(when org-tags-sort-function
|
||||||
|
(setq tags
|
||||||
|
(mapconcat
|
||||||
|
#'identity
|
||||||
|
(sort (org-split-string tags (org-re "[^[:alnum:]_@#%]+"))
|
||||||
|
org-tags-sort-function)
|
||||||
|
":")))
|
||||||
|
|
||||||
(if org-tags-sort-function
|
(if (not (org-string-nw-p tags)) (setq tags "")
|
||||||
(setq tags (mapconcat 'identity
|
(unless (string-match ":\\'" tags) (setq tags (concat tags ":")))
|
||||||
(sort (org-split-string
|
(unless (string-match "\\`:" tags) (setq tags (concat ":" tags))))
|
||||||
tags (org-re "[^[:alnum:]_@#%]+"))
|
|
||||||
org-tags-sort-function) ":")))
|
|
||||||
|
|
||||||
(if (string-match "\\`[\t ]*\\'" tags)
|
;; Insert new tags at the correct column
|
||||||
(setq tags "")
|
(beginning-of-line)
|
||||||
(unless (string-match ":$" tags) (setq tags (concat tags ":")))
|
(let ((level (if (looking-at org-outline-regexp)
|
||||||
(unless (string-match "^:" tags) (setq tags (concat ":" tags))))
|
(- (match-end 0) (point) 1)
|
||||||
|
1)))
|
||||||
;; Insert new tags at the correct column
|
(cond
|
||||||
(beginning-of-line 1)
|
((and (equal current "") (equal tags "")))
|
||||||
(setq level (or (and (looking-at org-outline-regexp)
|
((re-search-forward
|
||||||
(- (match-end 0) (point) 1))
|
(concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$")
|
||||||
1))
|
(line-end-position)
|
||||||
(cond
|
t)
|
||||||
((and (equal current "") (equal tags "")))
|
(if (equal tags "") (replace-match "" t t)
|
||||||
((re-search-forward
|
(goto-char (match-beginning 0))
|
||||||
(concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$")
|
(let* ((c0 (current-column))
|
||||||
(point-at-eol) t)
|
;; Compute offset for the case of org-indent-mode
|
||||||
(if (equal tags "")
|
;; active.
|
||||||
(replace-match "" t t)
|
(di (if (org-bound-and-true-p org-indent-mode)
|
||||||
(goto-char (match-beginning 0))
|
(* (1- org-indent-indentation-per-level)
|
||||||
(let* ((c0 (current-column))
|
(1- level))
|
||||||
;; compute offset for the case of org-indent-mode active
|
0))
|
||||||
(di (if (org-bound-and-true-p org-indent-mode)
|
(p0 (if (eq (char-before) ?*) (1+ (point)) (point)))
|
||||||
(* (1- org-indent-indentation-per-level) (1- level))
|
(tc (+ org-tags-column
|
||||||
0))
|
(if (> org-tags-column 0) (- di) di)))
|
||||||
(p0 (if (equal (char-before) ?*)
|
(c1 (max (1+ c0)
|
||||||
(1+ (point))
|
(if (> tc 0) tc
|
||||||
(point)))
|
(- (- tc) (string-width tags)))))
|
||||||
(tc (+ org-tags-column
|
(rpl (concat (make-string (max 0 (- c1 c0)) ?\s) tags)))
|
||||||
(if (> org-tags-column 0)
|
(replace-match rpl t t)
|
||||||
(- di)
|
(when (and (not (featurep 'xemacs)) indent-tabs-mode)
|
||||||
di)))
|
(tabify p0 (point))))))
|
||||||
(c1 (max (1+ c0) (if (> tc 0)
|
(t (error "Tags alignment failed"))))
|
||||||
tc
|
(org-move-to-column col))
|
||||||
(- (- tc) (string-width tags)))))
|
(unless just-align (run-hooks 'org-after-tags-change-hook))))))
|
||||||
(rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags)))
|
|
||||||
(replace-match rpl t t)
|
|
||||||
(when (and (not (featurep 'xemacs)) indent-tabs-mode)
|
|
||||||
(tabify p0 (point))))))
|
|
||||||
(t (error "Tags alignment failed")))
|
|
||||||
(org-move-to-column col)
|
|
||||||
(unless just-align
|
|
||||||
(run-hooks 'org-after-tags-change-hook))))))
|
|
||||||
|
|
||||||
(defun org-change-tag-in-region (beg end tag off)
|
(defun org-change-tag-in-region (beg end tag off)
|
||||||
"Add or remove TAG for each entry in the region.
|
"Add or remove TAG for each entry in the region.
|
||||||
|
|
Loading…
Reference in New Issue