;;; jao-eww-session.el --- Persistent eww sessions -*- lexical-binding: t; -*-

;; Copyright (C) 2003, 2004, 2006, 2007, 2008, 2009, 2012, 2021  Jose A Ortega Ruiz

;; Author: Jose A Ortega Ruiz <jao@gnu.org>
;; Version: 0.4
;; Keywords: hypermedia, eww, WWW

;; This file 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, or (at your option)
;; any later version.

;; This file 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 GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; jao-eww-session provides persistent eww browsing sessions. When
;; quitting eww (or, if you request it, at any other time while using
;; it) you can save the current eww session (that is, the set of open
;; tabs and the URLs they're visiting). Upon restarting emacs, you'll
;; have the possibity of recovering the saved session (that is, of
;; re-opening the saved tabs and URLs). You also have at your disposal
;; a command to recover the saved session at any other time, via the
;; commands:
;;
;;   jao-eww-session-load  --  load the last stored session
;;   jao-eww-session-save  --  save the current session
;;
;; A customization group, jao-eww-session, is available. There you can
;; customize the following variables:

;;; Code:

;;; Dependencies:

(require 'eww)
(require 'url)

;;; Custom variables:

(defgroup jao-eww-session nil
  "eww - session saving in eww."
  :group 'eww
  :prefix "jao-eww-session-")

(defcustom jao-eww-session-save-always nil
  "If on, always save eww session without asking."
  :type 'boolean)

(defcustom jao-eww-session-load-always nil
  "If on, always load eww session without asking."
  :type 'boolean)

(defcustom jao-eww-session-show-titles t
  "If on, show URL titles in the load prompt."
  :type 'boolean)

(defcustom jao-eww-session-duplicate-tabs 'never
  "How to treat session URL already being visited.

When loading a session with `jao-eww-session-load', if one of the URLs in
the session is already displayed in a eww tab, jao-eww-session can:
- `never' create a new tab (just reload it), or
- `always' duplicate the URL in a new tab, or
- `ask' the user what to do."
  :type  '(choice (const :value never)
                  (const :value always)
                  (const :value ask)))

(defcustom jao-eww-session-file "~/.emacs.d/eww-session.eld"
  "File to save the eww session data."
  :type 'file)

;;; Internals:

;;;; auxiliary functions

(defvar jao-eww-current-session '(jao-eww-session 0 nil))

(defun jao-eww-session--list-buffers (&optional skip)
  (seq-filter (lambda (b)
                (when (not (eq b skip))
                  (with-current-buffer b (derived-mode-p 'eww-mode))))
              (buffer-list)))

(defun jao-eww-session-invisible-buffers ()
  (seq-filter (lambda (b) (null (get-buffer-window b)))
              (jao-eww-session--list-buffers (current-buffer))))

(defun jao-eww--current-url ()
  (when-let (url (eww-current-url)) (url-encode-url url)))

(defun jao-eww-session--current-urls (&optional skip-current)
  (let ((urls)
        (cb (current-buffer))
        (pos 0)
        (count 0))
    (dolist (b (jao-eww-session--list-buffers (when skip-current cb))
               (list pos (reverse urls)))
      (set-buffer b)
      (when-let (url (jao-eww--current-url))
        (when (eq b cb) (setq pos count))
        (setq count (1+ count))
        (push (cons url (jao-eww-buffer-title)) urls)))))

(defun jao-eww-session-urls (&optional s)
  (let ((s (or s jao-eww-current-session)))
    (mapcar 'car (nth 2 s))))

(defun jao-eww-session-offset (&optional s)
  (let ((s (or s jao-eww-current-session)))
    (nth 1 s)))

(defun jao-eww-session-titles (&optional s)
  (let ((s (or s jao-eww-current-session)))
    (mapcar 'cdr (nth 2 s))))

(defun jao-eww-session--update-current (&optional skip-current)
  (save-current-buffer
    (setq jao-eww-current-session
          (cons 'jao-eww-session (jao-eww-session--current-urls skip-current)))))

(defun jao-eww-session--find-dups (urls)
  (seq-filter
   (lambda (b)
     (with-current-buffer b
       (when-let (url (jao-eww--current-url))
         (when (member url urls)
           (or (eq jao-eww-session-duplicate-tabs 'never)
               (not (y-or-n-p (format "'%s' (%s) is already open. Duplicate? "
                                      (jao-eww-buffer-title) url))))))))
   (jao-eww-session--list-buffers)))

(defun jao-eww-session-load-aux ()
  (let ((new-session (jao-eww-session-from-file
                      (expand-file-name jao-eww-session-file))))
    (when (and new-session
               (or jao-eww-session-load-always
                   (y-or-n-p
                    (if jao-eww-session-show-titles
                        (format "Load last eww session %S? "
                                (jao-eww-session-titles new-session))
                      "Load last eww session? "))))
      (setq jao-eww-current-session new-session))))

(defun jao-eww-session-from-file (fname)
  (let ((fname (jao-eww-session--check--backup fname)))
    (when (file-readable-p fname)
      (with-temp-buffer
        (insert-file-contents fname)
        (goto-char (point-min))
        (let ((sexp (read (current-buffer))))
          (and (equal 'jao-eww-session (car sexp)) sexp))))))

(defun jao-eww-session-not-empty () (> (length (jao-eww-session-urls)) 0))

(defun jao-eww-session--to--file (filename &optional skip)
  (require 'pp)
  (when (jao-eww-session-not-empty)
    (let ((inhibit-message t)
          (session (jao-eww-session--update-current skip)))
      (with-temp-buffer
        (insert ";;;; File generated by jao-eww-session. DO NOT EDIT!\n")
        (pp session (current-buffer))
        (insert "\n" ";;;; End of "
                (file-name-nondirectory jao-eww-session-file) "\n")
        (write-region (point-min) (point-max) (expand-file-name filename))))))

(defun jao-eww-session--backup-name (fname)
  (concat (expand-file-name fname) ".bak"))

(defun jao-eww-session--check--backup (fname)
  (let ((bfname (jao-eww-session--backup-name fname)))
    (if (and (file-newer-than-file-p bfname fname)
             (y-or-n-p "A newer autosaved session exists. Use it? "))
        bfname
      fname)))

(defun jao-eww-session--save-backup (&optional skip)
  (let ((f (jao-eww-session--backup-name jao-eww-session-file)))
    (jao-eww-session--to--file f skip)))

(defun jao-eww-session--save-backup-1 ()
  (when (derived-mode-p 'eww-mode) (jao-eww-session--save-backup t)))

;;;; save session on checkpoints
(add-hook 'kill-emacs-query-functions #'jao-eww-session-save)
(add-hook 'kill-buffer-hook #'jao-eww-session--save-backup-1)
(add-hook 'eww-after-render-hook #'jao-eww-session--save-backup)
(advice-add 'eww-back-url :after #'jao-eww-session--save-backup)
(advice-add 'eww-forward-url :after #'jao-eww-session--save-backup)

;;;###autoload
(defun jao-eww-buffer-title () (plist-get eww-data :title))

;;;###autoload
(defun jao-eww-session-save ()
  "Save the current eww session."
  (interactive)
  (when (and (jao-eww-session-not-empty)
             (or jao-eww-session-save-always (y-or-n-p "Save eww session? ")))
    (jao-eww-session--to--file jao-eww-session-file))
  t)

;;;###autoload
(defun jao-eww-session-load ()
  "Load last stored session into eww."
  (interactive)
  (when-let ((s (jao-eww-session-load-aux)))
    (let* ((urls (jao-eww-session-urls s))
           (offset (jao-eww-session-offset s))
           (buffers (unless (equal jao-eww-session-duplicate-tabs 'always)
                      (jao-eww-session--find-dups urls))))
      (dolist (url urls) (eww url 4))
      (seq-each #'kill-buffer buffers)
      (unless (zerop offset)
        (switch-to-buffer (nth offset (jao-eww-session--list-buffers)))))))

(provide 'jao-eww-session)
;;; jao-eww-session.el ends here