Merge branch 'maint'

This commit is contained in:
Nicolas Goaziou 2016-11-13 11:38:09 +01:00
commit 6ea46c7257
6 changed files with 96 additions and 59 deletions

View File

@ -3249,7 +3249,7 @@ This ensures the export commands can easily use it."
(setq tmp (replace-match "" t t tmp))) (setq tmp (replace-match "" t t tmp)))
(when (and (setq re (plist-get props 'org-todo-regexp)) (when (and (setq re (plist-get props 'org-todo-regexp))
(setq re (concat "\\`\\.*" re " ?")) (setq re (concat "\\`\\.*" re " ?"))
(string-match re tmp)) (let ((case-fold-search nil)) (string-match re tmp)))
(plist-put props 'todo (match-string 1 tmp)) (plist-put props 'todo (match-string 1 tmp))
(setq tmp (replace-match "" t t tmp))) (setq tmp (replace-match "" t t tmp)))
(plist-put props 'txt tmp))) (plist-put props 'txt tmp)))
@ -5441,6 +5441,7 @@ and the timestamp type relevant for the sorting strategy in
'help-echo 'help-echo
(format "mouse-2 or RET jump to org file %s" (format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name)))) (abbreviate-file-name buffer-file-name))))
(case-fold-search nil)
(regexp (format org-heading-keyword-regexp-format (regexp (format org-heading-keyword-regexp-format
(cond (cond
((and org-select-this-todo-keyword ((and org-select-this-todo-keyword
@ -6998,7 +6999,8 @@ The optional argument TYPE tells the agenda type."
(let* ((pla (text-property-any 0 (length a) 'org-heading t a)) (let* ((pla (text-property-any 0 (length a) 'org-heading t a))
(plb (text-property-any 0 (length b) 'org-heading t b)) (plb (text-property-any 0 (length b) 'org-heading t b))
(ta (and pla (substring a pla))) (ta (and pla (substring a pla)))
(tb (and plb (substring b plb)))) (tb (and plb (substring b plb)))
(case-fold-search nil))
(when pla (when pla
(if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "") (if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "")
"\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") ta) "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") ta)

View File

@ -356,7 +356,8 @@ this heading."
(org-set-tags-to all-tags)) (org-set-tags-to all-tags))
;; Mark the entry as done ;; Mark the entry as done
(when (and org-archive-mark-done (when (and org-archive-mark-done
(looking-at org-todo-line-regexp) (let ((case-fold-search nil))
(looking-at org-todo-line-regexp))
(or (not (match-end 2)) (or (not (match-end 2))
(not (member (match-string 2) org-done-keywords)))) (not (member (match-string 2) org-done-keywords))))
(let (org-log-done org-todo-log-states) (let (org-log-done org-todo-log-states)
@ -472,8 +473,9 @@ it is on a headline, try all direct children.
When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
(org-archive-all-matches (org-archive-all-matches
(lambda (_beg end) (lambda (_beg end)
(unless (re-search-forward org-not-done-heading-regexp end t) (let ((case-fold-search nil))
"no open TODO items")) (unless (re-search-forward org-not-done-heading-regexp end t)
"no open TODO items")))
tag)) tag))
(defun org-archive-all-old (&optional tag) (defun org-archive-all-old (&optional tag)

View File

@ -3036,7 +3036,7 @@ With a prefix argument ARG, change the region in a single item."
;; subtrees. ;; subtrees.
(when (< level ref-level) (setq ref-level level)) (when (< level ref-level) (setq ref-level level))
;; Remove stars and TODO keyword. ;; Remove stars and TODO keyword.
(looking-at org-todo-line-regexp) (let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
(delete-region (point) (or (match-beginning 3) (delete-region (point) (or (match-beginning 3)
(line-end-position))) (line-end-position)))
(insert bul) (insert bul)

View File

@ -315,10 +315,11 @@ This needs more work, to handle headings with lots of spaces in them."
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(let (tbl) (let (tbl)
(while (re-search-forward org-todo-line-regexp nil t) (let ((case-fold-search nil))
(push (org-make-org-heading-search-string (while (re-search-forward org-todo-line-regexp nil t)
(match-string-no-properties 3)) (push (org-make-org-heading-search-string
tbl)) (match-string-no-properties 3))
tbl)))
(pcomplete-uniqify-list tbl))) (pcomplete-uniqify-list tbl)))
(substring pcomplete-stub 1)))) (substring pcomplete-stub 1))))

View File

@ -2084,16 +2084,22 @@ Changing this requires a restart of Emacs to work correctly."
:type 'integer) :type 'integer)
(defcustom org-link-search-must-match-exact-headline 'query-to-create (defcustom org-link-search-must-match-exact-headline 'query-to-create
"Non-nil means internal links in Org files must exactly match a headline. "Non-nil means internal fuzzy links can only match headlines.
When nil, the link search tries to match a phrase with all words
in the search text." When nil, the a fuzzy link may point to a target or a named
construct in the document. When set to the special value
`query-to-create', offer to create a new headline when none
matched.
Spaces and statistics cookies are ignored during heading searches."
:group 'org-link-follow :group 'org-link-follow
:version "24.1" :version "24.1"
:type '(choice :type '(choice
(const :tag "Use fuzzy text search" nil) (const :tag "Use fuzzy text search" nil)
(const :tag "Match only exact headline" t) (const :tag "Match only exact headline" t)
(const :tag "Match exact headline or query to create it" (const :tag "Match exact headline or query to create it"
query-to-create))) query-to-create))
:safe #'symbolp)
(defcustom org-link-frame-setup (defcustom org-link-frame-setup
'((vm . vm-visit-folder-other-frame) '((vm . vm-visit-folder-other-frame)
@ -4903,29 +4909,43 @@ Otherwise, these types are allowed:
;;; Variables for pre-computed regular expressions, all buffer local ;;; Variables for pre-computed regular expressions, all buffer local
(defvar-local org-todo-regexp nil (defvar-local org-todo-regexp nil
"Matches any of the TODO state keywords.") "Matches any of the TODO state keywords.
Since TODO keywords are case-sensitive, `case-fold-search' is
expected to be bound to nil when matching against this regexp.")
(defvar-local org-not-done-regexp nil (defvar-local org-not-done-regexp nil
"Matches any of the TODO state keywords except the last one.") "Matches any of the TODO state keywords except the last one.
Since TODO keywords are case-sensitive, `case-fold-search' is
expected to be bound to nil when matching against this regexp.")
(defvar-local org-not-done-heading-regexp nil (defvar-local org-not-done-heading-regexp nil
"Matches a TODO headline that is not done.") "Matches a TODO headline that is not done.
Since TODO keywords are case-sensitive, `case-fold-search' is
expected to be bound to nil when matching against this regexp.")
(defvar-local org-todo-line-regexp nil (defvar-local org-todo-line-regexp nil
"Matches a headline and puts TODO state into group 2 if present.") "Matches a headline and puts TODO state into group 2 if present.
Since TODO keywords are case-sensitive, `case-fold-search' is
expected to be bound to nil when matching against this regexp.")
(defvar-local org-complex-heading-regexp nil (defvar-local org-complex-heading-regexp nil
"Matches a headline and puts everything into groups: "Matches a headline and puts everything into groups:
group 1: the stars group 1: Stars
group 2: The todo keyword, maybe group 2: The TODO keyword, maybe
group 3: Priority cookie group 3: Priority cookie
group 4: True headline group 4: True headline
group 5: Tags group 5: Tags
Since TODO keywords are case-sensitive, `case-fold-search' is Since TODO keywords are case-sensitive, `case-fold-search' is
expected to be bound to nil when matching this regexp.") expected to be bound to nil when matching against this regexp.")
(defvar-local org-complex-heading-regexp-format nil (defvar-local org-complex-heading-regexp-format nil
"Printf format to make regexp to match an exact headline. "Printf format to make regexp to match an exact headline.
This regexp will match the headline of any node which has the This regexp will match the headline of any node which has the
exact headline text that is put into the format, but may have any exact headline text that is put into the format, but may have any
TODO state, priority and tags.") TODO state, priority and tags.")
(defvar-local org-todo-line-tags-regexp nil (defvar-local org-todo-line-tags-regexp nil
"Matches a headline and puts TODO state into group 2 if present. "Matches a headline and puts TODO state into group 2 if present.
Also put tags into group 4 if tags are present.") Also put tags into group 4 if tags are present.")
@ -8197,7 +8217,7 @@ unchecked check box."
(save-excursion (save-excursion
(org-back-to-heading) (org-back-to-heading)
(outline-previous-heading) (outline-previous-heading)
(looking-at org-todo-line-regexp)) (let ((case-fold-search nil)) (looking-at org-todo-line-regexp)))
(let* ((new-mark-x (let* ((new-mark-x
(if (or (equal arg '(4)) (if (or (equal arg '(4))
(not (match-beginning 2)) (not (match-beginning 2))
@ -8289,12 +8309,12 @@ headings in the region."
"Fix cursor position and indentation after demoting/promoting." "Fix cursor position and indentation after demoting/promoting."
(let ((pos (point))) (let ((pos (point)))
(when (save-excursion (when (save-excursion
(beginning-of-line 1) (beginning-of-line)
(looking-at org-todo-line-regexp) (let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
(or (equal pos (match-end 1)) (equal pos (match-end 2)))) (or (eq pos (match-end 1)) (eq pos (match-end 2))))
(cond ((eobp) (insert " ")) (cond ((eobp) (insert " "))
((eolp) (insert " ")) ((eolp) (insert " "))
((equal (char-after) ?\ ) (forward-char 1)))))) ((equal (char-after) ?\s) (forward-char 1))))))
(defun org-current-level () (defun org-current-level ()
"Return the level of the current entry, or nil if before the first headline. "Return the level of the current entry, or nil if before the first headline.
@ -11221,22 +11241,22 @@ of matched result, which is either `dedicated' or `fuzzy'."
wspaceopt wspaceopt
"\\)")) "\\)"))
(sep (concat "\\(?:\\(?:" wspace "\\|" cookie "\\)+\\)")) (sep (concat "\\(?:\\(?:" wspace "\\|" cookie "\\)+\\)"))
(re (concat (title
org-outline-regexp-bol (format "\\(?:%s[ \t]+\\)?%s?%s%s?"
"\\(?:" org-todo-regexp "[ \t]+\\)?" org-comment-string
"\\(?:\\[#.\\][ \t]+\\)?" sep
"\\(?:" org-comment-string "[ \t]+\\)?" (let ((re (mapconcat #'regexp-quote words sep)))
sep "?" (if starred (substring re 1) re))
(let ((title (mapconcat #'regexp-quote sep))
words (exact-title (format "\\`%s\\'" title))
sep))) (re (concat org-outline-regexp-bol "+.*" title)))
(if starred (substring title 1) title))
sep "?"
"\\(?:[ \t]+:[[:alnum:]_@#%%:]+:\\)?"
"[ \t]*$")))
(goto-char (point-min)) (goto-char (point-min))
(re-search-forward re nil t))) (catch :found
(goto-char (match-beginning 0)) (while (re-search-forward re nil t)
(when (string-match-p exact-title (org-get-heading t t))
(throw :found t)))
nil)))
(beginning-of-line)
(setq type 'dedicated)) (setq type 'dedicated))
;; Offer to create non-existent headline depending on ;; Offer to create non-existent headline depending on
;; `org-link-search-must-match-exact-headline'. ;; `org-link-search-must-match-exact-headline'.
@ -12844,7 +12864,8 @@ changes. Such blocking occurs when:
(save-excursion (save-excursion
(org-back-to-heading t) (org-back-to-heading t)
(let* ((pos (point)) (let* ((pos (point))
(parent-pos (and (org-up-heading-safe) (point)))) (parent-pos (and (org-up-heading-safe) (point)))
(case-fold-search nil))
(unless parent-pos (throw 'dont-block t)) ; no parent (unless parent-pos (throw 'dont-block t)) ; no parent
(when (and (org-not-nil (org-entry-get (point) "ORDERED")) (when (and (org-not-nil (org-entry-get (point) "ORDERED"))
(forward-line 1) (forward-line 1)
@ -13225,7 +13246,7 @@ Returns the new TODO keyword, or nil if no state change should occur."
"Return the TODO keyword of the current subtree." "Return the TODO keyword of the current subtree."
(save-excursion (save-excursion
(org-back-to-heading t) (org-back-to-heading t)
(and (looking-at org-todo-line-regexp) (and (let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
(match-end 2) (match-end 2)
(match-string 2)))) (match-string 2))))
@ -14256,8 +14277,7 @@ ACTION can be `set', `up', `down', or a character."
(replace-match news t t nil 2)) (replace-match news t t nil 2))
(if remove (if remove
(user-error "No priority cookie found in line") (user-error "No priority cookie found in line")
(let ((case-fold-search nil)) (let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
(looking-at org-todo-line-regexp))
(if (match-end 2) (if (match-end 2)
(progn (progn
(goto-char (match-end 2)) (goto-char (match-end 2))
@ -24140,13 +24160,13 @@ unless optional argument NO-INHERITANCE is non-nil."
"If point is at the end of an empty headline, return t, else nil. "If point is at the end of an empty headline, return t, else nil.
If the heading only contains a TODO keyword, it is still still considered If the heading only contains a TODO keyword, it is still still considered
empty." empty."
(and (looking-at "[ \t]*$") (let ((case-fold-search nil))
(when org-todo-line-regexp (and (looking-at "[ \t]*$")
org-todo-line-regexp
(save-excursion (save-excursion
(beginning-of-line 1) (beginning-of-line)
(let ((case-fold-search nil)) (looking-at org-todo-line-regexp)
(looking-at org-todo-line-regexp) (string= (match-string 3) "")))))
(string= (match-string 3) ""))))))
(defun org-at-heading-or-item-p () (defun org-at-heading-or-item-p ()
(or (org-at-heading-p) (org-at-item-p))) (or (org-at-heading-p) (org-at-item-p)))

View File

@ -2098,7 +2098,8 @@ SCHEDULED: <2014-03-04 tue.>"
(let ((org-link-search-must-match-exact-headline t)) (org-open-at-point)) (let ((org-link-search-must-match-exact-headline t)) (org-open-at-point))
(looking-at "\\* Test"))) (looking-at "\\* Test")))
;; Heading match should not care about spaces, cookies, TODO ;; Heading match should not care about spaces, cookies, TODO
;; keywords, priorities, and tags. ;; keywords, priorities, and tags. However, TODO keywords are
;; case-sensitive.
(should (should
(let ((first-line (let ((first-line
"** TODO [#A] [/] Test [1/2] [33%] 1 \t 2 [%] :work:urgent: ")) "** TODO [#A] [/] Test [1/2] [33%] 1 \t 2 [%] :work:urgent: "))
@ -2108,15 +2109,26 @@ SCHEDULED: <2014-03-04 tue.>"
(org-todo-regexp "TODO")) (org-todo-regexp "TODO"))
(org-open-at-point)) (org-open-at-point))
(looking-at (regexp-quote first-line))))) (looking-at (regexp-quote first-line)))))
(should-error
(org-test-with-temp-text "** todo Test 1 2\nFoo Bar\n<point>[[*Test 1 2]]"
(let ((org-link-search-must-match-exact-headline nil)
(org-todo-regexp "TODO"))
(org-open-at-point))))
;; Heading match should still be exact. ;; Heading match should still be exact.
(should-error (should-error
(let ((first-line (org-test-with-temp-text "
"** TODO [#A] [/] Test [1/2] [33%] 1 \t 2 [%] :work:urgent: ")) ** TODO [#A] [/] Test [1/2] [33%] 1 \t 2 [%] :work:urgent:
(org-test-with-temp-text Foo Bar
(concat first-line "\nFoo Bar\n<point>[[*Test 1]]") <point>[[*Test 1]]"
(let ((org-link-search-must-match-exact-headline nil) (let ((org-link-search-must-match-exact-headline nil)
(org-todo-regexp "TODO")) (org-todo-regexp "TODO"))
(org-open-at-point))))) (org-open-at-point))))
(should
(org-test-with-temp-text "* Test 1 2 3\n** Test 1 2\n<point>[[*Test 1 2]]"
(let ((org-link-search-must-match-exact-headline nil)
(org-todo-regexp "TODO"))
(org-open-at-point))
(looking-at-p (regexp-quote "** Test 1 2"))))
;; Heading match ignores COMMENT keyword. ;; Heading match ignores COMMENT keyword.
(should (should
(org-test-with-temp-text "[[*Test]]\n* COMMENT Test" (org-test-with-temp-text "[[*Test]]\n* COMMENT Test"