diff options
Diffstat (limited to 'tools/emacs-pkgs')
-rw-r--r-- | tools/emacs-pkgs/FSF_OWNERS | 6 | ||||
-rw-r--r-- | tools/emacs-pkgs/buildEmacsPackage.nix | 30 | ||||
-rw-r--r-- | tools/emacs-pkgs/nix-util/default.nix | 1 | ||||
-rw-r--r-- | tools/emacs-pkgs/nix-util/nix-util.el | 40 | ||||
-rw-r--r-- | tools/emacs-pkgs/notable/OWNERS | 3 | ||||
-rw-r--r-- | tools/emacs-pkgs/notable/default.nix | 4 | ||||
-rw-r--r-- | tools/emacs-pkgs/passively/OWNERS | 1 | ||||
-rw-r--r-- | tools/emacs-pkgs/passively/README.md | 76 | ||||
-rw-r--r-- | tools/emacs-pkgs/passively/default.nix | 8 | ||||
-rw-r--r-- | tools/emacs-pkgs/passively/passively.el | 121 | ||||
-rw-r--r-- | tools/emacs-pkgs/term-switcher/term-switcher.el | 40 | ||||
-rw-r--r-- | tools/emacs-pkgs/treecrumbs/OWNERS | 2 | ||||
-rw-r--r-- | tools/emacs-pkgs/treecrumbs/default.nix | 7 | ||||
-rw-r--r-- | tools/emacs-pkgs/treecrumbs/treecrumbs.el | 202 | ||||
-rw-r--r-- | tools/emacs-pkgs/tvl/OWNERS | 4 | ||||
-rw-r--r-- | tools/emacs-pkgs/tvl/tvl.el | 159 |
16 files changed, 624 insertions, 80 deletions
diff --git a/tools/emacs-pkgs/FSF_OWNERS b/tools/emacs-pkgs/FSF_OWNERS new file mode 100644 index 000000000000..32a278ca744b --- /dev/null +++ b/tools/emacs-pkgs/FSF_OWNERS @@ -0,0 +1,6 @@ +# Users with approval powers for code that requires FSF copyright +# assignment. Users added here should have FSF paperwork on file, and +# should - if changes to a covered project are made - verify that the +# committers also have done the paperwork. + +tazjin diff --git a/tools/emacs-pkgs/buildEmacsPackage.nix b/tools/emacs-pkgs/buildEmacsPackage.nix index 160c0626136d..990b53b763b0 100644 --- a/tools/emacs-pkgs/buildEmacsPackage.nix +++ b/tools/emacs-pkgs/buildEmacsPackage.nix @@ -16,19 +16,23 @@ buildArgs: -pkgs.callPackage({ emacsPackages }: +pkgs.callPackage + ({ emacsPackages }: -let - # Select external dependencies from the emacsPackages set - externalDeps = (buildArgs.externalRequires or (_: [])) emacsPackages; + let + # Select external dependencies from the emacsPackages set + externalDeps = (buildArgs.externalRequires or (_: [ ])) emacsPackages; - # Override emacsPackages for depot-internal packages - internalDeps = map (p: p.override { inherit emacsPackages; }) - (buildArgs.internalRequires or []); + # Override emacsPackages for depot-internal packages + internalDeps = map (p: p.override { inherit emacsPackages; }) + (buildArgs.internalRequires or [ ]); - trivialBuildArgs = builtins.removeAttrs buildArgs [ - "externalRequires" "internalRequires" - ] // { - packageRequires = externalDeps ++ internalDeps; - }; -in emacsPackages.trivialBuild trivialBuildArgs) {} + trivialBuildArgs = builtins.removeAttrs buildArgs [ + "externalRequires" + "internalRequires" + ] // { + packageRequires = externalDeps ++ internalDeps; + }; + in + emacsPackages.trivialBuild trivialBuildArgs) +{ } diff --git a/tools/emacs-pkgs/nix-util/default.nix b/tools/emacs-pkgs/nix-util/default.nix index ffeb1cefade7..b167cb964214 100644 --- a/tools/emacs-pkgs/nix-util/default.nix +++ b/tools/emacs-pkgs/nix-util/default.nix @@ -4,4 +4,5 @@ depot.tools.emacs-pkgs.buildEmacsPackage { pname = "nix-util"; version = "1.0"; src = ./nix-util.el; + externalRequires = epkgs: [ epkgs.s ]; } diff --git a/tools/emacs-pkgs/nix-util/nix-util.el b/tools/emacs-pkgs/nix-util/nix-util.el index 4b9dd31a022e..4ddc81f563d3 100644 --- a/tools/emacs-pkgs/nix-util/nix-util.el +++ b/tools/emacs-pkgs/nix-util/nix-util.el @@ -1,10 +1,11 @@ ;;; nix-util.el --- Utilities for dealing with Nix code. -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2019 Google Inc. +;; Copyright (C) 2022 The TVL Authors ;; ;; Author: Vincent Ambo <tazjin@google.com> ;; Version: 1.0 -;; Package-Requires: (json map) +;; Package-Requires: (json map s) ;; ;;; Commentary: ;; @@ -13,8 +14,7 @@ (require 'json) (require 'map) - -(defvar nix-depot-path "/home/tazjin/depot") +(require 's) (defun nix/prefetch-github (owner repo) ; TODO(tazjin): support different branches "Fetch the master branch of a GitHub repository and insert the @@ -66,38 +66,4 @@ :stderr errbuf :sentinel prefetch-handler))) -(defun nix/sly-from-depot (attribute) - "Start a Sly REPL configured with a Lisp matching a derivation - from my depot. - - The derivation invokes nix.buildLisp.sbclWith and is built - asynchronously. The build output is included in the error - thrown on build failures." - - (interactive "sAttribute: ") - (lexical-let* ((outbuf (get-buffer-create (format "*depot-out/%s*" attribute))) - (errbuf (get-buffer-create (format "*depot-errors/%s*" attribute))) - (expression (format "let depot = import <depot> {}; in depot.nix.buildLisp.sbclWith [ depot.%s ]" attribute)) - ;; TODO(tazjin): use <depot> - (command (list "nix-build" "--no-out-link" "-I" (format "depot=%s" nix-depot-path) "-E" expression))) - - (message "Acquiring Lisp for <depot>.%s" attribute) - (make-process :name (format "depot-nix-build/%s" attribute) - :buffer outbuf - :stderr errbuf - :command command - :sentinel - (lambda (process event) - (unwind-protect - (pcase event - ("finished\n" - (let* ((outpath (s-trim (with-current-buffer outbuf (buffer-string)))) - (lisp-path (s-concat outpath "/bin/sbcl"))) - (message "Acquired Lisp for <depot>.%s at %s" attribute lisp-path) - (sly lisp-path))) - (_ (with-current-buffer errbuf - (error "Failed to build '%s':\n%s" attribute (buffer-string))))) - (kill-buffer outbuf) - (kill-buffer errbuf)))))) - (provide 'nix-util) diff --git a/tools/emacs-pkgs/notable/OWNERS b/tools/emacs-pkgs/notable/OWNERS index f7da62ecf709..45c9222313b4 100644 --- a/tools/emacs-pkgs/notable/OWNERS +++ b/tools/emacs-pkgs/notable/OWNERS @@ -1,2 +1 @@ -owners: - - tazjin +tazjin diff --git a/tools/emacs-pkgs/notable/default.nix b/tools/emacs-pkgs/notable/default.nix index 8c6935fe886b..f57b1c66ae3f 100644 --- a/tools/emacs-pkgs/notable/default.nix +++ b/tools/emacs-pkgs/notable/default.nix @@ -6,7 +6,9 @@ depot.tools.emacs-pkgs.buildEmacsPackage rec { src = ./notable.el; externalRequires = epkgs: with epkgs; [ - f ht s + f + ht + s ]; internalRequires = [ diff --git a/tools/emacs-pkgs/passively/OWNERS b/tools/emacs-pkgs/passively/OWNERS new file mode 100644 index 000000000000..45c9222313b4 --- /dev/null +++ b/tools/emacs-pkgs/passively/OWNERS @@ -0,0 +1 @@ +tazjin diff --git a/tools/emacs-pkgs/passively/README.md b/tools/emacs-pkgs/passively/README.md new file mode 100644 index 000000000000..a5ac0d5a40bf --- /dev/null +++ b/tools/emacs-pkgs/passively/README.md @@ -0,0 +1,76 @@ +<!-- SPDX-License-Identifier: MIT --> +passively +========= + +Passively is an Emacs Lisp library for passively learning new +information in an Emacs instance. + +Passively works by displaying a random piece of information to be +learned in the Emacs echoline whenever Emacs is idle for a set amount +of time. + +It was designed to aid in language acquisition by passively displaying +new vocabulary to learn. + +Passively is configured with a corpus of information (a hash table +mapping string keys to string values) and maintains a set of terms +that the user already learned in a file on disk. + +## Configuration & usage + +Configure passively like this: + +```lisp +;; Configure the terms to learn. Each term should have a key and a +;; string value which is displayed. +(setq passively-learn-terms + (ht ("забыть" "забыть - to forget") + ("действительно" "действительно - indeed, really"))) + +;; Configure a file in which passively should store its state +;; (defaults to $user-emacs-directory/passively.el) +(setq passively-store-state "/persist/tazjin/passively.el") + +;; Configure after how many seconds of idle time passively should +;; display a new piece of information. +;; (defaults to 4 seconds) +(setq passively-show-after-idle-for 5) + +;; Once this configuration has been set up, start passively: +(passively-enable) + +;; Or, if it annoys you, disable it again: +(passively-disable) +``` + +These variables are registered with `customize` and may be customised +through its interface. + +### Known terms + +Passively exposes the interactive function +`passively-mark-last-as-known` which marks the previously displayed +term as known. This means that it will not be included in the random +selection anymore. + +### Last term + +Passively stores the key of the last known term in +`passively-last-displayed`. + +## Installation + +Inside of the TVL depot, you can install passively from +`pkgs.emacsPackages.tvlPackages.passively`. Outside of the depot, you +can clone passively like this: + + git clone https://code.tvl.fyi/depot.git:/tools/emacs-pkgs/passively.git + +Passively depends on `ht.el`. + +Feel free to contribute patches by emailing them to `depot@tvl.su`. + +## Use-cases + +I'm using passively to learn Russian vocabulary. Once I've cleaned up +my configuration for that, my Russian term list will be linked here. diff --git a/tools/emacs-pkgs/passively/default.nix b/tools/emacs-pkgs/passively/default.nix new file mode 100644 index 000000000000..ec59cc85fd8f --- /dev/null +++ b/tools/emacs-pkgs/passively/default.nix @@ -0,0 +1,8 @@ +{ depot, ... }: + +depot.tools.emacs-pkgs.buildEmacsPackage { + pname = "passively"; + version = "1.0"; + src = ./passively.el; + externalRequires = (epkgs: with epkgs; [ ht ]); +} diff --git a/tools/emacs-pkgs/passively/passively.el b/tools/emacs-pkgs/passively/passively.el new file mode 100644 index 000000000000..0d871f26add6 --- /dev/null +++ b/tools/emacs-pkgs/passively/passively.el @@ -0,0 +1,121 @@ +;;; passively.el --- Passively learn new information -*- lexical-binding: t; -*- +;; +;; SPDX-License-Identifier: MIT +;; Copyright (C) 2020 The TVL Contributors +;; +;; Author: Vincent Ambo <tazjin@tvl.su> +;; Version: 1.0 +;; Package-Requires: (ht seq) +;; URL: https://code.tvl.fyi/about/tools/emacs-pkgs/passively/ +;; +;; This file is not part of GNU Emacs. + +(require 'ht) +(require 'seq) + +;; Customisation options + +(defgroup passively nil + "Customisation options for passively" + :group 'applications) + +(defcustom passively-learn-terms nil + "Terms that passively should randomly display to the user. The +format of this variable is a hash table with a string key that +uniquely identifies the term, and a string value that is +displayed to the user. + +For example, a possible value could be: + + (ht (\"забыть\" \"забыть - to forget\") + (\"действительно\" \"действительно - indeed, really\"))) +" + ;; TODO(tazjin): No hash-table type in customization.el? + :type '(sexp) + :group 'passively) + +(defcustom passively-store-state (format "%spassively.el" user-emacs-directory) + "File in which passively should store its state (e.g. known terms)" + :type '(file) + :group 'passively) + +(defcustom passively-show-after-idle-for 4 + "Number of seconds after Emacs goes idle that passively should +wait before displaying a term." + :type '(integer) + :group 'passively) + +;; Implementation of state persistence +(defvar passively-last-displayed nil + "Key of the last displayed passively term.") + +(defvar passively--known-terms (make-hash-table) + "Set of terms that are already known.") + +(defun passively--persist-known-terms () + "Persist the set of known passively terms to disk." + (with-temp-file passively-store-state + (insert (prin1-to-string (ht-keys passively--known-terms))))) + +(defun passively--load-known-terms () + "Load the set of known passively terms from disk." + (with-temp-buffer + (insert-file-contents passively-store-state) + (let ((keys (read (current-buffer)))) + (setq passively--known-terms (make-hash-table)) + (seq-do + (lambda (key) (ht-set passively--known-terms key t)) + keys))) + (message "passively: loaded %d known words" + (seq-length (ht-keys passively--known-terms)))) + +(defun passively-mark-last-as-known () + "Mark the last term that passively displayed as known. It will +not be displayed again." + (interactive) + + (ht-set passively--known-terms passively-last-displayed t) + (passively--persist-known-terms) + (message "passively: Marked '%s' as known" passively-last-displayed)) + +;; Implementation of main display logic +(defvar passively--display-timer nil + "idle-timer used for displaying terms by passively") + +(defun passively--random-term (timeout) + ;; This is stupid, calculate set intersections instead. + (if (< 1000 timeout) + (error "It seems you already know all the terms?") + (seq-random-elt (ht-keys passively-learn-terms)))) + +(defun passively--display-random-term () + (let* ((timeout 1) + (term (passively--random-term timeout))) + (while (ht-contains? passively--known-terms term) + (setq timeout (+ 1 timeout)) + (setq term (passively--random-term timeout))) + (setq passively-last-displayed term) + (message (ht-get passively-learn-terms term)))) + +(defun passively-enable () + "Enable automatic display of terms via passively." + (interactive) + (if passively--display-timer + (error "passively: Already running!") + (passively--load-known-terms) + (setq passively--display-timer + (run-with-idle-timer passively-show-after-idle-for t + #'passively--display-random-term)) + (message "passively: Now running after %s seconds of idle time" + passively-show-after-idle-for))) + +(defun passively-disable () + "Turn off automatic display of terms via passively." + (interactive) + (unless passively--display-timer + (error "passively: Not running!")) + (cancel-timer passively--display-timer) + (setq passively--display-timer nil) + (message "passively: Now disabled")) + +(provide 'passively) diff --git a/tools/emacs-pkgs/term-switcher/term-switcher.el b/tools/emacs-pkgs/term-switcher/term-switcher.el index 0055f87fd67f..c141a5e9cc08 100644 --- a/tools/emacs-pkgs/term-switcher/term-switcher.el +++ b/tools/emacs-pkgs/term-switcher/term-switcher.el @@ -1,19 +1,20 @@ ;;; term-switcher.el --- Easily switch between open vterms ;; -;; Copyright (C) 2019 Google Inc. +;; Copyright (C) 2019-2020 Google Inc. +;; Copyright (C) 2021-2023 The TVL Authors ;; -;; Author: Vincent Ambo <tazjin@google.com> +;; Author: Vincent Ambo <tazjin@tvl.su> ;; Version: 1.1 -;; Package-Requires: (dash ivy s vterm) +;; Package-Requires: (ivy s vterm) ;; ;;; Commentary: ;; ;; This package adds a function that lets users quickly switch between ;; different open vterms via ivy. -(require 'dash) (require 'ivy) (require 's) +(require 'seq) (require 'vterm) (defgroup term-switcher nil @@ -26,14 +27,18 @@ :type '(string) :group 'term-switcher) -(defun ts/open-or-create-vterm (buffer-name) - "Switch to the buffer with BUFFER-NAME or create a new vterm - buffer." - (if (equal "New vterm" buffer-name) - (vterm) - (if-let ((buffer (get-buffer buffer-name))) - (switch-to-buffer buffer) - (error "Could not find vterm buffer: %s" buffer-name)))) +(defun ts/create-vterm () + "Launch vterm, but don't open semi-broken vterms over TRAMP." + (if (file-remote-p default-directory) + (let ((default-directory "~")) + (vterm)) + (vterm))) + +(defun ts/open-or-create-vterm (buffer) + "Switch to the terminal in BUFFER, or create a new one if buffer is nil." + (if buffer + (switch-to-buffer buffer) + (ts/create-vterm))) (defun ts/is-vterm-buffer (buffer) "Determine whether BUFFER runs a vterm." @@ -43,15 +48,16 @@ "Switch to an existing vterm buffer or create a new one." (interactive) - (let ((terms (-map #'buffer-name - (-filter #'ts/is-vterm-buffer (buffer-list))))) + (let ((terms (seq-map (lambda (b) (cons (buffer-name b) b)) + (seq-filter #'ts/is-vterm-buffer (buffer-list))))) (if terms (ivy-read "Switch to vterm: " - (cons "New vterm" terms) + (cons "New vterm" (seq-map #'car terms)) :caller 'ts/switch-to-terminal :preselect (s-concat "^" term-switcher-buffer-prefix) :require-match t - :action #'ts/open-or-create-vterm) - (vterm)))) + :action (lambda (match) + (ts/open-or-create-vterm (cdr (assoc match terms))))) + (ts/create-vterm)))) (provide 'term-switcher) diff --git a/tools/emacs-pkgs/treecrumbs/OWNERS b/tools/emacs-pkgs/treecrumbs/OWNERS new file mode 100644 index 000000000000..6049a2363478 --- /dev/null +++ b/tools/emacs-pkgs/treecrumbs/OWNERS @@ -0,0 +1,2 @@ +set noparent +file:/tools/emacs-pkgs/FSF_OWNERS diff --git a/tools/emacs-pkgs/treecrumbs/default.nix b/tools/emacs-pkgs/treecrumbs/default.nix new file mode 100644 index 000000000000..8895baab9afb --- /dev/null +++ b/tools/emacs-pkgs/treecrumbs/default.nix @@ -0,0 +1,7 @@ +{ depot, ... }: + +depot.tools.emacs-pkgs.buildEmacsPackage { + pname = "treecrumbs"; + version = "1.0"; + src = ./treecrumbs.el; +} diff --git a/tools/emacs-pkgs/treecrumbs/treecrumbs.el b/tools/emacs-pkgs/treecrumbs/treecrumbs.el new file mode 100644 index 000000000000..cd49324ad747 --- /dev/null +++ b/tools/emacs-pkgs/treecrumbs/treecrumbs.el @@ -0,0 +1,202 @@ +;; treecrumbs.el --- Fast, tree-sitter based breadcrumbs -*- lexical-binding: t; -*- +;; +;; Copyright (C) Free Software Foundation, Inc. +;; SPDX-License-Identifier: GPL-3.0-or-later +;; +;; Author: Vincent Ambo <tazjin@tvl.su> +;; Created: 2024-03-08 +;; Version: 1.0 +;; Keywords: convenience +;; Package-Requires: ((emacs "29.1")) +;; URL: https://code.tvl.fyi/tree/tools/emacs-pkgs/treecrumbs +;; +;; This file is not (yet) part of GNU Emacs. + +;;; Commentary: + +;; This package provides a tree-sitter based implementation of "breadcrumbs", +;; that is indicators displaying where in the semantic structure of a document +;; the point is currently located. +;; +;; Imagine a large YAML-document where the names of the parent keys are far out +;; of view: Treecrumbs can quickly display the hierarchy of keys (e.g. `foo < [] +;; < baz') and help figure out where point is. +;; +;; Treecrumbs only works if a tree-sitter parser for the target language is +;; available in the buffer, and the language is supported in the +;; `treecrumbs-languages'. Adding a new language is not difficult, and patches +;; for this are welcome. +;; +;; To active treecrumbs, enable `treecrumbs-mode'. This buffer-local minor mode +;; adds the crumbs to the buffer's `header-line-format'. Alternatively, users +;; can also use the `treecrumbs-line-segment' either in their own header-line, +;; tab-line or mode-line configuration. + +;;; Code: + +(require 'seq) +(require 'treesit) + +(defvar treecrumbs-languages nil + "Describes the tree-sitter language grammars supported by +treecrumbs, and how the breadcrumbs for their node types are +generated. + +Alist of symbols representing tree-sitter languages (e.g. `yaml') +to another alist (the \"node type list\") describing how +different node types should be displayed in the crumbs. + +See `define-treecrumbs-language' for more details on how to add a +language.") + +(defmacro define-treecrumbs-language (lang &rest clauses) + "Defines a new language for use in treecrumbs. LANG should be a +symbol representing the language as understood by treesit (e.g. +`yaml'). + +Each of CLAUSES is a cons cell mapping the name of a tree +node (in string format) to one of either: + +1. a static string, which will become the breadcrumb verbatim + +2. a tree-sitter query (in S-expression syntax) which must capture + exactly one argument named `@key' that will become the + breadcrumb (e.g. the name of a function, the key in a map, ...) + +Treecrumbs will only consider node types that are mentioned in +CLAUSES. All other nodes are ignored when constructing the +crumbs. + +The defined languages are stored in `treecrumbs-languages'." + + (declare (indent 1)) + (let ((compiled + (seq-map (lambda (clause) + (if (stringp (cdr clause)) + `(cons ,(car clause) ,(cdr clause)) + `(cons ,(car clause) + (treesit-query-compile ',lang ',(cdr clause))))) + clauses))) + `(setf (alist-get ',lang treecrumbs-languages nil nil #'equal) (list ,@compiled)))) + +(define-treecrumbs-language yaml + ;; In YAML documents, crumbs are generated from the keys of maps, and from + ;; elements of arrays. "block"-nodes are standard YAML syntax, "flow"-nodes + ;; are inline JSON-ish syntax. + ("block_mapping_pair" . ((block_mapping_pair key: (_) @key))) + ("block_sequence" . "[]") + + ;; TODO: Why can this query not match on to (flow_pair)? + ("flow_pair" . ((_) key: (_) @key)) + ("flow_sequence" . "[]")) + +(define-treecrumbs-language json + ;; In JSON documents, crumbs are generated from key names and array fields. + ("pair" . ((pair key: (string (string_content) @key)))) + ("array" . "[]")) + +(define-treecrumbs-language toml + ;; TOML has sections, key names and arrays. Sections are the only + ;; relevant difference to YAML. Nested keys are not parsed, and just + ;; displayed as-is. + ("table" . ((table (_) @key)) ) + ;; TODO: query cannot match on pair in inline_table, hence matching + ;; directly on keys + ("pair" . ([(dotted_key) + (quoted_key) + (bare_key)])) + ("array" . "[]")) + +(define-treecrumbs-language cpp + ;; In C++ files, crumbs are generated from namespaces and + ;; identifier declarations. + ("namespace_definition" . ([(namespace_definition + name: (namespace_identifier) @key) + (namespace_definition + "namespace" @key + !name)])) + + ("function_definition" . ((function_definition + declarator: + (function_declarator + declarator: (_) @key)))) + + ("class_specifier" . ((class_specifier + name: (type_identifier) @key))) + + ("struct_specifier" . ((struct_specifier + name: (type_identifier) @key))) + + ("field_declaration" . ((field_declaration + declarator: (_) @key))) + + ("init_declarator" . ((init_declarator + declarator: (_) @key)))) + +(defvar-local treecrumbs--current-crumbs nil + "Current crumbs to display in the header line. Only updated when +the node under point changes.") + +(defun treecrumbs--crumbs-for (node) + "Construct the crumbs for the given NODE, if its language is +supported in `treecrumbs-languages'. This functions return value +is undefined, it directly updates the buffer-local +`treecrumbs--current-crumbs'." + (let ((lang (cdr (assoc (treesit-node-language node) treecrumbs-languages)))) + (unless lang + (user-error "No supported treecrumbs language at point!")) + + (setq-local treecrumbs--current-crumbs "") + (treesit-parent-while + node + (lambda (parent) + (when-let ((query (cdr (assoc (treesit-node-type parent) lang)))) + + (setq-local treecrumbs--current-crumbs + (concat treecrumbs--current-crumbs + (if (string-empty-p treecrumbs--current-crumbs) "" + " < ") + + (if (stringp query) + query + (substring-no-properties + (treesit-node-text (cdar (treesit-query-capture parent query)))))))) + t)))) + + +(defvar-local treecrumbs--last-node nil + "Caches the node that was last seen at point.") + +(defun treecrumbs-at-point () + "Returns the treecrumbs at point as a string, if point is on a +node in a language supported in `treecrumbs-languages'. + +The last known crumbs in a given buffer are cached, and only if +the node under point changes are they updated." + (let ((node (treesit-node-at (point)))) + (when (or (not treecrumbs--current-crumbs) + (not (equal treecrumbs--last-node node))) + (setq-local treecrumbs--last-node node) + (treecrumbs--crumbs-for node))) + + treecrumbs--current-crumbs) + +(defvar treecrumbs-line-segment + '(:eval (treecrumbs-at-point)) + + "Treecrumbs segment for use in the header-line or mode-line.") + +;;;###autoload +(define-minor-mode treecrumbs-mode + "Display header line hints about current position in structure." + :init-value nil + :lighter " Crumbs" + (if treecrumbs-mode + (if (treesit-parser-list) + (push treecrumbs-line-segment header-line-format) + (user-error "Treecrumbs mode works only in tree-sitter based buffers!")) + (setq header-line-format + (delq treecrumbs-line-segment header-line-format)))) + +(provide 'treecrumbs) +;;; treecrumbs.el ends here diff --git a/tools/emacs-pkgs/tvl/OWNERS b/tools/emacs-pkgs/tvl/OWNERS index ce7e0e37ee4f..b381c4e6604c 100644 --- a/tools/emacs-pkgs/tvl/OWNERS +++ b/tools/emacs-pkgs/tvl/OWNERS @@ -1,3 +1 @@ -inherited: true -owners: - - grfn +aspen diff --git a/tools/emacs-pkgs/tvl/tvl.el b/tools/emacs-pkgs/tvl/tvl.el index d39ba218a8b8..8db718a8359d 100644 --- a/tools/emacs-pkgs/tvl/tvl.el +++ b/tools/emacs-pkgs/tvl/tvl.el @@ -5,7 +5,7 @@ ;; ;; Author: Griffin Smith <grfn@gws.fyi> ;; Version: 0.0.1 -;; Package-Requires: (s magit) +;; Package-Requires: (cl s magit) ;; ;; This file is not part of GNU Emacs. ;; @@ -17,6 +17,7 @@ (require 'magit) (require 's) +(require 'cl) ; TODO(tazjin): replace lexical-let* with non-deprecated alternative (defgroup tvl nil "Customisation options for TVL functionality.") @@ -38,7 +39,7 @@ :safe (lambda (_) t)) (defun tvl--gerrit-ref (target-branch &optional flags) - (let ((flag-suffix (if flags (format "%%l=%s" (s-join "," flags)) + (let ((flag-suffix (if flags (format "%%%s" (s-join "," flags)) ""))) (format "HEAD:refs/for/%s%s" target-branch flag-suffix))) @@ -57,13 +58,24 @@ "Push to Gerrit as a work-in-progress." (interactive) (magit-push-refspecs tvl-gerrit-remote - (concat (tvl--gerrit-ref tvl-target-branch) "%wip") + (tvl--gerrit-ref tvl-target-branch '("wip")) nil)) (transient-append-suffix #'magit-push ["r"] (list "W" "push to Gerrit as a work-in-progress" #'magit-gerrit-push-wip)) +(transient-define-suffix magit-gerrit-push-autosubmit () + "Push to Gerrit with autosubmit enabled." + (interactive) + (magit-push-refspecs tvl-gerrit-remote + (tvl--gerrit-ref tvl-target-branch '("l=Autosubmit+1")) + nil)) + +(transient-append-suffix + #'magit-push ["r"] + (list "A" "push to Gerrit with autosubmit enabled" #'magit-gerrit-push-autosubmit)) + (transient-define-suffix magit-gerrit-submit () "Push to Gerrit for review." (interactive) @@ -77,23 +89,156 @@ (transient-define-suffix magit-gerrit-rubberstamp () - "Push, automatically approve and submit to Gerrit. This -rubberstamp operation is dangerous and should only be used in -`//users'." + "Push, approve and autosubmit to Gerrit. CLs created via this +rubberstamp method will automatically be submitted after CI +passes. This is potentially dangerous, use with care." (interactive) (magit-push-refspecs tvl-gerrit-remote (tvl--gerrit-ref tvl-target-branch - '("Code-Review+2" "publish-comments")) + '("l=Code-Review+2" + "l=Autosubmit+1" + "publish-comments")) nil)) (transient-append-suffix #'magit-push ["r"] (list "P" "push & rubberstamp to Gerrit" #'magit-gerrit-rubberstamp)) +(transient-define-suffix magit-gerrit-push-private () + "Push a private change to Gerrit." + (interactive) + (magit-push-refspecs tvl-gerrit-remote + (tvl--gerrit-ref tvl-target-branch + '("private" + "publish-comments")) + nil)) + +(transient-append-suffix + #'magit-push ["r"] + (list "Q" "push private change to Gerrit" #'magit-gerrit-push-private)) + +(defvar magit-cl-history nil) +(defun magit-read-cl (prompt remote) + (let* ((refs (prog2 (message "Determining available refs...") + (magit-remote-list-refs remote) + (message "Determining available refs...done"))) + (change-refs (-filter + (apply-partially #'string-prefix-p "refs/changes/") + refs)) + (cl-number-to-refs + (-group-by + (lambda (change-ref) + ;; refs/changes/34/1234/1 + ;; ^ ^ ^ ^ ^ + ;; 1 2 3 4 5 + ;; ^-- this one + (cadddr + (split-string change-ref (rx "/")))) + change-refs)) + (cl-numbers + (-map + (lambda (cl-to-refs) + (let ((latest-patchset-ref + (-max-by + (-on #'> (lambda (ref) + (string-to-number + (nth 4 (split-string ref (rx "/")))))) + (-remove + (apply-partially #'s-ends-with-p "meta") + (cdr cl-to-refs))))) + (propertize (car cl-to-refs) 'ref latest-patchset-ref))) + cl-number-to-refs))) + (get-text-property + 0 + 'ref + (magit-completing-read + prompt cl-numbers nil t nil 'magit-cl-history)))) + +(transient-define-suffix magit-gerrit-checkout (remote cl-refspec) + "Prompt for a CL number and checkout the latest patchset of that CL with + detached HEAD" + (interactive + (let* ((remote tvl-gerrit-remote) + (cl (magit-read-cl "Checkout CL" remote))) + (list remote cl))) + (magit-fetch-refspec remote cl-refspec (magit-fetch-arguments)) + ;; That runs async, so wait for it to finish (this is how magit does it) + (while (and magit-this-process + (eq (process-status magit-this-process) 'run)) + (sleep-for 0.005)) + (magit-checkout "FETCH_HEAD" (magit-branch-arguments)) + (message "HEAD detached at %s" cl-refspec)) + + +(transient-append-suffix + #'magit-branch ["l"] + (list "g" "gerrit CL" #'magit-gerrit-checkout)) + +(transient-define-suffix magit-gerrit-cherry-pick (remote cl-refspec) + "Prompt for a CL number and cherry-pick the latest patchset of that CL" + (interactive + (let* ((remote tvl-gerrit-remote) + (cl (magit-read-cl "Cherry-pick CL" remote))) + (list remote cl))) + (magit-fetch-refspec remote cl-refspec (magit-fetch-arguments)) + ;; That runs async, so wait for it to finish (this is how magit does it) + (while (and magit-this-process + (eq (process-status magit-this-process) 'run)) + (sleep-for 0.005)) + (magit-cherry-copy (list "FETCH_HEAD")) + (message "HEAD detached at %s" cl-refspec)) + + +(transient-append-suffix + #'magit-cherry-pick ["m"] + (list "g" "Gerrit CL" #'magit-gerrit-cherry-pick)) + (defun tvl-depot-status () "Open the TVL monorepo in magit." (interactive) (magit-status-setup-buffer tvl-depot-path)) +(eval-after-load 'sly + '(defun tvl-sly-from-depot (attribute only-deps) + "Start a Sly REPL configured with a Lisp matching a derivation + from the depot. + + The derivation invokes nix.buildLisp.sbclWith and is built + asynchronously. The build output is included in the error + thrown on build failures." + + ;; TODO(sterni): this function asumes that we are using SBCL + ;; - for determining the resulting wrapper's location + ;; - for creating the dep-only wrapper + + (interactive (list (read-string "Attribute: ") + (yes-or-no-p "Only include dependencies? "))) + (lexical-let* ((outbuf (get-buffer-create (format "*depot-out/%s*" attribute))) + (errbuf (get-buffer-create (format "*depot-errors/%s*" attribute))) + (attr-display (if only-deps attribute (format "dependencies of %s" attribute))) + (expression (if only-deps + (format "let d = import <depot> {}; in d.nix.buildLisp.sbcl.lispWith d.%s.lispDeps" + attribute) + (format "(import <depot> {}).%s.repl" attribute))) + (command (list "nix-build" "--no-out-link" "-I" (format "depot=%s" tvl-depot-path) "-E" expression))) + (message "Acquiring Lisp for <depot>.%s" attr-display) + (make-process :name (format "depot-nix-build/%s" attribute) + :buffer outbuf + :stderr errbuf + :command command + :sentinel + (lambda (process event) + (unwind-protect + (pcase event + ("finished\n" + (let* ((outpath (s-trim (with-current-buffer outbuf (buffer-string)))) + (lisp-path (s-concat outpath "/bin/sbcl"))) + (message "Acquired Lisp for <depot>.%s at %s" attr-display lisp-path) + (sly lisp-path))) + (_ (with-current-buffer errbuf + (error "Failed to build %s:\nTried building '%s':\n%s" attr-display expression (buffer-string))))) + (kill-buffer outbuf) + (kill-buffer errbuf))))))) + (provide 'tvl) ;;; tvl.el ends here |