From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp10.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms5.migadu.com with LMTPS id gMO8GMQNYGLQQQAAbAwnHQ (envelope-from ) for ; Wed, 20 Apr 2022 15:42:28 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp10.migadu.com with LMTPS id OMPEF8QNYGLIEAAAG6o9tA (envelope-from ) for ; Wed, 20 Apr 2022 15:42:28 +0200 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id AF4ABF2FD for ; Wed, 20 Apr 2022 15:42:27 +0200 (CEST) Received: from localhost ([::1]:49518 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nhAbC-0003oB-Ts for larch@yhetil.org; Wed, 20 Apr 2022 09:42:26 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:36970) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nhAKD-00049f-Lg for emacs-orgmode@gnu.org; Wed, 20 Apr 2022 09:24:54 -0400 Received: from mail-pj1-x102f.google.com ([2607:f8b0:4864:20::102f]:46770) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nhAK9-0003WZ-OO for emacs-orgmode@gnu.org; Wed, 20 Apr 2022 09:24:53 -0400 Received: by mail-pj1-x102f.google.com with SMTP id e62-20020a17090a6fc400b001d2cd8e9b0aso1994500pjk.5 for ; Wed, 20 Apr 2022 06:24:49 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=from:to:subject:in-reply-to:references:message-id:date:mime-version; bh=fs4PfYrj6cKTTxUvAvwjQODuy0uq+V3Ry3ARTC/ZePU=; b=VTDE3p3tw3v4ffXOpyc5NpgY2NnrVcJl28Tpl6qwZP+kCdZYgBokIfnMDJgKl+5Pse 14xT5PvpJc0JAdFHNJTCiTj+O0+gelivKvaYguZwrkgkuHeLV7a6wgM98LCoYChCZ4Ay GnmQb4AiKYAYbrZJUUh8i22bw6SVH4uD4FHWxbiu7wvUtAfbZsMP7C7kvNcnOZQxCnK0 0FsCEqHzGGRfjqbQ9y2V/vxPz2rbphzVGnJDpwwsvsT7kNk1ZsKLYzuARAIEm4rz0exA Lqpjm0vK6+k8Rck+cgg4eTDSXHerW1svsivN5xh6GBa2e+AtPwCTwuLzokawz083/pYl nfwA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:from:to:subject:in-reply-to:references :message-id:date:mime-version; bh=fs4PfYrj6cKTTxUvAvwjQODuy0uq+V3Ry3ARTC/ZePU=; b=Yjps7NWUvODg5KksuYtMK8vKUDS2gArleT2ISvRiUe16xWycQ75JQ08q9o//VO1p7n K6Gpc6ubUgXbfeqC+r5SvVKFGwlcNacoFxh/O5Oc42AxMsTSeG1r42pZPhz56xLesesH 5PWbVf6mANlJQPjy7e2/lDUsSurWpnCDWsF7i6QDfqIuJ42vk5Oa62a4Ps/1//0duHgf YDtm4XFRAH7ZTdT0FkOba/uZjTxSRrcY4p7G0g8PQOIwGPclWgPnvr6lqtH5YAn0+w0i 2Wv1pbAyevmpPI1GFYGYPIRGhQJE0SKMc9GxfjBz8d4eBHs5zOs2J/wqDnVwzsfxmP0v byQA== X-Gm-Message-State: AOAM531LZXJ52yM8/vkeXX0HSJQYZ3zl9x6mba6Q1qXeT9RDaYzyVDqc B9HwfkGzS7i9lWyhReP1h7DFxTC8nhoR9A== X-Google-Smtp-Source: ABdhPJxxE3grhp060N+958rHhTmV0pxt7seBE8wpyOzFxHPwZHvAufMy5IEdD3SrvPekOxObKA3LHg== X-Received: by 2002:a17:90b:4d0a:b0:1d1:7bd:cb00 with SMTP id mw10-20020a17090b4d0a00b001d107bdcb00mr4401507pjb.242.1650461086464; Wed, 20 Apr 2022 06:24:46 -0700 (PDT) Received: from localhost ([64.32.23.62]) by smtp.gmail.com with ESMTPSA id a38-20020a056a001d2600b004fae885424dsm21274439pfx.72.2022.04.20.06.24.44 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 20 Apr 2022 06:24:46 -0700 (PDT) From: Ihor Radchenko To: emacs-orgmode@gnu.org Subject: [PATCH v2 13/38] Fix subtle differences between overlays and invisible text properties In-Reply-To: References: Message-Id: <54c16b359cb04bbe5cd391cd9f773206300d9d96.1650460489.git.yantar92@gmail.com> Date: Wed, 20 Apr 2022 21:25:38 +0800 MIME-Version: 1.0 Content-Type: text/plain Received-SPF: pass client-ip=2607:f8b0:4864:20::102f; envelope-from=yantar92@gmail.com; helo=mail-pj1-x102f.google.com X-Spam_score_int: -18 X-Spam_score: -1.9 X-Spam_bar: - X-Spam_report: (-1.9 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_ENVFROM_END_DIGIT=0.25, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-orgmode@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+larch=yhetil.org@gnu.org Sender: "Emacs-orgmode" X-Migadu-Flow: FLOW_IN X-Migadu-To: larch@yhetil.org X-Migadu-Country: US ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1650462147; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:mime-version:mime-version: content-type:content-type:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=fs4PfYrj6cKTTxUvAvwjQODuy0uq+V3Ry3ARTC/ZePU=; b=RoAW4t6hadJW5gF+hTXzjKzBTx8L3FwobZzOgMf9IEffryzP2j67jR6ilKqDCRFt4unvw+ vrzxTFFM2GaZgMPgabLVDeZ0qwEZxXZhruFCUqHGC2p/atrR48qfRS+xlo4RsyldXsQD8J AFXZpVc1+L/kufQiSaDG1hvS6JbORqJI08WVRZMYd+sGnylW/+cenb7W9UMkIt0q86/SBG gDakO1fUKnDrcB2/V7dvu5Gyij2XVkt2znir94q8GHE6cHWpERA3Na2Po8Il9JBkuk64Wh UGcqFk9vwNvrUVCCTKr83AF8dpoSkpTB0xyJ78FWbp3dfY5uq5YN0QQ9UyxO6g== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1650462147; a=rsa-sha256; cv=none; b=ROy3nCi9B5fOz5NP0sxweYJzzJZr3YzFjPtpt6BYp90bRBPE8dMEdCYZ0XXLSd+Uirc3d3 IsJ38cfN8iJUVlwLE9L8Butt4b7qBqQFdD5SdUlD0HYcTLMGC5agau6GNRZS9+fSpzbNXh lXNx4fO/jNov4AZcKo0jLmAuOPd1sjcKm2GRKLpu9nu78qJBTywoBEFt7qHDyXlUfASTos FVefRJ0PcAHJGIu6MZE9dSOgbDvW5Q6q8pZ0Yb5u8iUPIqMjRsyVMxAo5EUWoLW9jGDzht emKg8CLf4WkOwEQVphoqZmZ4jTo08Uog9rFWNt2lMcuz5vUmWsZl29+0+4bgKQ== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=pass header.d=gmail.com header.s=20210112 header.b=VTDE3p3t; dmarc=pass (policy=none) header.from=gmail.com; spf=pass (aspmx1.migadu.com: domain of "emacs-orgmode-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="emacs-orgmode-bounces+larch=yhetil.org@gnu.org" X-Migadu-Spam-Score: -6.54 Authentication-Results: aspmx1.migadu.com; dkim=pass header.d=gmail.com header.s=20210112 header.b=VTDE3p3t; dmarc=pass (policy=none) header.from=gmail.com; spf=pass (aspmx1.migadu.com: domain of "emacs-orgmode-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="emacs-orgmode-bounces+larch=yhetil.org@gnu.org" X-Migadu-Queue-Id: AF4ABF2FD X-Spam-Score: -6.54 X-Migadu-Scanner: scn0.migadu.com X-TUID: 18XfY9/myJn3 * lisp/org-clock.el (org-clock-in): (org-clock-find-position): (org-clock-out): * lisp/org.el (org-add-planning-info): (org-scan-tags): (org-global-tags-completion-table): (org-make-tags-matcher): (org-tags-expand): (org--property-local-values): (org-read-date-analyze): (org-revert-all-org-buffers): (org-beginning-of-line): Make sure that we inherit invisible state when inserting text. (org-sort-entries): Preserve invisible state after replace-match. (org-log-beginning): Do not try to move by visible lines. * lisp/org-macs.el (org-preserve-local-variables): Do not try to preserve overlays. * lisp/ox.el (org-export--generate-copy-script): Preserve folding properties in export buffer. * testing/lisp/test-ob.el (test-ob/preserve-results-indentation): Fix test failure. * testing/lisp/test-org.el (test-org/meta-return): (test-org/custom-properties): Use new folding. --- lisp/org-clock.el | 116 ++++---- lisp/org-macs.el | 12 +- lisp/org.el | 560 ++++++++++++++++++++------------------- lisp/ox.el | 4 +- testing/lisp/test-ob.el | 12 +- testing/lisp/test-org.el | 3 + 6 files changed, 367 insertions(+), 340 deletions(-) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 583b30237..ec87aaf8a 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -1373,14 +1373,14 @@ (defun org-clock-in (&optional select start-time) (sit-for 2) (throw 'abort nil)) (t - (insert-before-markers "\n") + (insert-before-markers-and-inherit "\n") (backward-char 1) (when (and (save-excursion (end-of-line 0) (org-in-item-p))) (beginning-of-line 1) (indent-line-to (max 0 (- (current-indentation) 2)))) - (insert org-clock-string " ") + (insert-and-inherit org-clock-string " ") (setq org-clock-effort (org-entry-get (point) org-effort-property)) (setq org-clock-total-time (org-clock-sum-current-item (org-clock-get-sum-start))) @@ -1581,19 +1581,23 @@ (defun org-clock-find-position (find-unclosed) count (1+ count)))))) (cond ((null positions) - ;; Skip planning line and property drawer, if any. - (org-end-of-meta-data) - (unless (bolp) (insert "\n")) - ;; Create a new drawer if necessary. - (when (and org-clock-into-drawer - (or (not (wholenump org-clock-into-drawer)) - (< org-clock-into-drawer 2))) - (let ((beg (point))) - (insert ":" drawer ":\n:END:\n") - (org-indent-region beg (point)) - (org-flag-region - (line-end-position -1) (1- (point)) t 'outline) - (forward-line -1)))) + (org-fold-core-ignore-modifications + ;; Skip planning line and property drawer, if any. + (org-end-of-meta-data) + (unless (bolp) (insert-and-inherit "\n")) + ;; Create a new drawer if necessary. + (when (and org-clock-into-drawer + (or (not (wholenump org-clock-into-drawer)) + (< org-clock-into-drawer 2))) + (let ((beg (point))) + (insert-and-inherit ":" drawer ":\n:END:\n") + (org-indent-region beg (point)) + (if (eq org-fold-core-style 'text-properties) + (org-fold-region + (line-end-position -1) (1- (point)) t 'drawer) + (org-fold-region + (line-end-position -1) (1- (point)) t 'outline)) + (forward-line -1))))) ;; When a clock drawer needs to be created because of the ;; number of clock items or simply if it is missing, collect ;; all clocks in the section and wrap them within the drawer. @@ -1602,28 +1606,29 @@ (defun org-clock-find-position (find-unclosed) drawer) ;; Skip planning line and property drawer, if any. (org-end-of-meta-data) - (let ((beg (point))) - (insert - (mapconcat - (lambda (p) - (save-excursion - (goto-char p) - (org-trim (delete-and-extract-region - (save-excursion (skip-chars-backward " \r\t\n") - (line-beginning-position 2)) - (line-beginning-position 2))))) - positions "\n") - "\n:END:\n") - (let ((end (point-marker))) - (goto-char beg) - (save-excursion (insert ":" drawer ":\n")) - (org-flag-region (line-end-position) (1- end) t 'outline) - (org-indent-region (point) end) - (forward-line) - (unless org-log-states-order-reversed - (goto-char end) - (beginning-of-line -1)) - (set-marker end nil)))) + (org-fold-core-ignore-modifications + (let ((beg (point))) + (insert-and-inherit + (mapconcat + (lambda (p) + (save-excursion + (goto-char p) + (org-trim (delete-and-extract-region + (save-excursion (skip-chars-backward " \r\t\n") + (line-beginning-position 2)) + (line-beginning-position 2))))) + positions "\n") + "\n:END:\n") + (let ((end (point-marker))) + (goto-char beg) + (save-excursion (insert-and-inherit ":" drawer ":\n")) + (org-fold-region (line-end-position) (1- end) t 'outline) + (org-indent-region (point) end) + (forward-line) + (unless org-log-states-order-reversed + (goto-char end) + (beginning-of-line -1)) + (set-marker end nil))))) (org-log-states-order-reversed (goto-char (car (last positions)))) (t (goto-char (car positions)))))))) @@ -1672,24 +1677,25 @@ (defun org-clock-out (&optional switch-to-state fail-quietly at-time) (if fail-quietly (throw 'exit nil) (error "Clock start time is gone"))) (goto-char (match-end 0)) (delete-region (point) (point-at-eol)) - (insert "--") - (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) - (setq s (org-time-convert-to-integer - (time-subtract - (org-time-string-to-time te) - (org-time-string-to-time ts))) - h (floor s 3600) - m (floor (mod s 3600) 60)) - (insert " => " (format "%2d:%02d" h m)) - (move-marker org-clock-marker nil) - (move-marker org-clock-hd-marker nil) - ;; Possibly remove zero time clocks. - (when (and org-clock-out-remove-zero-time-clocks - (= 0 h m)) - (setq remove t) - (delete-region (line-beginning-position) - (line-beginning-position 2))) - (org-clock-remove-empty-clock-drawer) + (org-fold-core-ignore-modifications + (insert-and-inherit "--") + (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) + (setq s (org-time-convert-to-integer + (time-subtract + (org-time-string-to-time te) + (org-time-string-to-time ts))) + h (floor s 3600) + m (floor (mod s 3600) 60)) + (insert-and-inherit " => " (format "%2d:%02d" h m)) + (move-marker org-clock-marker nil) + (move-marker org-clock-hd-marker nil) + ;; Possibly remove zero time clocks. + (when (and org-clock-out-remove-zero-time-clocks + (= 0 h m)) + (setq remove t) + (delete-region (line-beginning-position) + (line-beginning-position 2))) + (org-clock-remove-empty-clock-drawer)) (when org-clock-mode-line-timer (cancel-timer org-clock-mode-line-timer) (setq org-clock-mode-line-timer nil)) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index a894d4323..42a91781b 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -170,16 +170,8 @@ (defmacro org-preserve-local-variables (&rest body) (when local-variables (org-with-wide-buffer (goto-char (point-max)) - ;; If last section is folded, make sure to also hide file - ;; local variables after inserting them back. - (let ((overlay - (cl-find-if (lambda (o) - (eq 'outline (overlay-get o 'invisible))) - (overlays-at (1- (point)))))) - (unless (bolp) (insert "\n")) - (insert local-variables) - (when overlay - (move-overlay overlay (overlay-start overlay) (point-max))))))))) + (unless (bolp) (insert "\n")) + (insert local-variables)))))) (defmacro org-no-popups (&rest body) "Suppress popup windows and evaluate BODY." diff --git a/lisp/org.el b/lisp/org.el index 9ebdb23e1..ca0a99681 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -6411,7 +6411,7 @@ (defun org-promote () (replace-match "# " nil t)) ((= level 1) (user-error "Cannot promote to level 0. UNDO to recover if necessary")) - (t (replace-match up-head nil t))) + (t (replace-match (apply #'propertize up-head (text-properties-at (match-beginning 0))) t))) (unless (= level 1) (when org-auto-align-tags (org-align-tags)) (when org-adapt-indentation (org-fixup-indentation (- diff)))) @@ -6426,9 +6426,10 @@ (defun org-demote () (level (save-match-data (funcall outline-level))) (down-head (concat (make-string (org-get-valid-level level 1) ?*) " ")) (diff (abs (- level (length down-head) -1)))) - (replace-match down-head nil t) - (when org-auto-align-tags (org-align-tags)) - (when org-adapt-indentation (org-fixup-indentation diff)) + (org-fold-core-ignore-fragility-checks + (replace-match (apply #'propertize down-head (text-properties-at (match-beginning 0))) t) + (when org-auto-align-tags (org-align-tags)) + (when org-adapt-indentation (org-fixup-indentation diff))) (run-hooks 'org-after-demote-entry-hook)))) (defun org-cycle-level () @@ -8956,7 +8957,15 @@ (defun org-todo (&optional arg) this org-state block-reason) (throw 'exit nil))))) (store-match-data match-data) - (replace-match next t t) + (org-fold-core-ignore-modifications + (save-excursion + (goto-char (match-beginning 0)) + (setf (buffer-substring (match-beginning 0) (match-end 0)) "") + (insert-and-inherit next) + (unless (org-invisible-p (line-beginning-position)) + (org-fold-region (line-beginning-position) + (line-end-position) + nil)))) (cond ((and org-state (equal this org-state)) (message "TODO state was already %s" (org-trim next))) ((not (pos-visible-in-window-p hl-pos)) @@ -9697,81 +9706,82 @@ (defun org--deadline-or-schedule (arg type time) "Insert DEADLINE or SCHEDULE information in current entry. TYPE is either `deadline' or `scheduled'. See `org-deadline' or `org-schedule' for information about ARG and TIME arguments." - (let* ((deadline? (eq type 'deadline)) - (keyword (if deadline? org-deadline-string org-scheduled-string)) - (log (if deadline? org-log-redeadline org-log-reschedule)) - (old-date (org-entry-get nil (if deadline? "DEADLINE" "SCHEDULED"))) - (old-date-time (and old-date (org-time-string-to-time old-date))) - ;; Save repeater cookie from either TIME or current scheduled - ;; time stamp. We are going to insert it back at the end of - ;; the process. - (repeater (or (and (org-string-nw-p time) - ;; We use `org-repeat-re' because we need - ;; to tell the difference between a real - ;; repeater and a time delta, e.g. "+2d". - (string-match org-repeat-re time) - (match-string 1 time)) - (and (org-string-nw-p old-date) - (string-match "\\([.+-]+[0-9]+[hdwmy]\ + (org-fold-core-ignore-modifications + (let* ((deadline? (eq type 'deadline)) + (keyword (if deadline? org-deadline-string org-scheduled-string)) + (log (if deadline? org-log-redeadline org-log-reschedule)) + (old-date (org-entry-get nil (if deadline? "DEADLINE" "SCHEDULED"))) + (old-date-time (and old-date (org-time-string-to-time old-date))) + ;; Save repeater cookie from either TIME or current scheduled + ;; time stamp. We are going to insert it back at the end of + ;; the process. + (repeater (or (and (org-string-nw-p time) + ;; We use `org-repeat-re' because we need + ;; to tell the difference between a real + ;; repeater and a time delta, e.g. "+2d". + (string-match org-repeat-re time) + (match-string 1 time)) + (and (org-string-nw-p old-date) + (string-match "\\([.+-]+[0-9]+[hdwmy]\ \\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\)" - old-date) - (match-string 1 old-date))))) - (pcase arg - (`(4) - (if (not old-date) - (message (if deadline? "Entry had no deadline to remove" - "Entry was not scheduled")) - (when (and old-date log) - (org-add-log-setup (if deadline? 'deldeadline 'delschedule) - nil old-date log)) - (org-remove-timestamp-with-keyword keyword) - (message (if deadline? "Entry no longer has a deadline." - "Entry is no longer scheduled.")))) - (`(16) - (save-excursion - (org-back-to-heading t) - (let ((regexp (if deadline? org-deadline-time-regexp - org-scheduled-time-regexp))) - (if (not (re-search-forward regexp (line-end-position 2) t)) - (user-error (if deadline? "No deadline information to update" - "No scheduled information to update")) - (let* ((rpl0 (match-string 1)) - (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0)) - (msg (if deadline? "Warn starting from" "Delay until"))) - (replace-match - (concat keyword - " <" rpl - (format " -%dd" - (abs (- (time-to-days - (save-match-data - (org-read-date - nil t nil msg old-date-time))) - (time-to-days old-date-time)))) - ">") t t)))))) - (_ - (org-add-planning-info type time 'closed) - (when (and old-date - log - (not (equal old-date org-last-inserted-timestamp))) - (org-add-log-setup (if deadline? 'redeadline 'reschedule) - org-last-inserted-timestamp - old-date - log)) - (when repeater - (save-excursion - (org-back-to-heading t) - (when (re-search-forward - (concat keyword " " org-last-inserted-timestamp) - (line-end-position 2) - t) - (goto-char (1- (match-end 0))) - (insert " " repeater) - (setq org-last-inserted-timestamp - (concat (substring org-last-inserted-timestamp 0 -1) - " " repeater - (substring org-last-inserted-timestamp -1)))))) - (message (if deadline? "Deadline on %s" "Scheduled to %s") - org-last-inserted-timestamp))))) + old-date) + (match-string 1 old-date))))) + (pcase arg + (`(4) + (if (not old-date) + (message (if deadline? "Entry had no deadline to remove" + "Entry was not scheduled")) + (when (and old-date log) + (org-add-log-setup (if deadline? 'deldeadline 'delschedule) + nil old-date log)) + (org-remove-timestamp-with-keyword keyword) + (message (if deadline? "Entry no longer has a deadline." + "Entry is no longer scheduled.")))) + (`(16) + (save-excursion + (org-back-to-heading t) + (let ((regexp (if deadline? org-deadline-time-regexp + org-scheduled-time-regexp))) + (if (not (re-search-forward regexp (line-end-position 2) t)) + (user-error (if deadline? "No deadline information to update" + "No scheduled information to update")) + (let* ((rpl0 (match-string 1)) + (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0)) + (msg (if deadline? "Warn starting from" "Delay until"))) + (replace-match + (concat keyword + " <" rpl + (format " -%dd" + (abs (- (time-to-days + (save-match-data + (org-read-date + nil t nil msg old-date-time))) + (time-to-days old-date-time)))) + ">") t t)))))) + (_ + (org-add-planning-info type time 'closed) + (when (and old-date + log + (not (equal old-date org-last-inserted-timestamp))) + (org-add-log-setup (if deadline? 'redeadline 'reschedule) + org-last-inserted-timestamp + old-date + log)) + (when repeater + (save-excursion + (org-back-to-heading t) + (when (re-search-forward + (concat keyword " " org-last-inserted-timestamp) + (line-end-position 2) + t) + (goto-char (1- (match-end 0))) + (insert-and-inherit " " repeater) + (setq org-last-inserted-timestamp + (concat (substring org-last-inserted-timestamp 0 -1) + " " repeater + (substring org-last-inserted-timestamp -1)))))) + (message (if deadline? "Deadline on %s" "Scheduled to %s") + org-last-inserted-timestamp)))))) (defun org-deadline (arg &optional time) "Insert a \"DEADLINE:\" string with a timestamp to make a deadline. @@ -9876,101 +9886,102 @@ (defun org-add-planning-info (what &optional time &rest remove) the time to use. If none is given, the user is prompted for a date. REMOVE indicates what kind of entries to remove. An old WHAT entry will also be removed." - (let (org-time-was-given org-end-time-was-given default-time default-input) - (when (and (memq what '(scheduled deadline)) - (or (not time) - (and (stringp time) - (string-match "^[-+]+[0-9]" time)))) - ;; Try to get a default date/time from existing timestamp - (save-excursion - (org-back-to-heading t) - (let ((end (save-excursion (outline-next-heading) (point))) ts) - (when (re-search-forward (if (eq what 'scheduled) - org-scheduled-time-regexp - org-deadline-time-regexp) - end t) - (setq ts (match-string 1) - default-time (org-time-string-to-time ts) - default-input (and ts (org-get-compact-tod ts))))))) - (when what - (setq time - (if (stringp time) - ;; This is a string (relative or absolute), set - ;; proper date. - (apply #'encode-time - (org-read-date-analyze - time default-time (decode-time default-time))) - ;; If necessary, get the time from the user - (or time (org-read-date nil 'to-time nil - (cl-case what - (deadline "DEADLINE") - (scheduled "SCHEDULED") - (otherwise nil)) - default-time default-input))))) - (org-with-wide-buffer - (org-back-to-heading t) - (let ((planning? (save-excursion - (forward-line) - (looking-at-p org-planning-line-re)))) - (cond - (planning? - (forward-line) - ;; Move to current indentation. - (skip-chars-forward " \t") - ;; Check if we have to remove something. - (dolist (type (if what (cons what remove) remove)) - (save-excursion - (when (re-search-forward - (cl-case type - (closed org-closed-time-regexp) - (deadline org-deadline-time-regexp) - (scheduled org-scheduled-time-regexp) - (otherwise (error "Invalid planning type: %s" type))) - (line-end-position) - t) - ;; Delete until next keyword or end of line. - (delete-region - (match-beginning 0) - (if (re-search-forward org-keyword-time-not-clock-regexp - (line-end-position) - t) + (org-fold-core-ignore-modifications + (let (org-time-was-given org-end-time-was-given default-time default-input) + (when (and (memq what '(scheduled deadline)) + (or (not time) + (and (stringp time) + (string-match "^[-+]+[0-9]" time)))) + ;; Try to get a default date/time from existing timestamp + (save-excursion + (org-back-to-heading t) + (let ((end (save-excursion (outline-next-heading) (point))) ts) + (when (re-search-forward (if (eq what 'scheduled) + org-scheduled-time-regexp + org-deadline-time-regexp) + end t) + (setq ts (match-string 1) + default-time (org-time-string-to-time ts) + default-input (and ts (org-get-compact-tod ts))))))) + (when what + (setq time + (if (stringp time) + ;; This is a string (relative or absolute), set + ;; proper date. + (apply #'encode-time + (org-read-date-analyze + time default-time (decode-time default-time))) + ;; If necessary, get the time from the user + (or time (org-read-date nil 'to-time nil + (cl-case what + (deadline "DEADLINE") + (scheduled "SCHEDULED") + (otherwise nil)) + default-time default-input))))) + (org-with-wide-buffer + (org-back-to-heading t) + (let ((planning? (save-excursion + (forward-line) + (looking-at-p org-planning-line-re)))) + (cond + (planning? + (forward-line) + ;; Move to current indentation. + (skip-chars-forward " \t") + ;; Check if we have to remove something. + (dolist (type (if what (cons what remove) remove)) + (save-excursion + (when (re-search-forward + (cl-case type + (closed org-closed-time-regexp) + (deadline org-deadline-time-regexp) + (scheduled org-scheduled-time-regexp) + (otherwise (error "Invalid planning type: %s" type))) + (line-end-position) + t) + ;; Delete until next keyword or end of line. + (delete-region (match-beginning 0) - (line-end-position)))))) - ;; If there is nothing more to add and no more keyword is - ;; left, remove the line completely. - (if (and (looking-at-p "[ \t]*$") (not what)) - (delete-region (line-end-position 0) - (line-end-position)) - ;; If we removed last keyword, do not leave trailing white - ;; space at the end of line. - (let ((p (point))) - (save-excursion - (end-of-line) - (unless (= (skip-chars-backward " \t" p) 0) - (delete-region (point) (line-end-position))))))) - (what - (end-of-line) - (insert "\n") - (when org-adapt-indentation - (indent-to-column (1+ (org-outline-level))))) - (t nil))) - (when what - ;; Insert planning keyword. - (insert (cl-case what - (closed org-closed-string) - (deadline org-deadline-string) - (scheduled org-scheduled-string) - (otherwise (error "Invalid planning type: %s" what))) - " ") - ;; Insert associated timestamp. - (let ((ts (org-insert-time-stamp - time - (or org-time-was-given - (and (eq what 'closed) org-log-done-with-time)) - (eq what 'closed) - nil nil (list org-end-time-was-given)))) - (unless (eolp) (insert " ")) - ts))))) + (if (re-search-forward org-keyword-time-not-clock-regexp + (line-end-position) + t) + (match-beginning 0) + (line-end-position)))))) + ;; If there is nothing more to add and no more keyword is + ;; left, remove the line completely. + (if (and (looking-at-p "[ \t]*$") (not what)) + (delete-region (line-end-position 0) + (line-end-position)) + ;; If we removed last keyword, do not leave trailing white + ;; space at the end of line. + (let ((p (point))) + (save-excursion + (end-of-line) + (unless (= (skip-chars-backward " \t" p) 0) + (delete-region (point) (line-end-position))))))) + (what + (end-of-line) + (insert-and-inherit "\n") + (when org-adapt-indentation + (indent-to-column (1+ (org-outline-level))))) + (t nil))) + (when what + ;; Insert planning keyword. + (insert-and-inherit (cl-case what + (closed org-closed-string) + (deadline org-deadline-string) + (scheduled org-scheduled-string) + (otherwise (error "Invalid planning type: %s" what))) + " ") + ;; Insert associated timestamp. + (let ((ts (org-insert-time-stamp + time + (or org-time-was-given + (and (eq what 'closed) org-log-done-with-time)) + (eq what 'closed) + nil nil (list org-end-time-was-given)))) + (unless (eolp) (insert " ")) + ts)))))) (defvar org-log-note-marker (make-marker) "Marker pointing at the entry where the note is to be inserted.") @@ -10020,13 +10031,19 @@ (defun org-log-beginning (&optional create) (throw 'exit nil)))) ;; No drawer found. Create one, if permitted. (when create - (unless (bolp) (insert "\n")) - (let ((beg (point))) - (insert ":" drawer ":\n:END:\n") - (org-indent-region beg (point)) - (org-flag-region (line-end-position -1) - (1- (point)) t 'outline)) - (end-of-line -1))))) + ;; Avoid situation when we insert drawer right before + ;; first "*". Otherwise, if the previous heading is + ;; folded, we are inserting after visible newline at + ;; the end of the fold, thus breaking the fold + ;; continuity. + (when (org-at-heading-p) (backward-char)) + (org-fold-core-ignore-modifications + (unless (bolp) (insert-and-inherit "\n")) + (let ((beg (point))) + (insert-and-inherit ":" drawer ":\n:END:\n") + (org-indent-region beg (point)) + (org-fold-region (line-end-position -1) (1- (point)) t (if (eq org-fold-core-style 'text-properties) 'drawer 'outline))))) + (end-of-line -1)))) (t (org-end-of-meta-data org-log-state-notes-insert-after-drawers) (skip-chars-forward " \t\n") @@ -10034,7 +10051,7 @@ (defun org-log-beginning (&optional create) (unless org-log-states-order-reversed (org-skip-over-state-notes) (skip-chars-backward " \t\n") - (forward-line))))) + (beginning-of-line 2))))) (if (bolp) (point) (line-beginning-position 2)))) (defun org-add-log-setup (&optional purpose state prev-state how extra) @@ -10160,34 +10177,35 @@ (defun org-store-log-note () (push note lines)) (when (and lines (not org-note-abort)) (with-current-buffer (marker-buffer org-log-note-marker) - (org-with-wide-buffer - ;; Find location for the new note. - (goto-char org-log-note-marker) - (set-marker org-log-note-marker nil) - ;; Note associated to a clock is to be located right after - ;; the clock. Do not move point. - (unless (eq org-log-note-purpose 'clock-out) - (goto-char (org-log-beginning t))) - ;; Make sure point is at the beginning of an empty line. - (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) - ((looking-at "[ \t]*\\S-") (save-excursion (insert "\n")))) - ;; In an existing list, add a new item at the top level. - ;; Otherwise, indent line like a regular one. - (let ((itemp (org-in-item-p))) - (if itemp - (indent-line-to - (let ((struct (save-excursion - (goto-char itemp) (org-list-struct)))) - (org-list-get-ind (org-list-get-top-point struct) struct))) - (org-indent-line))) - (insert (org-list-bullet-string "-") (pop lines)) - (let ((ind (org-list-item-body-column (line-beginning-position)))) - (dolist (line lines) - (insert "\n") - (indent-line-to ind) - (insert line))) - (message "Note stored") - (org-back-to-heading t))))) + (org-fold-core-ignore-modifications + (org-with-wide-buffer + ;; Find location for the new note. + (goto-char org-log-note-marker) + (set-marker org-log-note-marker nil) + ;; Note associated to a clock is to be located right after + ;; the clock. Do not move point. + (unless (eq org-log-note-purpose 'clock-out) + (goto-char (org-log-beginning t))) + ;; Make sure point is at the beginning of an empty line. + (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert-and-inherit "\n"))) + ((looking-at "[ \t]*\\S-") (save-excursion (insert-and-inherit "\n")))) + ;; In an existing list, add a new item at the top level. + ;; Otherwise, indent line like a regular one. + (let ((itemp (org-in-item-p))) + (if itemp + (indent-line-to + (let ((struct (save-excursion + (goto-char itemp) (org-list-struct)))) + (org-list-get-ind (org-list-get-top-point struct) struct))) + (org-indent-line))) + (insert-and-inherit (org-list-bullet-string "-") (pop lines)) + (let ((ind (org-list-item-body-column (line-beginning-position)))) + (dolist (line lines) + (insert-and-inherit "\n") + (indent-line-to ind) + (insert-and-inherit line))) + (message "Note stored") + (org-back-to-heading t)))))) ;; Don't add undo information when called from `org-agenda-todo'. (set-window-configuration org-log-note-window-configuration) (with-current-buffer (marker-buffer org-log-note-return-to) @@ -11318,34 +11336,35 @@ (defun org-set-tags (tags) This function assumes point is on a headline." (org-with-wide-buffer - (let ((tags (pcase tags - ((pred listp) tags) - ((pred stringp) (split-string (org-trim tags) ":" t)) - (_ (error "Invalid tag specification: %S" tags)))) - (old-tags (org-get-tags nil t)) - (tags-change? nil)) - (when (functionp org-tags-sort-function) - (setq tags (sort tags org-tags-sort-function))) - (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 tags-change? (run-hooks 'org-after-tags-change-hook))))) + (org-fold-core-ignore-modifications + (let ((tags (pcase tags + ((pred listp) tags) + ((pred stringp) (split-string (org-trim tags) ":" t)) + (_ (error "Invalid tag specification: %S" tags)))) + (old-tags (org-get-tags nil t)) + (tags-change? nil)) + (when (functionp org-tags-sort-function) + (setq tags (sort tags org-tags-sort-function))) + (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-and-inherit " " (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-fold-region (point) (line-end-position) nil 'outline)))) + ;; Align tags, if any. + (when tags (org-align-tags)) + (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. @@ -12539,19 +12558,20 @@ (defun org-entry-put (pom property value) ((member property org-special-properties) (error "The %s property cannot be set with `org-entry-put'" property)) (t - (let* ((range (org-get-property-block beg 'force)) - (end (cdr range)) - (case-fold-search t)) - (goto-char (car range)) - (if (re-search-forward (org-re-property property nil t) end t) - (progn (delete-region (match-beginning 0) (match-end 0)) - (goto-char (match-beginning 0))) - (goto-char end) - (insert "\n") - (backward-char)) - (insert ":" property ":") - (when value (insert " " value)) - (org-indent-line))))) + (org-fold-core-ignore-modifications + (let* ((range (org-get-property-block beg 'force)) + (end (cdr range)) + (case-fold-search t)) + (goto-char (car range)) + (if (re-search-forward (org-re-property property nil t) end t) + (progn (delete-region (match-beginning 0) (match-end 0)) + (goto-char (match-beginning 0))) + (goto-char end) + (insert-and-inherit "\n") + (backward-char)) + (insert-and-inherit ":" property ":") + (when value (insert-and-inherit " " value)) + (org-indent-line)))))) (run-hook-with-args 'org-property-changed-functions property value)))) (defun org-buffer-property-keys (&optional specials defaults columns) @@ -13705,23 +13725,24 @@ (defun org-insert-time-stamp (time &optional with-hm inactive pre post extra) PRE and POST are optional strings to be inserted before and after the stamp. The command returns the inserted time stamp." - (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats)) - stamp) - (when inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) - (insert-before-markers (or pre "")) - (when (listp extra) - (setq extra (car extra)) - (if (and (stringp extra) - (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra)) - (setq extra (format "-%02d:%02d" - (string-to-number (match-string 1 extra)) - (string-to-number (match-string 2 extra)))) - (setq extra nil))) - (when extra - (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1)))) - (insert-before-markers (setq stamp (format-time-string fmt time))) - (insert-before-markers (or post "")) - (setq org-last-inserted-timestamp stamp))) + (org-fold-core-ignore-modifications + (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats)) + stamp) + (when inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) + (insert-before-markers-and-inherit (or pre "")) + (when (listp extra) + (setq extra (car extra)) + (if (and (stringp extra) + (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra)) + (setq extra (format "-%02d:%02d" + (string-to-number (match-string 1 extra)) + (string-to-number (match-string 2 extra)))) + (setq extra nil))) + (when extra + (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1)))) + (insert-before-markers-and-inherit (setq stamp (format-time-string fmt time))) + (insert-before-markers-and-inherit (or post "")) + (setq org-last-inserted-timestamp stamp)))) (defun org-toggle-time-stamp-overlays () "Toggle the use of custom time stamp formats." @@ -18345,7 +18366,10 @@ (defun org--align-node-property () (let ((newtext (concat (match-string 4) (org-trim (format org-property-format (match-string 1) (match-string 3)))))) - (setf (buffer-substring (match-beginning 0) (match-end 0)) newtext))))) + ;; Do not use `replace-match' here as we want to inherit folding + ;; properties if inside fold. + (setf (buffer-substring (match-beginning 0) (match-end 0)) "") + (insert-and-inherit newtext))))) (defun org-indent-line () "Indent line depending on context. diff --git a/lisp/ox.el b/lisp/ox.el index 6b68fc2da..9a8e63046 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -2588,7 +2588,9 @@ (defun org-export--generate-copy-script (buffer) (or (memq var '(default-directory buffer-file-name - buffer-file-coding-system)) + buffer-file-coding-system + ;; Needed to preserve folding state + char-property-alias-alist)) (assq var bound-variables) (string-match "^\\(org-\\|orgtbl-\\)" (symbol-name var))) diff --git a/testing/lisp/test-ob.el b/testing/lisp/test-ob.el index 579d4df02..aa05f87a3 100644 --- a/testing/lisp/test-ob.el +++ b/testing/lisp/test-ob.el @@ -1557,8 +1557,8 @@ (ert-deftest test-ob/preserve-results-indentation () (org-test-with-temp-text " #+begin_src emacs-lisp\n(+ 1 1)\n #+end_src" (org-babel-execute-src-block) (let ((case-fold-search t)) (search-forward "RESULTS")) - (list (org-get-indentation) - (progn (forward-line) (org-get-indentation)))))) + (list (current-indentation) + (progn (forward-line) (current-indentation)))))) (should (equal '(2 2) @@ -1566,8 +1566,8 @@ (ert-deftest test-ob/preserve-results-indentation () " #+name: block\n #+begin_src emacs-lisp\n(+ 1 1)\n #+end_src" (org-babel-execute-src-block) (let ((case-fold-search t)) (search-forward "RESULTS")) - (list (org-get-indentation) - (progn (forward-line) (org-get-indentation)))))) + (list (current-indentation) + (progn (forward-line) (current-indentation)))))) ;; Don't get fooled by TAB-based indentation. (should (equal @@ -1577,8 +1577,8 @@ (ert-deftest test-ob/preserve-results-indentation () (setq tab-width 4) (org-babel-execute-src-block) (let ((case-fold-search t)) (search-forward "RESULTS")) - (list (org-get-indentation) - (progn (forward-line) (org-get-indentation)))))) + (list (current-indentation) + (progn (forward-line) (current-indentation)))))) ;; Properly indent examplified blocks. (should (equal diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index 0a47618ca..0cc8df154 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -1522,6 +1522,7 @@ (ert-deftest test-org/meta-return () (should (org-test-with-temp-text ":MYDRAWER:\n- a\n:END:" (forward-line) + (org-fold-reveal) (org-meta-return) (beginning-of-line) (looking-at "- $")))) @@ -2943,6 +2944,7 @@ (ert-deftest test-org/custom-properties () (let ((org-custom-properties '("FOO" "BAR"))) (org-test-with-temp-text "* H\n:PROPERTIES:\n:FOO: val\n:P: 1\n:BAR: baz\n:END:\n" + (org-fold-reveal) (org-toggle-custom-properties-visibility) (and (org-invisible-p2) (not (progn (forward-line) (org-invisible-p2))) @@ -2963,6 +2965,7 @@ (ert-deftest test-org/custom-properties () (let ((org-custom-properties '("A"))) (org-test-with-temp-text "* H\n:PROPERTIES:\n:A: 1\n:END:\n\n:PROPERTIES:\n:A: 2\n:END:" + (org-fold-reveal) (org-toggle-custom-properties-visibility) (org-invisible-p2))))) -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg