Browse Source

Small refactoring

* lisp/org.el (org-set-tags): Small refactoring.
Nicolas Goaziou 9 years ago
parent
commit
271ecd090a
1 changed files with 91 additions and 93 deletions
  1. 91 93
      lisp/org.el

+ 91 - 93
lisp/org.el

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