diff options
Diffstat (limited to 'tools/emacs-pkgs')
-rw-r--r-- | tools/emacs-pkgs/buildEmacsPackage.nix | 38 | ||||
-rw-r--r-- | tools/emacs-pkgs/defzone/defzone.el | 60 | ||||
-rw-r--r-- | tools/emacs-pkgs/defzone/example.el | 45 | ||||
-rw-r--r-- | tools/emacs-pkgs/dottime/default.nix | 7 | ||||
-rw-r--r-- | tools/emacs-pkgs/dottime/dottime.el | 81 | ||||
-rw-r--r-- | tools/emacs-pkgs/nix-util/default.nix | 8 | ||||
-rw-r--r-- | tools/emacs-pkgs/nix-util/nix-util.el | 69 | ||||
-rw-r--r-- | tools/emacs-pkgs/notable/OWNERS | 1 | ||||
-rw-r--r-- | tools/emacs-pkgs/notable/default.nix | 17 | ||||
-rw-r--r-- | tools/emacs-pkgs/notable/notable.el | 251 | ||||
-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/default.nix | 8 | ||||
-rw-r--r-- | tools/emacs-pkgs/term-switcher/term-switcher.el | 63 | ||||
-rw-r--r-- | tools/emacs-pkgs/tvl/OWNERS | 1 | ||||
-rw-r--r-- | tools/emacs-pkgs/tvl/default.nix | 8 | ||||
-rw-r--r-- | tools/emacs-pkgs/tvl/tvl.el | 244 |
19 files changed, 1107 insertions, 0 deletions
diff --git a/tools/emacs-pkgs/buildEmacsPackage.nix b/tools/emacs-pkgs/buildEmacsPackage.nix new file mode 100644 index 000000000000..990b53b763b0 --- /dev/null +++ b/tools/emacs-pkgs/buildEmacsPackage.nix @@ -0,0 +1,38 @@ +# Builder for depot-internal Emacs packages. Packages built using this +# builder are added into the Emacs packages fixpoint under +# `emacsPackages.tvlPackages`, which in turn makes it possible to use +# them with special Emacs features like native compilation. +# +# Arguments passed to the builder are the same as +# emacsPackages.trivialBuild, except: +# +# * packageRequires is not used +# +# * externalRequires takes a selection function for packages from +# emacsPackages +# +# * internalRequires takes other depot packages +{ pkgs, ... }: + +buildArgs: + +pkgs.callPackage + ({ 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 [ ]); + + trivialBuildArgs = builtins.removeAttrs buildArgs [ + "externalRequires" + "internalRequires" + ] // { + packageRequires = externalDeps ++ internalDeps; + }; + in + emacsPackages.trivialBuild trivialBuildArgs) +{ } diff --git a/tools/emacs-pkgs/defzone/defzone.el b/tools/emacs-pkgs/defzone/defzone.el new file mode 100644 index 000000000000..ffd359e5ff83 --- /dev/null +++ b/tools/emacs-pkgs/defzone/defzone.el @@ -0,0 +1,60 @@ +;;; defzone.el --- Generate zone files from Elisp -*- lexical-binding: t; -*- + +(require 'dash) +(require 'dash-functional) +(require 's) + +(defun record-to-record (zone record &optional subdomain) + "Evaluate a record definition and turn it into a zone file + record in ZONE, optionally prefixed with SUBDOMAIN." + + (cl-labels ((plist->alist (plist) + (when plist + (cons + (cons (car plist) (cadr plist)) + (plist->alist (cddr plist)))))) + (let ((name (if subdomain (s-join "." (list subdomain zone)) zone))) + (pcase record + ;; SOA RDATA (RFC 1035; 3.3.13) + ((and `(SOA . (,ttl . ,keys)) + (let (map (:mname mname) (:rname rname) (:serial serial) + (:refresh refresh) (:retry retry) (:expire expire) + (:minimum min)) + (plist->alist keys))) + (if-let ((missing (-filter #'null (not (list mname rname serial + refresh retry expire min))))) + (error "Missing fields in SOA record: %s" missing) + (format "%s %s IN SOA %s %s %s %s %s %s %s" + name ttl mname rname serial refresh retry expire min))) + + (`(NS . (,ttl . ,targets)) + (->> targets + (-map (lambda (target) (format "%s %s IN NS %s" name ttl target))) + (s-join "\n"))) + + (`(MX . (,ttl . ,pairs)) + (->> pairs + (-map (-lambda ((preference . exchange)) + (format "%s %s IN MX %s %s" name ttl preference exchange))) + (s-join "\n"))) + + (`(TXT ,ttl ,text) (format "%s %s IN TXT %s" name ttl (prin1-to-string text))) + + (`(A . (,ttl . ,ips)) + (->> ips + (-map (lambda (ip) (format "%s %s IN A %s" name ttl ip))) + (s-join "\n"))) + + (`(CNAME ,ttl ,target) (format "%s %s IN CNAME %s" name ttl target)) + + ((and `(,sub . ,records) + (guard (stringp sub))) + (s-join "\n" (-map (lambda (r) (record-to-record zone r sub)) records))) + + (_ (error "Invalid record definition: %s" record)))))) + +(defmacro defzone (fqdn &rest records) + "Generate zone file for the zone at FQDN from a simple DSL." + (declare (indent defun)) + + `(s-join "\n" (-map (lambda (r) (record-to-record ,fqdn r)) (quote ,records)))) diff --git a/tools/emacs-pkgs/defzone/example.el b/tools/emacs-pkgs/defzone/example.el new file mode 100644 index 000000000000..e9c86d25eec8 --- /dev/null +++ b/tools/emacs-pkgs/defzone/example.el @@ -0,0 +1,45 @@ +;;; example.el - usage example for defzone macro + +(defzone "tazj.in." + (SOA 21600 + :mname "ns-cloud-a1.googledomains.com." + :rname "cloud-dns-hostmaster.google.com." + :serial 123 + :refresh 21600 + :retry 3600 + :expire 1209600 + :minimum 300) + + (NS 21600 + "ns-cloud-a1.googledomains.com." + "ns-cloud-a2.googledomains.com." + "ns-cloud-a3.googledomains.com." + "ns-cloud-a4.googledomains.com.") + + (MX 300 + (1 . "aspmx.l.google.com.") + (5 . "alt1.aspmx.l.google.com.") + (5 . "alt2.aspmx.l.google.com.") + (10 . "alt3.aspmx.l.google.com.") + (10 . "alt4.aspmx.l.google.com.")) + + (TXT 3600 "google-site-verification=d3_MI1OwD6q2OT42Vvh0I9w2u3Q5KFBu-PieNUE1Fig") + + (A 300 "34.98.120.189") + + ;; Nested record sets are indicated by a list that starts with a + ;; string (this is just joined, so you can nest multiple levels at + ;; once) + ("blog" + ;; Blog "storage engine" is in a separate DNS zone + (NS 21600 + "ns-cloud-c1.googledomains.com." + "ns-cloud-c2.googledomains.com." + "ns-cloud-c3.googledomains.com." + "ns-cloud-c4.googledomains.com.")) + + ("git" + (A 300 "34.98.120.189") + (TXT 300 "<3 edef")) + + ("files" (CNAME 300 "c.storage.googleapis.com."))) diff --git a/tools/emacs-pkgs/dottime/default.nix b/tools/emacs-pkgs/dottime/default.nix new file mode 100644 index 000000000000..b819e9c14d2c --- /dev/null +++ b/tools/emacs-pkgs/dottime/default.nix @@ -0,0 +1,7 @@ +{ depot, ... }: + +depot.tools.emacs-pkgs.buildEmacsPackage { + pname = "dottime"; + version = "1.0"; + src = ./dottime.el; +} diff --git a/tools/emacs-pkgs/dottime/dottime.el b/tools/emacs-pkgs/dottime/dottime.el new file mode 100644 index 000000000000..2446f6488f32 --- /dev/null +++ b/tools/emacs-pkgs/dottime/dottime.el @@ -0,0 +1,81 @@ +;;; dottime.el --- use dottime in the modeline +;; +;; Copyright (C) 2019 Google Inc. +;; +;; Author: Vincent Ambo <tazjin@google.com> +;; Version: 1.0 +;; Package-Requires: (cl-lib) +;; +;;; Commentary: +;; +;; This package changes the display of time in the modeline to use +;; dottime (see https://dotti.me/) instead of the standard time +;; display. +;; +;; Modeline dottime display is enabled by calling +;; `dottime-display-mode' and dottime can be used in Lisp code via +;; `dottime-format'. + +(require 'cl-lib) +(require 'time) + +(defun dottime--format-string (&optional offset prefix) + "Creates the dottime format string for `format-time-string' + based on the local timezone." + + (let* ((offset-sec (or offset (car (current-time-zone)))) + (offset-hours (/ offset-sec 60 60)) + (base (concat prefix "%m-%dT%H·%M"))) + (if (/= offset-hours 0) + (concat base (format "%0+3d" offset-hours)) + base))) + +(defun dottime--display-time-update-advice (orig) + "Function used as advice to `display-time-update' with a + rebound definition of `format-time-string' that renders all + timestamps as dottime." + + (cl-letf* ((format-orig (symbol-function 'format-time-string)) + ((symbol-function 'format-time-string) + (lambda (&rest _) + (funcall format-orig (dottime--format-string) nil t)))) + (funcall orig))) + +(defun dottime-format (&optional time offset prefix) + "Format the given TIME in dottime at OFFSET. If TIME is nil, + the current time will be used. PREFIX is prefixed to the format + string verbatim. + + OFFSET can be an integer representing an offset in seconds, or + the argument can be elided in which case the system time zone + is used." + + (format-time-string (dottime--format-string offset prefix) time t)) + +(defun dottime-display-mode (arg) + "Enable time display as dottime. Disables dottime if called + with prefix 0 or nil." + + (interactive "p") + (if (or (eq arg 0) (eq arg nil)) + (advice-remove 'display-time-update #'dottime--display-time-update-advice) + (advice-add 'display-time-update :around #'dottime--display-time-update-advice)) + (display-time-update) + + ;; Amend the time display in telega.el to use dottime. + ;; + ;; This will never display offsets in the chat window, as those are + ;; always visible in the modeline anyways. + (when (featurep 'telega) + (defun telega-ins--dottime-advice (orig timestamp) + (let* ((dtime (decode-time timestamp t)) + (current-ts (time-to-seconds (current-time))) + (ctime (decode-time current-ts)) + (today00 (telega--time-at00 current-ts ctime))) + (if (> timestamp today00) + (telega-ins (format "%02d·%02d" (nth 2 dtime) (nth 1 dtime))) + (funcall orig timestamp)))) + + (advice-add 'telega-ins--date :around #'telega-ins--dottime-advice))) + +(provide 'dottime) diff --git a/tools/emacs-pkgs/nix-util/default.nix b/tools/emacs-pkgs/nix-util/default.nix new file mode 100644 index 000000000000..b167cb964214 --- /dev/null +++ b/tools/emacs-pkgs/nix-util/default.nix @@ -0,0 +1,8 @@ +{ depot, ... }: + +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 new file mode 100644 index 000000000000..4ddc81f563d3 --- /dev/null +++ b/tools/emacs-pkgs/nix-util/nix-util.el @@ -0,0 +1,69 @@ +;;; 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 s) +;; +;;; Commentary: +;; +;; This package adds some functionality that I find useful when +;; working in Nix buffers or programs installed from Nix. + +(require 'json) +(require 'map) +(require 's) + +(defun nix/prefetch-github (owner repo) ; TODO(tazjin): support different branches + "Fetch the master branch of a GitHub repository and insert the + call to `fetchFromGitHub' at point." + + (interactive "sOwner: \nsRepository: ") + + (let* (;; Keep these vars around for output insertion + (point (point)) + (buffer (current-buffer)) + (name (concat "github-fetcher/" owner "/" repo)) + (outbuf (format "*%s*" name)) + (errbuf (get-buffer-create "*github-fetcher/errors*")) + (cleanup (lambda () + (kill-buffer outbuf) + (kill-buffer errbuf) + (with-current-buffer buffer + (read-only-mode -1)))) + (prefetch-handler + (lambda (_process event) + (unwind-protect + (pcase event + ("finished\n" + (let* ((json-string (with-current-buffer outbuf + (buffer-string))) + (result (json-read-from-string json-string))) + (with-current-buffer buffer + (goto-char point) + (map-let (("rev" rev) ("sha256" sha256)) result + (read-only-mode -1) + (insert (format "fetchFromGitHub { + owner = \"%s\"; + repo = \"%s\"; + rev = \"%s\"; + sha256 = \"%s\"; +};" owner repo rev sha256)) + (indent-region point (point)))))) + (_ (with-current-buffer errbuf + (error "Failed to prefetch %s/%s: %s" + owner repo (buffer-string))))) + (funcall cleanup))))) + + ;; Fetching happens asynchronously, but we'd like to make sure the + ;; point stays in place while that happens. + (read-only-mode) + (make-process :name name + :buffer outbuf + :command `("nix-prefetch-github" ,owner ,repo) + :stderr errbuf + :sentinel prefetch-handler))) + +(provide 'nix-util) diff --git a/tools/emacs-pkgs/notable/OWNERS b/tools/emacs-pkgs/notable/OWNERS new file mode 100644 index 000000000000..45c9222313b4 --- /dev/null +++ b/tools/emacs-pkgs/notable/OWNERS @@ -0,0 +1 @@ +tazjin diff --git a/tools/emacs-pkgs/notable/default.nix b/tools/emacs-pkgs/notable/default.nix new file mode 100644 index 000000000000..f57b1c66ae3f --- /dev/null +++ b/tools/emacs-pkgs/notable/default.nix @@ -0,0 +1,17 @@ +{ depot, ... }: + +depot.tools.emacs-pkgs.buildEmacsPackage rec { + pname = "notable"; + version = "1.0"; + src = ./notable.el; + + externalRequires = epkgs: with epkgs; [ + f + ht + s + ]; + + internalRequires = [ + depot.tools.emacs-pkgs.dottime + ]; +} diff --git a/tools/emacs-pkgs/notable/notable.el b/tools/emacs-pkgs/notable/notable.el new file mode 100644 index 000000000000..4668dd333c99 --- /dev/null +++ b/tools/emacs-pkgs/notable/notable.el @@ -0,0 +1,251 @@ +;;; notable.el --- a simple note-taking app -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2020 The TVL Contributors +;; +;; Author: Vincent Ambo <mail@tazj.in> +;; Version: 1.0 +;; Package-Requires: (cl-lib dash f rx s subr-x) +;; +;;; Commentary: +;; +;; This package provides a simple note-taking application which can be +;; invoked from anywhere in Emacs, with several interactive +;; note-taking functions included. +;; +;; As is tradition for my software, the idea here is to reduce +;; friction which I see even with tools like `org-capture', because +;; `org-mode' does a ton of things I don't care about. +;; +;; Notable stores its notes in simple JSON files in the folder +;; specified by `notable-note-dir'. + +(require 'cl-lib) +(require 'dottime) +(require 'f) +(require 'ht) +(require 'rx) +(require 's) +(require 'subr-x) + +;; User-facing customisation options + +(defgroup notable nil + "Simple note-taking application." + :group 'applications) + +;; TODO(tazjin): Use whatever the XDG state dir thing is for these by +;; default. +(defcustom notable-note-dir (expand-file-name "~/.notable/") + "File path to the directory containing notable's notes." + :type 'string + :group 'notable) + +;; Package internal definitions + +(cl-defstruct (notable--note (:constructor notable--make-note)) + "Structure containing the fields of a single notable note." + time ;; UNIX timestamp at which the note was taken + content ;; Textual content of the note + ) + +(defvar notable--note-lock (make-mutex "notable-notes") + "Exclusive lock for note operations with shared state.") + +(defvar notable--note-regexp + (rx "note-" + (group (one-or-more (any num))) + ".json") + "Regular expression to match note file names.") + +(defvar notable--next-note + (let ((next 0)) + (dolist (file (f-entries notable-note-dir)) + (when-let* ((match (string-match notable--note-regexp file)) + (id (string-to-number + (match-string 1 file))) + (larger (> id next))) + (setq next id))) + (+ 1 next)) + "Next ID to use for notes. Initial value is determined based on + the existing notes files.") + +(defun notable--serialize-note (note) + "Serialise NOTE into JSON format." + (check-type note notable--note) + (json-serialize (ht ("time" (notable--note-time note)) + ("content" (notable--note-content note))))) + +(defun notable--deserialize-note (json) + "Deserialise JSON into a notable note." + (check-type json string) + (let ((parsed (json-parse-string json))) + (unless (and (ht-contains? parsed "time") + (ht-contains-p parsed "content")) + (error "Missing required keys in note structure!")) + (notable--make-note :time (ht-get parsed "time") + :content (ht-get parsed "content")))) + +(defun notable--next-id () + "Return the next note ID and increment the counter." + (with-mutex notable--note-lock + (let ((id notable--next-note)) + (setq notable--next-note (+ 1 id)) + id))) + +(defun notable--note-path (id) + (check-type id integer) + (f-join notable-note-dir (format "note-%d.json" id))) + +(defun notable--archive-path (id) + (check-type id integer) + (f-join notable-note-dir (format "archive-%d.json" id))) + +(defun notable--add-note (content) + "Add a note with CONTENT to the note store." + (let* ((id (notable--next-id)) + (note (notable--make-note :time (time-convert nil 'integer) + :content content)) + (path (notable--note-path id))) + (when (f-exists? path) (error "Note file '%s' already exists!" path)) + (f-write-text (notable--serialize-note note) 'utf-8 path) + (message "Saved note %d" id))) + +(defun notable--archive-note (id) + "Archive the note with ID." + (check-type id integer) + + (unless (f-exists? (notable--note-path id)) + (error "There is no note with ID %d." id)) + + (when (f-exists? (notable--archive-path id)) + (error "Oh no, a note with ID %d has already been archived!" id)) + + (f-move (notable--note-path id) (notable--archive-path id)) + (message "Archived note with ID %d." id)) + +(defun notable--list-note-ids () + "List all note IDs (not contents) from `notable-note-dir'" + (cl-loop for file in (f-entries notable-note-dir) + with res = nil + if (string-match notable--note-regexp file) + do (push (string-to-number (match-string 1 file)) res) + finally return res)) + +(defun notable--get-note (id) + (let ((path (notable--note-path id))) + (unless (f-exists? path) + (error "No note with ID %s in note storage!" id)) + (notable--deserialize-note (f-read-text path 'utf-8)))) + +;; Note view buffer implementation + +(defvar-local notable--buffer-note nil "The note ID displayed by this buffer.") + +(define-derived-mode notable-note-mode fundamental-mode "notable-note" + "Major mode displaying a single Notable note." + (set (make-local-variable 'scroll-preserve-screen-position) t) + (setq truncate-lines t) + (setq buffer-read-only t) + (setq buffer-undo-list t)) + +(setq notable-note-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "q" 'kill-current-buffer) + map)) + +(defun notable--show-note (id) + "Display a single note in a separate buffer." + (check-type id integer) + + (let ((note (notable--get-note id)) + (buffer (get-buffer-create (format "*notable: %d*" id))) + (inhibit-read-only t)) + (with-current-buffer buffer + (notable-note-mode) + (erase-buffer) + (setq notable--buffer-note id) + (setq header-line-format + (format "Note from %s" + (dottime-format + (seconds-to-time (notable--note-time note)))))) + (switch-to-buffer buffer) + (goto-char (point-min)) + (insert (notable--note-content note)))) + +(defun notable--show-note-at-point () + (interactive) + (notable--show-note (get-text-property (point) 'notable-note-id))) + +(defun notable--archive-note-at-point () + (interactive) + (notable--archive-note (get-text-property (point) 'notable-note-id))) + +;; Note list buffer implementation + +(define-derived-mode notable-list-mode fundamental-mode "notable" + "Major mode displaying the Notable note list." + ;; TODO(tazjin): `imenu' functions? + + (set (make-local-variable 'scroll-preserve-screen-position) t) + (setq truncate-lines t) + (setq buffer-read-only t) + (setq buffer-undo-list t) + (hl-line-mode t)) + +(setq notable-list-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "a" 'notable--archive-note-at-point) + (define-key map "q" 'kill-current-buffer) + (define-key map "g" 'notable-list-notes) + (define-key map (kbd "RET") 'notable--show-note-at-point) + map)) + +(defun notable--render-note (id note) + (check-type id integer) + (check-type note notable--note) + + (let* ((start (point)) + (date (dottime-format (seconds-to-time + (notable--note-time note)))) + (first-line (truncate-string-to-width + (car (s-lines (notable--note-content note))) + ;; Length of the window, minus the date prefix: + (- (window-width) (+ 2 (length date))) + nil nil 1))) + (insert (propertize (s-concat date " " first-line) + 'notable-note-id id)) + (insert "\n"))) + +(defun notable--render-notes (notes) + "Retrieve each note in NOTES by ID and insert its contents into +the list buffer. + +For larger notes only the first line is displayed." + (dolist (id notes) + (notable--render-note id (notable--get-note id)))) + +;; User-facing functions + +(defun notable-take-note (content) + "Interactively prompt the user for a note that should be stored +in Notable." + (interactive "sEnter note: ") + (check-type content string) + (notable--add-note content)) + +(defun notable-list-notes () + "Open a buffer listing all active notes." + (interactive) + + (let ((buffer (get-buffer-create "*notable*")) + (notes (notable--list-note-ids)) + (inhibit-read-only t)) + (with-current-buffer buffer + (notable-list-mode) + (erase-buffer) + (setq header-line-format "Notable notes")) + (switch-to-buffer buffer) + (goto-char (point-min)) + (notable--render-notes notes))) + +(provide 'notable) 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/default.nix b/tools/emacs-pkgs/term-switcher/default.nix new file mode 100644 index 000000000000..e775de5cdbe8 --- /dev/null +++ b/tools/emacs-pkgs/term-switcher/default.nix @@ -0,0 +1,8 @@ +{ depot, ... }: + +depot.tools.emacs-pkgs.buildEmacsPackage { + pname = "term-switcher"; + version = "1.0"; + src = ./term-switcher.el; + externalRequires = epkgs: with epkgs; [ dash ivy s vterm ]; +} diff --git a/tools/emacs-pkgs/term-switcher/term-switcher.el b/tools/emacs-pkgs/term-switcher/term-switcher.el new file mode 100644 index 000000000000..c141a5e9cc08 --- /dev/null +++ b/tools/emacs-pkgs/term-switcher/term-switcher.el @@ -0,0 +1,63 @@ +;;; term-switcher.el --- Easily switch between open vterms +;; +;; Copyright (C) 2019-2020 Google Inc. +;; Copyright (C) 2021-2023 The TVL Authors +;; +;; Author: Vincent Ambo <tazjin@tvl.su> +;; Version: 1.1 +;; Package-Requires: (ivy s vterm) +;; +;;; Commentary: +;; +;; This package adds a function that lets users quickly switch between +;; different open vterms via ivy. + +(require 'ivy) +(require 's) +(require 'seq) +(require 'vterm) + +(defgroup term-switcher nil + "Customization options `term-switcher'.") + +(defcustom term-switcher-buffer-prefix "vterm<" + "String prefix for vterm terminal buffers. For example, if you + set your titles to match `vterm<...>' a useful prefix might be + `vterm<'." + :type '(string) + :group 'term-switcher) + +(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." + (equal 'vterm-mode (buffer-local-value 'major-mode buffer))) + +(defun ts/switch-to-terminal () + "Switch to an existing vterm buffer or create a new one." + + (interactive) + (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" (seq-map #'car terms)) + :caller 'ts/switch-to-terminal + :preselect (s-concat "^" term-switcher-buffer-prefix) + :require-match t + :action (lambda (match) + (ts/open-or-create-vterm (cdr (assoc match terms))))) + (ts/create-vterm)))) + +(provide 'term-switcher) diff --git a/tools/emacs-pkgs/tvl/OWNERS b/tools/emacs-pkgs/tvl/OWNERS new file mode 100644 index 000000000000..d2800bc9413a --- /dev/null +++ b/tools/emacs-pkgs/tvl/OWNERS @@ -0,0 +1 @@ +grfn diff --git a/tools/emacs-pkgs/tvl/default.nix b/tools/emacs-pkgs/tvl/default.nix new file mode 100644 index 000000000000..5dcc184bb521 --- /dev/null +++ b/tools/emacs-pkgs/tvl/default.nix @@ -0,0 +1,8 @@ +{ depot, ... }: + +depot.tools.emacs-pkgs.buildEmacsPackage { + pname = "tvl"; + version = "1.0"; + src = ./tvl.el; + externalRequires = (epkgs: with epkgs; [ magit s ]); +} diff --git a/tools/emacs-pkgs/tvl/tvl.el b/tools/emacs-pkgs/tvl/tvl.el new file mode 100644 index 000000000000..8db718a8359d --- /dev/null +++ b/tools/emacs-pkgs/tvl/tvl.el @@ -0,0 +1,244 @@ +;;; tvl.el --- description -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2020 Griffin Smith +;; Copyright (C) 2020 The TVL Contributors +;; +;; Author: Griffin Smith <grfn@gws.fyi> +;; Version: 0.0.1 +;; Package-Requires: (cl s magit) +;; +;; This file is not part of GNU Emacs. +;; +;;; Commentary: +;; +;; This file provides shared utilities for interacting with the TVL monorepo +;; +;;; Code: + +(require 'magit) +(require 's) +(require 'cl) ; TODO(tazjin): replace lexical-let* with non-deprecated alternative + +(defgroup tvl nil + "Customisation options for TVL functionality.") + +(defcustom tvl-gerrit-remote "origin" + "Name of the git remote for gerrit" + :type '(string) + :group 'tvl) + +(defcustom tvl-depot-path "/depot" + "Location at which the TVL depot is checked out." + :type '(string) + :group 'tvl) + +(defcustom tvl-target-branch "canon" + "Branch to use to target CLs" + :group 'tvl + :type '(string) + :safe (lambda (_) t)) + +(defun tvl--gerrit-ref (target-branch &optional flags) + (let ((flag-suffix (if flags (format "%%%s" (s-join "," flags)) + ""))) + (format "HEAD:refs/for/%s%s" target-branch flag-suffix))) + +(transient-define-suffix magit-gerrit-push-for-review () + "Push to Gerrit for review." + (interactive) + (magit-push-refspecs tvl-gerrit-remote + (tvl--gerrit-ref tvl-target-branch) + nil)) + +(transient-append-suffix + #'magit-push ["r"] + (list "R" "push to Gerrit for review" #'magit-gerrit-push-for-review)) + +(transient-define-suffix magit-gerrit-push-wip () + "Push to Gerrit as a work-in-progress." + (interactive) + (magit-push-refspecs tvl-gerrit-remote + (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) + (magit-push-refspecs tvl-gerrit-remote + (tvl--gerrit-ref tvl-target-branch '("submit")) + nil)) + +(transient-append-suffix + #'magit-push ["r"] + (list "S" "push to Gerrit to submit" #'magit-gerrit-submit)) + + +(transient-define-suffix magit-gerrit-rubberstamp () + "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 + '("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 |