From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Philip Kaludercic Newsgroups: gmane.emacs.devel Subject: Re: Stepping Back: A Wealth Of Completion systems Re: [ELPA] New package: vertico Date: Wed, 21 Apr 2021 09:20:24 +0000 Message-ID: <87h7k0c7tz.fsf@posteo.net> References: <9c9af088-580f-9fb1-4d79-237a74ce605c@inventati.org> <874kgkxxs0.fsf@posteo.net> <87blamp5hy.fsf@posteo.net> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="12785"; mail-complaints-to="usenet@ciao.gmane.io" To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Wed Apr 21 11:21:47 2021 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1lZ93K-0003Cm-0Y for ged-emacs-devel@m.gmane-mx.org; Wed, 21 Apr 2021 11:21:46 +0200 Original-Received: from localhost ([::1]:41564 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lZ93J-0004WO-4H for ged-emacs-devel@m.gmane-mx.org; Wed, 21 Apr 2021 05:21:45 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:38016) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lZ92E-0003oO-HO for emacs-devel@gnu.org; Wed, 21 Apr 2021 05:20:39 -0400 Original-Received: from mout01.posteo.de ([185.67.36.65]:46097) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lZ929-0005Zb-44 for emacs-devel@gnu.org; Wed, 21 Apr 2021 05:20:37 -0400 Original-Received: from submission (posteo.de [89.146.220.130]) by mout01.posteo.de (Postfix) with ESMTPS id 68ECE240027 for ; Wed, 21 Apr 2021 11:20:26 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=posteo.net; s=2017; t=1618996826; bh=PD5Vv9h/fHvwg0P/SvY7YpQy/sO5jAb2b7EOs/1sUD4=; h=From:To:Subject:Date:From; b=jbMHeVjEH8qiiO7yFiK2fEZiJ8SSuFDNLHWGMIa5vBd5hKKIq4wm7kq5Z8bdelPs7 eou1N6VN9o3RyznEFbvTF+ZypaAwFRT7n0ac3krrAN1DRI/DKXo5E78Z7PaFtlL5Wn MSjezUPyY08JSO3rdggB3BMelofAyjdsVS20JgxnsGDJWt40boFWemSU1K5kIlhino 0sbkqxsWVpIdROSqpSuXYXn6D9d62ZlGeLEAYQm6ZFGdF9cGGcjHcoj3f1Rs9EB1vE QLT7YIkzzCY+m751oV2CaH0m3pnb6WpCA6bAFisu1pEBlC2lwDgmTtr9w/PrqgtEU1 +5qvgCu7m0umQ== Original-Received: from customer (localhost [127.0.0.1]) by submission (posteo.de) with ESMTPSA id 4FQFQK66fnz9rxM for ; Wed, 21 Apr 2021 11:20:25 +0200 (CEST) In-Reply-To: <87blamp5hy.fsf@posteo.net> (Philip Kaludercic's message of "Sat, 10 Apr 2021 16:40:41 +0200") Received-SPF: pass client-ip=185.67.36.65; envelope-from=philipk@posteo.net; helo=mout01.posteo.de X-Spam_score_int: -12 X-Spam_score: -1.3 X-Spam_bar: - X-Spam_report: (-1.3 / 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, FROM_FMBLA_NEWDOM=1.5, RCVD_IN_DNSWL_LOW=-0.7, RCVD_IN_MSPIKE_H4=0.001, RCVD_IN_MSPIKE_WL=0.001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=no autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.io gmane.emacs.devel:268222 Archived-At: --=-=-= Content-Type: text/plain Here is an updated version, not with improved visuals: --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=selecting-read.el Content-Transfer-Encoding: quoted-printable ;;; selecting-read.el --- Utility function for selection -*- lexical-bindi= ng: t; -*- ;; Copyright (C) 2021 Philip Kaludercic ;; Author: Philip Kaludercic ;; Keywords: lisp ;; 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: ;; Selecting Framework for Emacs. ;;; Code: (eval-when-compile (require 'subr-x)) (require 'cl-lib) (require 'cl-generic) (defgroup selecting-read nil "Utility function for selection." :group 'convenience) (defcustom selecting-read-indent 1 "Number of columns to indent subtrees by." :type 'number) (defcustom selecting-read-display-action '(display-buffer-in-side-window (window-height . 0.25) (side . bottom)) "Specification on how to display a `selecting-read' buffer." :type display-buffer--action-custom-type) (defcustom selecting-read-auto-narrow nil "Jump directly into narrowing mode." :type 'boolean) (defface selecting-read-candidate-face '((t :inherit highlight :extend t)) "Face to use for selection candidate.") (defvar selecting-read-function #'selecting-read-default "Function called by `selecting-read'. This function must accept two variables LIST and OPTIONS. LIST may be a list or an alist. OPTIONS may consist of the following keys: :multiple If non-nil, `selecting-read' will return multiple results in form of a list.") (defvar selecting-read-buffer nil "Buffer used by `selecting-read'.") ;;; object framework (cl-defgeneric selecting-read-represent (object) "Return a string to represent OBJECT.") (cl-defgeneric selecting-read-properties (object) "Return a plist of properties for OBJECT." (ignore object)) (cl-defgeneric selecting-read-children (object) "Return a list of children for OBJECT." (ignore object)) (cl-defgeneric selecting-read-flags (object) "Return a list of symbols indicating flags for OBJECT." (ignore object)) ;;;; simple string object (cl-defmethod selecting-read-represent ((str string)) "A string STR represents itself." str) ;;;; generic node object (cl-defmethod selecting-read-represent ((node (head node))) "Return representation for NODE (node OBJECT CHILDREN). OBJECT may be a string or a cons cell (REPRESENTATION . PROPERTIES). If REPRESENTATION or OBJECT is string, then this string will be returned. If REPRESENTATION or OBJECT is a function, this function will be called with no arguments. It is expected to return a string that will be returned by this method." (let ((represent (if (consp (cadr node)) (caadr node) (cadr node)))) (cond ((functionp represent) (funcall represent)) ((stringp represent) represent) ((error "Invalid representation"))))) (cl-defmethod selecting-read-properties ((node (head node))) "Return properties for NODE (node OBJECT CHILDREN). OBJECT may be a string or a cons cell (REPRESENTATION . PROPERTIES)." (and (consp (cadr node)) (cdadr node))) (cl-defmethod selecting-read-children ((node (head node))) "Return children for NODE (node REPRESENTATION CHILDREN)." (cddr node)) ;;; default UI (defvar-local selecting-read-list nil) (defvar-local selecting-read-options nil) (defvar-local selecting-read-selection nil) (defvar-local selecting-read-hl-overlay nil) (defvar selecting-read-query nil) (defun selecting-read-select () "Select object at point." (interactive) (with-current-buffer selecting-read-buffer (when-let ((object (get-text-property (overlay-start selecting-read-hl-= overlay) 'selecting-read-object))) (when (memq 'non-selectable (selecting-read-flags object)) (user-error "This object is not selectable")) (unless (plist-get selecting-read-options :multiple) (setq selecting-read-selection object))) (if selecting-read-auto-narrow (unless selecting-read-selection (message "Nothing selected") (sit-for 0.5)) (exit-recursive-edit)))) (defun selecting-read-cycle () "Show or hide the children of the current object." (interactive) (if-let ((ov (get-text-property (point) 'selecting-read-sub))) (overlay-put ov 'invisible (if (eq (overlay-get ov 'invisible) 'selecting-read) nil 'selecting-read)) (user-error "No children"))) (defun selecting-read-narrow (query) "Narrow listing to options that much regexp QUERY." (interactive (list (read-string "Narrow: " selecting-read-query))) (setq selecting-read-query query) (selecting-read-redraw)) (defun selecting-read-interactive-narrow () "Narrow selection after every command and select what is left." (interactive) (minibuffer-with-setup-hook (lambda () (let ((last-query "")) (add-hook 'post-command-hook (lambda () (let ((query (minibuffer-contents))) (unless (string-equal last-query query) (selecting-read-narrow query)) (setq last-query query))) nil t)) (add-hook 'post-command-hook #'selecting-read-hl-current nil t) (local-set-key [remap previous-line] #'selecting-read-previous) (local-set-key [remap next-line] #'selecting-read-next)) (if (plist-get selecting-read-options :must-select) (while (not selecting-read-selection) (read-string "Narrow: " selecting-read-query) (selecting-read-select)) (read-string "Narrow: " selecting-read-query) (selecting-read-select)))) (defun selecting-read-mark () "Add object at point to selection." (interactive) (unless (plist-get selecting-read-options :multiple) (user-error "Cannot mark multiple elements")) (push (get-text-property (point) 'selecting-read-object) selecting-read-selection)) (defun selecting-read-next () "Move to next object." (interactive) (with-selected-window (get-buffer-window selecting-read-buffer) (goto-char (or (next-single-property-change (point) 'selecting-read-obj= ect) (point))))) (defun selecting-read-previous () "Move to previous object." (interactive) (with-selected-window (get-buffer-window selecting-read-buffer) (goto-char (or (previous-single-property-change (point) 'selecting-read= -object) (point-min))))) (defun selecting-read-hl-current () "Highlight current object at point." (with-current-buffer selecting-read-buffer (move-overlay selecting-read-hl-overlay (or (previous-single-property-change (min (1+ (point)) (point-max)) 'selecting-read-object) (point-min)) (or (next-single-property-change (point) 'selecting-read-object) (point-max))))) (defun selecting-read-quit (force) "Attempt to quit selection. With a prefix argument or non-nil value for FORCE, force quitting even if an argument is requested." (interactive (list (or (eq last-command #'selecting-read-quit) (eq this-command #'keyboard-quit) current-prefix-arg))) (if (and (not force) (plist-get selecting-read-options :must-select)) (message (substitute-command-keys "Must select an object. \ Press \\[selecting-read-quit] again to force-quit.")) (abort-recursive-edit))) (defvar selecting-read-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "q") #'selecting-read-quit) (define-key map [remap keyboard-quit] #'selecting-read-quit) (define-key map (kbd "") #'selecting-read-select) (define-key map (kbd "") #'selecting-read-cycle) (define-key map (kbd "/") #'selecting-read-narrow) (define-key map (kbd "m") #'selecting-read-mark) (define-key map (kbd "n") #'selecting-read-next) (define-key map (kbd "p") #'selecting-read-previous) map)) (define-derived-mode selecting-read-mode special-mode "Selecting Read" "Major mode for Selecting Read buffers." (setq-local selecting-read-hl-overlay (make-overlay 0 0)) (overlay-put selecting-read-hl-overlay 'face 'selecting-read-candidate-fa= ce) (add-hook 'post-command-hook #'selecting-read-hl-current nil t) (add-to-invisibility-spec 'selecting-read) (setq-local mode-line-format " Select using RET") (setq-local cursor-type nil)) (defun selecting-read-draw (list depth) "Insert LIST indented by DEPTH." (dolist (object list) (let ((string (selecting-read-represent object)) (properties (selecting-read-properties object)) (children (selecting-read-children object)) (start (point))) (when (or (not selecting-read-query) (string-match-p selecting-read-query string)) (insert string) (unless (bolp) (insert ?\n))) ;ensure newline (let ((mid (make-marker))) (cl-loop for (key val) on properties by #'cddr do (insert (propertize (symbol-name key) 'face 'shadow) " \t" (cond ((stringp val) val) ((functionp val) (funcall val object)) ((prin1-to-string val))) "\n")) (set-marker mid (point)) (selecting-read-draw children (1+ depth)) ;; TODO: allow lazy subtree computation (when children (let ((sub (make-overlay mid (point)))) (overlay-put sub 'priority (- depth)) (add-text-properties start mid (list 'selecting-read-sub sub)) (when (memq 'folded (selecting-read-flags object)) (overlay-put sub 'invisible 'selecting-read)))) (when (> depth 0) (indent-rigidly start mid (* depth selecting-read-indent))) (add-text-properties start mid (list 'selecting-read-object object 'mouse-face 'match)))))) (defun selecting-read-redraw () "Redraw current buffer." (with-current-buffer selecting-read-buffer (let ((inhibit-read-only t)) (erase-buffer) (selecting-read-draw selecting-read-list 0) (goto-char (point-min)) (selecting-read-hl-current)))) (defun selecting-read-initialize (list options) "Initialize a Selecting Read buffer for LIST. OPTIONS is a plist as specified in `selecting-read-function'." (selecting-read-mode) (setq selecting-read-options options) (setq selecting-read-list list) (setq header-line-format (plist-get selecting-read-options :prompt)) (setq selecting-read-query (plist-get selecting-read-options :initial-que= ry)) (selecting-read-redraw)) (defun selecting-read-default (list options) "Default selection function. LIST and OPTIONS are passed directly from `selecting-read'." (with-current-buffer (generate-new-buffer " *Selecting Read*") (setq selecting-read-buffer (current-buffer)) (select-window (funcall (car selecting-read-display-action) (current-buffer) (cdr selecting-read-display-action))) (let (return-value) (unwind-protect (progn (selecting-read-initialize list options) (if selecting-read-auto-narrow (selecting-read-interactive-narrow) (recursive-edit))) (setq return-value selecting-read-selection) (setq selecting-read-query nil) (kill-buffer)) return-value))) ;;;###autoload (defun selecting-read (list &rest options) "Ask user to select an element from LIST. LIST and the plist OPTIONS are passed to the function designated by `selecting-read-function'." (cl-assert (=3D (mod (length options) 2) 0) nil "Incomplete property list.") (cl-assert (cl-loop for (key _val) on options by #'cddr always (keywordp key)) nil "Degenerated property list.") (funcall selecting-read-function list options)) (provide 'selecting-read) ;;; selecting-read.el ends here --=-=-= Content-Type: text/plain For the most part, the suggestion is the same, I just added an additional generic function (selecting-read-flags object) that returns a list of flags, to indicate if an object is selectable, should be folded by default, etc. As a demonstration, the option selecting-read-auto-narrow enabled a behaviour that is similar to what selecting completion framework provide. I have also mentioned that a "translation function" could be written to translate completing-read calls into selecting-read. Here is an example that could be set to completing-read-function, even if it does not implement the entire interface: --8<---------------cut here---------------start------------->8--- (defun selecting-read-<-completing-read (prompt collection &optional predicate require-match initial-input _hist default _inherit-input-method) "Translation interface for `completing-read' to `selecting-read'. PROMPT, COLLECTION, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT and DEFAULT are all interpreted as by `completing-read'." (or (selecting-read (all-completions "" collection predicate) :must-select (not (memq require-match '(confirm-after-completion confirm nil))) :initial-query initial-input :prompt prompt) (cond ((listp default) (car default)) ((null default) "") (default)))) --8<---------------cut here---------------end--------------->8--- There are still issues, especially with large collections (try C-h o and wait). When I get around to working on this again, I'll try to implement the lazy selection generation, as mentioned before. Philip Kaludercic writes: > Philip Kaludercic writes: > >> It might therefore be necessary to actually implement a "selecting-read" >> function, that could be used more or less like completing-read, but that >> provides a better default UI not based around completing text but >> actually selecting objects/items. > > I attached a primitive version of selecting-read to this message. The UI > is horridly primitive, but the basic idea should be understandable. > > Using generic functions, methods can be defined determining how an > object is handled. In this iteration, three generic functions are used: > > - (selecting-read-represent object) > > Return a string representing the object. This is the only necessary > method. > > - (selecting-read-properties object) > > Return a plist denoting properties of the object > > - (selecting-read-children object) > > Return a list of children of this object > > It seems that these three functions are enough, and that adding more > would risk becoming too complicated. > > When evaluating a nonsensical query like > > (selecting-read '((node "one" "one.1" "one.2" "one.3") > (node ("two" :property "propertied" :key "value") > "two.1" "two.2") > "three")) > > a child window appears and the user can select an object, that > selecting-read returns directly (eq). > > Additional arguments are passed as keywords. A simple example is > :multiple that lets selecting-read give me a list of items that were > marked > > (selecting-read '((node "one" "one.1\n" "one.2" "one.3") > (node ("two" :property "propertied" :key "value") > "two.1" "two.2") > "three") > :multiple t) > > Because I'm not just now primarily concerned with what completing-read > might look like, it doesn't do "automatic narrowing" like Helm or > Ivy. The framework I sketched here should be flexible enough to support > something like that, if preferred. -- Philip K. --=-=-=--