dict: Quality-of-life changes

I am too tired to list the changes.

1 files changed, 390 insertions, 48 deletions

diff --git a/durand-dict.el b/durand-dict.el
index 0e1f8e7..0eb98e4 100644
--- a/durand-dict.el
+++ b/durand-dict.el
@@ -32,6 +32,8 @@
 
 ;;; Code:
 
+;;;; Requirements
+
 ;; structure library
 (require 'cl-lib)
 
@@ -44,6 +46,52 @@
 ;; URL fetching library
 (require 'url)
 
+;; obtaining word at point
+(require 'thingatpt)
+
+;; Multilingually reading command
+;;
+;; For some reason mule-cmds does not provide a package, so we simply
+;; ignore errors here.
+(ignore-errors (require 'mule-cmds))
+
+;;;; Convenient key-bindings
+
+(defvar durand-dictionary-keymap (make-sparse-keymap "dictionary")
+  "A keymapp for dictionary-related functionaties.")
+
+(define-key durand-dictionary-keymap (vector ?t) #'dudict-quick-tamil)
+
+(define-key global-map (vector 3 ?d) durand-dictionary-keymap)
+(define-key global-map (vector ?\H-d) durand-dictionary-keymap)
+
+;;;;; A history variable
+
+(defvar dudict-tamil-history nil
+  "History variable for the Tamil search.")
+
+;;;;; Quick search
+
+(defun dudict-quick-tamil (word include-tamilverb)
+  "Quickly search a Tamil WORD.
+Asks the user what word to search.
+
+If the cursor is over a word, that word is offered as the
+default.
+
+If INCLUDE-TAMILVERB is non-nil, also search for the Tamil Verb
+website."
+  (interactive
+   (let ((def (thing-at-point 'word)))
+     (list
+      (read-multilingual-string "Word to search: " def "tamil99")
+      current-prefix-arg)))
+  (let ((methods
+         (cons
+          dudict-search-agarathi
+          (cond (include-tamilverb (list dudict-search-tamilverb))))))
+    (dudict-search methods word #'dudict-tamil-buffer-name)))
+
 ;;;; Derived mode
 
 (define-derived-mode dudict-mode org-mode "DUDICT"
@@ -64,7 +112,9 @@ parse, and to present the search results to the user."
    :type function)
   (search
    nil
-   :documentation "Searching function, required"
+   :documentation "Searching function, required.
+This should be a function that receives a word and returns the
+URL to fetch."
    :type function)
   (parse
    nil
@@ -82,54 +132,97 @@ parse, and to present the search results to the user."
 
 ;;;;; Main framework function
 ;; Main framework function
-(defun dudict-search (search-method word)
+(defun dudict-search (search-method word present-fun)
   "Search for the definition of WORD by means of SEARCH-METHOD.
 SEARCH-METHOD should be a struct `dudict-search' that provides
 methods to pre-process, to search, and to post-process the search
-results.  All this does is to integrate various methods provided."
+results.  All this does is to integrate various methods provided.
+
+PRESENT-FUN should be a function that accepts the WORD and
+returns the buffer name to contain the search results."
   (cond
-   ((dudict-search-p search-method))
-   ((user-error "Requires a dudict-search struct, but found %S"
-                search-method)))
-  (let* ((name (dudict-search-name search-method))
-         (preprocess (dudict-search-pre search-method))
-         (search (dudict-search-search search-method))
-         (parse (dudict-search-parse search-method))
-         (present (dudict-search-present search-method))
-         (present-name (concat name " - " word))
-         temp-buffer parse-result)
+   ((dudict-search-p search-method)
+    (setq search-method (list search-method)))
+   ((and (listp search-method)
+         (eval
+          (cons
+           'and
+           (mapcar #'dudict-search-p search-method)))))
+   ((error "Requires a `dudict-search' struct or a list of \
+them, but found %S"
+           search-method)))
+  (cond
+   ((and (functionp present-fun)
+         (equal (func-arity present-fun) (cons 1 1))))
+   ((error "Requires a function with one argument for PRESENT-FUN, \
+but got %S"
+           present-fun)))
+  (let ((present-name (funcall present-fun word))
+        (ls search-method)
+        temp-buffer method)
     (cond
      ((setq temp-buffer (get-buffer present-name))
       ;; already searched
       (switch-to-buffer temp-buffer))
      (t
-      (cond
-       ((functionp preprocess)
-        (setq word (funcall preprocess word))))
-      (cond
-       ((functionp search))
-       (user-error "Requires a function to search, but found %S"
-                   search))
-      (setq temp-buffer (funcall search word))
-      (cond
-       ((functionp parse))
-       (user-error "Requires a function to parse, but found %S"
-                   parse))
-      (with-current-buffer temp-buffer
-        (setq parse-result (funcall parse)))
-      (kill-buffer temp-buffer)
-      (cond
-       ((functionp present))
-       ((user-error "Requires a function to present, but found %S"
-                    present)))
+      ;; must be new buffer
       (setq temp-buffer (get-buffer-create present-name))
-      (with-current-buffer temp-buffer
-        (delete-region (point-min) (point-max))
-        (funcall present parse-result))
+      (while (consp ls)
+        (setq method (car ls))
+        (setq ls (cdr ls))
+        (let* ((name (dudict-search-name method))
+               (preprocess (dudict-search-pre method))
+               (search (dudict-search-search method))
+               (parse (dudict-search-parse method))
+               (present (dudict-search-present method))
+               temp-buffer parse-result)
+          (cond
+           ((functionp preprocess)
+            (setq word (funcall preprocess word))))
+          (cond
+           ((and
+             (functionp search)
+             (equal (func-arity search) (cons 1 1))))
+           ((error
+             "Requires a function with one argument, but found %S"
+             search)))
+          (setq search (funcall search word))
+          (setq
+           temp-buffer
+           (url-retrieve-synchronously
+            search t t 20))
+          (cond
+           ((functionp parse))
+           (error "Requires a function to parse, but found %S"
+                  parse))
+          (with-current-buffer temp-buffer
+            (setq parse-result (funcall parse)))
+          (kill-buffer temp-buffer)
+          (cond
+           ((and (functionp present)
+                 (equal (func-arity present) (cons 1 1))))
+           ((error
+             "Requires a function with one argument, but found %S"
+             present)))
+          ;; already created
+          (setq temp-buffer (get-buffer present-name))
+          (with-current-buffer temp-buffer
+            (goto-char (point-max))
+            (newline)
+            (insert "* " name)
+            (newline)
+            (funcall present parse-result))))
       (switch-to-buffer temp-buffer)
       (dudict-mode)
       (goto-char (point-min))))))
 
+;;;; Tamil dictionary buffer name
+
+(defun dudict-tamil-buffer-name (word)
+  "Return the buffer name for holding Tamil WORD searches."
+  (declare (side-effect-free t) (pure t))
+  (concat "தமிழ் - " word))
+
 ;;;; agarathi dictionary
 ;; For searching the agarathi dictionary, we for now do not need to
 ;; preprocess the search term, but in the future it might be useful to
@@ -160,23 +253,19 @@ results.  All this does is to integrate various methods provided."
        :pre nil
        :search (function
                 (lambda (word)
-                  (url-retrieve-synchronously
-                   (concat "https://agarathi.com/word/" word)
-                   t t 20)))
+                  (concat "https://agarathi.com/word/" word)))
        :parse #'dudict-parse-agarathi
        :present #'dudict-present-agarathi))
 
 ;;;;; Short-cut
 
-(defvar dudict-agarathi-history nil
-  "History variable for the agarathi search.")
-
 (defun dudict-search-agarathi (word)
   "A short-cut that passes `dudict-search-agarathi' and WORD to
 `dudict-search'."
   (interactive
-   (read-string "Enter search term: " nil 'dudict-agarathi-history))
-  (dudict-search dudict-search-agarathi word))
+   (read-string "Enter search term: " nil 'dudict-tamil-history))
+  (dudict-search
+   dudict-search-agarathi word #'dudict-tamil-buffer-name))
 
 ;;;;; Structures of the dictionary website
 
@@ -675,14 +764,14 @@ arise."
     (while (consp panels)
       (setq panel (car panels))
       (setq panels (cdr panels))
-      (insert "* " (agarathi-panel-title panel))
+      (insert "** " (agarathi-panel-title panel))
       (newline)
       (setq descriptions (agarathi-panel-descriptions panel))
       (while (consp descriptions)
         (setq description (car descriptions))
         (setq descriptions (cdr descriptions))
         (insert
-         "** "
+         "*** "
          (dudict-trim (agarathi-description-title description)))
         (newline)
         (setq definitions
@@ -695,7 +784,7 @@ arise."
               (agarathi-description-examples description))
         (cond
          (examples
-          (insert "*** Examples")
+          (insert "**** Examples")
           (newline)
           (mapc
            (lambda (ex) (insert "+ " (dudict-trim ex)) (newline))
@@ -711,9 +800,262 @@ arise."
    (string 32)
    str))
 
-;;;;; Test
+;;;; Tamilverb dictionary
+
+;;;;; Search Struct
+
+(defvar dudict-search-tamilverb nil
+  "The search struct that is used to search the Tamil Verb \
+dictionary.")
+
+(setq dudict-search-tamilverb
+      (make-dudict-search
+       :name "TamilVerb"
+       :pre nil
+       :search (function
+                (lambda (word)
+                  (concat "https://tamilverb.com/?q=" word)))
+       :parse #'dudict-parse-tamilverb
+       :present #'dudict-present-tamilverb))
+
+;;;;; Short-cut
+
+(defun dudict-search-tamilverb (word)
+  "A short-cut that passes `dudict-search-tamilverb' and WORD to
+`dudict-search'."
+  (interactive
+   (read-string "Enter search term: " nil 'dudict-tamil-history))
+  (dudict-search
+   dudict-search-tamilverb word #'dudict-tamil-buffer-name))
+
+;;;;; Structures
+
+;;;;;; All entries
+
+(cl-defstruct tamilverb-entries
+  "A list of entries."
+  (ls
+   nil
+   :documentation "The list of contained entries.
+Each entry has the type `tamilverb-entry'."
+   :type list))
+
+(defun tamilverb-check-valid-entries (entries)
+  "Check that an object is a valid entries structure."
+  (declare (side-effect-free t) (pure t))
+  (and
+   (tamilverb-entries-p entries)
+   (let ((ls (tamilverb-entries-ls entries))
+         (result t)
+         temp)
+     (and
+      (listp ls)
+      (progn
+        (while (consp ls)
+          (setq temp (car-safe ls))
+          (setq ls (cdr-safe ls))
+          (cond
+           ((tamilverb-check-valid-entry temp))
+           (t
+            (setq result nil)
+            (setq ls nil))))
+        result)))))
+
+;;;;;; One entry
+
+(cl-defstruct tamilverb-entry
+  "An entry of the definition.
+It contains the headword, which is a short summary of the definition.
+
+Then it contains the verb class, and some \"sub-words\", which
+are alternate (spoken) spellings.
+
+Then follow the detailed definitions.
+
+Finally it contains one usage example and optionally some
+synonyms."
+  (head
+   ""
+   :documentation "A short summary."
+   :type string)
+  (class
+   0
+   :documentation "The verb class of the verb."
+   :type integer)
+  (transitivity
+   nil
+   :documentation "The transitivity of the verb."
+   :type bool)
+  (def
+   ""
+   :documentation "Detailed definition."
+   :type string)
+  (sub
+   ""
+   :documentation "Spellings"
+   :type string)
+  (ex
+   ""
+   :documentation "A usage example"
+   :type string)
+  (synonyms
+   nil
+   :documentation "Some synonyms"
+   :type list))
+
+(defun tamilverb-check-valid-entry (entry)
+  "Check that an object is a valid entry structure."
+  (declare (side-effect-free t) (pure t))
+  (and
+   (tamilverb-entry-p entry)
+   (let ((head (tamilverb-entry-head entry))
+         (class (tamilverb-entry-class entry))
+         (trans (tamilverb-entry-transitivity entry))
+         (def (tamilverb-entry-def entry))
+         (sub (tamilverb-entry-sub entry))
+         (ex (tamilverb-entry-ex entry))
+         (synonyms (tamilverb-entry-synonyms entry)))
+     (and
+      (stringp head)
+      (integerp class)
+      (or (null trans) (equal trans t))
+      (stringp def)
+      (stringp sub)
+      (stringp ex)
+      (listp synonyms)
+      (eval (cons #'and (mapcar #'stringp synonyms)))))))
+
+;;;;; main function
+
+(defun dudict-parse-tamilverb ()
+  "Parse the search result from the Tamil Verb website.
+The current buffer is assumed to contain the search results already."
+  ;; ;; First re-insert the results, as the Tamil Verb website escapes
+  ;; ;; the characters for some reason.
+  ;; (let ((dom (libxml-parse-html-region (point-min) (point-max))))
+  ;;   (delete-region (point-min) (point-max))
+  ;;   (dom-print dom))
+  (let* ((dom (libxml-parse-html-region (point-min) (point-max)))
+         (entries (dom-by-tag dom 'entry))
+         (result (make-tamilverb-entries)))
+    (cond
+     ((null entries))
+     ((setq
+       result
+       (make-tamilverb-entries
+        :ls (mapcar #'dudict-parse-tamilverb-entry entries)))))
+    result))
+
+;;;;; Parse one entry
+
+(defun dudict-parse-tamilverb-entry (entry)
+  "Convert ENTRY to a `tamilverb-entry' struct."
+  (declare (side-effect-free t) (pure t))
+  (let* ((head (dom-text (car (dom-by-tag entry 'headword))))
+         (class (dom-text (car (dom-by-tag entry 'verbclass))))
+         (trans (cond
+                 ((string-match-p "intr" class) nil)
+                 (t)))
+         (class (string-to-number
+                 (save-match-data
+                   (string-match (rx-to-string (list 'seq 'digit) t)
+                                 class)
+                   (match-string 0 class))))
+         (def (dom-text (car (dom-by-tag entry 'definition))))
+         (sub (dom-texts (car (dom-by-tag entry 'subword))))
+         (ex (dom-texts
+              (car
+               (dom-by-class
+                (car (dom-by-tag entry 'usage))
+                (rx-to-string (list 'seq 'bos "detail" 'eos) t)))))
+         (synonyms (dom-texts
+                    (car
+                     (dom-by-class
+                      (car (dom-by-tag entry 'synonyms))
+                      (rx-to-string
+                       (list 'seq 'bos "detail" 'eos) t))))))
+    (make-tamilverb-entry
+     :head head
+     :class class
+     :transitivity trans
+     :def def
+     :sub sub
+     :ex ex
+     :synonyms synonyms)))
+
+;;;;; De-escaping function
+
+(defun dudict-de-escape (str)
+  "If STR contains slices of the form \"&#xNNN;\", where NNN are
+digits, replace those slices by UNICODE characters with the
+corresponding UNICODE code point.
+
+Tamil Verb website escapes the Tamil Script in this way, maybe to
+suit some legacy devices?"
+  (declare (side-effect-free t) (pure t))
+  (let ((s str)
+        (regex (rx-to-string
+                (list
+                 'seq "&#x"
+                 (list 'group (list 'one-or-more 'hex))
+                 ?\;)
+                t)))
+    (save-match-data
+      (while (string-match regex s)
+        (setq
+         s
+         (replace-match
+          (make-string 1 (string-to-number (match-string 1 s) 16))
+          t t s))))
+    s))
+
+;;;;; Insert the parse result
+
+(defun dudict-present-tamilverb (entries)
+  "Insert the entries into the current buffer."
+  (cond
+   ((tamilverb-entries-p entries))
+   ((error "Requires a tamilverb-entries, but found %S" entries)))
+  (let* ((entries (tamilverb-entries-ls entries))
+         entry head class trans def ex syn)
+    (cond
+     ((null entries)
+      (insert "Not found")
+      (newline)))
+    (while (consp entries)
+      (setq entry (car entries))
+      (setq entries (cdr entries))
+      (insert "** " (tamilverb-entry-head entry))
+      (newline)
+      (insert
+       (format "Class: %d" (tamilverb-entry-class entry)))
+      (newline)
+      (insert
+       (format "Transitivity: %S"
+               (tamilverb-entry-transitivity entry)))
+      (newline)
+      (insert
+       (dudict-trim (dudict-de-escape (tamilverb-entry-sub entry))))
+      (newline 2)
+      (insert (tamilverb-entry-def entry))
+      (newline)
+      (insert "*** Example Usage")
+      (newline)
+      (insert
+       (dudict-trim (dudict-de-escape (tamilverb-entry-ex entry))))
+      (newline)
+      (insert "*** Synonyms")
+      (newline)
+      (insert
+       (dudict-trim
+        (dudict-de-escape (tamilverb-entry-synonyms entry))))
+      (newline))))
+
+;;;; Wiktionary search
 
-(dudict-parse-agarathi "கறுப்பு")
+;; TODO: Take the search from https://en.wiktionary.org/ into the
+;; considerations, as sometimes this is more reliable and includes
+;; more modern usages.
 
 (provide 'durand-dict)
 ;;; durand-dict.el ends here