ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

`org-set-tags' modifies buffer only when necessary 

* lisp/org.el (org--align-tags-here):
(org-set-tags): Modify buffer only when necessary.

* testing/lisp/test-org.el (test-org/set-tags): Add tests.

Reported-by: Allen Li <darkfeline@felesatra.moe>
<http://lists.gnu.org/r/emacs-orgmode/2018-06/msg00242.html>
This commit is contained in:
Nicolas Goaziou 2018-06-19 09:40:00 +02:00
parent 2e1daf14e0
commit 593058e4a6
2 changed files with 59 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
lisp/org.el
View File

@ -14250,28 +14250,33 @@ If ONOFF is `on' or `off', don't toggle but set to this state."
"Align tags on the current headline to TO-COL.
Assume point is on a headline. Preserve point when aligning
tags."
(when (and (org-match-line org-tag-line-re)
(/= to-col (save-excursion ;nothing to do?
(goto-char (match-beginning 1)) (current-column))))
(let* ((shift (if (>= to-col 0) to-col
(- (abs to-col) (string-width (match-string 1)))))
(origin (point-marker))
(column (current-column))
(tags-start (match-beginning 1))
(when (org-match-line org-tag-line-re)
(let* ((tags-start (match-beginning 1))
(blank-start (save-excursion
(goto-char tags-start)
(skip-chars-backward " \t")
(point)))
(in-blank? (and (> origin blank-start)
(<= origin tags-start))))
(delete-region blank-start tags-start)
(goto-char blank-start)
(let ((indent-tabs-mode nil)) (indent-to shift 1))
;; Try to move back to original position. If point was in the
;; blanks before the tags, ORIGIN marker is of no use because it
;; now points to BLANK-START. Use COLUMN instead.
(if in-blank? (org-move-to-column column)
(goto-char origin)))))
(new (max (if (>= to-col 0) to-col
(- (abs to-col) (string-width (match-string 1))))
;; Introduce at least one space after the heading
;; or the stars.
(save-excursion
(goto-char blank-start)
(1+ (current-column)))))
(current
(save-excursion (goto-char tags-start) (current-column)))
(origin (point-marker))
(column (current-column)))
(when (/= new current)
(delete-region blank-start tags-start)
(goto-char blank-start)
(let ((indent-tabs-mode nil)) (indent-to new))
;; Try to move back to original position. If point was in the
;; blanks before the tags, ORIGIN marker is of no use because
;; it now points to BLANK-START. Use COLUMN instead.
(let ((in-blank? (and (> origin blank-start) (<= origin tags-start))))
(if in-blank? (org-move-to-column column)
(goto-char origin)))))))
(defun org-set-tags-command (&optional arg)
"Set the tags for the current visible entry.
@ -14367,28 +14372,29 @@ This function assumes point is on a headline."
((pred stringp) (split-string (org-trim tags) ":" t))
(_ (error "Invalid tag specification: %S" tags))))
(old-tags (org-get-tags nil t))
(change-flag nil))
(tags-change? nil))
(when (functionp org-tags-sort-function)
(setq tags (sort tags org-tags-sort-function)))
(unless (equal tags old-tags) (setq change-flag t))
;; Delete previous tags and any trailing white space.
(goto-char (if (org-match-line org-tag-line-re) (match-beginning 1)
(line-end-position)))
(skip-chars-backward " \t")
(delete-region (point) (line-end-position))
;; Deleting white spaces may break an otherwise empty headline.
;; Re-introduce one space in this case.
(unless (org-at-heading-p) (insert " "))
(when tags
(save-excursion (insert " " (org-make-tag-string tags)))
;; When text is being inserted on an invisible region
;; boundary, it can be inadvertently sucked into
;; invisibility.
(unless (org-invisible-p (line-beginning-position))
(org-flag-region (point) (line-end-position) nil 'outline)))
(setq tags-change? (not (equal tags old-tags)))
(when tags-change?
;; Delete previous tags and any trailing white space.
(goto-char (if (org-match-line org-tag-line-re) (match-beginning 1)
(line-end-position)))
(skip-chars-backward " \t")
(delete-region (point) (line-end-position))
;; Deleting white spaces may break an otherwise empty headline.
;; Re-introduce one space in this case.
(unless (org-at-heading-p) (insert " "))
(when tags
(save-excursion (insert " " (org-make-tag-string tags)))
;; When text is being inserted on an invisible region
;; boundary, it can be inadvertently sucked into
;; invisibility.
(unless (org-invisible-p (line-beginning-position))
(org-flag-region (point) (line-end-position) nil 'outline))))
;; Align tags, if any.
(when tags (org-align-tags))
(when change-flag (run-hooks 'org-after-tags-change-hook)))))
(when tags-change? (run-hooks 'org-after-tags-change-hook)))))
(defun org-change-tag-in-region (beg end tag off)
"Add or remove TAG for each entry in the region.

17
testing/lisp/test-org.el
View File

@ -6209,6 +6209,23 @@ Paragraph<point>"
(org-test-with-temp-text "* "
(let ((org-tags-column 1)) (org-set-tags '("tag0")))
(buffer-string))))
;; Modify buffer only when a tag change happens or alignment is
;; done.
(should-not
(org-test-with-temp-text "* H :foo:"
(set-buffer-modified-p nil)
(let ((org-tags-column 1)) (org-set-tags '("foo")))
(buffer-modified-p)))
(should
(org-test-with-temp-text "* H :foo:"
(set-buffer-modified-p nil)
(let ((org-tags-column 10)) (org-set-tags '("foo")))
(buffer-modified-p)))
(should
(org-test-with-temp-text "* H :foo:"
(set-buffer-modified-p nil)
(let ((org-tags-column 10)) (org-set-tags '("bar")))
(buffer-modified-p)))
;; Pathological case: when setting tags of a folded headline, do not
;; let new tags being sucked into invisibility.
(should-not