From a2482f465703b4f520228be0cd7c8ca83ffa75f5 Mon Sep 17 00:00:00 2001 From: Adrien Date: Mon, 18 Jul 2022 17:34:26 +0200 Subject: [PATCH] Add first feature: fetch sentence examples and display them on a buffer --- lengusa4e.el | 237 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 237 insertions(+) create mode 100644 lengusa4e.el diff --git a/lengusa4e.el b/lengusa4e.el new file mode 100644 index 0000000..5b0f4f7 --- /dev/null +++ b/lengusa4e.el @@ -0,0 +1,237 @@ +;;; lengusa4e.el --- Lengusa integration for Emacs -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Adrien Sueur + +;; Author: Adrien Sueur +;; Version: 0.1 +;; Package-Requires: ((emacs "27.1")) +;; Keywords: TBD +;; URL: TBD + +;; This file is NOT part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; TBD +;; + +;;; Code: + +(require 'subr-x) +(require 'eieio) + +;; Customizatiion options +(defgroup lengusa4e nil + "Lengusa4e: A lengusa interface for Emacs." + :group 'lengusa4e + :prefix "lengusa4e-") + +(defcustom lengusa4e-sentence-examples-url "https://www.lengusa.com/sentence-examples" + "Lengusa URL to use for retrieving sentence examples." + :group 'lengusa4e + :type '(string)) + +(defcustom lengusa4e-sentence-examples-nb 10 + "Number of sentence examples to fetch for a given entry." + :group 'lengusa4e + :type '(int)) + +(defclass lengusa4e--sentence () + ((text :initarg text + :initform nil + :type (or null string) + :documentation "The text of the example") + (source :initarg source + :initform "" + :type string + :documentation "The name of the sentence source") + (url :initarg url + :initform nil + :type (or null string) + :documentation "The URL from which the sentence has been collected"))) + +(defclass lengusa4e--search () + ((entry :initarg entry + :initform nil + :type (or null string) + :documentation "The search entry") + (encoding :initarg encoding + :initform "utf-8" + :type (or null string) + :documentation "The name of the sentences encoding system") + (sentences :initarg sentences + :type (list-of lengusa4e--sentence) + :initform (list) + :documentation "A list of sentences illustrating the entry"))) + +(defgroup lengusa4e-faces nil + "Faces used by lengusa4e." + :prefix "lengusa4e-" + :group 'lengusa4e) + +(defface lengusa4e-keyword-face + '((t (:foreground "red"))) + "Lengusa4e face for keywords." + :package-version '(lengusa4e . "0.1") + :group 'lengusa4e-faces) + +(defface lengusa4e-reference-face + '((t (:foreground "green"))) + "Lengusa4e face for keywords." + :package-version '(lengusa4e . "0.1") + :group 'lengusa4e-faces) + +(defconst lengusa4e-sentences-buffer "*Lengusa4e Sentences*" + "The name of the buffer to show example sentences in.") + +(defun lengusa4e-sentences-buffer () + "Get the buffer object to show example sentences in. +Get the buffer named by variable `lengusa4e-sentences-buffer', +or nil if the buffer does not exist." + (get-buffer lengusa4e-sentences-buffer)) + +(define-derived-mode lengusa4e-sentences-mode special-mode + "Lengusa4e example sentences" + "Major mode for example sentences." + (setq buffer-read-only t) + (buffer-disable-undo)) + +(defun lengusa4e-display-example-sentences (search) + "Display the example setences for SEARCH instance." + ;; TODO: Fit window to the buffer content. + (with-slots (sentences) search + (when-let (buf (get-buffer lengusa4e-sentences-buffer)) + (with-current-buffer buf + (unless (derived-mode-p 'lengusa4e-sentences-mode) + (lengusa4e-sentences-mode)) + (setq buffer-read-only nil) + (save-excursion + (erase-buffer) + (let ((max-width (window-width))) + (set-fill-column max-width) + (dolist (sentence sentences) + (let* ((text (slot-value sentence 'text)) + (source (slot-value sentence 'source)) + (source-length (length source)) + (url (slot-value sentence 'url))) + (put-text-property 0 source-length 'font-lock-face 'lengusa4e-reference-face source) + (insert-and-inherit text) + (insert (make-string (- max-width source-length (% (current-column) max-width)) ? )) + (insert-button source 'action `(lambda(x) (browse-url ,url))) + (insert "\n")))) + (setq buffer-read-only t)))))) + +(defun lengusa4e--search--format-sentence-from-html (encoded) + "Return a propertized elisp sentence string from the html ENCODED sentence." + (let ((continue 1) + (prev-begin 0) + (prev-end 0)) + (while (= continue 1) + (let* ((begin (string-match "" encoded (+ prev-begin 1))) + (end (string-match "" encoded (+ prev-end 1)))) + (if (or (equal begin nil) + (equal end nil)) + (setq continue 0) + (progn + (put-text-property (+ begin 8) end 'font-lock-face 'lengusa4e-keyword-face encoded) + (setq prev-begin begin) + (setq prev-end end)))))) + (replace-regexp-in-string "" "" encoded)) + +(cl-defmethod lengusa4e--search-load-sentences ((search lengusa4e--search) (buffer buffer)) + "Fill SEARCH sentences attribute with the content of the html BUFFER. +The given BUFFER consist of the lengusa response +of 'lengusa4e-sentence-examples-url' query." + (with-current-buffer buffer + (let ((continue 1)) + (while (= continue 1) + (let* ((begin (search-forward "

" nil t))) + (if (equal begin nil) + (setq continue 0) + (let ((sentence nil) + (paragraph (buffer-substring (- begin 3) end))) + (save-match-data + ;; Elisp doesn't seem to manage Negative Lookahead: class="(.*)">(?! + (if (and (string-match "class=\"\\([^\"]*\\)\">\\([^<].*\\)

" paragraph) + (not (string-prefix-p "" nil t)) + (cite-end (search-forward "" nil t))) + (if (not (equal cite-begin nil)) + (let ((cite (buffer-substring (- cite-begin 6) cite-end))) + (save-match-data + (if (string-match "href=\"\\([^\"]*\\)\"[^>]*>\\([^<]*\\)<" cite) + (with-slots (url source) sentence + (setq url (match-string 1 cite)) + (setq source (string-trim-right (match-string 2 cite))))))))))))))))) + + +(cl-defmethod lengusa4e--search-on-dl-sentence-examples-cb ((search lengusa4e--search) (buffer buffer)) + "Fill SEARCH sentences filling from BUFFER response." + (lengusa4e--search-load-sentences search buffer) + (lengusa4e-display-example-sentences search)) + +(cl-defmethod lengusa4e--search-get-sentence-examples ((search lengusa4e--search)) + "Get the SEARCH sentence examples. +If sentences attribute is empty, request examples from Lengusa website." + (with-slots (sentences) search + (if (eq sentences nil) + (lengusa4e--search-dl-sentence-examples search) + ))) + +(cl-defmethod lengusa4e--get-encoding ((search lengusa4e--search) (buffer buffer)) + "Set SEARCH encoding attribute from the html BUFFER header. +This method extract the 'charset' attribute provided by the HTTP server." + (with-current-buffer buffer + (let* ((begin (search-forward "charset=" nil t)) + (end (search-forward "\n" nil t))) + (setf (slot-value search 'encoding) (buffer-substring begin (- end 1))) + ))) + +(cl-defmethod lengusa4e--search-dl-sentence-examples ((search lengusa4e--search)) + "Fill SEARCH with the sentence examples downloaded from lengusa." + (with-slots (entry) search + (let ((url (format "%s/%s" lengusa4e-sentence-examples-url entry))) + (url-retrieve url + (lambda (_result) + (lengusa4e--get-encoding search (current-buffer)) + (lengusa4e--search-on-dl-sentence-examples-cb search (current-buffer)) + (kill-buffer)))))) + +;; Entry points +(defun lengusa4e-get-sentence-examples (entry &optional _others) + "Request sentence examples for ENTRY and display them in a dedicated buffer." + (interactive + (list (read-from-minibuffer "Word(s) to lengusa: ") current-prefix-arg)) + (let ((search (make-instance 'lengusa4e--search 'entry entry))) + (with-current-buffer (get-buffer-create lengusa4e-sentences-buffer) + (lengusa4e-sentences-mode) + (display-buffer lengusa4e-sentences-buffer)) + (lengusa4e--search-get-sentence-examples search) +)) + +(provide 'lengusa4e) +;;; lengusa4e.el ends here