;;; my-utils.el -- Basic utilities used by other extensions -*- 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:

;; Basic utilities used by other extensions.

;;; Code:


;; time and date
(defun my-date-part (td)
  (nthcdr 3 td))

(defun my-tomorrow ()
  (decode-time (time-add 86400 (current-time))))

(defun my-skip-http-header ()
  (goto-char (point-min))
  (re-search-forward "\r?\n\r?\n"))

(defun my-seq-random-element (xs)
  "Returns a random element of sequence."
  (elt xs (random (length xs))))

(defun my-delete-http-header ()
  (delete-region (point-min) (progn (my-skip-http-header) (point))))

(defun my-time-from-epoch (t)
  "Encode time from epoch T.

Example: (format-time-string ... (my-time-from-epoch 1698582504))"
  (encode-time (decode-time t)))

;; lists
(defun my-list-cycle (xs)
  "Cycle a list."
  (cdr (append xs (list (car xs)))))

(defun my-get-current-line-no-properties ()
  (save-excursion
    (let ((beg (progn (beginning-of-line)
		                  (point)))
	        (end (progn (beginning-of-line 2)
		                  (point))))
      (buffer-substring-no-properties beg (1- end)))))

(defun my-sudo-find-file ()
  (interactive)
  (let* ((maybe-filename (thing-at-point 'filename t))
	       (matched (and maybe-filename
		                   (string-match "^\\(.*/\\)\\(.*\\)$" maybe-filename)))
	       (file (read-file-name
		            "Open as root: "
		            (and matched (match-string 1 maybe-filename)) nil nil
		            (and matched (match-string 2 maybe-filename)))))
    (unless (file-writable-p file)
      (find-file (concat "/sudo::" file)))))

(defvar my-url-regexp
  (concat
   "~?\\<\\([-a-zA-Z0-9+&@#/%?=~_|!:,.;]*\\)"
   "[.@]"
   "\\([-a-zA-Z0-9+&@#/%?=~_|!:,.;]+\\)\\>/?")
  "Regular expression to match (most?) URLs or email addresses.")


(defun my-clean-property-value (value)
  (when value
    (replace-regexp-in-string
     "\n" ", "
     (string-trim (replace-regexp-in-string " " "_" value)
		              "[ \t\n\r_]+" "[ \t\n\r_]+"))))

;; rewriting urls
(defvar my-max-url-rewrite 100 "Max number of URL redirect")
(defun my-rewrite-url (url)
  (let ((new-url url)
        (tmp-url)
        (i 0))
    (catch 'done
        (while (< i my-max-url-rewrite)
          (setq tmp-url (my-rewrite-url-once new-url))
          (when (equal tmp-url new-url) (throw 'done nil))
          (setq new-url tmp-url
                i (1+ i))))
    (unless (equal url new-url)
      (message "Rewriting %s to %s" url new-url))
    new-url))

(defvar my-simple-url-rewrites
  '((:name http-to-https
           :description "Rewrite http to https."
           :from "^http://\\(.*\\)$"
           :to "https://%s"
           :parts (1))
    (:name ddg-result
           :description "duckduckgo result transform."
           :from "^https://duckduckgo.com/l/\\?uddg=\\(.*\\)&rut=.*$"
           :to "%s"
           :parts (1)
           :match-processor url-unhex-string)
    (:name youtube-to-yewtu-be
           :description "youtube to yewtu.be"
           :from "^https://\\(www\\.\\)?youtube.com/\\(.*\\)$"
           :to "https://yewtu.be/%s"
           :parts (2))
    (:name reddit-to-old
           :description "Reddit to old Reddit"
           :from "^https://\\(www\\.\\)?reddit.com/\\(.*\\)$"
           :to "https://old.reddit.com/%s"
           :parts (2))
    (:name twitter-to-nitter
           :description "Twitter to nitter."
           :from "^https://twitter.com/\\(.*\\)$"
           :to "https://nitter.eu/%s"
           :parts (1))
    (:name google-to-ddg
           :description "Google to duckduckgo"
           :from "^https://www.google.com/search\\?q=\\(.*\\)$"
           :to "https://html.duckduckgo.com/html?q=%s"
           :parts (1))
    (:name php-manual-to-english
           :descripton "PHP manual to English"
           :from "^https://www.php.net/manual/../\\(.*\\)$"
           :to "https://www.php.net/manual/en/%s"
           :parts (1))
    (:name google-sheets-to-csv
           :description "Google sheets to csv"
           :from "https://docs.google.com/spreadsheets/\\(.*\\)/.*"
           :to "https://docs.google.com/spreadsheets/%s/export?format=csv"
           :parts (1))
    (:name google-docs-to-odt
           :description "Google docs to odt"
           :from "https://docs.google.com/document/\\(.*\\)/.*"
           :to "https://docs.google.com/document/%s/export?format=odt"
           :parts (1))
    (:name utm-remover-not-last
           :description "Removing a utm_foo query that is not the last query"
           :from "\\(.*\\)\\butm_[a-z_]+=[^&]*&\\(.*\\)"
           :to "%s%s"
           :parts (1 2))
    (:name utm-remover-last
           :description "Removing a utm_foo query that is the last query"
           :from "\\(.*\\)[&?]utm_[a-z_]+=[^#]*\\(.*\\)"
           :to "%s%s"
           :parts (1 2))))

(defun my-simple-rewrite-function-name (data)
  (intern (format "my-simple-url-rewrite-%s"
                           (plist-get data :name))))

(defmacro my-def-simple-rewrite (data)
  (let ((processor (plist-get data :match-processor)))
    `(defun ,(my-simple-rewrite-function-name data) (url)
       ,(plist-get data :description)
       (when (string-match ,(plist-get data :from) url)
         ,(append `(format ,(plist-get data :to))
                  (mapcar (lambda (part)
                            (if processor
                                `(,processor (match-string ,part url))
                              `(match-string ,part url)))
                          (plist-get data :parts)))))))

;; TODO: why do we need an eval here?
;; Because we are using plist-get in the defmacro
(dolist (data my-simple-url-rewrites)
  (eval `(my-def-simple-rewrite ,data)))

(defvar my-url-rewrite-functions
  (mapcar 'my-simple-rewrite-function-name my-simple-url-rewrites))

(defun my-rewrite-url-once (url)
  (let* ((rewriters my-url-rewrite-functions)
         (rewritten) (rewriter) (result))
    (while (and rewriters (not rewritten))
      (setq rewriter (car rewriters)
            rewriters (cdr rewriters)
            rewritten (funcall rewriter url)))
    (or rewritten url)))

(defun my-shell-command-output (command)
  (let ((inhibit-message t))
    (if (= 0
           (shell-command command))
        (with-current-buffer shell-command-buffer-name
          (string-trim (buffer-string)))
      (error (with-current-buffer shell-command-buffer-name
               (string-trim (buffer-string)))))))

;; mailman utils
(defun my-mailman-to-listinfo-url (url)
  (when (string-match "^\\(.*\\)/archive/html/\\(.*\\)" url)
    (format "%s/mailman/listinfo/%s"
            (match-string 1 url) (match-string 2 url))))

(defun my-mailman-to-archive-url (url)
  (when (string-match "^\\(.*\\)/mailman/listinfo/\\(.*\\)" url)
    (format "%s/archive/html/%s"
            (match-string 1 url) (match-string 2 url))))

;; filenames

(defun my-make-filename (name &optional sep)
  "Convert name to filename by replacing special chars with sep."
  (unless sep (setq sep "-"))
  (replace-regexp-in-string "[[:punct:][:space:]\n\r]+" sep
                            (string-trim name)))

(defun my-make-filename-from-url (url)
  (let* ((urlobj (url-generic-parse-url url))
         (filename (url-filename urlobj))
         (host (url-host urlobj)))
    (replace-regexp-in-string
     "^-+" ""
     (replace-regexp-in-string
      "-+$" "" (my-make-filename (concat host "-" filename))))))

(defun my-clean-property-key (key)
  (when key
    (let ((new-key
	         (replace-regexp-in-string
	          "[ \t\n\r_]+" "-" (string-trim
			                         (replace-regexp-in-string " " "_" key)))))
      (cond ((string-match "Publication-date" new-key)
	           "Published")
	          ((string= new-key "Publication") "Published")
	          ((string= new-key "出版時間") "Published")
	          ((string= new-key "出生") "Born")
	          ((string= new-key "逝世") "Died")
	          ((string= new-key "Formed") "Founded")
	          ((string-match "^成立" new-key) "Founded")
	          ((string= new-key "网站") "Website")
	          ((string= new-key "網站") "Website")
	          ((string= new-key "出版日期") "Published")
	          ((string= new-key "Author") "Authors")
	          ((string= new-key "作者") "Authors")
	          ((string= new-key "Designer") "Designers")
	          ((string-match "Directed" new-key) "Director")
	          ((string= new-key "Created-by") "Director")
	          ((string-match "导演" new-key) "Director")
	          ((string-match "[Rr]elease-date" new-key) "Released")
	          ((string-match "上映日期" new-key) "Released")
	          ((string-match "[Oo]riginal-release" new-key) "Released")
	          ((string-match "[Ii]nitial-release" new-key) "Released")
	          ((string-match "^Release$" new-key) "Released")
	          ((string-match "^Developer" new-key) "Developers")
	          ((string-match "^Repository" new-key) "Source")
	          ((string-match "^URL" new-key) "Website")
	          ((string-match "^Official-website" new-key) "Website")
	          (t new-key)))))

(defun my-parse-colon-separated-output (buffer)
  (with-current-buffer buffer
    (goto-char (point-min))
    (let ((result) (field) (value))
      (while (not (eobp))
	      (if (re-search-forward "\\(.*?\\)\\ +:" nil t)
	          (progn
	            (setq field
		                (replace-regexp-in-string
		                 "[()]" ""
                     (replace-regexp-in-string "\\ " "-" (match-string 1))))
	            (re-search-forward "\\ *\\(.*?\\)\n")
	            (setq value (match-string 1))
	            (push (cons field value) result))
	        (message "Failed search in parsing!")
	        (goto-char (point-max))))
      result)))

(defvar my-docs-root-dir nil "Root directory of documentation")
(defun my-get-list-of-docs ()
  (directory-files my-docs-root-dir nil directory-files-no-dot-files-regexp))

(defvar my-incoming-dir "~/Downloads")
(defvar my-video-incoming-dir my-incoming-dir)
(defvar my-audio-incoming-dir my-incoming-dir)
(defvar my-document-incoming-dir my-incoming-dir)

(defmacro my-with-default-directory (dir &rest body)
  "Run BODY with the default directory."
  (declare (indent 1) (debug t))
  `(let ((saved default-directory))
     (setq default-directory ,dir)
     ,@body
     (setq default-directory saved)))

(defun my-call-process-with-torsocks
    (program &optional infile destination display &rest args)
  (apply 'call-process
         (append (list "torsocks" infile destination display program) args)))

(defun my-start-process-with-torsocks (no-tor name buffer program &rest program-args)
  (if no-tor
      (apply 'start-process (append (list name buffer program) program-args))
    (apply 'start-process
           (append (list name buffer "torsocks" program) program-args))))

(defun my-touch-new-file (filename)
  "Touch a new file."
  (with-temp-buffer (write-file filename)))

(defvar my-extension-types
  '((audio . ("asf" "cue" "flac" "m4a" "m4r" "mid" "mp3" "ogg" "opus"
              "wav" "wma" "spc"))
    (video . ("avi" "m4v" "mkv" "mp4" "mpg" "ogg" "ogv" "rmvb" "webm" "wmv"))))

;;; files
(defun my-rename-and-symlink-back (file newname ok-if-already-exists)
  (when (directory-name-p newname)
    (setq newname (concat newname (file-name-nondirectory file))))
  (rename-file file newname ok-if-already-exists)
  (make-symbolic-link newname file ok-if-already-exists)
  newname)

(defun my-rewrite-url-advice (args)
  (let ((url (car args)))
    (setcar args (my-rewrite-url url)))
  args)

(defun my-server-p ()
  "nonnil if the emacs is a server or daemon"
  (and (boundp 'server-process) server-process))

;; cleaning utilities
(defun my-extract-year (text)
  (if (string-match "\\([0-9]\\{4\\}\\)" text)
      (match-string 1 text)
    ""))

(defun my-rename-file-and-buffer (name)
  "Apply NAME to current file and rename its buffer.
Do not try to make a new directory or anything fancy."
  (interactive
   (list (read-file-name "Rename current file to: ")))
  (let ((file (buffer-file-name)))
    (if (vc-registered file)
        (vc-rename-file file name)
      (rename-file file name))
    (set-visited-file-name name t t)))

(defun my-delete-file-and-kill-buffer ()
  "Delete the buffer and the file

Only accept if the file is vc-registered (easy to recover from mistakes)"
  (interactive)
  (let ((file (buffer-file-name)))
    (unless (vc-registered file)
      (error "Cannot delete file not under vc"))
    (vc-revert-file file)
    (vc-refresh-state)
    (vc-delete-file file))
  (kill-buffer))

;;; Some of the following functions are adapted from prot-dotfiles
;;;###autoload
(defun my-keyboard-quit-dwim ()
  "Do-What-I-Mean behaviour for a general `keyboard-quit'.

The generic `keyboard-quit' does not do the expected thing when
the minibuffer is open.  Whereas we want it to close the
minibuffer, even without explicitly focusing it.

The DWIM behaviour of this command is as follows:

- When the region is active, disable it.
- When a minibuffer is open, but not focused, close the minibuffer.
- When the Completions buffer is selected, close it.
- In every other case use the regular `keyboard-quit'."
  (interactive)
  (cond
   ((region-active-p)
    (keyboard-quit))
   ((derived-mode-p 'completion-list-mode)
    (delete-completion-window))
   ((> (minibuffer-depth) 0)
    (abort-recursive-edit))
   (t
    (keyboard-quit))))

;; The `my-line-regexp-p' and `my--line-regexp-alist'
;; are contributed by Gabriel: <https://github.com/gabriel376>.
(defvar my--line-regexp-alist
  '((empty . "[\s\t]*$")
    (indent . "^[\s\t]+")
    (non-empty . "^.+$")
    (list . "^\\([\s\t#*+]+\\|[0-9]+[^\s]?[).]+\\)")
    (heading . "^[=-]+"))
  "Alist of regexp types used by `my-line-regexp-p'.")

(defun my-line-regexp-p (type &optional n)
  "Test for TYPE on line.
TYPE is the car of a cons cell in
`my--line-regexp-alist'.  It matches a regular
expression.

With optional N, search in the Nth line from point."
  (save-excursion
    (goto-char (line-beginning-position))
    (and (not (bobp))
         (or (beginning-of-line n) t)
         (save-match-data
           (looking-at
            (alist-get type my--line-regexp-alist))))))

(defun my-quit-emacs (arg)
  (interactive "P")
  (save-some-buffers t t)
  (kill-emacs))

(defun my-post-process-licensing-name (name)
  (cond ((equal name "MIT") "expat")
        (t name)))

(provide 'my-utils)