238 lines
8.6 KiB
EmacsLisp
238 lines
8.6 KiB
EmacsLisp
;;; lengusa4e.el --- Lengusa integration for Emacs -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2022 Adrien Sueur
|
|
|
|
;; Author: Adrien Sueur <lengusa4e@adrien.run>
|
|
;; 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 <https://www.gnu.org/licenses/>.
|
|
|
|
;;; 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 "<strong>" encoded (+ prev-begin 1)))
|
|
(end (string-match "</strong>" 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 "</*strong>" "" 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 "<p " nil t))
|
|
(end (search-forward "</p>" 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="(.*)">(?!<a)(.*)<\/p>
|
|
(if (and (string-match "class=\"\\([^\"]*\\)\">\\([^<].*\\)</p>" paragraph)
|
|
(not (string-prefix-p "<a" (match-string 2 paragraph))))
|
|
(let ((classes (match-string 1 paragraph))
|
|
(text (match-string 2 paragraph)))
|
|
(if (string-search "mt-1" classes)
|
|
(with-slots (encoding sentences) search
|
|
;; TODO: Check (intern encoding) result
|
|
(let* ((encoded (decode-coding-string text (intern encoding)))
|
|
(formatted (lengusa4e--search--format-sentence-from-html encoded)))
|
|
(setq sentence (make-instance 'lengusa4e--sentence 'text formatted))
|
|
(add-to-list 'sentences sentence)))))))
|
|
(if (not (equal sentence nil))
|
|
(let ((cite-begin (search-forward "<cite>" nil t))
|
|
(cite-end (search-forward "</cite>" 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
|