Add 'lookup' to 'util'

util/lookup/README.org

@@ -0,0 +1,59 @@
+** About
+   This is a tiny module for automating dictionary and search engine
+   lookups under StumpWM. It operates on user-provided query strings,
+   either typed on the keyboard or obtained from the X selection. The
+   user query, combined with the relevant URL, gets passed to the
+   browser via =xdg-open=.
+** Usage
+*** Installation
+    To enable the =lookup= module run the following (assuming your
+    Quicklisp can reach the =stumpwm-contrib= directory):
+    #+BEGIN_SRC lisp
+      (ql:quickload :lookup)
+    #+END_SRC
+*** Keybindings
+    The module defines two StumpWM commands for performing dictionary
+    and search engine lookups, =dictionary-lookup= and =search-lookup=,
+    respectively. By default, they are bound to =s-d= and =s-g=,
+    respectively. They can easily be rebound by running the following
+    code:
+    #+BEGIN_SRC lisp
+      (define-key *top-map* (kbd "<new-binding>") "<lookup-command>")
+    #+END_SRC
+** Configuration
+*** Adding/changing dictionaries
+    In order to add new or modify existing entries one needs to add
+    appropriate entries to the =lookup::*dictionaries*= plist. For
+    instance, to define a new entry for German (regardless of whether
+    there was one previously) one would run the following code:
+    #+BEGIN_SRC lisp
+      (setf (getf lookup::*dictionaries* :de)
+            "http://en.pons.com/translate?q=~a&l=deen#dict")
+    #+END_SRC
+    The query URL requires exactly one instance of =~a=, where the URL
+    would normally have the query string. The query string will be
+    subject to URL-encoding before opening.
+*** Changing search engine
+    Currently the =lookup= module only supports a single search engine
+    (Google by default). In order to change that one needs to
+    customize the variable =lookup::*search-engine*=. For instance, to
+    switch to DuckDuckGo, one would run the following code:
+    #+BEGIN_SRC lisp
+      (setf lookup::*search-engine* "https://duckduckgo.com/?q=~a")
+    #+END_SRC
+    Remember to put exactly one instance of =~a= in the URL, where the
+    query string is expected.
+*** Sticky language selection
+    The default behavior of dictionary lookup is to provide two-level
+    selection - first for the language, then for the search
+    phrase. With the sticky language selection enabled the =lookup=
+    module remembers the last language used and suggests it for the
+    user (requiring them to press Enter to accept). This saves some
+    typing when performing a sequence of lookups for the same
+    language. Last choice is remembered for the duration of the
+    current session. It is enabled by default. To disable it run the
+    following code:
+    #+BEGIN_SRC lisp
+      (setf lookup::*sticky-language-selection* nil)
+    #+END_SRC
+

util/lookup/lookup.asd

@@ -0,0 +1,10 @@
+;;;; lookup.asd
+
+(asdf:defsystem #:lookup
+  :serial t
+  :description "Dictionary/search engine lookup module for StumpWM."
+  :author "Wojciech S. Gac <wojciech.s.gac@gmail.com>"
+  :license "GPLv3"
+  :depends-on (#:stumpwm #:alexandria)
+  :components ((:file "package")
+               (:file "lookup")))

util/lookup/lookup.lisp

@@ -0,0 +1,83 @@
+;;;; lookup.lisp
+
+(in-package #:lookup)
+
+;;; "lookup" goes here. Hacks and glory await!
+
+;; Dictionary/search engine lookup module for StumpWM.
+;;
+;; Copyright (C) 2019 Wojciech S. Gac
+;;
+;; Maintainer: Wojciech S. Gac
+;;
+
+;;; Code:
+
+;; Dictionary Lookup
+(defparameter *dictionaries*
+  '(:en "https://www.thefreedictionary.com/~a"
+    :ja "https://jisho.org/search/~a"
+    :ru "http://en.pons.com/translate?q=~a&l=enru"
+    :pl "https://sjp.pwn.pl/szukaj/~a.html"
+    :de "https://dict.tu-chemnitz.de/dings.cgi?service=deen&opterrors=0&optpro=0&query=~a&iservice="
+    :es "https://www.spanishdict.com/translate/~a")
+  "List of dictionaries available to the service. Right now there is
+  one dictionary per language. This may change in the future.")
+
+(defparameter *sticky-language-selection* t
+  "When set to non-NIL, the system will by default suggest the
+  language used for the previous lookup.")
+
+(defparameter *last-language-selected* nil
+  "Stores the last language selected for lookup.")
+
+(defun %dictionary-lookup (lang &key (dictionaries *dictionaries*))
+  "Given a language LANG, obtain a lookup phrase from the user,
+suggesting current X selection."
+  (let ((url-template (getf dictionaries (make-keyword (string-upcase lang)))))
+    (unless url-template
+      (error "Unknown lookup language: ~a" lang))
+    (let* ((phrase (read-one-line (current-screen)
+				  (format nil "Lookup [~a]: " lang)
+				  :initial-input (get-x-selection)))
+	   (url (format nil url-template
+			(quri::url-encode (or phrase ; Non-local exit if empty
+					      (return-from %dictionary-lookup nil))))))
+      (run-shell-command (format nil "xdg-open '~a'" url)))))
+
+
+(defcommand dictionary-lookup () ()
+  (let ((lang (completing-read (current-screen) "Language: "
+			       (loop for (k v) on *dictionaries* by #'cddr
+				     collect (symbol-name k)
+				     collect (string-downcase
+					      (symbol-name k)))
+			       :require-match t
+                               :initial-input (when *sticky-language-selection*
+                                                *last-language-selected*))))
+    (when *sticky-language-selection*
+      (setf *last-language-selected* lang))
+    (%dictionary-lookup (or lang
+			    (return-from dictionary-lookup)))))
+
+;; Search Engine Lookup
+(defparameter *search-engine*
+  "https://www.google.com/search?q=~a")
+
+(defun %search-lookup ()
+  "Interactively obtain a lookup phrase. By default suggest current X
+selection. Pass the phrase to the search engine and open result in the
+browser."
+  (let* ((phrase (read-one-line (current-screen) "Google Lookup: "
+				:initial-input (get-x-selection)))
+	 (url (format nil *search-engine*
+		      (quri::url-encode (or phrase
+					    (return-from %search-lookup nil))))))
+    (run-shell-command (format nil "xdg-open ~a" url))))
+
+(defcommand search-lookup () ()
+  (%search-lookup))
+
+;; Key Bindings
+(define-key *top-map* (kbd "s-d") "dictionary-lookup")
+(define-key *top-map* (kbd "s-g") "search-lookup")

util/lookup/package.lisp

@@ -0,0 +1,4 @@
+;;;; package.lisp
+
+(defpackage #:lookup
+  (:use #:cl #:stumpwm #:alexandria))