;;; 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