From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp2.migadu.com ([2001:41d0:303:e224::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms1.migadu.com with LMTPS id uASeE2b7LGYpNQEAe85BDQ:P1 (envelope-from ) for ; Sat, 27 Apr 2024 15:19:34 +0200 Received: from aspmx1.migadu.com ([2001:41d0:303:e224::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp2.migadu.com with LMTPS id uASeE2b7LGYpNQEAe85BDQ (envelope-from ) for ; Sat, 27 Apr 2024 15:19:34 +0200 X-Envelope-To: larch@yhetil.org Authentication-Results: aspmx1.migadu.com; dkim=pass header.d=outlook.com header.s=selector1 header.b="EC6/6tp2"; dmarc=pass (policy=none) header.from=outlook.com; arc=pass ("microsoft.com:s=arcselector9901:i=1"); 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" ARC-Seal: i=2; s=key1; d=yhetil.org; t=1714223974; a=rsa-sha256; cv=pass; b=tUKc9Y3skjsKwEqnaRjnYkiIa6JZu8SI/jRDDZ/r8WsP2qcQpq+/ELmbllyObkaj460GpY eXRFV5sXXUGbEe5dZWRXZm31baR21ScZWUBtUJZndzBZuBLPsQy+SBGRK0VM193QLuNqv3 vrW2q4tVkA51LBIZXnpKXSCy/ib44CGdJ3gSE0p2CAWqSvidx4RWIqwoGSXwAefAW0Ckl+ qv7yI+3Yk+i/JkvXoSGEKdwz+kRMKy5ED2yHlPg3PmAUbOZxNeXQBOvMHw7++zlRTNOTir dyBoT3SgfTqgJxe6ML5QRmnAslQxokLl7y2QyPASyoS+4C1ZA/0VqgfkZShgYg== ARC-Authentication-Results: i=2; aspmx1.migadu.com; dkim=pass header.d=outlook.com header.s=selector1 header.b="EC6/6tp2"; dmarc=pass (policy=none) header.from=outlook.com; arc=pass ("microsoft.com:s=arcselector9901:i=1"); 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" ARC-Message-Signature: i=2; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1714223974; 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:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=mVafJWWOT3gmOSvEZHUIUjstYHUQzVCJVVEWuIPNlEw=; b=O+fBRGpSDtTNXpIZYXP1aijg0/72TlO7nN+ZAV6DJ9RkJOU2BDGswTnCY9Vqs5h8cOtv6a HncbVyK7ZE7QElcA8MfCKDJ03spz7QqfarnYGX3ZOBwYfn34vKR8b7PBtSnt/FG2ghM4o/ xy+faQN7V/XDRnsXkSlsmLvgu8O6xP+V+Trvrah6elzuXqMnmMDkQv93/HVerqdG8GAUI0 E8ieq0FP3te5ww5RfDsEh92PxHa4TEa7fT3Ju3HiLjf6N4w2B6llBwLoEVPB0a832Acwk/ Fb/3s37zFkc2Er8E8dzJ9ed0iS3TtlqEZtaBTIF9gBEIPDniZHF5UCzUxJieDw== 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 E931D2065B for ; Sat, 27 Apr 2024 15:19:33 +0200 (CEST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1s0hwy-0007rl-Ax; Sat, 27 Apr 2024 09:18:44 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1s0hwv-0007mw-SP for emacs-orgmode@gnu.org; Sat, 27 Apr 2024 09:18:42 -0400 Received: from mail-mw2nam10olkn20800.outbound.protection.outlook.com ([2a01:111:f403:2c12::800] helo=NAM10-MW2-obe.outbound.protection.outlook.com) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1s0hwt-0007YJ-3A for emacs-orgmode@gnu.org; Sat, 27 Apr 2024 09:18:41 -0400 ARC-Seal: i=1; a=rsa-sha256; s=arcselector9901; d=microsoft.com; cv=none; b=CrCskpp8q5qAipxd+UE4gBzFg+8tK6F29wybuK1eB8ow+Zzy6nTs/zW1TuAp+r5/NRAF5zHz2n/PllF0aidBPS3g4pDbHSLLaiR3Vhu8WpniC/TLS4Hu1aiNbw/zbsOwx/SllrSHU+bYdvNEx+t0J5WMcLFAYm/ND0BKIY3e7RbPHggmXfIsVWx1HorXpknYBlwz/C2TnpuGJb6oBUrOIX0tK+/NPPTOQ9xoBFO6wJwTCCIa2EyEsRJ0r0RaWbQ+Ou/xDQ1K7iHioh71kLMpomyiQkXFJBfkUXPCJ9AP+HbmD6w7cwpTdRO8l0GdCBcUWBN1oUorUUPV9pqEqZEbXA== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=microsoft.com; s=arcselector9901; h=From:Date:Subject:Message-ID:Content-Type:MIME-Version:X-MS-Exchange-AntiSpam-MessageData-ChunkCount:X-MS-Exchange-AntiSpam-MessageData-0:X-MS-Exchange-AntiSpam-MessageData-1; bh=mVafJWWOT3gmOSvEZHUIUjstYHUQzVCJVVEWuIPNlEw=; b=ZUKTMHMJBTt3L49/l94OW6PnwD9taATQjQuLRS4kT9ysRjkVgKsZ8IVg5Zug3nlRJDWDYeSi27bY6PJQ0f0VNZOsc4qcbySOZF5bHI9HWq2fwrRkH5UwbBeZWQ52AbfSBu1u0L8+DHlisudM0sdaSjzKrdRftU4UC5PfVx8Js5XcG9/lhpVGjwMYMBTdkGmZD0s9QPQNZb83rlSNg1+YJzW/9KakUVqfroSlsR8BlfT6nTMuSY9SJc5hvN1cGg86v8HxjbB4JRPJU567hQgweQakl/+kYyz5vr7VeIhKr+RJCZz1HlHBDi1gO14tKpOd9ghnb1LlvcBZDTNlqTa/4g== ARC-Authentication-Results: i=1; mx.microsoft.com 1; spf=none; dmarc=none; dkim=none; arc=none DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=outlook.com; s=selector1; h=From:Date:Subject:Message-ID:Content-Type:MIME-Version:X-MS-Exchange-SenderADCheck; bh=mVafJWWOT3gmOSvEZHUIUjstYHUQzVCJVVEWuIPNlEw=; b=EC6/6tp257L19Ld37YtA+UY3oq1LkXTWmqB9MRTwULC+UnSmbxf14h/uszhuO4YArDm56FVbvoNQxesH9tahurzGUzoRj0JW+R4e1WwquU6wF56Dy5Nt7PHO1BaxrksodMBC4SogjwLvrUAbyxi+sFFn+tsZPujy5xj24b5EyQAM6X/yBVjUYPQG7Qs4zKFuJcwQX2VSSJXk6euh0khQkmleYJwfBbLG6rdcimCl81DbO4qa6lcbQUa/D7xySnusEFP5qvJFue17inlQPTFUgtscRcJNew4UrMOiLyYEf3OkxLAWrHcdyHjNDB9OpRLXGmJVCwCqSkY4XCNfcSphtQ== Received: from CH3PR84MB3424.NAMPRD84.PROD.OUTLOOK.COM (2603:10b6:610:1c4::17) by LV8PR84MB3814.NAMPRD84.PROD.OUTLOOK.COM (2603:10b6:408:1c8::13) with Microsoft SMTP Server (version=TLS1_2, cipher=TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) id 15.20.7519.31; Sat, 27 Apr 2024 13:13:33 +0000 Received: from CH3PR84MB3424.NAMPRD84.PROD.OUTLOOK.COM ([fe80::178d:1518:8a49:2a45]) by CH3PR84MB3424.NAMPRD84.PROD.OUTLOOK.COM ([fe80::178d:1518:8a49:2a45%6]) with mapi id 15.20.7519.031; Sat, 27 Apr 2024 13:13:32 +0000 From: Morgan Smith To: emacs-orgmode@gnu.org Subject: [PATCH] Rewrite `org-clock-sum' X-Hashcash: 1:20:240427:emacs-orgmode@gnu.org::Gujr0mv+SVLIGt1O:01JQ Date: Sat, 27 Apr 2024 09:13:28 -0400 Message-ID: User-Agent: Gnus/5.13 (Gnus v5.13) Content-Type: multipart/mixed; boundary="=-=-=" X-TMN: [ORq4iCICWREkCWjhjNZ82ZT28ALzOaKz] X-ClientProxiedBy: YT4PR01CA0241.CANPRD01.PROD.OUTLOOK.COM (2603:10b6:b01:10f::11) To CH3PR84MB3424.NAMPRD84.PROD.OUTLOOK.COM (2603:10b6:610:1c4::17) X-Microsoft-Original-Message-ID: <87sez7ne2v.fsf@outlook.com> MIME-Version: 1.0 X-MS-Exchange-MessageSentRepresentingType: 1 X-MS-PublicTrafficType: Email X-MS-TrafficTypeDiagnostic: CH3PR84MB3424:EE_|LV8PR84MB3814:EE_ X-MS-Office365-Filtering-Correlation-Id: dde562be-9791-4502-970e-08dc66bbd555 X-Microsoft-Antispam: BCL:0; ARA:14566002|6092099003|461199019|440099019|3412199016; X-Microsoft-Antispam-Message-Info: oMqVEMRvVhyG3NgAdHdLXD8mNZYOTTWO30SR8UulXw5I//K1HD7CmlAsmVQB4DCYCIfbuFOmK6ovg9ab8DwNYCLxpifvfFy/7yB6dKEm2ofdG3guZqH/K2Nc0e0tBfL0zhqP2xp6ES8ZwuoTi6aWD9u8irZfWa4aMxBnT0zeReWiyFSXP5ixueqiTNnmKw61SxoPVmA6/dZW2lCN3NAixe33RRXGI4oJQ1yxZqh5roS2STLlUdPr2IZ9G55N3NdvpuiH33ksCdNgviH8jJLQ7JVxXbWt8u9J5QanTfgVrOvAZqq0yXSgm+e2Brn1NwKQMnvH+IAeqBtKcd03vgrv13AVPEdzXoPt8HQpYPiIjk7EGLB1v/Rt0tGEar67Ll8MBBAKsvvg6JEo79ibGZ/stQAjTDW1Vb2EflnBomj3mkKkvoPzSeFd130QiiJOkcvO0XutMyK9S0nnlvkSaMaad9SknIrt0VPWblG37Cde5QrYCQhSi5vRlatmU7kX8gM4zbeZd7meoLjGRdo+Kyk95iQ2L/v3kneKO6OB+pXzwmsAO3eJ0P0iF9VCpbDEpBGroON5AY21JSOa/YTn8BvQ+FMcP3KwkoRs2WuBVKGl0zCGUQDKU/2mQYE2Hl90iHx9 X-MS-Exchange-AntiSpam-MessageData-ChunkCount: 1 X-MS-Exchange-AntiSpam-MessageData-0: =?us-ascii?Q?1LvXqk8/Eupx7LlRjLaT2e/H8430azld0P8+B2/73yn5IVs5rvktl0pl6LUW?= =?us-ascii?Q?MUDmIU/ZIl13tl3jy+unMg/07jT7D7KRSzP3rPT1HLkayzdM2Qsx4frwJu+J?= =?us-ascii?Q?cxn71ZnWiqGTATQRQ4MlSmfb726xd0bD2HwB2bUhizzv5xC/G6vHhjpU9gYm?= =?us-ascii?Q?PS7sh44RpoB00jTFSPuQwU5or4MBrpm7uMqMF9Lqbct1mwCzuCRGvl/5Gla6?= =?us-ascii?Q?Obw7bcTmqGSZb4Eaer5qj601nMlceUGpuHXEQeaFGFtWbs3ozJF/GiHxny6z?= =?us-ascii?Q?ZskvYTKJx+lMz+urCLfrv76yqlXkhKhS1+2UAO/XFdsq4hnbky9PuAge7zlG?= =?us-ascii?Q?V5/z5j8+Jfxa7nUwUbh69ATQ+joI3ExbM2op5pTImXAmfBRRMNis0PTjitNi?= =?us-ascii?Q?/SDYNZGRWVaqOZCS+VTMFzbeCmCEUD8WDcsRE51A+1glkn3jWtF55UsDTWSF?= =?us-ascii?Q?M12WHbZBdza3W5QGPm1aTSbranI5nDNHkVO43e9JyZ7/JdFeY+iOKMyGlcX/?= =?us-ascii?Q?kXd52MzTpLZ20VDAIaygk/NpN9VTl/04EskMUYAmbA9gJUE2boGpiB1edByE?= =?us-ascii?Q?yLcMWQE7TLbMJPbBwTc+Of7Xt/IUORT7+dR+GAD/3OMFXq+sPbMCuK/HKKRd?= =?us-ascii?Q?ItfFU10VwTRqv4kwA6t3ohxa9OiLShg848lohz/Q+ZJU+yJX6qeIb+TDv+w5?= =?us-ascii?Q?YkQDsNTOwZWhNdXdJdtaxEtLC9mUfT2cFtq77w8JA0hclTMQzMteq4LuSdFh?= =?us-ascii?Q?m2BzGmbKALjLyTPy8XPzkqEPnuvw9C0ufDxmMrAoOpEhpD1LreIil1BbyqYj?= =?us-ascii?Q?MYUYvmaE12JJ3HsN5f0Wcd8jsrcR35iCezpCjXJEoicsXmwGT3W5/3Mw3R/a?= =?us-ascii?Q?Dz+vplK8EuM0eAENjblcHliHFSSJKIvjF4ZkzCLbmAWU9jhzrIg0DX8UQjfd?= =?us-ascii?Q?XgWXXiI/sdTjMM8lbLD7/fkdabLLo/fg5tQ2EQMbwzZgnLI7hYvgWfHiq+rj?= =?us-ascii?Q?lo+T2W4hgjMpmOC0lQX/M5C1csfnl1DobR6GSKXJrH6/BzSdQycD6/+wLNN9?= =?us-ascii?Q?9ZlWDews22/MHM4eEjLsiS3iKLcnL3PI1+PJuM4NHmNBH+RCF2taPuMD/TiO?= =?us-ascii?Q?PNgGgfu8f92WYzR9KN2jOQu9WuHBPgT1+y+1z2CiZy+WI3MEzvtr9cQmeoL0?= =?us-ascii?Q?6pL3hdOoKQ4t/hLFQLeJxTxU8AGMUtEkcXzxwGIDUErYFp0Y6vMVaJMbj5Iz?= =?us-ascii?Q?MAzGBi5kkxHaAjPqXpuM?= X-OriginatorOrg: outlook.com X-MS-Exchange-CrossTenant-Network-Message-Id: dde562be-9791-4502-970e-08dc66bbd555 X-MS-Exchange-CrossTenant-AuthSource: CH3PR84MB3424.NAMPRD84.PROD.OUTLOOK.COM X-MS-Exchange-CrossTenant-AuthAs: Internal X-MS-Exchange-CrossTenant-OriginalArrivalTime: 27 Apr 2024 13:13:32.2756 (UTC) X-MS-Exchange-CrossTenant-FromEntityHeader: Hosted X-MS-Exchange-CrossTenant-Id: 84df9e7f-e9f6-40af-b435-aaaaaaaaaaaa X-MS-Exchange-CrossTenant-RMS-PersistedConsumerOrg: 00000000-0000-0000-0000-000000000000 X-MS-Exchange-Transport-CrossTenantHeadersStamped: LV8PR84MB3814 Received-SPF: pass client-ip=2a01:111:f403:2c12::800; envelope-from=Morgan.J.Smith@outlook.com; helo=NAM10-MW2-obe.outbound.protection.outlook.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 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_FROM=0.001, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001 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-bounces+larch=yhetil.org@gnu.org X-Migadu-Country: US X-Migadu-Flow: FLOW_IN X-Migadu-Queue-Id: E931D2065B X-Migadu-Scanner: mx12.migadu.com X-Migadu-Spam-Score: -9.81 X-Spam-Score: -9.81 X-TUID: XSVWhzd9gD/i --=-=-= Content-Type: text/plain Hello! I may have rewritten org-clock-sum yet again. See attached patch. * things I want you to tell me 1. Does this look like something that could be eventually merged upstream or am I wasting my time? 2. Would you like me to do more performance testing? I basically only tested my use case. If yes, should I create some test files for benchmarking that can be shared? 3. Do you want `org-element-cache-map' fixed before we merge this patch? If yes, please be willing to wait. I have already spent probably about 8 hours looking into it and it still makes my head hurt. * todo The patch is like 95% done. I still gotta 1. Write a decent docstring for `org-clock-ranges'. Maybe add a news entry for it too. 2. Check `org-clock-hd-marker' for open clock. 3. Figure out what to do about open clocks that aren't the current one. Historically we ignored them so I guess I should just do that. 4. Maybe test clocking in inlinetasks. I honestly don't even know what these are. * Benefits of my rewrite 1. New function `org-clock-ranges' which should help third party packages with clock range visualization stuff 2. Performance (see table below) - We run the filter before doing all the clock range calculations unlike before so aggressive filters should run much faster (I didn't test this though). 3. Code is easier to understand (subjective) * Downsides of my rewrite 1. Does it still perform better with the cache disabled? idk. Probably not. 2. Radical change. Likely has bugs 3. Dances around bugs in `org-element-cache-map' but does it actually dance around all of them? * Performance I didn't see a big difference on the third run so I assume run 1 is with a cold cache (obtained by running `org-element-cache-reset') and run 2 is with a warm cache. I have an almost 3M file of clocking data. In it I have this source block which I use to update my 10 clocktables: #+BEGIN_SRC elisp (let (;; (gc-cons-threshold (* 50 1000 1000)) (start-time (current-time))) (org-dblock-update t) (time-to-seconds (time-since start-time))) #+END_SRC The time results are as follows | patch | run # | gc-cons-threshold | time (s) | |-------------+-------+-------------------+--------------| | origin/main | 1 | 800000 | 59.824324488 | | mine | 1 | 800000 | 33.397901059 | | origin/main | 2 | 800000 | 48.354095581 | | mine | 2 | 800000 | 23.581749901 | | origin/main | 1 | 50000000 | 41.856530738 | | mine | 1 | 50000000 | 30.237918254 | | origin/main | 2 | 50000000 | 33.944309156 | | mine | 2 | 50000000 | 19.84887913 | --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-lisp-org-clock.el-org-clock-sum-Rewrite-using-elemen.patch >From bfc01710186be01aab2186762cf678d360c5476e Mon Sep 17 00:00:00 2001 From: Morgan Smith Date: Thu, 11 Apr 2024 12:23:21 -0400 Subject: [PATCH] lisp/org-clock.el (org-clock-sum): Rewrite using element api --- lisp/org-clock.el | 191 +++++++++++++++++++++++----------------------- 1 file changed, 94 insertions(+), 97 deletions(-) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 65a54579a..8731d6ee5 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -33,15 +33,13 @@ (require 'cl-lib) (require 'org) +(require 'org-element) (declare-function calendar-iso-to-absolute "cal-iso" (date)) (declare-function notifications-notify "notifications" (&rest params)) (declare-function org-element-property "org-element-ast" (property node)) -(declare-function org-element-contents-end "org-element" (node)) -(declare-function org-element-end "org-element" (node)) (declare-function org-element-type "org-element-ast" (node &optional anonymous)) (declare-function org-element-type-p "org-element-ast" (node types)) -(defvar org-element-use-cache) (declare-function org-inlinetask-at-task-p "org-inlinetask" ()) (declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) (declare-function org-inlinetask-goto-end "org-inlinetask" ()) @@ -1998,6 +1996,9 @@ With prefix arg SELECT, offer recently clocked tasks for selection." (org-clock-sum (car r) (cadr r) headline-filter (or propname :org-clock-minutes-custom)))) +;;; TODO: +;; Maybe add more tests? +;; Are there tests for inlinetasks? ;;;###autoload (defun org-clock-sum (&optional tstart tend headline-filter propname) "Sum the times for each subtree. @@ -2008,100 +2009,62 @@ each headline in the time range with point at the headline. Headlines for which HEADLINE-FILTER returns nil are excluded from the clock summation. PROPNAME lets you set a custom text property instead of :org-clock-minutes." (with-silent-modifications - (let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" - org-clock-string - "[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\)")) - (lmax 30) - (ltimes (make-vector lmax 0)) - (level 0) - (tstart (cond ((stringp tstart) (org-time-string-to-seconds tstart)) - ((consp tstart) (float-time tstart)) - (t tstart))) - (tend (cond ((stringp tend) (org-time-string-to-seconds tend)) - ((consp tend) (float-time tend)) - (t tend))) - (t1 0) - time) - (remove-text-properties (point-min) (point-max) - `(,(or propname :org-clock-minutes) t - :org-clock-force-headline-inclusion t)) - (save-excursion - (goto-char (point-max)) - (while (re-search-backward re nil t) - (let* ((element (save-match-data (org-element-at-point))) - (element-type (org-element-type element))) - (cond - ((and (eq element-type 'clock) (match-end 2)) - ;; Two time stamps. - (let* ((timestamp (org-element-property :value element)) - (ts (float-time - (org-encode-time - (list 0 - (org-element-property :minute-start timestamp) - (org-element-property :hour-start timestamp) - (org-element-property :day-start timestamp) - (org-element-property :month-start timestamp) - (org-element-property :year-start timestamp) - nil -1 nil)))) - (te (float-time - (org-encode-time - (list 0 - (org-element-property :minute-end timestamp) - (org-element-property :hour-end timestamp) - (org-element-property :day-end timestamp) - (org-element-property :month-end timestamp) - (org-element-property :year-end timestamp) - nil -1 nil)))) - (dt (- (if tend (min te tend) te) - (if tstart (max ts tstart) ts)))) - (when (> dt 0) (cl-incf t1 (floor dt 60))))) - ((match-end 4) - ;; A naked time. - (setq t1 (+ t1 (string-to-number (match-string 5)) - (* 60 (string-to-number (match-string 4)))))) - ((memq element-type '(headline inlinetask)) ;A headline - ;; Add the currently clocking item time to the total. - (when (and org-clock-report-include-clocking-task - (eq (org-clocking-buffer) (current-buffer)) - (eq (marker-position org-clock-hd-marker) (point)) - tstart - tend - (>= (float-time org-clock-start-time) tstart) - (<= (float-time org-clock-start-time) tend)) - (let ((time (floor (org-time-convert-to-integer - (time-since org-clock-start-time)) - 60))) - (setq t1 (+ t1 time)))) - (let* ((headline-forced - (get-text-property (point) - :org-clock-force-headline-inclusion)) - (headline-included - (or (null headline-filter) - (save-excursion - (save-match-data (funcall headline-filter)))))) - (setq level (- (match-end 1) (match-beginning 1))) - (when (>= level lmax) - (setq ltimes (vconcat ltimes (make-vector lmax 0)) lmax (* 2 lmax))) - (when (or (> t1 0) (> (aref ltimes level) 0)) - (when (or headline-included headline-forced) - (if headline-included - (cl-loop for l from 0 to level do - (aset ltimes l (+ (aref ltimes l) t1)))) - (setq time (aref ltimes level)) - (goto-char (match-beginning 0)) - (put-text-property (point) (line-end-position) - (or propname :org-clock-minutes) time) - (when headline-filter - (save-excursion - (save-match-data - (while (org-up-heading-safe) - (put-text-property - (point) (line-end-position) - :org-clock-force-headline-inclusion t)))))) - (setq t1 0) - (cl-loop for l from level to (1- lmax) do - (aset ltimes l 0)))))))) - (setq org-clock-file-total-minutes (aref ltimes 0)))))) + (let ((tstart (cond ((stringp tstart) (org-time-string-to-seconds tstart)) + ((consp tstart) (float-time tstart)) + (t tstart))) + (tend (cond ((stringp tend) (org-time-string-to-seconds tend)) + ((consp tend) (float-time tend)) + (t tend))) + (propname (or propname :org-clock-minutes)) + (t1 0) + (total 0) + time) + (remove-text-properties (point-min) (point-max) `(,propname t)) + (org-element-cache-map + (lambda (element) + (when (or (null headline-filter) + (save-excursion + (funcall headline-filter))) + (mapc + (lambda (range) + (setq time + (pcase range + (`(,_ . now) + (when (and org-clock-report-include-clocking-task + (eq (org-clocking-buffer) (current-buffer)) + ;; TODO + ;; (eq (marker-position org-clock-hd-marker) (point)) + tstart + tend + (>= (float-time org-clock-start-time) tstart) + (<= (float-time org-clock-start-time) tend)) + (floor (org-time-convert-to-integer + (time-since org-clock-start-time)) + 60))) + ((pred floatp) range) + (`(,time1 . ,time2) + (let* ((ts (float-time time1)) + (te (float-time time2)) + (dt (- (if tend (min te tend) te) + (if tstart (max ts tstart) ts)))) + (floor dt 60))))) + (when (and time (> time 0)) (cl-incf t1 time))) + (org-clock-ranges element)) + (when (> t1 0) + (setq total (+ total t1)) + (org-element-lineage-map element + (lambda (parent) + (put-text-property + (org-element-begin parent) (1- (org-element-contents-begin parent)) + propname + (+ t1 (or (get-text-property + (org-element-begin parent) + propname) + 0)))) + '(headline) t)) + (setq t1 0))) + :narrow t) + (setq org-clock-file-total-minutes total)))) (defun org-clock-sum-current-item (&optional tstart) "Return time, clocked on current item in total." @@ -2116,6 +2079,40 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes." (org-clock-sum tstart) org-clock-file-total-minutes))) +(defun org-clock-ranges (headline) + "Return the clock ranges of HEADLINE. +Does not recurse into subheadings. +Ranges are one of 3 formats: +\(cons time . time) +\(cons time . now) +float" + (unless (org-element-type-p headline '(headline inlinetask)) + (error "Argument must be a headline")) + (or (org-element-cache-get-key headline :clock-ranges) + (let ((clock-ranges + (org-element-cache-map + (lambda (elem) + (when (org-element-type-p elem 'clock) + (if-let ((timestamp (org-element-property :value elem))) + (cons (org-timestamp-to-time timestamp) + (if (eq 'running (org-element-property :status elem)) + 'now + (org-timestamp-to-time timestamp t))) + (org-duration-to-minutes (org-element-property :duration elem))))) + ;; XXX: using these arguments would be more intuitive + ;; but don't seem to work due to bugs in + ;; `org-element-cache-map' + ;; :restrict-elements '(clock) + ;; :after-element headline + :granularity 'element + :next-re org-element-clock-line-re + :from-pos (org-element-contents-begin headline) + :to-pos (save-excursion + (goto-char (org-element-begin headline)) + (org-entry-end-position))))) + (org-element-cache-store-key headline :clock-ranges clock-ranges) + clock-ranges))) + ;;;###autoload (defun org-clock-display (&optional arg) "Show subtree times in the entire buffer. -- 2.41.0 --=-=-=--