;;; my-web.el -- web related extensions for emacs core -*- lexical-binding: t -*-

;; Copyright (C) 2023 Free Software Foundation.

;; Author: Yuchen Pei <id@ypei.org>
;; Package-Requires: ((emacs "28.2"))

;; This file is part of dotfiles.

;; dotfiles is free software: you can redistribute it and/or modify it under
;; the terms of the GNU Affero General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; dotfiles 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 Affero General
;; Public License for more details.

;; You should have received a copy of the GNU Affero General Public
;; License along with dotfiles.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; web related extensions for emacs core. Covers eww etc.

;;; Code:



(defun my-eww-next-path ()
  (interactive)
  (let ((url (plist-get eww-data :url)))
    (when (string-match "^\\(.*?\\)\\([0-9]+\\)\\(.*\\)$" url)
      (eww (concat
	          (match-string 1 url)
	          (number-to-string
	           (1+ (string-to-number (match-string 2 url))))
	          (match-string 3 url))))))

(defun my-eww-prev-path ()
  (interactive)
  (let ((url (plist-get eww-data :url)))
    (when (string-match "^\\(.*\\)\\([0-9]+\\)\\(.*\\)$" url)
      (eww (concat
	    (match-string 1 url)
	    (number-to-string
	     (1- (string-to-number (match-string 2 url))))
	    (match-string 3 url))))))

(defun my-eww-up-path ()
  (interactive)
  (let ((url (plist-get eww-data :url)))
    (when (and (string-match "^\\(.*//.*/\\)[^/]+\\(/\\)?$" url)
	       (match-string 1 url))
      (eww (match-string 1 url)))))

(defun my-eww-top-path ()
  (interactive)
  (let ((url (plist-get eww-data :url)))
    (when (and (string-match "^\\(.*//.*?/\\).*$" url)
	       (match-string 1 url))
      (eww (match-string 1 url)))))

(defun my-browse-url-tor-browser (url)
  "Browse URL with tor-browser."
  (setq url (browse-url-encode-url url))
  (start-process (concat "tor-browser " url) nil "tor-browser"
                 "--allow-remote" url))

(defun my-browse-url-firefox-private (url)
  "Browse URL in a private firefox window."
  (setq url (browse-url-encode-url url))
  (start-process (concat "firefox-private " url) nil "firefox"
                 "--private-window" url))

(defun my-browse-url-qutebrowser (url)
  "Browse URL with qutebrowser."
  (setq url (browse-url-encode-url url))
  (start-process (concat "qutebrowser " url) nil "qutebrowser"
                 url))

(defun my-browse-url-mullvad (url)
  "Browse URL with Mullvad browser."
  (setq url (browse-url-encode-url url))
  (start-process (concat "mullvad-browser " url) nil "mullvad-browser"
                 url))

(defun my-browse-url-at-point (arg)
  (interactive "P")
  (my-browse-url (browse-url-url-at-point) arg))

;; override eww-copy-page-url to work with bookmark id frags.
(defun eww-copy-page-url ()
  "Copy the URL of the current page into the kill ring."
  (interactive)
  (let* ((url (plist-get eww-data :url))
	 (id (get-text-property (point) 'shr-frag-id))
	 (url-no-frag
	  (if (string-match "^\\(.*\\)#.*$" url)
	      (match-string 1 url)
	    url))
	 (final-url
	  (if id (concat url-no-frag "#" id)
	    url))
	 )
    (message "%s" final-url)
    (kill-new final-url)))

(defun my-eww-switch-by-title (title-and-buffer)
  "Switches to an eww buffer with selected title."
  (interactive
   (list
    (let ((com-table))
      (dolist (buffer (buffer-list))
	      (with-current-buffer buffer
	        (when (equal major-mode 'eww-mode)
	          (add-to-list
	           'com-table
	           (concat (plist-get eww-data :title)
		                 (propertize (concat " " (buffer-name))
				                         'invisible t))))))
      (completing-read "Eww buffer title: " com-table))))
  (string-match "^.* \\(.*\\)$" title-and-buffer)
  (switch-to-buffer (match-string 1 title-and-buffer)))

(defun my-red-energy-copy-clean-url (beg end)
  "Clean up the payment url in a raw red energy bill email."
  (interactive "r")
  (let ((url (url-unhex-string
              (replace-regexp-in-string
               "^.*url=" "" (replace-regexp-in-string
                             "=3D" "=" (replace-regexp-in-string "=
" "" (buffer-substring-no-properties beg end)))))))
    (kill-new url)
    (message "Copied link: %s" url)))

;;; webgetter
(require 'my-net)
(defun my-fetch-browse (url &optional no-overwrite)
  "Fetch URL to a local file then browse it with firefox.

Useful for bypassing \"Enable JavaScript and cookies to continue\"."
  (interactive "sUrl to fetch and browse: ")
  (let ((file-name
         (if no-overwrite
             (my-make-unique-file-name
              (my-make-file-name-from-url url)
              my-download-dir)
           (expand-file-name
            (my-make-file-name-from-url url "html")
            my-download-dir))))
    (url-copy-file url file-name (not no-overwrite))
    (browse-url-firefox (format "file://%s" file-name))))

(defun my-fetch-browse-as-googlebot (url &optional no-overwrite)
  "Same as `my-fetch-browse', but spoofing googlebot.

Useful for bypassing some paywalls."
  (interactive "sUrl to fetch and browse as googlebot: ")
  (my-url-as-googlebot
   (my-fetch-browse url no-overwrite)))

(require 'hmm)
(defvar my-url-context-function 'hmm-url "Context function for urls.")
(defvar my-file-context-function 'hmm-file "Context function for files.")

(defun my-hacker-news-url-p (url)
  "Check if a url is a hacker news post.
e.g. https://news.ycombinator.com/item?id=42505454"
  (let ((urlobj (url-generic-parse-url url)))
    (and (equal "news.ycombinator.com" (url-host urlobj))
         (string-match-p "^/item\\?id=[0-9]+$" (url-filename urlobj)))))

(defvar my-newscorp-au-amp-nk nil)
(defun my-open-newscorp-au (url)
  (interactive "sNews Corp AU link: ")
  (pcase-let* ((urlobj (url-generic-parse-url url))
               (`(,path . _) (url-path-and-query urlobj)))
    (setf (url-filename urlobj)
          (format "%s?amp&nk=%s" path my-newscorp-au-amp-nk))
    (browse-url-firefox (url-recreate-url urlobj))))

(defun my-newscorp-au-url-p (url)
  (string-match-p "^\\(www\\.\\)?\\(heraldsun\\|theaustralian\\)\\.com\\.au$"
                  (url-host (url-generic-parse-url url))))

(defun my-stack-overflow-url-p (url)
  "Guess whether a url stack overflow question
e.g.
https://emacs.stackexchange.com/questions/40887/in-org-mode-how-do-i-link-to-internal-documentation"
  (pcase-let* ((urlobj (url-generic-parse-url url))
               (`(,path . _) (url-path-and-query urlobj)))
    (string-match-p "^/questions/[0-9]+/.+$" path))  )

(advice-add 'server-visit-files :around #'my-ec-handle-http)
(defun my-ec-handle-http (orig-fun files client &rest args)
  ;; (message "GOT %s" files)
  (dolist (var files)
    (let ((fname (expand-file-name (car var))))
      (when (string-match ".*/?\\(https?:\\)/+" fname)
        (browse-url (replace-match "\\1//" nil nil fname))
        (setq files (delq var files)))))
  (apply orig-fun files client args))

(defvar my-firefox-profile-dir nil "Firefox profile dir")
(defvar my-firefox-place-limit 1000 "Firefox urls result limit")

(defun my-firefox-places (&optional query)
  (let ((where
         (mapconcat
          (lambda (word) (format "(url LIKE '%%%s%%' OR title LIKE '%%%s%%')" word word))
          (split-string (or query ""))
          " AND ")))
    (unless (string-empty-p where) (setq where (format "WHERE %s" where)))
    (with-temp-buffer
      (call-process "sqlite3" nil t nil
                    (format "file://%s/places.sqlite?immutable=1"
                            (expand-file-name my-firefox-profile-dir))
                    (format
                     "SELECT url,title FROM moz_places %s ORDER BY visit_count desc limit %d"
                     where
                     my-firefox-place-limit))
      (string-lines (buffer-string))
      )))

(defun my-firefox-places-collection (query pred action)
  (if (eq action 'metadata)
      `(metadata (display-sort-function . ,#'identity)
                 ;; Needed for icomplete to respect list order
                 (cycle-sort-function . ,#'identity))
    (let ((candidates (my-firefox-places query)))
      (message "Got %d candidates for query %s. Current action is %s" (length candidates) query action)
      (cl-loop for str in-ref candidates do
               (setf str (orderless--highlight regexps ignore-case (substring str))))
      candidates
      ;; Does not show remotely as many results
      ;; (complete-with-action action candidates query pred)
      )))

(defun my-browse-url (url)
  (interactive (list (completing-read "URL to browse: "
                                      #'my-firefox-places-collection)))
  (message url))

(defun my-forge-infobox-format-url (url)
  (concat url
          " -- " (buttonize "clone"
                            (lambda (_)
                              (my-magit-clone url current-prefix-arg)))
          " " (buttonize "context"
                         (lambda (_)
                           (funcall my-url-context-function url)))))

(provide 'my-web)
;;; my-web.el ends here