From eb04f8414a19706e1267d3fc9dbd6c0396a9f798 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Tue, 27 Jun 2023 19:53:49 +0300 Subject: [PATCH] Improve module completion annotations * sweep.pl (sweep_known_module/1, sweep_is_module/2) (sweep_module_description_/3, sweep_matching_module/3) (sweep_module_annotation/2): New predicates. (sweep_modules_collection/2): Adapt. * sweeprolog.el (sweeprolog-module-completion-table) (sweeprolog-module-p, sweeprolog-module-minibuffer-annotation) (sweeprolog-module-annotation): New functions. (sweeprolog-modules-collection) (sweeprolog-read-module-name): Adapt. (sweeprolog-find-module): Improve feedback for modules that are not backed by files. --- sweep.pl | 63 +++++++++++++++++++++++++++++------- sweeprolog.el | 90 ++++++++++++++++++++++++++++++++++++++------------- 2 files changed, 119 insertions(+), 34 deletions(-) diff --git a/sweep.pl b/sweep.pl index ab4d5d6..72465d7 100644 --- a/sweep.pl +++ b/sweep.pl @@ -87,7 +87,9 @@ sweep_current_breakpoints_in_region/2, sweep_breakpoint_range/2, sweep_breakpoint_file/2, - sweep_expand_macro/2 + sweep_expand_macro/2, + sweep_module_annotation/2, + sweep_is_module/2 ]). :- use_module(library(pldoc)). @@ -313,17 +315,54 @@ sweep_module_html_documentation(M0, D) :- phrase(pldoc_html:html(DOM), HTML), with_output_to(string(D), html_write:print_html(HTML)). -sweep_modules_collection([], Modules) :- - findall([M|P], ( module_property(M, file(P0)), atom_string(P0, P) ), Modules0, Tail), - setof([M|P], P0^N^('$autoload':library_index(N, M, P0), string_concat(P0, ".pl", P) ), Tail), - list_to_set(Modules0, Modules1), - maplist(sweep_module_description, Modules1, Modules). - -sweep_module_description([M0|P], [M|[P|D]]) :- - doc_comment(M0:module(D0), _, _, _), - atom_string(M0, M), - atom_string(D0, D). -sweep_module_description([M0|P], [M|[P]]) :- atom_string(M0, M). +sweep_modules_collection([Bef|Aft], Ms) :- + setof(M, sweep_known_module(M), Ms0), + include(sweep_matching_module(Bef,Aft), Ms0, Ms1), + maplist(atom_string, Ms1, Ms). + +sweep_matching_module([], Aft, Mod) :- + !, + sweep_matching_module_(Aft, 0, Mod). +sweep_matching_module(Bef, Aft, Mod) :- + once(sub_atom(Mod, N, L, _, Bef)), + M is N + L, + sweep_matching_module_(Aft, M, Mod). + +sweep_matching_module_([], _, _) :- !. +sweep_matching_module_(A, N, M) :- + sub_atom(M, B, _, _, A), + B >= N, + !. + +sweep_module_annotation(M0, [P|D]) :- + atom_string(M, M0), + ( sweep_module_path_(M, P0), nonvar(P0) + -> sweep_file_path_in_library(P0, P) + ; P = [] + ), + ( sweep_module_description_(M, P0, D0) + -> atom_string(D0, D) + ; D = [] + ). + +sweep_known_module(M) :- + current_module(M). +sweep_known_module(M) :- + xref_module(_, M). +sweep_known_module(M) :- + '$autoload':library_index(_, M, _). + +sweep_is_module(M0, _) :- + atom_string(M, M0), + once(sweep_known_module(M)). + +sweep_module_description_(M, _, D) :- + doc_comment(M:module(D), _,_,_). +sweep_module_description_(_, P, D) :- + xref_comment(P, D, _). +sweep_module_description_(M, _, D) :- + atom_concat('sec:', M, S), + man_object_property(section(_, _, S, _), summary(D)). sweep_predicate_references(MFN, Refs) :- term_string(M:PI, MFN), diff --git a/sweeprolog.el b/sweeprolog.el index 4a180ee..ae2cd48 100644 --- a/sweeprolog.el +++ b/sweeprolog.el @@ -1168,27 +1168,72 @@ the prefix argument." ;;;; Modules -(defun sweeprolog-modules-collection () - (sweeprolog--query-once "sweep" "sweep_modules_collection" nil)) - -(defun sweeprolog-module-path (mod) - (sweeprolog--query-once "sweep" "sweep_module_path" mod)) +(defvar-local sweeprolog--module-max-width nil) + +(defun sweeprolog-modules-collection (&optional before after) + "Return Prolog modules with names including BEFORE and AFTER in order." + (when-let ((col (sweeprolog--query-once "sweep" "sweep_modules_collection" + (cons before after)))) + (setq sweeprolog--module-max-width + (seq-max (mapcar #'string-width col))) + col)) + +(defun sweeprolog-module-annotation (module) + "Return a cons cell (FILE . DESC) for MODULE. + +FILE is the file name of MODULE and DESC is its description, or nil." + (sweeprolog--query-once "sweep" "sweep_module_annotation" module)) + +(defun sweeprolog-module-minibuffer-annotation (module) + "Annotation function for module completion candidates. + +Return a string used to annotate MODULE." + (let* ((width (string-width module)) + (file-desc (sweeprolog-module-annotation module)) + (file (car file-desc)) + (desc (cdr file-desc))) + (concat + (make-string + (+ (max (- (or sweeprolog--module-max-width width) width) 0) 2) + ?\s) + (when file (concat file (when desc (concat ": ")))) + (replace-regexp-in-string (rx "library(" (+ graph) "): ") "" + (or desc ""))))) + +(defun sweeprolog-module-p (mod) + "Return non-nil if MOD is a known Prolog module." + (not (null (sweeprolog--query-once "sweep" "sweep_is_module" mod)))) + +(defun sweeprolog-module-completion-table (string predicate action) + "Programmed completion function for prolog modules. + +See (info \"(elisp)Programmed Completion\") for the meaning of +STRING, PREDICATE and ACTION." + (cond + ((eq action 'lambda) + (and (sweeprolog-module-p string) + (or (null predicate) + (funcall predicate string)))) + ((eq action 'metadata) + '(metadata + . + ((category . sweeprolog-module) + (annotation-function . sweeprolog-module-minibuffer-annotation)))) + (t (complete-with-action action + (sweeprolog-modules-collection string) + string + predicate)))) (defun sweeprolog-read-module-name () "Read a Prolog module name from the minibuffer, with completion." - (let* ((col (sweeprolog-modules-collection)) - (completion-extra-properties - (list :annotation-function - (lambda (key) - (let* ((val (cdr (assoc-string key col))) - (pat (car val)) - (des (cdr val))) - (concat (make-string (max 0 (- 32 (length key))) ? ) - (if des - (concat pat (make-string (max 0 (- 80 (length pat))) ? ) des) - pat))))))) - (completing-read sweeprolog-read-module-prompt col nil nil nil - 'sweeprolog-read-module-history))) + (completing-read sweeprolog-read-module-prompt + #'sweeprolog-module-completion-table + nil nil nil + 'sweeprolog-read-module-history)) + +(defun sweeprolog-module-path (mod) + "Return the name of the file that defining the Prolog module MOD." + (sweeprolog--query-once "sweep" "sweep_module_path" mod)) ;;;###autoload (defun sweeprolog-find-module (mod &optional other-window) @@ -1200,10 +1245,11 @@ Interactively, OTHER-WINDOW is the prefix argument and this command prompts for MOD." (interactive (list (sweeprolog-read-module-name) current-prefix-arg)) - (let ((file (sweeprolog-module-path mod))) - (if other-window - (find-file-other-window file) - (find-file file)))) + (if-let ((file (sweeprolog-module-path mod))) + (if other-window + (find-file-other-window file) + (find-file file)) + (user-error "Module %s is not defined in a source file!" mod))) ;;;; Completion at point -- 2.39.5