about summary refs log tree commit diff
path: root/tools/emacs-pkgs
diff options
context:
space:
mode:
Diffstat (limited to 'tools/emacs-pkgs')
-rw-r--r--tools/emacs-pkgs/defzone/defzone.el60
-rw-r--r--tools/emacs-pkgs/defzone/example.el45
-rw-r--r--tools/emacs-pkgs/dottime/default.nix7
-rw-r--r--tools/emacs-pkgs/dottime/dottime.el81
-rw-r--r--tools/emacs-pkgs/nix-util/default.nix7
-rw-r--r--tools/emacs-pkgs/nix-util/nix-util.el103
-rw-r--r--tools/emacs-pkgs/term-switcher/default.nix14
-rw-r--r--tools/emacs-pkgs/term-switcher/term-switcher.el56
8 files changed, 373 insertions, 0 deletions
diff --git a/tools/emacs-pkgs/defzone/defzone.el b/tools/emacs-pkgs/defzone/defzone.el
new file mode 100644
index 0000000000..ffd359e5ff
--- /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 0000000000..e9c86d25ee
--- /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 0000000000..633aad187e
--- /dev/null
+++ b/tools/emacs-pkgs/dottime/default.nix
@@ -0,0 +1,7 @@
+{ pkgs, ... }:
+
+pkgs.emacsPackages.trivialBuild rec {
+  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 0000000000..2446f6488f
--- /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 0000000000..2356ad75f2
--- /dev/null
+++ b/tools/emacs-pkgs/nix-util/default.nix
@@ -0,0 +1,7 @@
+{ pkgs, ... }:
+
+pkgs.emacsPackages.trivialBuild rec {
+  pname = "nix-util";
+  version = "1.0";
+  src = ./nix-util.el;
+}
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 0000000000..4b9dd31a02
--- /dev/null
+++ b/tools/emacs-pkgs/nix-util/nix-util.el
@@ -0,0 +1,103 @@
+;;; nix-util.el --- Utilities for dealing with Nix code. -*- lexical-binding: t; -*-
+;;
+;; Copyright (C) 2019 Google Inc.
+;;
+;; Author: Vincent Ambo <tazjin@google.com>
+;; Version: 1.0
+;; Package-Requires: (json map)
+;;
+;;; Commentary:
+;;
+;; This package adds some functionality that I find useful when
+;; working in Nix buffers or programs installed from Nix.
+
+(require 'json)
+(require 'map)
+
+(defvar nix-depot-path "/home/tazjin/depot")
+
+(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)))
+
+(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/term-switcher/default.nix b/tools/emacs-pkgs/term-switcher/default.nix
new file mode 100644
index 0000000000..0c5e4c17cd
--- /dev/null
+++ b/tools/emacs-pkgs/term-switcher/default.nix
@@ -0,0 +1,14 @@
+{ pkgs, ... }:
+
+with pkgs.emacsPackages;
+
+melpaBuild rec {
+  pname = "term-switcher";
+  version = "1.0";
+  src = ./term-switcher.el;
+  packageRequires = [ dash ivy s vterm ];
+
+  recipe = builtins.toFile "recipe" ''
+    (term-switcher :fetcher github :repo "tazjin/depot")
+  '';
+}
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 0000000000..67595474fa
--- /dev/null
+++ b/tools/emacs-pkgs/term-switcher/term-switcher.el
@@ -0,0 +1,56 @@
+;;; term-switcher.el --- Easily switch between open vterms
+;;
+;; Copyright (C) 2019 Google Inc.
+;;
+;; Author: Vincent Ambo <tazjin@google.com>
+;; Version: 1.1
+;; Package-Requires: (dash 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 '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/open-or-create-vterm (buffer-name)
+  "Switch to the buffer with BUFFER-NAME or create a new vterm
+  buffer."
+  (let ((buffer (get-buffer buffer-name)))
+    (if (not buffer)
+        (vterm)
+      (switch-to-buffer buffer))))
+
+(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 (-map #'buffer-name
+                     (-filter #'ts/is-vterm-buffer (buffer-list)))))
+    (if terms
+        (ivy-read "Switch to vterm: "
+                  (cons "New vterm" terms)
+                  :caller 'ts/switch-to-terminal
+                  :preselect (s-concat "^" term-switcher-buffer-prefix)
+                  :require-match t
+                  :action #'ts/open-or-create-vterm)
+      (vterm))))
+
+(provide 'term-switcher)