From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp12.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms5.migadu.com with LMTPS id CAiUGlIHrGJ9dAEAbAwnHQ (envelope-from ) for ; Fri, 17 Jun 2022 06:47:14 +0200 Received: from aspmx1.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp12.migadu.com with LMTPS id GHhzGlIHrGJ6nAAAauVa8A (envelope-from ) for ; Fri, 17 Jun 2022 06:47:14 +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 741059383 for ; Fri, 17 Jun 2022 06:47:13 +0200 (CEST) Received: from localhost ([::1]:34294 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1o23t0-00080y-K0 for larch@yhetil.org; Fri, 17 Jun 2022 00:47:10 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:60388) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1o23ro-00080p-MR for emacs-orgmode@gnu.org; Fri, 17 Jun 2022 00:45:56 -0400 Received: from mail-am5eur02olkn0808.outbound.protection.outlook.com ([2a01:111:f400:fe07::808]:6211 helo=EUR02-AM5-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 1o23rj-0007iD-Gg for emacs-orgmode@gnu.org; Fri, 17 Jun 2022 00:45:56 -0400 ARC-Seal: i=1; a=rsa-sha256; s=arcselector9901; d=microsoft.com; cv=none; b=K7KkXGoCd1KoKDGKadRJDTcWcXPgsSKhoqngooJwqvKaTZhmEDm4qQb0bysW/jyUCb4iy3dJhWEkRiui5m8b+9f6z9x9yycxeB63XkJdtPomOEY28BP+Yerk0QNHx3VZ6rhNPX6uoBzIXAG+96OeB6ZFXJInoIsAd3SIsOTkZksxYTl7Oa0WsSu4B1EWuLyN5UmOeU//sJJWAzw5f5HaFSydyYXzevRJOWKCKao4Iblh5vPMie2o0QNZ9ZpT+2g0cCafQcViy3DFxGTIA4DviwCuJrZWpUidTYhR1rFB4OKmbmAEmz4Tdf+EW8vXgX2aUxOUquTGzYPq0Whgg9GCwA== 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=B9I2vnE9yUOAPMN2DAxIrXdSjtx7oblNVfGonu7PNEo=; b=H2zU1V+Ds/0zrqQOvb18cJRFvwtUgLvPPhMsQsJVMtfj+vd3hRuVLLWdugrB/kgIh15l04Gbyjlg0RaX5+jTWjVWhqiVq+hV++Bue620Vri792Yq9hXe7i2dTW5tiaygsa6PsaX2OH+XFRXoWQyVz/UYWRn9kFkLkicdStQADD7kwvX3cDjjOXg9wDXQ5bNF22+ew3rpLy1ObfSvSOkAzvDEwSUDkcvN8lEQGbuoYOAmPny/3qm27Pd9G4m3GF1MPl9Aglt3DpKRNXZp2VgVT2UxQHw1lEqMY4MR7YAJBbFdInnnyiRQWeXq2gKSk7dmmy/ILyXT5nXbRfPKdL3SKg== 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=live.com; s=selector1; h=From:Date:Subject:Message-ID:Content-Type:MIME-Version:X-MS-Exchange-SenderADCheck; bh=B9I2vnE9yUOAPMN2DAxIrXdSjtx7oblNVfGonu7PNEo=; b=arqdKISn2SA14DbcI0AThGZMDm1cWvFicE1/JU0QUbG05+nSzlENJCbhbRa3jsWErpNA0QLrtwXMErb+RZFRL2lyOQFsMGnX5IaeTiMRErXK4Zp1vUYe5OagJxr3qXLV93BjeNl3UN1WDPc9VMDw38IY9i9vvTQchIRGoIgtPK4GQUaVmpODsGXwOyxe4fyyfZRu7U4U/T38Lz2uvUmbjFUO0nq1eV5RBcEIlGwpBLjf1j1ri5n9MEGpdovnyVhHk7TUXhL2TQu3AB9hk802uJw0zxrQVkMJ63ZPupDw5JVZPfn7oCsWFunjlaOe3KjAWWlxqOe1NgPW9pX78I4CGg== Received: from AM9PR09MB4977.eurprd09.prod.outlook.com (2603:10a6:20b:304::20) by PAXPR09MB4943.eurprd09.prod.outlook.com (2603:10a6:102:136::9) with Microsoft SMTP Server (version=TLS1_2, cipher=TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) id 15.20.5353.16; Fri, 17 Jun 2022 04:40:47 +0000 Received: from AM9PR09MB4977.eurprd09.prod.outlook.com ([fe80::48c7:3657:142f:a842]) by AM9PR09MB4977.eurprd09.prod.outlook.com ([fe80::48c7:3657:142f:a842%4]) with mapi id 15.20.5353.016; Fri, 17 Jun 2022 04:40:47 +0000 From: Arthur Miller To: Ihor Radchenko Cc: Tim Cross , emacs-orgmode@gnu.org Subject: Re: Proposal: 'executable' org-capture-templaes References: <87mtf3tui1.fsf@localhost> <87pmjyco0x.fsf@localhost> <87fskrobiw.fsf@localhost> <87a6ay1enh.fsf@localhost> <87zgisvuu5.fsf@localhost> <87sfoi1xde.fsf@gmail.com> <87ilpbs4tw.fsf@localhost> Date: Fri, 17 Jun 2022 06:40:46 +0200 In-Reply-To: <87ilpbs4tw.fsf@localhost> (Ihor Radchenko's message of "Wed, 08 Jun 2022 20:43:55 +0800") Message-ID: User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (gnu/linux) Content-Type: multipart/mixed; boundary="=-=-=" X-TMN: [pBVV0SG0/2mAPwFxZ5c/vwFWZpm0VHiT] X-ClientProxiedBy: BEXP281CA0003.DEUP281.PROD.OUTLOOK.COM (2603:10a6:b10::13) To AM9PR09MB4977.eurprd09.prod.outlook.com (2603:10a6:20b:304::20) X-Microsoft-Original-Message-ID: <87tu8joqb5.fsf@live.com> MIME-Version: 1.0 X-MS-Exchange-MessageSentRepresentingType: 1 X-MS-PublicTrafficType: Email X-MS-Office365-Filtering-Correlation-Id: 7de5d164-a49e-4ea6-5cb8-08da501b8c0b X-MS-TrafficTypeDiagnostic: PAXPR09MB4943:EE_ X-Microsoft-Antispam: BCL:0; X-Microsoft-Antispam-Message-Info: RbH4oPQuka87ulc91aOeainiT3f5v5EvIvgI/cOZ2xsaijFo5c3ffaO0wPNfqUn3zbKnisYSLxqhP77uvFUfT91dmKBpEAFWV4K2c860O7keO7H2B6T5zzkiXhstXuMBJJauG+QnlwHcUFLLaKlKIoII5ZK9DG/aRuEj0otwmhL8pJgRcZPn+7YhUpvFbNDKomzBSeqTXL3eZOW9Xzfr4qRJhttkkZioBAwZpvG9UJ+m7tNLnAbkuWldtTbqXUstfajp6PLFh3S6Zyxw8RfMGa6w4CkjLsEcKuJSNq5R3YqN6VzQ9Ec8YNl1jNOJp+/CQvOT/Wl3hqCmRmN5eNFF8CoQxUiPmoUsG6u68FtBAFN/ceRmLAEocQXYwlGu4hfBKb1cj49E/9cs01NKqqxtoBUu83Z5OdLXoqzQmv2q7fMvSjG9586XN3EmN60YBRAE/OQB35M/omD95dbDF8SDA4cn55AK8OU2K/5fQs5LNn56ZnlmuW8BfokMXUn3t/i2VGr7J8JX9LRZhLaUYvoXFrRTEVciTzscfAJZaWaHQxUO2HNsJDFgMSOGeo6/6iLzERcqyJvPHSs16l04w543YA== X-MS-Exchange-AntiSpam-MessageData-ChunkCount: 1 X-MS-Exchange-AntiSpam-MessageData-0: =?us-ascii?Q?lN1VmEZfUQFYikCjuNFDVAAm741v1CDJSJgZ7DAprUlqagRx3dqnlgU7APMM?= =?us-ascii?Q?v2KuSGqV1skoRDb6oCOTD2NvcNVmOsM9n/z+VidS9eXn8F6EqyIPY83w7a0Z?= =?us-ascii?Q?B+PZu2ySZeszegM0v4x44J8xyiCpMaq4NxwyZtK6WCuIOkmgJcRVQdzlqn+o?= =?us-ascii?Q?h9hrST8BUuddRtsxJ1174bb34EOQyOioXX/uuX/rhrUBYkx6L6IRwJx4x5nA?= =?us-ascii?Q?uI3KCfPQDjAUYDkYu/ypcpTYf3uDo0I6gxj6XNRrL9xpGjfej3ov/26INqIk?= =?us-ascii?Q?+28op9UGOXABsBQbJ7NAFimAZE4ekcEw3oe6oj09ZV0g5mjs/Z99UZUuCqrC?= =?us-ascii?Q?XUgAEUJ0TuOFeiYaZ+2va61A8g3H1XxAUuIGfmEK6rbf3rgryd+AOUO3t8AH?= =?us-ascii?Q?GWgAPbxj8lFPxBxtuDAuhf9GulYUBVDvXUQiMIQ3tcVO/Tj+HAWrtJ6gMJq5?= =?us-ascii?Q?5RFKOv/X24U3xRxIa8z9HaCBsCrb/1DVgqnYbIe5lFnvvhL2BtTawYraMNjl?= =?us-ascii?Q?Lc7JgLqapcdv03MD/v3svuFV2s29P1y24ZiiHNbX94rZNuGGCm2Jej3Zvv1V?= =?us-ascii?Q?9YitBcYYMLa43y3CZqw6droFtPKrYK0I1WmnEtkNgDECvr3S7xUOmj/Sb5l7?= =?us-ascii?Q?8KSBkHhNHTYBMlCnSCSHIXd7ckG8JsyL3PDbwJzt5G3OjGb/zMjVsi9cpled?= =?us-ascii?Q?d48Nn5SRPOxT9WCWC84BSluqmcBWpO+ekwxkKvQAG9HrnDAJIwi+5JEQZOFz?= =?us-ascii?Q?1T4++I5cvgvKQapVae4CvktanVDJ/wKjGBo5rWn0eV22uGUVy4v2gjHutGun?= =?us-ascii?Q?DAo85Qu/2qn4D3V2HB6rvLdcIdxmH6ret9ht9cwswPKtDFxEhZAnCI7ugwe9?= =?us-ascii?Q?n2kzUHOHcvefinneKHUewn9Hc+3G+IGn2+jLDZlp0mbyGQvv3TJ8A6kAEMxF?= =?us-ascii?Q?fD0wIasaW4VqnqmmbpDvflaa3GI23CWZ9nRzv/gcJAPV5oRTA8i3JyP7oNJo?= =?us-ascii?Q?wxyZN+I2OxuQFXRXymibFWgX0CQOftRe3BfQAAxgkkvGQS7rtFWybESOWkdw?= =?us-ascii?Q?4ABbdFmel1a8ZyBn8JcSuBabQP0oi7ENTC5HUgpsWyO2zz40Vz4B3OyZ78HG?= =?us-ascii?Q?1YQfo5fxw0pK2Cvc6j24yduAEndTehhlffTUQ5PVuuunXg/lLgJWoPlZHRxK?= =?us-ascii?Q?aMgJd1vGLfAprf+SY765DnhJInpetj53pcYPWScwfdFZumn4WOc7K/etkm3s?= =?us-ascii?Q?Vnbu0hRYV5ZG5by8KpT84h62jB2kUeOQUb5ybp8nBfvG8s2XD18fBiBMBET3?= =?us-ascii?Q?aR+MAbKmQJbHQ6VqJ9w/3r0opHU8gjryEt1bpM2scXiiTQEqjKmdfA15vZpP?= =?us-ascii?Q?3yeCY1JlfuDa/MAw9A7bJk3IzribezEx7XnXb2gpGPQd06ygby1cfNjdhDhi?= =?us-ascii?Q?5dLQT+oZbJA=3D?= X-OriginatorOrg: sct-15-20-4755-11-msonline-outlook-64da6.templateTenant X-MS-Exchange-CrossTenant-Network-Message-Id: 7de5d164-a49e-4ea6-5cb8-08da501b8c0b X-MS-Exchange-CrossTenant-AuthSource: AM9PR09MB4977.eurprd09.prod.outlook.com X-MS-Exchange-CrossTenant-AuthAs: Internal X-MS-Exchange-CrossTenant-OriginalArrivalTime: 17 Jun 2022 04:40:47.4145 (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: PAXPR09MB4943 Received-SPF: pass client-ip=2a01:111:f400:fe07::808; envelope-from=arthur.miller@live.com; helo=EUR02-AM5-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, 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=2; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1655441233; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc: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=B9I2vnE9yUOAPMN2DAxIrXdSjtx7oblNVfGonu7PNEo=; b=qngZgzGhReaeeZBbue1fnxLzKt1UcEJdwQW6Fv6aMjEFmBmeXGGaCq6b1qvb2aR/ne2DaF 3ZgoG42ZRCQYZ4/o1BAZpfE/05u9GPu8nGwinwzQQxEeSI6oXHkPwbWNlo2pSaC4mpBzB1 +E652cF7W/rew9v3XoZSGwfHjTbEfG70qPu4lPt5DFihrWX3OB4dfYlKS7wtmEV/Kg33Ge N+C4QZvxUXQl5EpQH5J8XM8n51HoHpr23Mb9ZinXNfJrLruVpjfxhKg2naDJ/0rQsrHkBn Gpp4AANgvUmleFpMrC3icHgVGF+jEMnvZofENb3YtdpPrlssFwi0LvE2BDWJ/A== ARC-Seal: i=2; s=key1; d=yhetil.org; t=1655441233; a=rsa-sha256; cv=pass; b=mv4l8qDasjm7O4Tvw4DzPJWBp4L0fvfDRphXezx0joVmrKT61J6/yoSWJ7x3njSBSkjKH+ rX+b641GmOeaFBjYQ/LSHiPTgHnjqqab8wKO+daGFWLyI3UE9Em4w9JVeJORTNIvipH2qU ZKxt/rDfn2bA/dzEo6pScXVGp2bL7ziYF0TcDmBXjeDKtmDm7tgJIgQv383wIEymj3nhDF afwSqLemTp+xLWjdnIRo3I0vii1yfrrxGD5/yfkPcssD8GiLhe0QWYZ1rcUP2/c7EcptFj 12i4Ns9YGVWumssRAuuljhQrl63Uz1f21F1zzAyGzkXq9o9Nd1w7/mq1pPNASw== ARC-Authentication-Results: i=2; aspmx1.migadu.com; dkim=pass header.d=live.com header.s=selector1 header.b=arqdKISn; arc=pass ("microsoft.com:s=arcselector9901:i=1"); dmarc=pass (policy=none) header.from=live.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.49 Authentication-Results: aspmx1.migadu.com; dkim=pass header.d=live.com header.s=selector1 header.b=arqdKISn; arc=pass ("microsoft.com:s=arcselector9901:i=1"); dmarc=pass (policy=none) header.from=live.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: 741059383 X-Spam-Score: -6.49 X-Migadu-Scanner: scn0.migadu.com X-TUID: kRm0Ov+UeCi6 --=-=-= Content-Type: text/plain Ihor Radchenko writes: > Tim Cross writes: > >> I'm not sure I really understand the exact goal you have here. To me, it >> feels like yet another input selection/menu/completion scheme and I'm >> not clear on how it will be an improvement or why do something >> 'different' in org compared to other modes etc. However, I also don't >> have any problems using the existing capture interface, so perhaps I >> just don't have the number or complexity of capture choices to expose >> issues/limitations wiht the existing approach. >> >> The main 'concern' (well, not really a concern, but ....) I have is that >> Emacs already has far too many solutions along this line, which makes it >> harder to get a consistent UI. I also feel this is one of those areas >> which appears to be really easy to 'fix' or improve, but also has a lot >> of hidden complexity which only becomes evident once lots of different >> users and workflows try to use it. > > Let me clarify my vision of this thread. > > 1. Arthur is interested to implement something similar to org-capture > menu. We can help him with this regardless of our stance on whether > to include the result into Org. > > 2. Org mode has multiple implementations of menu. Menus for org-capture, > org-export, org-todo, org-set-tags-command, and org-agenda are all > implemented independently creating redundancy in our codebase. > > 3. Because of the redundancy, there has been a proposal in the past to > switch from our existing menus to transient. However, it will be a > breaking change. We would prefer to support old menus as well (at > least for a handful of years) > > 4. If Arthur's implementation turns out sufficient to replicate the > "look and feel" or our existing menus, we can use it instead. This > will at least reduce the amount of menu code in Org. We can also take > this opportunity to make the menu backend selectable: the old menus, > Arthur's menu backend, transient. Then, we can eventually drop the > old menus backend and leave Arthur's + transient. They will be much > easier to maintain, especially if Arthur's implementation can be > distributed as separate package (even if not, one menu implementation > is easier than multiple that we have now). Hello, and sorry for long time no hear ... thought I would had something last weekend, but it took a bit longer time. Anyway, I have been playing and testing a bit, and didn't want to prolong discussion untill I have something to show. So here is a small prototype. It is just a rough sketch of the idea. The idea is simple: just ordinary keymap, with automated mode and keymap creation from templates. It uses simple template format to specify a key and a label to display in a buffer for the user. It can either return the template back to some callback, or it can use the 3rd argument as "executable" and wrap it in an interactive lambda to tuck into the keymap. I think that it is the minimum required. Rest is a boilerplate. It also puts declaration of gui and logic in same place (the template). For example org-capture defines its own template language, so it is just to give the chosen template to org-capture. This is what org-mks does, pretty much. I have just refactored the org-capture in an example to show that it is possible to implement the equivalent with almost no changes, more than it does not use org-mks under the hood. There is no code saving there. However, when it comes to org-agenda, as I see from the current implementation it does not use org-mks at all, but does something very similar on it's own, with ui and logic hardcoded in `org-agenda-get-restriction-and-command'. In this example the mode map approach seems slightly more convenient. I don't know, in org-agenda-test, I haven't implemented all of org-agenda, restrictions, prefixes and some other stuff, mostly because I don't really understand the implementation. I didn't want to sitt too long and figure out how stuff works, if the fundamental approach is not acceptable, but I have implemented quite few of the menu choices, at least to show the pattern. As said, it is just a rough sketch to illustrate the idea. I am not sure myself if it is good idea or not. I have implemented it so it works with org-capture templates, and I hope it wasn't too much of extra "customizations" tossed in. "Horizontal" menu was needed to simulate org-agenda looks, otherwise the code would be much smaller. Also to note is that the "logic" does not use anything in buffer on display, so it would be possible for someone interested to "rice" it up after the drawing is done, so the customization options could be further reduced. To answer some questions I have seen in mails, sorry for late answeres: @Ihor I really don't have problem with "read key". Originally I just wanted to extend org-capture templates to do a bit extra :). Actually org-mks and similar approach is really efficient in terms of resource (no minor/major modes etc). It is only the thing if same framework is to be used by non-modal applications too, than there have to be other way to read user input, and since the other way are keymaps, read-key becomes redundant. Sometimes, something like 'read-key' is what is needed, and sometimes that is just enough. When I first thought of using org-capture templates for "executable" definitions, I really didn't know how org-capture worked under the hood. Max is correct about wrapper, that is how org-capture works. But since it is so easy, we can also automate it and skip writing wrappers and lambdas every time we use it. That is the idea behind the "default handler" in the example. Big difference with org-mks vs ordinary mode-map based menu, is that org-mks locks entire session. Modal behaviour is used to ensure that just one task at the time is manipulating org files. I think it can be achieved by other means too. I have not done it correctly in the example :), but I think it is possible. I am including also an older test which I have later refactored, that has "read-key" interface (in org-select-modal); i.e it behaves similar to org-mks, just to show that such modal interface can be tucked on. It just reads a key from the user and then invokes the command from the mode map. It is very crappy, but it shows that both @Tim Thank you for mentioning emacspeak. I have never used it so I don't know how it works, but I have taken a look at some code in Emacspeak after your mail. Also if I understand what you and Ihor say, it needs to get labels echoed to minibuffer in order to work with Emacspeak? I have done it so, I am not sure if works always though :). @Max I agree with you that completing read is a good alternative, but it is a bit like discussion about GUI vs. terminal. I am personally heavy user of Helm, but not everyone is I believe. About the name: org-select; i really have no idea what to call it, so better name would be nice. Sorry for the bugs, I am aware of many, but it still displays the idea I think. --=-=-= Content-Type: text/plain; charset=utf-8 Content-Disposition: attachment; filename=org-select.el Content-Transfer-Encoding: quoted-printable ;;; org-select.el --- Build custom menus from declarative templates -*- le= xical-binding: t; -*- ;; Copyright (C) 2022 Arthur Miller ;; Author: Arthur Miller ;; Keywords: tools ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;;=20 ;;=20 ;;; Code: =0C (require 'org-macs) ;;; User vars =0C (defgroup org-select nil "Create menus from declarative templates." :prefix "org-select-" :prefix "osl--" :tag "Org Select" :group 'org) (defcustom org-select-back-key [f10] "Used to render string for the horizontal separator." :type 'character :group 'org-select) (defcustom org-select-horizontal-separator "|" "Used to render string for the horizontal separator." :type 'string :group 'org-select) (defcustom org-select-vertical-separator "-" "Used to render string for the vetical separator." :type 'string :group 'org-select) (defcustom org-select-key-decorator-chars "" "Characters used to decorate shortcut keys. This string should contain only two characters, the first one for the left decorator and the second one for the right decorator. Example: string \"[]\" will render key \"C\" as \"[C]\"." :type 'string :group 'org-select) (defcustom org-select-label-decorators (cons "..." "...") "Used to render string for the vetical separator." :type 'cons :group 'org-select) =0C ;;; Implementation =0C (defvar-local osl--init nil) (defvar-local osl--args nil) (defvar-local osl--buffer nil) (defvar-local osl--menu-begin nil) (defvar-local osl--buffer-menu nil) (defvar-local osl--longest-label 0) (defvar-local osl--buffer-window nil) (defvar-local org-select-mode-map nil) (defvar-local osl--horizontal-layout nil) (defvar-local osl--default-handler-fn nil) (defvar-local osl--current-menu-column nil) (define-minor-mode org-select-mode "" :interactive nil :global nil) ;;;; Help-functions (defun osl--arg (key) (plist-get osl--args key)) (defun osl--init () (buffer-local-value 'osl--init (current-buffer))) (defun osl--default-handler-fn (entry) "Try to execute form found in ENTRY if any." (let ((form (nth 2 entry))) (cond ((listp form) (eval form)) (t (if (commandp form) (call-interactively form) (eval form)))))) (with-eval-after-load (setq osl--default-handler-fn #'osl--default-handler-fn)) (defun osl--ignore-key () (interactive) (message "Invalid key %S" ;; I am not happy but it works somewhat (edmacro-format-keys (vector last-input-event)))) (defun org-select-quit (&optional abort-message buffer-name) (interactive) (let ((window (if buffer-name (get-buffer-window buffer-name) osl--buffer-window)) (kill-buffer (buffer-local-value 'osl--buffer (current-buffer)))) (when (window-live-p window) (select-window window) (quit-window kill-buffer window)) (message (or abort-message "Org Select Quit")))) (defun osl--make-mode-map () (let ((map (make-sparse-keymap))) (define-key map [?q] #'org-select-quit) (define-key map [?\C-g] #'org-select-abort) (define-key map [left] #'osl--back) (define-key map [?\C-p] #'osl--back) (define-key map [remap newline] #'osl--ignore-key) (define-key map [remap self-insert-command] #'osl--ignore-key) (setq org-select-mode-map map) (use-local-map org-select-mode-map))) (defun org-select-abort () (interactive) (org-select-quit "Aborted")) (defun osl--back () (interactive) (when (bound-and-true-p org-select-mode) (osl--make-mode-map) (osl--draw))) (defun osl--longest-line () "Return the length of the longest line in current buffer." (let ((n 1) (L 0) (e 0) (E (point-max)) l) (while (< e E) (setq e (line-end-position n) l (- e (line-beginning-position n)) n (1+ n)) (if (> l L) (setq L l))) L)) (defun osl--decorate-key (key) "Place string KEY between characters specified in DECORATOR string." (let ((kd (if (> (length org-select-key-decorator-chars) 0) org-select-key-decorator-chars (osl--arg :key-decorator)))) (if (=3D (length kd) 2) (concat (substring kd 0 1) key (substring kd 1)) key))) (defun osl--decorate-label (entry) "Place string LABEL between strings specified in DECORATORS strings. DECOARATOR is a cons containing two elements: left and right decorators." (let ((left (car org-select-label-decorators)) (right (cdr org-select-label-decorators))) (if (=3D (length entry) 2) (concat left (cadr entry) right) (cadr entry)))) (defun osl--make-separator (&optional marker length) (let ((len (or length (osl--longest-line))) (sep (if (osl--arg :horizontal) org-select-horizontal-separator org-select-vertical-separator))) (if marker (concat "sep" sep) (make-string len (string-to-char sep))))) (defun osl--insert-horizontal-separator (sep &optional _length) (goto-char 1) (let ((lol (osl--longest-line)) (sep (or org-select-horizontal-separator sep))) (while (not (eobp)) (let* ((eol (line-end-position)) (bol (line-beginning-position)) (fill (- (+ bol lol) eol))) (goto-char eol) (if (> fill 0) (while (> fill 0) (insert " ") (setq fill (1- fill))) (while (> 0 fill) (delete-char 1) (setq fill (1+ fill)))) (insert " " sep " ")) (forward-line)) (setq osl--current-menu-column (+ lol (length sep) 2)))) (defun osl--insert-separator (sep &optional _length) (if (osl--arg :horizontal) (osl--insert-horizontal-separator sep) (insert sep))) (defun osl--insert (&rest strings) (cond ((and (osl--arg :horizontal) (> osl--current-menu-column 0)) (goto-char (+ (line-beginning-position) osl--current-menu-column)) (apply #'insert strings) (if (char-after) (forward-line) (insert "\n"))) (t=20 (apply #'insert strings) (insert "\n")))) (defun osl--forward-menu () (cond ((osl--arg :horizontal) (goto-char (point-min)) (goto-char (line-end-position)) (setq osl--current-menu-column (- (point) (line-beginning-position)))) (t (insert "\n")))) ;;;; Menu drawing (defun osl--setup-buffer (tables args) "Setup buffer local variables needed for an org-select buffer." (let* ((buffer (or (plist-get args :label) "*Org-select: ")) (window (get-buffer-window buffer))) (if window (select-window window) (org-switch-to-buffer-other-window buffer)) (with-current-buffer (get-buffer buffer) (special-mode) ;;(setq cursor-type nil) (org-select-mode) (osl--make-mode-map) (setq osl--args args osl--buffer-menu tables osl--current-menu-column 0 osl--buffer (current-buffer) osl--buffer-window (get-buffer-window) osl--default-handler-fn 'osl--default-handler-fn)))) ;; menu is a list of tables, display one table at a time (defun osl--draw () "Starts menu parsing and insertig." (with-silent-modifications (erase-buffer) (setq osl--init nil) (let ((marker (osl--make-separator 'marker)) (text (osl--arg :text)) (menus (buffer-local-value 'osl--buffer-menu (current-buffer)))) (setq osl--menu-begin (point)) (dolist (menu menus) (if (symbolp menu) (setq menu (eval menu))) (osl--do-menu menu) (setq menus (cdr menus)) (when menus (osl--insert-separator marker) (osl--forward-menu))) (goto-char 1) (let ((sep (osl--make-separator nil (osl--longest-line))) ;; (osl--make-separator nil fill-column)) ) (while (search-forward marker nil t) (replace-match "") (osl--insert-separator sep))) (when text (goto-char 1) (insert "\n" text "\n")) (org-fit-window-to-buffer) (setq osl--init t) (goto-char 1)))) ; unnecessary but prettier if beacon-mode is active ;; iterate through menu and render a single entry or a group of entries on = each ;; iteration (defun osl--do-menu (menu) "Insert one menu at a time." (while menu (let ((entry (car menu))) (setq menu (if (> (length entry) 2) (osl--do-entry menu) (osl--do-group menu)))))) (defun osl--do-group (menu) "Do a menu with group nodes." (let ((group (car menu)) (transient (osl--arg :transient)) newmenu) (osl--do-entry menu) (while (> (length (cadr menu)) 2) (let (entry newentry key) (setq menu (cdr menu) entry (car menu)) (setq key (substring (car entry) 1)) (push key newentry) (dolist (elt (cdr entry)) (push elt newentry)) (push (nreverse newentry) newmenu))) (setq newmenu (nreverse newmenu)) (define-key org-select-mode-map (kbd (car group)) (lambda () (interactive) (with-silent-modifications (erase-buffer) (setq osl--current-menu-column 0) (osl--do-menu newmenu) (if transient (org-select-quit ""))))) (cdr menu))) ;; return next group in chain ;; we send in the entire menu so we can return next piece in chain, ;; but *the* entry we work with is just the very first one (car menu) (defun osl--do-entry (menu) "Display a single entry in the buffer." (let* ((entry (car menu)) (key (car entry)) (line-length 0) (transient (osl--arg :transient))) (define-key org-select-mode-map (kbd key) (lambda () (interactive) (let ((label (nth 1 entry)) (handler (or (osl--arg :handler) osl--default-handler-fn)) (init (buffer-local-value 'osl--init osl--buffer)) msg) (and init handler (setq msg (funcall handler entry))) (if transient (org-select-quit "")) (message (or msg label))))) (osl--insert (osl--decorate-key key) " " (osl--decorate-label entry)= ) (setq line-length (- (line-end-position) (line-beginning-position))) (if (> line-length osl--longest-label) (setq osl--longest-label line-length)) (cdr menu))) =0C ;;; API =0C (defun org-select (tables &rest args) "Select a member of an alist with multiple keys. TABLE is an alist which should contain entries where the car is a string. There should be two types of entries. 1. prefix descriptions like (\"a\" \"Description\") This indicates that `a' is a prefix key for multi-letter selection, and that there are entries following with keys like \"ab\", \"ax\"... 2. Select-able members must have more than two elements, with the first being the string of keys that lead to selecting it, and the second a short description string of the item.=20 The command will then make a temporary buffer listing all entries that can be selected with a single key, and all the single key prefixes. When you press the key for a single-letter entry, it is selected= . When you press a prefix key, the commands (and maybe further prefixes) under this key will be shown and offered for selection. ARGS is a property list containing following members: :text a string placed over the selection in the buffer. :label a string used for the selections buffer name. :prompt a string used when prompting for a key. :always when `t', this menu is shown; even descended into submenus :transient when `t', the menu is dissmised after user perform an action :key-decorator a two-character string used to decorate command characters. = When this string is specified, it will take precedence over the global variable `org-select-key-decorator-chars'. TABLES are additional menus in the same format as TABLE. If there are more than one menus, they will be separated by a separator line rendered with character as specified in `org-select-horizontal-separator'" (osl--setup-buffer tables args) (osl--draw)) =0C ;;; Demo =0C ;;;; org-capture =0C (require 'org) (require 'org-capture) (defvar org-capture--current-goto nil) (defvar org-capture--current-keys nil) (defvar org-capture--old-window-config nil) (defun org-capture-test (&optional goto keys) "Simple illustration to recreate org-capture menu (visually only)." (interactive "P") (let ((org-select-vertical-separator "-") (org-capture-templates (or (org-contextualize-keys (org-capture-upgrade-templates org-capture-templates) org-capture-templates-contexts) '(("t" "Task" entry (file+headline "" "Tasks") "* TODO %?\n %u\n %a"))))) (if keys (or (assoc keys org-capture-templates) (error "No capture template referred to by \"%s\" keys" keys))) (cond ((equal goto '(4)) (org-capture-goto-target keys)) ((equal goto '(16)) (org-capture-goto-last-stored)) (t (if goto (setq org-capture--current-goto goto)) (setq org-capture--old-window-config (current-window-configuration)) (org-select ;; tables '(org-capture-templates (("C" "Customize org-capture-templates" (customize-variable 'org-capture-templates)) ("q" "Abort" (org-select-quit "Abort")))) ;; description :transient t :handler #'org-capture--handle :label "*Capture*" :key-decorator "[]" :text "Select a capture template\n=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D")))) (message "Org Capture")) (define-key global-map (kbd "C-v c") #'org-capture-test) (defun org-capture--handle (entry) (org-select-quit "") (cond ((or (equal "C" (car entry)) (equal "q" (car entry))) (eval (nth 2 entry))) (t (let* ((orig-buf (current-buffer)) (annotation (if (and (boundp 'org-capture-link-is-already-stored) org-capture-link-is-already-stored) (plist-get org-store-link-plist :annotation) (ignore-errors (org-store-link nil)))) (entry (or org-capture-entry entry)) (goto org-capture--current-goto) (inhibit-read-only t) initial) (setq initial (or org-capture-initial (and (org-region-active-p) (buffer-substring (point) (mark))))) (when (stringp initial) (remove-text-properties 0 (length initial) '(read-only t) initial)) (when (stringp annotation) (remove-text-properties 0 (length annotation) '(read-only t) annotation)) (org-capture-set-plist entry) (org-capture-get-template) (org-capture-put :original-buffer orig-buf :original-file (or (buffer-file-name orig-buf) (and (featurep 'dired) (car (rassq orig-buf dired-buffers)))) :original-file-nondirectory (and (buffer-file-name orig-buf) (file-name-nondirectory (buffer-file-name orig-buf))) :annotation annotation :initial initial :return-to-wconf (current-window-configuration) :default-time (or org-overriding-default-time (org-current-time))) (org-capture-set-target-location (and (equal goto 0) 'here)) (condition-case error (org-capture-put :template (org-capture-fill-template)) ((error quit) ;;(if (get-buffer "*Capture*") (kill-buffer "*Capture*")) (org-select-quit "" "*Capture*") (error "Capture abort: %s" (error-message-string error)))) (setq org-capture-clock-keep (org-capture-get :clock-keep)) (condition-case error (org-capture-place-template (eq (car (org-capture-get :target)) 'function)) ((error quit) (when (and (buffer-base-buffer (current-buffer)) (string-prefix-p "CAPTURE-" (buffer-name))) (kill-buffer (current-buffer))) (set-window-configuration (org-capture-get :return-to-wconf)) (error "Capture template `%s': %s" (org-capture-get :key) (error-message-string error)))) (when (and (derived-mode-p 'org-mode) (org-capture-get :clock-in)) (condition-case nil (progn (when (org-clock-is-active) (org-capture-put :interrupted-clock (copy-marker org-clock-marker))) (org-clock-in) (setq-local org-capture-clock-was-started t)) (error "Could not start the clock in this capture buffer"))) (when (org-capture-get :immediate-finish) (org-capture-finalize)))))) =0C ;;;; Org Agenda =0C (require 'org-agenda) (defvar org-agenda--arg nil) (defvar org-agenda--keys nil) (defvar org-agenda--restriction nil) (defun org-agenda--exec (action &rest args) "Execute ACTION and exit org-agenda menu." (interactive) (org-select-quit "") (apply action args)) (defvar org-agenda--menu '((("a" "Agenda for current week or day" (org-agenda--exec 'org-agenda-list)) ("t" "List of all TODO entries" (org-agenda--exec 'org-todo-list)) ("m" "Match a TAGS/PROP/TODO query" (org-agenda--exec 'org-tags-view)) ("s" "Search for keywords" (org-agenda--exec 'org-search-view)) ("/" "Multi-occur" (call-interactively 'org-occur-in-agenda-files)) ("?" "Find :FLAGGED: entries" (org-agenda--exec 'org-tags-view nil "+FLAGGED")) ("*" "Toggle sticky agenda views" (call-interactively #'org-toggle-sticky-agenda))) (("<" "Buffer, subtree/region restriction" ignore) (">" "Remove restriction" ignore) ("e" "Export agenda views" org-store-agenda-views) ("T" "Entries with special TODO kwd" (org-agenda--exec 'org-call-with-arg 'org-todo-list (or org-agenda--arg '(4)))) ("M" "Like m, but only TODO entries" (org-agenda--exec 'org-call-with-arg 'org-tags-view (or org-agenda--arg '(4)))) ("S" "Like s, but only TODO entries" (org-agenda--exec 'org-call-with-arg 'org-search-view (or org-agenda--arg '(4)))) ("C" "Configure custom agenda commands" (org-agenda--exec 'customize-variable 'org-agenda-custom-commands)) ("#" "List stuck projects" (org-agenda--exec 'org-agenda-list-stuck-projects)) ("!" "Configure stuck projects" (org-agenda--exec 'customize-variable 'org-stuck-projects))))) (defun org-agenda-test (&optional _arg _keys _restriction) (interactive "P") (let ((org-select-horizontal-separator " ")) (org-select org-agenda--menu :text "Press key for an agenda command: --------------------------------\n" :horizontal t) (org-agenda-fit-window-to-buffer))) =0C (defun test1 () "Stays after a choice is made." (interactive) (let ((org-select-horizontal-separator "=E2=94=82")) (org-select ;; table '((("1" "One" (message "One!")) ("2" "Two" (message "Two!!")) ("3" "Three" (message "Three!!!"))) (("C-4" "Four" (message "Four!!!!")) ("C-5" "Five" (message "Five!!!!!")) ("C-6" "six" (message "Six!"))) (("M-7" "Seven" (message "Seven!")) ("M-8" "Eight" (message "Eight!")) ("M-9" "Nine" (message "Nine!")))) ;; description :horizontal t :key-decorator "<>"))) (defun test2 () "Dissapears after a choice is made." (interactive) (let ((org-select-horizontal-separator "=E2=94=82")) (org-select ;; menus '((("h" "Hello, World!" (message "Hello, World!")) ("b" "Bar" (message "Hello, Bar!"))) (("f" "Find File" find-file) ("o" "Open File" (flet ((next-read-file-uses-dialog-p () t)) (call-interactively #'find-file))))) ;; description :key-decorator "\"\"" :transient t) ;; Hints (setq header-line-format (if (not (pos-visible-in-window-p (point-max))) "Use C-v, M-v, C-n or C-p to navigate. C-g, q to quit." "Use C-p/Left to go back, C-g, q to quit.")))) (defun test3 () "Illustrate nested menus, unicode separator and alternative decorator." (interactive) (let ((org-select-vertical-separator "=E2=94=80")) (org-select ;; tables '((("g" "Greetings") ("gh" "Hello, World!" (message "Hello, World!")) ("gb" "Bar" (message "Hello, Bar!"))) (("f" "Functions") ("ff" "Find File" find-file) ("fo" "Open File" (flet ((next-read-file-uses-dialog-p () t)) (call-interactively #'find-file))))))) ;; Hints (setq header-line-format (if (not (pos-visible-in-window-p (point-max))) "Use C-v, M-v, C-n or C-p to navigate. C-g, q to quit." "Use C-p/Left to go back, C-g, q to quit."))) (provide 'org-select) ;;; org-select.el ends here --=-=-= Content-Type: text/plain; charset=utf-8 Content-Disposition: attachment; filename=org-select-modal.el Content-Transfer-Encoding: quoted-printable ;;; org-select.el --- Build custom menus from declarative templates -*- le= xical-binding: t; -*- ;; Copyright (C) 2022 Arthur Miller ;; Author: Arthur Miller ;; Keywords: tools ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;;=20 ;;=20 ;;; Code: =0C (require 'org-macs) ;;; User vars =0C (defgroup org-select nil "Create menus from declarative templates." :prefix "org-select-" :prefix "osl--" :tag "Org Select" :group 'org) (defcustom org-select-back-key [f10] "Used to render string for the horizontal separator." :type 'character :group 'org-select) (defcustom org-select-horizontal-separator "|" "Used to render string for the horizontal separator." :type 'string :group 'org-select) (defcustom org-select-vertical-separator "-" "Used to render string for the vetical separator." :type 'string :group 'org-select) (defcustom org-select-key-decorator-chars "" "Characters used to decorate shortcut keys. This string should contain only two characters, the first one for the left decorator and the second one for the right decorator. Example: string \"[]\" will render key \"C\" as \"[C]\"." :type 'string :group 'org-select) (defcustom org-select-label-decorators (cons "..." "...") "Used to render string for the vetical separator." :type 'cons :group 'org-select) =0C ;;; Implementation =0C (defvar-local osl--args nil) (defvar-local osl--menu-begin nil) (defvar-local osl--buffer-menu nil) (defvar-local osl--longest-label 0) (defvar-local osl--allowed-keys nil) (defvar-local osl--buffer-window nil) (defvar-local org-select-mode-map nil) (defvar-local osl--horizontal-layout nil) (defvar-local osl--default-handler-fn nil) (defvar-local osl--current-menu-column nil) (define-minor-mode org-select-mode "" :interactive nil :global nil) ;;;; Help-functions (defun osl--arg (key) (plist-get osl--args key)) (defun osl--default-handler-fn (entry) "Try to execute form found in ENTRY if any." (let ((form (nth 2 entry))) (cond ((listp form) (eval form)) (t (if (commandp form) (call-interactively form) (eval form)))))) (with-eval-after-load (setq osl--default-handler-fn #'osl--default-handler-fn)) (defun osl--ignore-key () (interactive) (message "Invalid key %S" ;; I am not happy but it works somewhat (edmacro-format-keys (vector last-input-event)))) (defun osl--read-key () (let ((key (read-key-sequence (concat (or (osl--arg :label) "Org-select") ": ")))) (funcall (local-key-binding key)))) (defun org-select-quit (&optional abort-message) (interactive) (catch 'exit (when (> 0 (recursion-depth)) (exit-recursive-edit) (top-level))) (while osl--buffer-window (quit-window t osl--buffer-window) (message (or abort-message "Org Select Quit")))) (defun osl--back () (interactive) (osl--draw)) (defun osl--line-length () (- (line-end-position) (line-beginning-position))) (defun osl--decorate-key (key) "Place string KEY between characters specified in DECORATOR string." (let ((kd (if (> (length org-select-key-decorator-chars) 0) org-select-key-decorator-chars (osl--arg :key-decorator)))) (if (=3D (length kd) 2) (concat (substring kd 0 1) key (substring kd 1)) key))) (defun osl--decorate-label (entry) "Place string LABEL between strings specified in DECORATORS strings. DECOARATOR is a cons containing two elements: left and right decorators." (let ((left (car org-select-label-decorators)) (right (cdr org-select-label-decorators))) (if (=3D (length entry) 2) (concat left (cadr entry) right) (cadr entry)))) (defun osl--make-separator (&optional marker length) (let ((length (or length osl--longest-label)) (sepch (if (osl--arg :horizontal) (string-to-char org-select-horizontal-separator) (string-to-char org-select-vertical-separator)))) (if marker (concat "sep" (char-to-string sepch)) (make-string length sepch)))) (defun osl--insert-separator (sep) (if (osl--arg :horizontal) (osl--insert-horizontal-separator sep) (insert sep "\n"))) (defun osl--longest-menu-length () (let ((longest-menu-length 0) (menus (buffer-local-value 'osl--buffer-menu (current-buffer))) length) (dolist (m menus) (setq length (if (symbolp m) (length (eval m)) (length m))) (if (> length longest-menu-length) (setq longest-menu-length length))= ) longest-menu-length)) (defun osl--insert-horizontal-separator (sep) (goto-char osl--menu-begin) (dotimes (i (osl--longest-menu-length)) (let* ((eol (line-end-position)) (bol (line-beginning-position)) (lol osl--longest-label) (sep (or org-select-horizontal-separator sep)) (fill (abs (- eol (+ bol lol))))) (goto-char eol) (while (> fill 0) (insert " ") (setq fill (1- fill))) (goto-char (line-end-position)) (insert " ") (if (> (length sep) 0) (insert sep " ")) (forward-line) (setq i (1+ i)))) (setq osl--current-menu-column (1- (point)))) (defun osl--insert (&rest strings) (if (osl--arg :horizontal) (goto-char (line-end-position))) (apply #'insert strings)) (defun osl--forward-menu () (cond ((osl--arg :horizontal) (goto-char osl--menu-begin) (setq osl--current-menu-column (+ osl--current-menu-column osl--longest-label))) (t ;;(insert "\n") ))) ;;;; Menu drawing (defun osl--setup-buffer (tables args) "Setup buffer local variables needed for an org-select buffer." (let* ((buffer (or (plist-get args :label) "*Org-select: ")) (window (get-buffer-window buffer))) (if window (select-window window) (org-switch-to-buffer-other-window buffer)) (with-current-buffer (get-buffer buffer) (special-mode) (setq cursor-type nil) (org-select-mode) (setq org-select-mode-map (let ((map (make-sparse-keymap))) (define-key map [?q] #'org-select-quit) (define-key map [?\C-g] #'org-select-quit) (define-key map [left] #'osl--back) (define-key map [?\C-p] #'osl--back) (define-key map [remap newline] #'osl--ignore-key) (define-key map [remap self-insert-command] #'osl--ignore-key= ) map)) (use-local-map org-select-mode-map) (setq osl--args args osl--buffer-menu tables osl--current-menu-column 0 osl--buffer-window (get-buffer-window) osl--default-handler-fn 'osl--default-handler-fn)))) ;; menu is a list of tables, display one table at a time (defun osl--draw () "Starts menu parsing and insertig." (with-silent-modifications (erase-buffer) (let ((marker (osl--make-separator 'marker)) (modal (osl--arg :modal)) (text (osl--arg :text)) (menus (buffer-local-value 'osl--buffer-menu (current-buffer)))) (when text (insert text "\n")) (setq osl--menu-begin (point)) (dolist (menu menus) (if (symbolp menu) (setq menu (eval menu))) (osl--do-menu menu) (setq menus (cdr menus)) (when menus (osl--insert-separator marker) (osl--forward-menu))) (let ((separator (osl--make-separator))) (while (search-backward marker nil t) (replace-match "") (osl--insert-separator separator))) (org-fit-window-to-buffer) (goto-char 1) ;; unnecessary but looks prettier if beacon-mode is act= ive (if modal (osl--read-key))))) ;; iterate through menu and render a single entry or a group of entries on = each ;; iteration (defun osl--do-menu (menu) "Insert one menu at a time." (while menu (let ((entry (car menu))) (setq menu (if (> (length entry) 2) (osl--do-entry menu) (osl--do-group menu)))))) (defun osl--do-group (menu) "Do a menu with group nodes." (let ((group (car menu)) (modal (osl--arg :modal)) (transient (osl--arg :transient)) newmenu) (osl--do-entry menu) (while (> (length (cadr menu)) 2) (let (entry newentry key) (setq menu (cdr menu) entry (car menu)) (setq key (substring (car entry) 1)) (push key newentry) (dolist (elt (cdr entry)) (push elt newentry)) (push (nreverse newentry) newmenu))) (setq newmenu (nreverse newmenu)) (define-key org-select-mode-map (kbd (car group)) (lambda () (interactive) (with-silent-modifications (erase-buffer) (setq osl--current-menu-column 0) (osl--do-menu newmenu) (if modal (osl--read-key)) (if transient (org-select-quit ""))))) (cdr menu))) ;; return next group in chain ;; we send in the entire menu so we can return next piece in chain, ;; but *the* entry we work with is just the first one (car menu) (defun osl--do-entry (menu) "Display a single entry in the buffer." (let* ((entry (car menu)) (key (car entry)) (line-length 0) (transient (osl--arg :transient))) (push key osl--allowed-keys) (define-key org-select-mode-map (kbd key) (lambda () (interactive) (let ((label (nth 1 entry)) (handler (or (plist-get :handler entry) osl--default-handler-fn))) (if handler (funcall handler entry)) (if transient (org-select-quit "")) (message label)))) (osl--insert (osl--decorate-key key) " " (osl--decorate-label entry)= ) (setq line-length (- (line-end-position) (line-beginning-position))) (if (> line-length osl--longest-label) (setq osl--longest-label line-length)) (if (=3D 0 osl--current-menu-column) (insert "\n") (forward-line)) (cdr menu))) =0C ;;; API =0C (defun org-select (tables &rest args) "Select a member of an alist with multiple keys. TABLE is an alist which should contain entries where the car is a string. There should be two types of entries. 1. prefix descriptions like (\"a\" \"Description\") This indicates that `a' is a prefix key for multi-letter selection, and that there are entries following with keys like \"ab\", \"ax\"... 2. Select-able members must have more than two elements, with the first being the string of keys that lead to selecting it, and the second a short description string of the item.=20 The command will then make a temporary buffer listing all entries that can be selected with a single key, and all the single key prefixes. When you press the key for a single-letter entry, it is selected= . When you press a prefix key, the commands (and maybe further prefixes) under this key will be shown and offered for selection. ARGS is a property list containing following members: :text a string placed over the selection in the buffer. :label a string used for the selections buffer name. :prompt a string used when prompting for a key. :modal when `t', read minibuffer until dialog is dismissed :always when `t', this menu is shown; even descended into submenus :transient when `t', the menu is dissmised after user perform an action :key-decorator a two-character string used to decorate command characters. = When this string is specified, it will take precedence over the global variable `org-select-key-decorator-chars'. TABLES are additional menus in the same format as TABLE. If there are more than one menus, they will be separated by a separator line rendered with character as specified in `org-select-horizontal-separator'" (osl--setup-buffer tables args) (osl--draw)) =0C ;;; Demo =0C (require 'org) (require 'org-capture) (defun demo1 () "Simple illustration to recreate org-capture menu (visually only)." (interactive) (org-select ;; tables '(org-capture-templates (("C" "Customize org-capture-templates" (customize-variable 'org-capture-templates)) ("q" "Abort" (org-select-quit "Abort")))) ;; description :label "*Quick Select*" :key-decorator "[]" :horizontal t :text "Select a capture template\n=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D")) (defun demo2 () "Menu composition with automatic separator." (interactive) (let ((org-select-key-decorator-chars "<>")) (org-select ;; menus '((("h" "Hello, World!" (message "Hello, World!")) ("b" "Bar" (message "Hello, Bar!"))) (("f" "Find File" find-file) ("o" "Open File" (flet ((next-read-file-uses-dialog-p () t)) (call-interactively #'find-file)))) (("q" "Abort" (org-select-quit "Abort")))) ;; description :key-decorator "<>"))) (defun demo3 () "Menu dissapears after a choice is made." (interactive) (org-select ;; menus '((("h" "Hello, World!" (message "Hello, World!")) ("b" "Bar" (message "Hello, Bar!"))) (("f" "Find File" find-file) ("o" "Open File" (flet ((next-read-file-uses-dialog-p () t)) (call-interactively #'find-file)))) (("q" "Abort" (message "Abort")))) ;; description :key-decorator "<>" :transient t :horizontal t)) (defun demo4 () "Illustrate nested menus, unicode separator and alternative decorator." (interactive) (let ((org-select-vertical-separator "=E2=94=80")) (org-select ;; tables '((("g" "Greetings") ("gh" "Hello, World!" (message "Hello, World!")) ("gb" "Bar" (message "Hello, Bar!"))) (("f" "Functions") ("ff" "Find File" find-file) ("fo" "Open File" (flet ((next-read-file-uses-dialog-p () t)) (call-interactively #'find-file)))) (("q" "Abort" (org-select-quit "Abort")))) ;; description :key-decorator "<>"))) (defun demo5 () "Same as demo4 but modal." (interactive) (let ((org-select-vertical-separator "=E2=94=80")) (org-select ;; table '((("g" "Greetings") ("gh" "Hello, World!" (message "Hello, World!")) ("gb" "Bar" (message "Hello, Bar!"))) ;; more tables (("f" "Functions") ("ff" "Find File" (call-interactively #'find-file)) ("fo" "Open File" (flet ((next-read-file-uses-dialog-p () t)) (call-interactively 'find-file)))) (("q" "Abort" (org-select-quit "Abort")))) ;; description :modal t :transient t))) (defun demo6 () "Horizontal menus." (interactive) (let ((org-select-vertical-separator "=E2=94=80")) (org-select ;; table '((("1" "One" (message "One!")) ("2" "Two" (message "Two!!")) ("3" "Three" (message "Three!!!"))) (("4" "Four" (message "Four!!!!")) ("5" "Five" (message "Five!!!!!")) ("6" "six" (message "Six!"))) (("7" "Seven" (message "Seven!")) ("8" "Eight" (message "Eight!")) ("9" "Nine" (message "Nine!")))) ;; description :transient t :horizontal t))) (provide 'org-select) ;;; org-select.el ends here --=-=-=--