;; -*- lexical-binding: t; -*-

(defvar hmm-web-search-engines nil "hmm web search engines.")
(defvar hmm-web-browsers nil "hmm web browers.")
(defvar hmm-file-handlers nil "hmm file handlers.")
(defvar hmm-query-handlers nil "hmm query handlers.")
(defvar hmm-url-handlers nil "hmm url handlers.")
(defvar hmm-handlers '(:query nil :url nil :file nil))

(defmacro hmm-define-web-search-engine (engine browser)
  (let* ((engine-name (plist-get engine :name))
         (browser-name (plist-get browser :name))
         (function-name (intern
                         (format "hmm-search-%s-%s" engine-name browser-name))))
    `(progn
       (defun ,function-name (query)
         ,(format "Search %s in %s." engine-name browser-name)
         (interactive ,(format "sSearch %s in %s for: " engine-name browser-name))
         (,(plist-get browser :command)
          (format ,(plist-get engine :format) query)))
       (hmm-add-handler '(:command ,function-name) :query))))

(defmacro hmm-define-external-handler (xdg-handler)
  (let* ((description (format "%s - %s"
                              (plist-get xdg-handler :name)
                              (plist-get xdg-handler :description)))
         (function-name (intern
                         (format "hmm-%s"
                                 (plist-get xdg-handler :xdg-desktop-name))))
         (command `(replace-regexp-in-string
                    "%[fFuU]" arg
                    ,(plist-get xdg-handler :external-command)))
         (name (plist-get xdg-handler :name))
         (handler (plist-put xdg-handler :command function-name)))
    `(progn
       (defun ,function-name (arg)
         ,description
         (interactive ,(format "sRun %s with: " name))
         (start-process-shell-command
          (concat ,name " " arg) nil ,command))
       (hmm-add-handler ',handler :file))))

(defun hmm-add-handler (handler handling)
  (let ((handlers (plist-get hmm-handlers handling)))
    (add-to-list 'handlers handler)
    (plist-put hmm-handlers handling handlers)))

(defun hmm-thing-in-region (from to)
  (interactive "r")
  (unless (region-active-p) (error "Region not active."))
  (let* ((query (buffer-substring from to)))
    (hmm-query query)))

(defun hmm-thing-at-point ()
  (interactive)
  "Prompt for what to do with thing at point.

If it is a file, display a list of file handlers.
If it is a url, display a list of url handlers."
  (cond ((thing-at-point-url-at-point)
         (hmm-url (thing-at-point-url-at-point)))
        ((thing-at-point-file-at-point)
         (hmm-file (thing-at-point-file-at-point)))
        ((and (derived-mode-p 'dired-mode)
              (dired-get-filename nil t))
         (hmm-file (dired-get-filename nil t)))
        ((and (derived-mode-p 'org-mode)
              (my-org-link-at-point))
         (hmm-url (my-org-link-at-point)))
        ((get-text-property (point) 'shr-url)
         (hmm-url (get-text-property (point) 'shr-url)))
        ((thing-at-point 'symbol)
         (hmm-query (thing-at-point 'symbol)))
        ((buffer-file-name)
         (hmm-file (buffer-file-name)))
        (t (error "Cannot guess what to do with what."))))

(defun hmm ()
  (interactive)
  (cond ((region-active-p)
         (call-interactively 'hmm-thing-in-region))
        (t (call-interactively 'hmm-thing-at-point))))

(define-key global-map (kbd "C-M-<return>") 'hmm)

(defun hmm-query (query)
  (interactive "sQuery: ")
  (hmm-open-internal query :query "Search %s using: "))

(defun hmm-url (url)
  (interactive (list (read-string "URL: " (thing-at-point-url-at-point))))
  (hmm-handle-internal url :url "Handle url %s using: "))

(defun hmm-file (file)
  (interactive (list (read-file-name "File: " default-directory
                                     (thing-at-point-file-at-point))))
  (hmm-handle-internal file :file "Handle file %s using: "))

(defun hmm-handle-internal (thing type prompt)
  (let ((selected
         (completing-read
          (format prompt thing)
          (mapcar
           (lambda (command)
             (format "%s (%s)" command
                     (if (documentation command)
                         (car
                          (split-string
                           (documentation command)
                           "\n"))
                       "Undocumented")))
           (hmm-filter-commands thing type)))))
    (funcall-interactively (intern (car (split-string selected " ("))) thing)))

(defun hmm-filter-commands (thing type)
  (let ((mimetype (hmm-file-mime-type thing)))
    (mapcar
     (lambda (handler)
       (plist-get handler :command))
     (seq-filter
      (lambda (handler)
        (and (string-match (or (plist-get handler :regex) ".*") thing)
             (or (member mimetype 
                  (plist-get handler :mimetypes))
                 (and (null (plist-get handler :mimetypes))
                      (not (plist-get handler :xdg-desktop-name))))))
      (plist-get hmm-handlers type)))))

(defun hmm-update-handlers ()
  (interactive)
  (setq hmm-handlers '(:query nil :url nil :file nil))
  (dolist (engine hmm-web-search-engines)
    (dolist (browser hmm-web-browsers)
      (eval `(hmm-define-web-search-engine ,engine ,browser))))
  (dolist (xdg-handler (hmm-get-xdg-handlers))
    (eval `(hmm-define-external-handler ,xdg-handler)))
  (dolist (handler hmm-query-handlers) (hmm-add-handler handler :query))
  (mapc (lambda (browser)
          (add-to-list 'hmm-url-handlers
                       (list :command (plist-get browser :command)
                             :regex "^http\\(s\\)?://.*$")))
        hmm-web-browsers)
  (mapc (lambda (handler) (hmm-add-handler handler :url))
        hmm-url-handlers)
  (mapc (lambda (handler) (hmm-add-handler handler :file))
        hmm-file-handlers))

(defun hmm-get-xdg-handlers ()
  (seq-filter
   'identity
   (mapcar
    (lambda (desktop-file)
      (condition-case nil
          (let ((parsed (xdg-desktop-read-file desktop-file)))
            (list
             :name (gethash "Name" parsed)
             :description (gethash "Comment" parsed)
             :xdg-desktop-name (intern (concat "xdg-desktop-"
                                               (file-name-base desktop-file)))
             :external-command (gethash "Exec" parsed)
             :mimetypes (seq-filter (lambda (s) (not (string-empty-p s)))
                                    (split-string (gethash "MimeType" parsed) ";"))))
        (error nil)))
    (hmm-get-all-desktop-files))))

(defun hmm-get-all-desktop-files ()
  (mapcan (lambda (dir)
            (let ((app-dir (expand-file-name "applications" dir)))
              (when (file-exists-p app-dir)
                (directory-files app-dir t "\\.desktop$"))))
          (cons (xdg-data-home) (xdg-data-dirs))))

(defun hmm-file-mime-type (file)
  "Returns (or print if called interactively) mimetype of FILE."
  (interactive)
  (let ((out))
    (when (file-exists-p file)
      (replace-regexp-in-string
       "^.*: \\(.*\\); .*$" "\\1"
       (with-temp-buffer
         (call-process "file" nil '(t t) nil "-Li" file)
         (setq out (string-trim (buffer-string)))
         (if (called-interactively-p)
             (message out)
           out))))))

(provide 'hmm)