From 288ccb3984c7cb46b67d0f6bf7fb6d53c5d7a2d3 Mon Sep 17 00:00:00 2001 From: bd Date: Sat, 13 Dec 2025 23:43:10 -0500 Subject: guix: full refactor of configuration structure --- .config/emacs/libraries/copyright.el | 35 -- .config/emacs/libraries/exwm-outer-gaps.el | 77 --- .config/emacs/libraries/fill-column.el | 39 -- .config/emacs/libraries/powerthesaurus.el | 940 ----------------------------- .config/emacs/libraries/selector.el | 653 -------------------- 5 files changed, 1744 deletions(-) delete mode 100644 .config/emacs/libraries/copyright.el delete mode 100644 .config/emacs/libraries/exwm-outer-gaps.el delete mode 100644 .config/emacs/libraries/fill-column.el delete mode 100644 .config/emacs/libraries/powerthesaurus.el delete mode 100644 .config/emacs/libraries/selector.el (limited to '.config/emacs/libraries') diff --git a/.config/emacs/libraries/copyright.el b/.config/emacs/libraries/copyright.el deleted file mode 100644 index 112512d..0000000 --- a/.config/emacs/libraries/copyright.el +++ /dev/null @@ -1,35 +0,0 @@ -;;; copyright.el --- Insert a Guix copyright. -*- lexical-binding: t; -*- - -;; Copyright © 2020 Oleg Pykhalov - -;; This file is part of GNU Guix. - -;; GNU Guix 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. - -;; GNU Guix 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: - -;; This package provides skeleton to insert a copyright with `guix-copyright'. - -;;; Code: - -(define-skeleton guix-copyright - "Insert a copyright by $USER notice at cursor." - "FULL_NAME : " - comment-start - ";; Copyright © " `(format-time-string "%Y") " " - (or (format "%s <%s>" user-full-name user-mail-address) str) - comment-end) - -(provide 'copyright) -;;; copyright.el ends here diff --git a/.config/emacs/libraries/exwm-outer-gaps.el b/.config/emacs/libraries/exwm-outer-gaps.el deleted file mode 100644 index c315e8b..0000000 --- a/.config/emacs/libraries/exwm-outer-gaps.el +++ /dev/null @@ -1,77 +0,0 @@ -;;; -*- lexical-binding: t; -*- -;;; Commentary: - -;; modified version of https://github.com/lucasgruss/exwm-outer-gaps - -;;; Code: - - -(require 'exwm-workspace) -(require 'exwm-core) -(require 'exwm) -(require 'xelb) -(require 'xcb) - -(defgroup exwm-outer-gaps nil - "Outer gaps for exwm." - :group 'appearance - :prefix "exwm-outer-gaps") - -(defcustom exwm-outer-gaps-width 15 - "Width between the edge of the monitor and emacs frame for all sides.") - -(defcustom exwm-outer-gaps-increment-step 5 - "Default increment/decrement value for gaps.") - -(defcustom exwm-outer-gaps-max-width - (* exwm-outer-gaps-increment-step 20) - "The maximum size of the gaps.") - -(defun exwm-outer-gaps-compute-gaps () - "Hook to be ran after exwm-workspace--update-workareas-hook" - (let (workareas frames) - (dolist (w exwm-workspace--workareas) - (setf (aref w 3) (+ (aref w 3) exwm-outer-gaps-width) - (aref w 4) (+ (aref w 4) exwm-outer-gaps-width) - (aref w 5) (- (aref w 5) (* 2 exwm-outer-gaps-width)) - (aref w 6) (- (aref w 6) (* 2 exwm-outer-gaps-width)))))) - -(defun exwm-outer-gaps-apply () - "Function used to apply gaps to the emacs frames." - (exwm-workspace--update-workareas) - (dolist (f exwm-workspace--list) - (exwm-workspace--set-fullscreen f))) - -(defun exwm-outer-gaps-set (width) - "Sets the gap width to WIDTH. Automatically clamps the size of the gaps -from 0 to `exwm-outer-max-gaps-width'" - (setq exwm-outer-gaps-width - (max 0 (min width exwm-outer-gaps-max-width)))) - -(defun exwm-outer-gaps-increment () - "Increment the outer gaps by exwm-outer-gaps-increment-step" - (interactive) - (when exwm-outer-gaps-mode - (exwm-outer-gaps-set (+ exwm-outer-gaps-width exwm-outer-gaps-increment-step)) - (exwm-outer-gaps-apply))) - -(defun exwm-outer-gaps-decrement () - "Decrement the outer gaps by exwm-outer-gaps-increment-step" - (interactive) - (when exwm-outer-gaps-mode - (exwm-outer-gaps-set (- exwm-outer-gaps-width exwm-outer-gaps-increment-step)) - (exwm-outer-gaps-apply))) - -;;;###autoload -(define-minor-mode exwm-outer-gaps-mode - "Add useless outer gaps to exwm." - :global t - (if exwm-outer-gaps-mode - (add-hook 'exwm-workspace--update-workareas-hook - #'exwm-outer-gaps-compute-gaps) - (remove-hook 'exwm-workspace--update-workareas-hook - #'exwm-outer-gaps-compute-gaps)) - (exwm-outer-gaps-apply)) - - -(provide 'exwm-outer-gaps) diff --git a/.config/emacs/libraries/fill-column.el b/.config/emacs/libraries/fill-column.el deleted file mode 100644 index 2a70cd6..0000000 --- a/.config/emacs/libraries/fill-column.el +++ /dev/null @@ -1,39 +0,0 @@ -;;; -*- lexical-binding: t; -*- -;;; Commentary: - -;; yanked from https://codeberg.org/daviwil/dotfiles/src/branch/master/emacs - -;;; Code: - - -(defvar fill-column-desired-width 120 - "The desired width of a document centered in the window.") - -(defun fill-column--adjust-margins () - "Resets window margins, then calculates the appropriate -margin given the window width and `fill-column-desired-width' -if fill-column-mode is t." - (set-window-parameter nil 'min-margins nil) - (set-window-margins nil nil) - (when fill-column-mode - (let ((margin-width (max 0 - (truncate - (/ (- (window-width) - fill-column-desired-width) - 2.0))))) - (when (> margin-width 0) - (set-window-parameter nil 'min-margins '(0 . 0)) - (set-window-margins nil margin-width margin-width))))) - -(define-minor-mode fill-column-mode - "Toggle centered text layout in the current buffer." - :lighter " Centered" - :group 'editing - (if fill-column-mode - (add-hook 'window-configuration-change-hook #'fill-column--adjust-margins 'append 'local) - (remove-hook 'window-configuration-change-hook #'fill-column--adjust-margins 'local)) - (fill-column--adjust-margins)) - - -(provide 'fill-column) -;;; fill-column ends here diff --git a/.config/emacs/libraries/powerthesaurus.el b/.config/emacs/libraries/powerthesaurus.el deleted file mode 100644 index 2c76df0..0000000 --- a/.config/emacs/libraries/powerthesaurus.el +++ /dev/null @@ -1,940 +0,0 @@ -;;; powerthesaurus.el --- Powerthesaurus integration -*- lexical-binding: t; -*- - -;; Copyright (c) 2018-2023 Valeriy Savchenko (GNU/GPL Licence) - -;; Authors: Valeriy Savchenko -;; URL: http://github.com/SavchenkoValeriy/emacs-powerthesaurus -;; Version: 0.4.1 -;; Package-Requires: ((emacs "26.1") (jeison "1.0.0") (s "1.13.0")) -;; Keywords: convenience, writing - -;; This file is NOT part of GNU Emacs. - -;; powerthesaurus.el 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. - -;; powerthesaurus.el 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 powerthesaurus.el. -;; If not, see . - -;;; Commentary: - -;;; This package is an integration with powerthesaurus.org. -;;; It helps to look up a word in powerthesaurus and either replace or -;;; insert selected option in the buffer (depending on the current selection). - -;;; Code: -(require 'eieio) -(require 'cl-seq) -(require 'url) -(require 's) -(require 'subr-x) -(require 'jeison) - -(defvar powerthesaurus-request-headers - '(("Content-Type" . "application/json")) - "List of headers included in the request sent to 'powerthesaurus.org'.") - -(defvar powerthesaurus-user-agent "Chrome/74.0.3729.169") - -(defvar powerthesaurus-synchronous-requests nil - "If non-nil, requests send to 'powerthesaurus.org' are synchronous.") - -(defvar powerthesaurus-show-tags t - "Whether to show word tags during completion.") - -(defvar powerthesaurus-show-part-of-speech t - "Whether to show word's part of speech during completion.") - -(defvar powerthesaurus-show-rating t - "Whether to show word's rating during completion.") - -(defconst powerthesaurus-supported-query-types - (list :synonyms :antonyms :related :definitions :sentences)) - -(defconst powerthesaurus-api-url "https://api.powerthesaurus.org") - -(defface powerthesaurus-definition-part-of-speech - '((t :inherit font-lock-keyword-face)) - "Face of the definition's part of speech." - :group 'powerthesaurus) - -(defface powerthesaurus-definition-definition - '((t :weight bold)) - "Face of the actual definition part of the definition." - :group 'powerthesaurus) - -(defface powerthesaurus-definition-usages - '((t :inherit font-lock-comment-face)) - "Face of the usage example for the definition." - :group 'powerthesaurus) - -(defface powerthesaurus-definition-synonyms - '((t :inherit font-lock-type-face)) - "Face of the definition's synonyms." - :group 'powerthesaurus) - -(defface powerthesaurus-definition-author - '((t :inherit default)) - "Face of the definition's author." - :group 'powerthesaurus) - -(defface powerthesaurus-sentence-sentence - '((t :weight bold)) - "Face of the example sentence." - :group 'powerthesaurus) - -(defface powerthesaurus-sentence-author - '((t :inherit default)) - "Face of the example sentence author." - :group 'powerthesaurus) - -;;;###autoload -(defun powerthesaurus-lookup-dwim (&optional action-type query-type) - "Wrapper function for general lookup commands. - -When called interactively, optional argument ACTION-TYPE corresponds to -the prefix argument passed to this command, which is translated to an action -using `powerthesaurus-prefix-to-action'. When called programmatically, -its value can either be nil or a symbol that can be possibly returned by -`powerthesaurus-prefix-to-action' (e.g., `action-insert' or `action-display'). - -The argument passed to QUERY-TYPE should be the same as in -`powerthesaurus-lookup' or nil; in the latter case, -the user will be prompt for a valid value." - (interactive "P") - (pcase-let ((`(,query-term ,beg ,end) - ;; selection is active -> look up whatever is selected - (if (use-region-p) - (powerthesaurus--extract-query-region) - ;; point is is at a word -> look it up - (if (thing-at-point 'word) - (powerthesaurus--extract-original-word) - ;; nothing appropriate nearby -> ask the user - (list nil nil nil))))) - (setq query-term (read-string "Term: " query-term) - query-type (or query-type - (intern (completing-read "Query type: " - powerthesaurus-supported-query-types - nil t))) - action-type (powerthesaurus-prefix-to-action action-type query-type)) - (cond - ((eq action-type 'action-insert) - (when (null beg) - (setq beg (point) end (point)))) - ((eq action-type 'action-display) - (when (or beg end) - (setq beg nil end nil)))) - (funcall 'powerthesaurus-lookup query-term query-type beg end))) - -;;;###autoload -(defun powerthesaurus-lookup-synonyms-dwim (&optional action-type) - "Wrapper function for synonym lookup. -ACTION-TYPE accepts the same arguments as in `powerthesaurus-lookup-dwim'." - (interactive "P") - (powerthesaurus-lookup-dwim action-type :synonyms)) - -;;;###autoload -(defun powerthesaurus-lookup-antonyms-dwim (&optional action-type) - "Wrapper function for antonym lookup. -ACTION-TYPE accepts the same arguments as in `powerthesaurus-lookup-dwim'." - (interactive "P") - (powerthesaurus-lookup-dwim action-type :antonyms)) - -;;;###autoload -(defun powerthesaurus-lookup-related-dwim (&optional action-type) - "Wrapper function for related lookup. -ACTION-TYPE accepts the same arguments as in `powerthesaurus-lookup-dwim'." - (interactive "P") - (powerthesaurus-lookup-dwim action-type :related)) - -;;;###autoload -(defun powerthesaurus-lookup-definitions-dwim (&optional action-type) - "Wrapper function for definition lookup. -ACTION-TYPE accepts the same arguments as in `powerthesaurus-lookup-dwim'." - (interactive "P") - (powerthesaurus-lookup-dwim action-type :definitions)) - -;;;###autoload -(defun powerthesaurus-lookup-sentences-dwim (&optional action-type) - "Wrapper function for sentence lookup. -ACTION-TYPE accepts the same arguments as in `powerthesaurus-lookup-dwim'." - (interactive "P") - (powerthesaurus-lookup-dwim action-type :sentences)) - -;;;###autoload -(defun powerthesaurus-lookup (query-term query-type &optional beg end) - "Retrieve the given QUERY-TERM's synonyms, antonyms, etc... online. - -Argument QUERY-TYPE specifies the type of query and must be an element of -`powerthesaurus-supported-query-types'. -QUERY-TERM corresponds to the word/term/sentence to look up. - -If specified, BEG and END specify the beginning and end positions of -the text in the buffer to be replaced by the selected result. -Particularly, if both BEG and END are both nil, then the results of the queries -will be displayed on a distinct buffer. If only BEG is specified or -both BEG and END are the same, then the user will be prompted to select one of -the results to be inserted at BEG. Finally, if both BEG and END are specified -and are different, then the user will be prompted to select a result -which will replace the text between these bounds." - (powerthesaurus--query - query-term - query-type - (powerthesaurus--make-callback query-term query-type beg end))) - -;; =============================================================== -;; UX functions implementation -;; =============================================================== - -(defun powerthesaurus-prefix-to-action (uarg qtype) - "Map given prefix argument UARG to corresponding action type. - -A single universal argument (\\[universal-argument]) indicates that -the result of the query should be inserted at point, -potentially replacing the word under it or the selected phrase. -This corresponds to returning the symbol `action-insert'. - -A double universal argument (\\[universal-argument] \\[universal-argument]) -indicates that the results of the query should be displayed on -a separate buffer without modifying the current one. -This corresponds to returning the symbol `action-display'. - -If no prefix argument is given, -then the type of the query specified via QTYPE is used for -determining the action that should be preferred. -Particularly, if the type is one of 'synonyms', 'antonyms' or 'related', -then the result defaults to `action-insert'. -In any other case, it defaults to `action-display'." - (cond - ((null uarg) - (if (member qtype '(:synonyms :antonyms :related)) - 'action-insert - 'action-display)) - ((memq uarg '(action-insert action-display)) uarg) - ((equal uarg '(4)) 'action-insert) - ((equal uarg '(16)) 'action-display) - (t (error "Unexpected prefix argument")))) - -(defun powerthesaurus--extract-original-word (&optional pnt) - "Parse the word under point to look up. - -If optional argument PNT is not specified, -default to cursor's current location." - (setq pnt (or pnt (point))) - (save-mark-and-excursion - (goto-char pnt) - (unless (looking-at-p "\\<") - (backward-word)) - (let (beg end) - (setq beg (point)) - (forward-word) - (setq end (point)) - (powerthesaurus--extract-query-region beg end)))) - -(defun powerthesaurus--extract-query-region (&optional beg end) - "Parse the phrase in region. - -If optional arguments BEG and END are not specified, -the contents of the current active region are used." - (cl-flet ((substring-and-bounds - (lambda (beg end) - (list (buffer-substring-no-properties beg end) - beg end)))) - ;; If *either* BEG or END have been specified, - ;; then try to get the specified substring. - ;; Notice that in case only one of them has been passed, - ;; then `buffer-substring-no-properties' will take care of throwing an error. - (if (or beg end) - (substring-and-bounds beg end) - (if (use-region-p) - (substring-and-bounds (region-beginning) (region-end)) - (error "Failed parsing query term from active region"))))) - -(defun powerthesaurus--read-query-term (&optional prompt) - "Ask the user for which word to look up. -If PROMPT is not specified, a default one will be used." - (setq prompt (or prompt "Term: ")) - (list (substring-no-properties (read-string prompt)) nil nil)) - -(defun powerthesaurus--make-callback (query-term query-type - &optional beg end) - "Generate a callback to be executed upon successful completion of request. - -If BEG and/or END are non-nil, then `powerthesaurus--make-insert-callback' -will be used as the underlying callback generator, otherwise it defaults to -`powerthesaurus--make-display-callback'. - -QUERY-TYPE and QUERY-TERM will be passed to -the underlying callback generator, possibly altering its behavior to -better accommodate the corresponding type of query." - (cond - ((or beg end) - (powerthesaurus--make-insert-callback query-term query-type - (current-buffer) - beg end)) - (t - (powerthesaurus--make-display-callback query-term query-type)))) - -(defun powerthesaurus--make-insert-callback (query-term - query-type - buffer beg end) - "Generate a callback that will insert the query's result to buffer. - -The callback generated by this function accepts the data belonging to -the response to a previously made request as its sole argument. - -If END is nil or BEG and END are equal, -the generated callback will prompt the user to select a returned result and -insert it at point. -Otherwise, if BEG and END differ, -then the region between these points will be replaced by the selected result. -BEG must be non-nil. - -BUFFER is the buffer object where term will be replaced and -should be explicitly specified since, in case of asynchronous execution, -the callback may be executed with cursor under a different buffer. - -QUERY-TERM corresponds to the text to be replaced by -the generated callback, and BEG and END correspond to the substituted text's -beginning and ending positions within the buffer. - -QUERY-TYPE must be an element of `powerthesaurus-supported-query-types' and -is used for determining how to parse the aforementioned data. -In general, its argument should be the same as the type specified when -creating the corresponding request." - (let ((backend (if (or (null end) - (equal beg end)) - (lambda (new original) - (with-current-buffer buffer - (powerthesaurus--insert-text new original))) - (lambda (new original) - (with-current-buffer buffer - (powerthesaurus--replace-text new beg end original)))))) - (lambda (results) - (funcall backend - (powerthesaurus--select-candidate results) - query-term)))) - -(defun powerthesaurus--make-display-callback (query-term query-type) - "Generate a callback that will display the query's results to another buffer. - -The callback generated by this function accepts the data belonging to -the response to a previously made request as its sole argument. -The results of the query will then be extracted and displayed on -a different buffer. - -QUERY-TERM corresponds to the original text that was queried online. - -QUERY-TYPE must be an element of `powerthesaurus-supported-query-types' and -is used for determining how to parse the aforementioned data. -In general, its argument should be the same as the type specified when -creating the corresponding request. -Additionally, it affects aspects of the generated callback's behavior, -such as the default string used for separating the results displayed -in the buffer." - (lambda (results) - (powerthesaurus--display-results - results - query-term - query-type))) - -(defun powerthesaurus--replace-text (replacement beg end original) - "Pick an alternative from response and replace the selected text. - -REPLACEMENT corresponds to the new text to be inserted in place of ORIGINAL. -BEG and END correspond to the bounds of the selected text to be replaced." - (delete-region beg end) - (powerthesaurus--insert-text replacement original (min beg end))) - -(defun powerthesaurus--preprocess-text (text reference) - "Adjust cases of TEXT according to REFERENCE. - -For now, it supports upcasing and capitalization." - (cond ((s-uppercase-p reference) (upcase text)) - ((s-capitalized-p reference) (capitalize text)) - (t text))) - -(defun powerthesaurus--insert-text (text reference &optional pnt) - "Insert TEXT at the point after preprocessing it according to REFERENCE. - -REFERENCE corresponds to the term whose query yielded TEXT. - -If optional argument PNT is given, the insert text there. Otherwise, -insert text under cursor." - (when pnt (goto-char pnt)) - (insert (powerthesaurus--preprocess-text text reference))) - -(defun powerthesaurus--insert-definition-as-text (definition) - "Insert given lookup DEFINITION as text into the current buffer." - (let ((pos (string-join (mapcar - (lambda (index) - (propertize - (oref (powerthesaurus--part-of-speech-of-index index) singular) - 'face 'powerthesaurus-definition-part-of-speech)) - (oref definition pos)) - ", ")) - (usages (string-join (mapcar (lambda (usage) - (propertize - (format "%S" usage) - 'face 'powerthesaurus-definition-usages)) - (oref definition usages)) - "\n")) - (definition (propertize (oref definition text) - 'face 'powerthesaurus-definition-definition)) - (author (propertize (oref definition author) - 'face 'powerthesaurus-definition-author)) - (synonyms (string-join (mapcar (lambda (synonym) - (propertize - synonym - 'face 'powerthesaurus-definition-synonyms)) - (oref definition synonyms)) - ", "))) - (when (> (length pos) 0) - (insert pos "\n\n")) - (insert definition "\n\n") - (when (> (length usages) 0) - (insert usages "\n\n")) - (when (> (length synonyms) 0) - (insert "synonyms: " synonyms "\n\n")) - (insert author))) - -(defun powerthesaurus--insert-sentence-as-text (sentence) - "Insert given lookup SENTENCE as text into the current buffer." - (let ((text (propertize (oref sentence text) - 'face 'powerthesaurus-sentence-sentence)) - (author (propertize (oref sentence author) - 'face 'powerthesaurus-sentence-author))) - (insert text) - (when (and (> (length author) 0) (not (string= author "unknown"))) - (insert "\n\n" author)))) - -(defun powerthesaurus--insert-as-text (result) - "Insert given lookup RESULT as text into the current buffer." - (cond - ((powerthesaurus-definition-p result) - (powerthesaurus--insert-definition-as-text result)) - ((powerthesaurus-sentence-p result) - (powerthesaurus--insert-sentence-as-text result)) - (t (insert (oref result text))))) - -(defun powerthesaurus--display-results (results query-term query-type - &optional sep) - "Display results on a dedicated buffer. - -RESULTS must be a list of `powerthesaurus-result' instances. -QUERY-TERM and QUERY-TYPE must be the text that was queried online -and the corresponding query type that yielded the results to be displayed. - -Optional argument SEP is the string that will be used to separate -the displayed results in the buffer. If not specified, -its default value varies depending on value of QUERY-TYPE." - (unless sep - (cond - ((member query-type '(:definitions :sentences)) - (setq sep "\n────────────────\n")) - (t (setq sep "\n")))) - (let* ((buf-name (format "*Powerthesaurus - \"%s\" - %s*" - query-term query-type)) - (buf-exists (get-buffer buf-name)) - (buf (or buf-exists (get-buffer-create buf-name)))) - (with-current-buffer buf - (when buf-exists - (fundamental-mode) - (read-only-mode -1) - (erase-buffer)) - (dolist (elt results) - (powerthesaurus--insert-as-text elt) - (insert "\n" - sep - (propertize "\014" 'display "") - "\n")) - (help-mode) - (goto-char (point-min))) - (pop-to-buffer buf))) - -(defun powerthesaurus--compose-completion-candidate (result) - "Compose completion candidate out of the given RESULT. - -RESULT should be an instance of `powerthesaurus-result'." - (let* ((text (oref result text)) - (rating (format "%s★ " (oref result rating)))) - (propertize text 'line-prefix rating))) - -(defun powerthesaurus--compose-completion-candidates (results) - "Compose completion candidates out of the given RESULTS. - -RESULT should be a list of `powerthesaurus-result'." - (if (not powerthesaurus-show-rating) - (mapcar (lambda (result) (oref result text)) results) - (let* ((ratings (mapcar - (lambda (result) (number-to-string (oref result rating))) - results)) - (maxlen (cl-reduce #'max (mapcar #'length ratings)))) - (cl-mapcar (lambda (result rating) - (let* ((len (length rating)) - (padding-len (1+ (- maxlen len))) - (padding (make-string padding-len ? )) - (rating-pretty (format "%s★%s" rating padding))) - (propertize (oref result text) 'line-prefix rating-pretty))) - results ratings)))) - -(defun powerthesaurus--annotate-candidate (candidate max-candidate-length) - "Annotate given completion CANDIDATE. - -MAX-CANDIDATE-LENGTH is the maximum length among all candidates, it is required -for proper annotation alignment." - (let* ((tags (string-join (oref candidate tags) ", ")) - (padding-len (- max-candidate-length (length (oref candidate text)))) - (padding (make-string padding-len ? )) - (pos (string-join (mapcar - (lambda (index) - (oref (powerthesaurus--part-of-speech-of-index index) shorter)) - (oref candidate pos)) - ", ")) - (annotation "")) - (when (and powerthesaurus-show-part-of-speech (> (length pos) 0)) - (setq annotation pos)) - (when (and powerthesaurus-show-tags (> (length tags) 0)) - (setq annotation (concat annotation "\t#" tags))) - (if (> (length annotation) 0) - (concat padding "\t\t\t" annotation) - ""))) - -(defun powerthesaurus--select-candidate (candidates) - "Prompt the user to select one of the CANDIDATES returned from a query." - (let* ((candidates-processed (powerthesaurus--compose-completion-candidates candidates)) - (candidates-by-text (mapcar - (lambda (candidate) `(,(oref candidate text) . ,candidate)) - candidates)) - (maxlen (cl-reduce #'max (mapcar - (lambda (candidate) (length (oref candidate text))) - candidates))) - ;; this is the only way we can keep the order while using - ;; the default implementation of completing-read function - ;; see: https://emacs.stackexchange.com/a/41808/23751 - (completion-table - (lambda (string pred action) - (if (eq action 'metadata) - `(metadata (display-sort-function . identity) - (cycle-sort-function . identity) - (annotation-function . ,(lambda (text) - (powerthesaurus--annotate-candidate - (assoc-default text candidates-by-text) - maxlen)))) - (complete-with-action - action candidates-processed string pred)))) - ;; ivy still will try to sort it lexicographically: deny it - (ivy-sort-functions-alist '((t . (lambda (x y) 0)))) - ;; ivy-rich can mess up our efforts of displaying rating - (ivy--display-transformers-alist nil)) - ;; If we try to call completing-read with an active company popup, - ;; we inherit its key map. That leads to some funny bugs (see issue#33). - (when (fboundp 'company-uninstall-map) - (company-uninstall-map)) - (substring-no-properties - (completing-read "Choose a candidate: " completion-table nil nil)))) - -;; =============================================================== -;; Requests and JSON parsing -;; =============================================================== - -(defclass powerthesaurus--part-of-speech nil - ((singular :initarg :singular :type string) - (plural :initarg :plural :type string) - (shorter :initarg :shorter :type string))) - -(defconst powerthesaurus-parts-of-speech - (vector - (powerthesaurus--part-of-speech :singular "adjective" - :plural "adjectives" - :shorter "adj.") - (powerthesaurus--part-of-speech :singular "noun" - :plural "nouns" - :shorter "n.") - (powerthesaurus--part-of-speech :singular "pronoun" - :plural "pronouns" - :shorter "pr.") - (powerthesaurus--part-of-speech :singular "adverb" - :plural "adverbs" - :shorter "adv.") - (powerthesaurus--part-of-speech :singular "idiom" - :plural "idioms" - :shorter "idi.") - (powerthesaurus--part-of-speech :singular "verb" - :plural "verbs" - :shorter "v.") - (powerthesaurus--part-of-speech :singular "interjection" - :plural "interjections" - :shorter "int.") - (powerthesaurus--part-of-speech :singular "phrase" - :plural "phrases" - :shorter "phr.") - (powerthesaurus--part-of-speech :singular "conjunction" - :plural "conjunctions" - :shorter "conj.") - (powerthesaurus--part-of-speech :singular "preposition" - :plural "prepositions" - :shorter "prep.") - (powerthesaurus--part-of-speech :singular "phrasal verb" - :plural "phrasal verbs" - :shorter "phr. v.")) - "All parts of speech supported by powerthesaurus.") - -(defun powerthesaurus--part-of-speech-of-index (index) - "Return the POS info for the given API INDEX." - (elt powerthesaurus-parts-of-speech (1- index))) - -(jeison-defclass powerthesaurus-result nil - ((text :initarg :text :type string :path (node targetTerm name) - :documentation "Actual text of the word from Powerthesaurus") - (rating :initarg :rating :type number :path (node rating) - :documentation "User rating of the word") - (tags :initarg :tags :type (list-of string) :path (node relations tags) - :documentation "Tags of the word") - (pos :initarg :pos :type (list-of number) :path (node relations parts_of_speech) - :documentation "Parts of speech indicies (1-based) of the word"))) - -(defun powerthesaurus--get-synonym-names (json-array) - "For the given synonym JSON-ARRAY, return its name as string." - (mapcar (lambda (json) (jeison-read 'string json '(name))) json-array)) - -(jeison-defclass powerthesaurus-definition nil - ((text :initarg :text :type string :path (node definition) - :documentation "Definition from Powerthesaurus") - (rating :initarg :rating :type number :path (node rating) - :documentation "User rating of the definition") - (synonyms :initarg :synonyms :type (list-of string) - :path (node (powerthesaurus--get-synonym-names synonyms)) - :documentation "List of synonyms for the definition") - (usages :initarg :usages :type (list-of string) :path (node usages) - :documentation "List of usages for the definition") - (author :initarg :author :type string :path (node author title) - :documentation "Original author of the definition") - (pos :initarg :pos :type (list-of number) :path (node partsOfSpeech) - :documentation "Parts of speech indicies (1-based) of the definition"))) - -(jeison-defclass powerthesaurus-sentence nil - ((text :initarg :text :type string :path (node sentence) - :documentation "Sentence example from Powerthesaurus") - (rating :initarg :rating :type number :path (node rating) - :documentation "User rating of the sentence") - (author :initarg :author :type string :path (node author title) - :documentation "Original author of the sentence"))) - -(defun powerthesaurus--query (term type &optional callback sync) - "Make a query to Powerthesaurus. - -TERM is the main text of the query. -TYPE should be a query type for thesaurus (e.g. ':synonyms' or ':related'). -CALLBACK gets called whenever the response is received and processed. -SYNC is t for synchronous version of the request." - (let ((query (pcase type - ((pred powerthesaurus--is-thesaurus-query-type) - #'powerthesaurus--query-thesaurus) - (:definitions #'powerthesaurus--query-definition) - (:sentences #'powerthesaurus--query-sentence) - (_ (error "Unknown query type '%s'" type))))) - (funcall query term type callback sync))) - -(defun powerthesaurus--request-term-id (term callback &optional sync) - "Request id for the given TERM. - -CALLBACK gets called whenever the response is received and processed. -SYNC is t for synchronous version of the request. - -Powerthesaurus APIs require explicit IDs assigned to every term. -This request fetches it for the further use." - (powerthesaurus--query-impl - `(("query" . ,term)) - powerthesaurus--search-query - callback - (lambda (data) (jeison-read t data '(data search terms 0 id))) - sync)) - -(defmacro powerthesaurus--with-term-id (term name sync &rest body) - "Request id for the given TERM, bind it to NAME, and execute BODY. - -TERM is the term to get ID for. -SYNC is t for synchronous version of the request." - (declare (indent 3) (debug t)) - `(let ((on-success - (lambda (,name) - ,@body))) - (powerthesaurus--request-term-id ,term on-success ,sync))) - -(defun powerthesaurus--query-thesaurus (term type &optional callback sync) - "Request thesaurus information from Powerthesaurus. - -TERM is the text to get definition for. -TYPE should be a query type for thesaurus (e.g. ':synonyms' or ':related'). -CALLBACK gets called whenever the response is received and processed. -SYNC is t for synchronous version of the request." - (powerthesaurus--with-term-id term term-id sync - (powerthesaurus--query-impl - `(("type" . ,(powerthesaurus--type-of-thesaurus-query type)) - ("termID" . ,term-id) - ("sort" . - (("field" . "RATING") - ("direction" . "DESC")))) - powerthesaurus--thesaurus-query - callback - (lambda (data) (jeison-read '(list-of powerthesaurus-result) data '(data thesauruses edges))) - sync))) - -(defun powerthesaurus--is-thesaurus-query-type (query-type) - "Return 't' if the given QUERY-TYPE is for thesaurus queries." - (member query-type '(:synonyms :antonyms :related))) - -(defun powerthesaurus--type-of-thesaurus-query (type) - "Return an API type corresponding to the given query TYPE." - (pcase type - (:synonyms "SYNONYM") - (:antonyms "ANTONYM") - (:related "RELATED") - (_ (error "Unknown thesaurus query type '%s'" type)))) - -(defun powerthesaurus--query-definition (term type &optional callback sync) - "Request definitions from Powerthesaurus. - -TERM is the text to get definition for. -TYPE should be nothing but ':definitions'. -CALLBACK gets called whenever the response is received and processed. -SYNC is t for synchronous version of the request." - (powerthesaurus--with-term-id term term-id sync - (powerthesaurus--query-impl - `(("termID" . ,term-id)) - powerthesaurus--definition-query - callback - (lambda (data) (jeison-read '(list-of powerthesaurus-definition) data '(data definitions edges))) - sync))) - -(defun powerthesaurus--query-sentence (term type &optional callback sync) - "Request sentences from Powerthesaurus. - -TERM is the text for sentence examples. -TYPE should be nothing but ':sentences'. -CALLBACK gets called whenever the response is received and processed. -SYNC is t for synchronous version of the request." - (powerthesaurus--with-term-id term term-id sync - (powerthesaurus--query-impl - `(("termID" . ,term-id)) - powerthesaurus--sentence-query - callback - (lambda (data) (jeison-read '(list-of powerthesaurus-sentence) data '(data sentences edges))) - sync))) - -(defun powerthesaurus--query-impl (variables query &optional callback postprocess sync) - "Request data from Powerthesaurus GraphQL API. - -VARIABLES is an alist of query-specific parameters. -QUERY is the actual GraphQL query. -CALLBACK gets called whenever the response is received and processed. -POSTPROCESS is the additional processing of the JSON response alist. -SYNC is t for synchronous version of the request." - (make-local-variable 'url-show-status) - (let* ((post (or postprocess 'identity)) - (sync (or (null callback) - sync - powerthesaurus-synchronous-requests)) - (url-request-data (json-encode `(("variables" . ,variables) - ("query" . ,query)))) - (url-request-extra-headers powerthesaurus-request-headers) - (url-request-method "POST") - ;; User agent has to be set separately like this, so that - ;; url-retrieve won't add anything else to it. - (url-user-agent powerthesaurus-user-agent) - ;; Prohibit it from writing "Contacting host:..." every - ;; time we send a request, it's not informative. - (url-show-status nil) - (callback (lambda (&rest _) - (with-local-quit - (let* ((raw (string-trim - (buffer-substring - url-http-end-of-headers (point-max)))) - ;; TODO: parse JSON more efficiently - ;; if native method is available - (json (json-read-from-string raw)) - (data (funcall post json))) - (funcall callback data)))))) - (if (not sync) - (url-retrieve powerthesaurus-api-url callback) - (with-current-buffer - (url-retrieve-synchronously powerthesaurus-api-url) - (funcall callback))))) - -(defun powerthesaurus--wrap-as-callback (fun) - "Wrap the given FUN function as a `request' callback." - (cl-function - (lambda (&key data &allow-other-keys) - ;; in order to allow users to quit powerthesaurus - ;; prompt with C-g, we need to wrap callback with this - (with-local-quit (funcall fun data))))) - -;; =============================================================== -;; Define old API's now deprecated functions. -;; =============================================================== - -;;;###autoload -(defun powerthesaurus-lookup-word-dwim () - "Wrapper function for powerthesaurus-lookup-word commands. - -If a region is selected use powerthesaurus-lookup-word -if a thing at point is not empty use powerthesaurus-lookup-word-at-point -otherwise as for word using powerthesaurus-lookup-word" - (interactive) - (let (beg end) - ;; selection is active -> look up whatever is selected - (if (use-region-p) - (progn - (setq beg (region-beginning)) - (setq end (region-end)) - (powerthesaurus-lookup-word beg end)) - ;; point is is at a word -> look it up - (if (thing-at-point 'word) - (powerthesaurus-lookup-word-at-point (point)) - ;; nothing appropriate nearby -> ask the user - (powerthesaurus-lookup-word))))) - -;;;###autoload -(defun powerthesaurus-lookup-word-at-point (word-point) - "Find word at `WORD-POINT', look it up in powerthesaurs, and replace it." - (interactive (list (point))) - (pcase-let ((`(,word ,beg ,end) - (powerthesaurus--extract-original-word word-point))) - (powerthesaurus-lookup word :synonyms beg end))) - -;;;###autoload -(defun powerthesaurus-lookup-word (&optional beginning end) - "Find the given word's synonyms at powerthesaurus.org. - -`BEGINNING' and `END' correspond to the selected text with a word to replace. -If there is no selection provided, additional input will be required. -In this case, a selected synonym will be inserted at the point." - (interactive - ;; it is a simple interactive function instead of interactive "r" - ;; because it doesn't produce an error in a buffer without a mark - (if (use-region-p) (list (region-beginning) (region-end)) - (list nil nil))) - (pcase-let ((`(,word _ _) - (if beginning - (powerthesaurus--extract-query-region beginning end) - (powerthesaurus--read-query-term "Word to fetch: ")))) - (powerthesaurus-lookup word :synonyms (or beginning (point)) end))) - -(make-obsolete 'powerthesaurus-lookup-word - 'powerthesaurus-lookup "0.2.0") -(make-obsolete 'powerthesaurus-lookup-word-at-point - 'powerthesaurus-lookup "0.2.0") -(make-obsolete 'powerthesaurus-lookup-word-dwim - 'powerthesaurus-lookup "0.2.0") - -;; =============================================================== -;; GraphQL queries -;; =============================================================== - -(defconst powerthesaurus--search-query - "query SEARCH($query: String!) { - search(query: $query) { - terms { - id - name - } - } -}") - -(defconst powerthesaurus--thesaurus-query - "query THESAURUS($termID: ID!, $type: List!, $sort: ThesaurusSorting!) { - thesauruses(termId: $termID, sort: $sort, list: $type) { - edges { - node { - targetTerm { - name - } - relations - rating - votes - } - } - } -}") - -(defconst powerthesaurus--definition-query - "query DEFINITION($termID: ID!) { - definitions(termId: $termID) { - edges { - node { - definition - rating - votes - synonyms - usages - partsOfSpeech - author { - title - } - } - } - } -}") - -(defconst powerthesaurus--sentence-query - "query SENTENCE($termID: ID!) { - sentences(termId: $termID) { - edges { - node { - sentence - rating - votes - author { - title - } - } - } - } -}") - -;; =============================================================== -;; UI shortcuts -;; =============================================================== - -;;;###autoload -(when (require 'hydra nil :noerror) - (eval '(defhydra powerthesaurus-hydra (:color blue :hint nil) - " - Power Thesaurus - ^Similarity^ ^Information^ - --------------------------------------- - _s_: Synonyms _d_: Definitions - _a_: Antonyms _e_: Example Sentences - _r_: Related Words - _q_: Quit - " - ("s" powerthesaurus-lookup-synonyms-dwim) - ("a" powerthesaurus-lookup-antonyms-dwim) - ("r" powerthesaurus-lookup-related-dwim) - ("d" powerthesaurus-lookup-definitions-dwim) - ("e" powerthesaurus-lookup-sentences-dwim) - ("q" nil)))) - -;;;###autoload -(when (require 'transient nil :noerror) - (eval '(transient-define-prefix powerthesaurus-transient () - "Transient for Power Thesaurus." - [["Similarity" - ("s" "Synonyms" powerthesaurus-lookup-synonyms-dwim) - ("a" "Antonyms" powerthesaurus-lookup-antonyms-dwim) - ("r" "Related Words" powerthesaurus-lookup-related-dwim)] - ["Information" - ("d" "Definitions" powerthesaurus-lookup-definitions-dwim) - ("e" "Example Sentences" powerthesaurus-lookup-sentences-dwim)]]))) - -(provide 'powerthesaurus) -;;; powerthesaurus.el ends here diff --git a/.config/emacs/libraries/selector.el b/.config/emacs/libraries/selector.el deleted file mode 100644 index 3b77190..0000000 --- a/.config/emacs/libraries/selector.el +++ /dev/null @@ -1,653 +0,0 @@ -;;; -*- lexical-binding: t; -*- -;;; Commentary: - -;; modified version of lcolonq: https://github.com/lcolonq/emacs - -;;; Code: - - -(require 'dash) -(require 'recentf) - -(defgroup selector nil - "Efficient selection and navigation." - :group 'convenience) - -(defgroup selector-faces nil - "Faces for `selector'." - :group 'selector - :group 'faces) - -(defface selector-source-name - '((default :underline t :inherit bold) - (((class color) (background dark)) :foreground "white")) - "Face used to highlight source names.") - -(defface selector-highlight - '((t :inherit highlight)) - "Face used to highlight the current selection.") - -(defvar selector-minibuffer-lines 20 - "Number of lines to display in the minibuffer.") - -(defvar selector-exit-hook nil - "Hook run when exiting minibuffer selection.") - -(defvar selector--sources '()) -(defvar selector--last nil) -(defvar selector--matching '()) -(defvar selector--source 0) -(defvar selector--index 0) -(defvar selector--action nil) -(defvar selector--result nil) -(defvar selector--drawn-this-frame 0) - -(defvar selector-minibuffer-map (make-sparse-keymap)) -(define-key selector-minibuffer-map (kbd "\\") (lambda () (interactive) nil)) -(define-key selector-minibuffer-map (kbd "C-g") 'selector-quit) -(define-key selector-minibuffer-map (kbd "C-c") 'selector-quit) -(define-key selector-minibuffer-map (kbd "") 'selector-do) -(define-key selector-minibuffer-map (kbd "C-m") 'selector-do) -(define-key selector-minibuffer-map (kbd "") 'selector-previous) -(define-key selector-minibuffer-map (kbd "") 'selector-next) -(define-key selector-minibuffer-map (kbd "") 'selector-previous) -(define-key selector-minibuffer-map (kbd "") 'selector-next) -(define-key selector-minibuffer-map (kbd "") 'selector-previous-source) -(define-key selector-minibuffer-map (kbd "") 'selector-next-source) -(define-key selector-minibuffer-map (kbd "C-p") 'selector-previous) -(define-key selector-minibuffer-map (kbd "C-n") 'selector-next) -(define-key selector-minibuffer-map (kbd "M-v") 'selector-previous-source) -(define-key selector-minibuffer-map (kbd "C-v") 'selector-next-source) - -(defun selector-minibuffer-line-face (str face) - "Write STR to the minibuffer in FACE." - (cl-incf selector--drawn-this-frame) ;; sort of an ugly hack, - ;; but this fixes the annoying "cursor jumping" glitch when multiple monitors - ;; are active. the real fix probably should live in selector-nearby? - (when (< selector--drawn-this-frame selector-minibuffer-lines) - (let ((before (point))) - (goto-char (point-max)) - (insert (concat "\n" str)) - (goto-char before) - (forward-line) - (put-text-property (line-beginning-position) (point-max) 'face face)))) - -(defun selector-minibuffer-clear () - "Clear minibuffer." - (save-excursion - (goto-char (minibuffer-prompt-end)) - (delete-region (line-end-position) (point-max)))) - -(defun selector-minibuffer-input () - "Get current minibuffer input." - (buffer-substring-no-properties - (minibuffer-prompt-end) - (line-end-position))) - -(cl-defstruct (selector-candidate (:constructor selector-candidate--create) - (:copier nil) - (:conc-name selector-candidate--)) - type (display nil :type string) face value action) - -(cl-defun selector-candidate-create - (display &key - value - (type 'normal) - (face 'default) - (action '())) - "Create a candidate. -DISPLAY is the string to display (using FACE) / match against. -VALUE is the value to pass to actions when the candidate is selected. -TYPE is either normal or dummy - dummy candidates always appear in the -results list regardless of the input pattern. -ACTION is an alist mapping keybindings to candidate-specific actions." - (selector-candidate--create - :type type - :display display - :face face - :value (if value value display) - :action action)) - -(defun selector-candidate-display (candidate) - "Return the display string for CANDIDATE." - (cond ((selector-candidate-p candidate) (selector-candidate--display candidate)) - (t candidate))) - -(defun selector-candidate-value (candidate) - "Return the value of CANDIDATE." - (cond ((selector-candidate-p candidate) (selector-candidate--value candidate)) - (t candidate))) - -(defun selector-candidate-type (candidate) - "Return the candidate type of CANDIDATE." - (cond ((selector-candidate-p candidate) (selector-candidate--type candidate)) - (t 'normal))) - -(defun selector-candidate-face (candidate) - "Return the display face for CANDIDATE." - (cond ((selector-candidate-p candidate) (selector-candidate--face candidate)) - (t 'default))) - -(defun selector-candidate-action (candidate) - "Return the actions for CANDIDATE." - (cond ((selector-candidate-p candidate) (selector-candidate--action candidate)) - (t '()))) - -(defun selector-candidate-display-string (candidate) - "Return the display of CANDIDATE as a string." - (let ((display (selector-candidate-display candidate))) - (cond ((stringp display) display) - (t (error "Invalid candidate display %s for candidate %s (of type %s)" - display candidate (type-of display)))))) - -(defun selector-highlight-candidate (candidate) - "Return a copy of CANDIDATE with the face set to selector-highlight." - (selector-candidate--create - :type (selector-candidate-type candidate) - :display (selector-candidate-display candidate) - :face 'selector-highlight - :value (selector-candidate-value candidate) - :action (selector-candidate-action candidate))) - -(defun selector-match (candidate regex) - "Determine whether CANDIDATE is a match for REGEX." - (let ((type (selector-candidate-type candidate))) - (cond ((eq 'dummy type) t) - (t (string-match-p regex (selector-candidate-display-string candidate)))))) - -(cl-defstruct (selector-source (:constructor selector-source--create) - (:copier nil)) - name candidates actions keymap) - -(defun selector-action-function (action) - "Return the function associated with ACTION." - (if (functionp action) - action - (cdr action))) - -(defun selector-actions-keymap (actions) - "Return a keymap for ACTIONS." - (let ((keymap (make-sparse-keymap))) - (set-keymap-parent keymap selector-minibuffer-map) - (mapc - (lambda (a) - (unless (functionp a) - (define-key keymap (car a) - (lambda () (interactive) - (selector-do (cdr a)))))) - actions) - keymap)) - -(cl-defun selector-source-create (name &key candidates (actions '())) - "Create a new source named NAME with the given CANDIDATES and ACTIONS. - -CANDIDATES is either: -- A list of candidates -- A function returning a list of candidates given a regex -ACTIONS is a list of actions, which can be: -- functions taking candidate values as arguments -- pairs of key strings and such functions" - (selector-source--create - :name name - :candidates - (if (functionp candidates) candidates - (--map (if (selector-candidate-p it) it (selector-candidate-create it)) - candidates)) - :actions actions - :keymap (selector-actions-keymap actions))) - -(defun selector-matching-candidates (candidates pattern) - "Return the candidates in CANDIDATES matching PATTERN." - (cond ((functionp candidates) (funcall candidates pattern)) - (t (let ((regex (selector-pattern-regex pattern))) - (--filter (selector-match it regex) candidates))))) - -(defun selector-filter-source (source pattern) - "Return a copy of SOURCE including only the candidates matching PATTERN." - (selector-source--create - :name (selector-source-name source) - :candidates (selector-matching-candidates (selector-source-candidates source) pattern) - :actions (selector-source-actions source) - :keymap (selector-source-keymap source))) - -(defun selector-pattern-regex (pattern) - "Convert PATTERN into a regular expression." - (apply #'string-join - (--map (concat "\\(" it "\\)") (split-string pattern)) - '(".*"))) - -(defun selector-matching-sources (sources pattern) - "Return the sources in SOURCES matching PATTERN." - (let* ((matches (--map (selector-filter-source it pattern) sources))) - (-filter #'selector-source-candidates matches))) - -(defun selector-display-source (source) - "Display SOURCE." - (when source - (selector-minibuffer-line-face (selector-source-name source) 'selector-source-name) - (--map (selector-minibuffer-line-face - (selector-candidate-display-string it) - (selector-candidate-face it)) - (selector-source-candidates source)))) - -(defun selector-nearby (sources) - "Filter SOURCES to only include candidates close to the selected candidate." - (let* ((adjacent - (--map - (cond ((and (< (cdr it) (+ selector--source selector-minibuffer-lines)) - (> (cdr it) selector--source)) - (cons (car it) 'g)) - ((= (cdr it) selector--source) - (cons (car it) 'e)) - (t nil)) - (-zip-pair sources (number-sequence 0 (length sources)))))) - (--map - (when it - (let* ((candidates (selector-source-candidates (car it)))) - (selector-source--create - :name (selector-source-name (car it)) - :candidates - (cond ((eq (cdr it) 'g) - (-take selector-minibuffer-lines candidates)) - (t - (cl-loop for i from (max (- selector--index - (- (/ selector-minibuffer-lines 2) 1)) - 0) - for j in (-take - selector-minibuffer-lines - (-drop - (- selector--index - (- (/ selector-minibuffer-lines 2) 1)) - candidates)) - collect (if (= i selector--index) - (selector-highlight-candidate j) - j)))) - :actions (selector-source-actions (car it)) - :keymap (selector-source-keymap (car it))))) - adjacent))) - -(defun selector-update-transient-map () - "Update the transient keymap to match the current source." - (let ((source (car (nthcdr selector--source selector--matching)))) - (when source - (set-transient-map (selector-source-keymap source))))) - -(defun selector-minibuffer-render () - "Draw matching candidates to minibuffer." - (setq selector--drawn-this-frame 0) - (save-excursion - (let ((pattern (selector-minibuffer-input))) - (unless (string= pattern selector--last) - (setq selector--last pattern - selector--index 0 - selector--source 0 - selector--matching (selector-matching-sources selector--sources pattern)))) - (-map #'selector-display-source (selector-nearby selector--matching)) - (goto-char (minibuffer-prompt-end)) - (put-text-property (line-end-position) (point-max) 'readonly t)) - (selector-update-transient-map)) - -(defun selector-minibuffer-setup (initial) - "Ready minibuffer for completion with INITIAL as initial input." - (add-hook 'pre-command-hook 'selector-minibuffer-clear nil t) - (add-hook 'post-command-hook 'selector-minibuffer-render nil t) - (setq-local max-mini-window-height selector-minibuffer-lines) - (when initial - (save-excursion - (minibuffer-prompt-end) - (insert initial))) - (end-of-line) - (selector-update-transient-map)) - -(defun selector-previous-source () - "Move to the previous source." - (interactive) - (setq selector--index 0) - (setq selector--source (if (= selector--source 0) - (- (length selector--matching) 1) - (- selector--source 1)))) - -(defun selector-next-source () - "Move to the next source." - (interactive) - (setq selector--index 0) - (setq selector--source (% (+ selector--source 1) (length selector--matching)))) - -(defun selector-previous () - "Move to the previous candidate." - (interactive) - (let* ((new-source-index (if (= selector--source 0) - (- (length selector--matching) 1) - (- selector--source 1))) - (source (car (nthcdr new-source-index selector--matching)))) - (setq selector--index (- selector--index 1)) - (when (< selector--index 0) - (setq selector--index (- (length (selector-source-candidates source)) 1) - selector--source new-source-index)))) - -(defun selector-next () - "Move to the next candidate." - (interactive) - (let* ((source (car (nthcdr selector--source selector--matching)))) - (setq selector--index (+ selector--index 1)) - (when (= selector--index (length (selector-source-candidates source))) - (setq selector--index 0 - selector--source (% (+ selector--source 1) (length selector--matching)))))) - -(defun selector-quit () - "Quit the selection interface without running an action." - (interactive) - (run-hooks 'selector-exit-hook) - (keyboard-escape-quit)) - -(defun selector-do (&optional action-function) - "Act upon selected candidate. -If ACTION-FUNCTION is given use it, otherwise use the first action for the candidate." - (interactive) - (if (null selector--matching) - (progn - (setq selector--action (lambda (x) x) - selector--result nil)) - (progn - (let* ((source (car (nthcdr selector--source selector--matching))) - (candidate (car (nthcdr selector--index (selector-source-candidates source))))) - (setq selector--action (cond (action-function - action-function) - ((selector-candidate-action candidate) - (selector-candidate-action candidate)) - (t - (let ((actions (selector-source-actions source))) - (if actions - (selector-action-function (car actions)) - (lambda (x) x))))) - selector--result (selector-candidate-value candidate))))) - (run-hooks 'selector-exit-hook) - (exit-minibuffer)) - -;;;###autoload -(cl-defun selector (sources &key prompt initial) - "Select a candidate and run an action using SOURCES. -Display PROMPT as the prompt, or \"pattern: \" if not given. -Use INITIAL as the initial input." - (setq selector--sources sources - selector--last nil - selector--matching (selector-matching-sources sources "") - selector--source 0 - selector--index 0 - selector--action nil - selector--result nil) - (let ((inhibit-message t)) - (minibuffer-with-setup-hook - (apply-partially 'selector-minibuffer-setup initial) - (read-from-minibuffer (or prompt "pattern: ") nil selector-minibuffer-map))) - (funcall selector--action selector--result)) - -(defvar selector-completing-read-candidate-transformer (lambda (x) x)) - -;;;###autoload -(defun selector-completing-read (prompt collection &optional predicate require-match - initial-input hist def inherit-input-method) - "Replacement for `completing-read'. -PROMPT, COLLECTION, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST, DEF, and -INHERIT-INPUT-METHOD have the same meaning as in `completing-read'." - (ignore predicate hist def inherit-input-method) - (let ((unspecified-source - (if require-match - '() - (list - (selector-source-create - "Other" - :candidates - (list (selector-candidate-create - "Specify" - :type 'dummy - :action (lambda (_) (selector-input))))))))) - (or - (cond ((functionp collection) - (selector - (cons - (selector-source-create - "Completions" - :candidates - (-non-nil - (--map - (when-let ((disp (funcall selector-completing-read-candidate-transformer it))) - (selector-candidate-create disp :value it)) - (funcall collection "" nil t)))) - unspecified-source) - :prompt prompt - :initial initial-input)) - ((hash-table-p collection) - (selector - (cons - (selector-source-create - "Completions" - :candidates (hash-table-keys collection)) - unspecified-source) - :prompt prompt - :initial initial-input)) - ((obarrayp collection) - (let ((candidates (list))) - (mapatoms (lambda (x) (push (selector-candidate-create (symbol-name x)) candidates)) collection) - (selector - (cons (selector-source-create "Completions" :candidates candidates) unspecified-source) - :prompt prompt - :initial initial-input))) - (t (selector - (cons (selector-source-create - "Completions" - :candidates - (--map (if (consp it) - (selector-candidate-create (car it)) - it) - collection)) - unspecified-source) - :prompt prompt - :initial initial-input))) - (selector-input)))) - -(defun selector-input () "Return last minibuffer input." selector--last) - -(defvar selector-extended-command-actions - (list (lambda (c) - (add-to-list 'extended-command-history c) - (command-execute (intern-soft c))) - (cons (kbd "C-h") (lambda (c) (describe-function (intern-soft c)))))) - -;;;###autoload -(defun selector-extended-commands-source () - "Source for extended commands (`M-x')." - (selector-source-create - "Commands" - :candidates - (-map - #'selector-candidate-create - (all-completions "" obarray #'commandp)) - :actions - selector-extended-command-actions)) - -;;;###autoload -(defun selector-extended-command-history-source () - "Source for extended command history." - (selector-source-create - "Command History" - :candidates - (-map - #'selector-candidate-create - extended-command-history) - :actions - selector-extended-command-actions)) - -;;;###autoload -(defun selector-apropos-command-source () - "Source for command lookup." - (selector-source-create - "Commands" - :candidates - (lambda (r) (-map #'selector-candidate-create (all-completions r obarray #'commandp))) - :actions - (list (lambda (c) (describe-function (intern-soft c)))))) - -;;;###autoload -(defun selector-apropos-function-source () - "Source for function lookup." - (selector-source-create - "Functions" - :candidates - (lambda (r) (-map #'selector-candidate-create (all-completions r obarray #'fboundp))) - :actions - (list (lambda (c) (describe-function (intern-soft c)))))) - -;;;###autoload -(defun selector-apropos-variable-source () - "Source for variable lookup." - (selector-source-create - "Variables" - :candidates - (lambda (r) (-map #'selector-candidate-create - (all-completions - r obarray - (lambda (x) (let ((sym (intern-soft x))) - (and (boundp sym) (not (keywordp sym)))))))) - :actions - (list (lambda (c) (describe-variable (intern-soft c)))))) - -(defvar selector-buffer-actions - (list 'switch-to-buffer - (cons (kbd "C-k") 'kill-buffer))) - -;;;###autoload -(defun selector-buffers-source (&optional sort-pred) - "Source for open buffers. -An optional SORT-PRED may be provided to sort the buffers (see `sort')." - (selector-source-create - "Buffers" - :candidates - (--map (selector-candidate-create (buffer-name it)) - (if sort-pred (sort (buffer-list) sort-pred) (buffer-list))) - :actions - selector-buffer-actions)) - -;;;###autoload -(defun selector-create-buffer-source () - "Dummy source to create a buffer." - (selector-source-create - "Other" - :candidates - (list (selector-candidate-create - "Create buffer" - :type 'dummy - :action (lambda (_) (switch-to-buffer (selector-input))))))) - -(defvar selector-file-actions - (list 'find-file - (cons (kbd "C-d") (lambda (f) - (when (y-or-n-p (concat "Delete file " f "? ")) - (delete-file f)))))) - -;;;###autoload -(defun selector-files-source () - "Source for files in current directory." - (selector-source-create - "Files" - :candidates - (-map #'selector-candidate-create (directory-files default-directory)) - :actions - selector-file-actions)) - -;;;###autoload -(defun selector-create-file-source () - "Dummy source to create a file." - (selector-source-create - "Other" - :candidates - (list (selector-candidate-create - "Create file" - :type 'dummy - :action (lambda (_) (find-file (selector-input))))))) - -;;;###autoload -(defun selector-recentf-source () - "Source for recentf." - (selector-source-create - "Recent Files" - :candidates - (-map #'selector-candidate-create recentf-list) - :actions - selector-file-actions)) - -;;;###autoload -(defun selector-M-x () - "Preconfigured `selector' interface to replace `execute-external-command'." - (interactive) - (selector (list (selector-extended-command-history-source) - (selector-extended-commands-source)))) - -;;;###autoload -(defun selector-apropos (&optional initial) - "Preconfigured `selector' interface to replace `apropos'. -INITIAL is the initial text to match." - (interactive) - (selector (list (selector-apropos-command-source) - (selector-apropos-function-source) - (selector-apropos-variable-source)) - :initial (if initial initial (thing-at-point 'symbol t)))) - -;;;###autoload -(defun selector-for-buffers () - "Preconfigured `selector' interface for open buffers and recentf." - (interactive) - (selector (list (selector-buffers-source) - (selector-recentf-source) - (selector-create-buffer-source)))) - -;;;###autoload -(defun selector-for-files () - "Preconfigured `selector' interface for files in the current directory." - (interactive) - (selector (list (selector-files-source) - (selector-create-file-source)))) - -;;;###autoload -(defun selector-read-file-name (prompt &optional dir default-filename mustmatch initial predicate) - "Replacement for `read-file-name'. -PROMPT, DIR, DEFAULT-FILENAME, MUSTMATCH, INITIAL and PREDICATE have the same -meaning as in `read-file-name'." - (ignore default-filename mustmatch predicate) - (let ((d (if dir dir default-directory))) - (concat d (selector (list (selector-source-create - "Files" - :candidates (-map #'selector-candidate-create (directory-files d))) - (selector-source-create - "Other" - :candidates (list (selector-candidate-create - "New file" - :type 'dummy - :action (lambda (_) (selector-input)))))) - :prompt prompt - :initial initial)))) - -(defun selector-file-contents-actions (file) - "Actions for candidate values corresponding to lines in FILE." - (list - (lambda (index) - (find-file file) - (goto-char (point-min)) - (forward-line index) - (pulse-momentary-highlight-one-line (point))))) - -(defun selector-file-contents-source (file) - "Source for lines in FILE." - (selector-source-create - file - :candidates - (-map-indexed - (lambda (index l) - (selector-candidate-create l :value index)) - (split-string (f-read-text file) "\n")) - :actions - (selector-file-contents-actions file))) - - -(provide 'selector) -;;; selector.el ends here -- cgit v1.2.3