;;; wiki-markup.el -- A wikitext mode -*- lexical-binding: t -*-

;; Copyright (C) 2023  Free Software Foundation, Inc.

;; Author: Yuchen Pei <id@ypei.org>

;; This file is part of wiki-markup.el.

;; wiki.el 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.

;; wiki.el 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 wiki.el.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; A wikitext mode for wiki-markup

;;; Code:
(require 'wiki-faces)
(require 'wiki-utils)

(defvar wiki-url-re "https?://[^ |}]+")

(defvar wiki-external-link-re
  (rx (seq "["
           (group (seq "http"
                       (opt "s")
                       "://"
                       (+ (not " "))))
           (opt (seq " " (group (+? anything))))
           "]")))

(defvar wiki-internal-link-re
  (rx (seq "[["
	         ;; Target
	         (group
	          (one-or-more
             (not (any "[|]"))))
		       ;; Label (optional)
		       (opt (seq "|" (group (+? anything))))
		       "]]"))
  )

(defvar wiki-font-lock-keywords
  '(;; Headers
    ("^======.*======\\ *$" . wiki-level-6)
    ("^=====.*=====\\ *$" . wiki-level-5)
    ("^====.*====\\ *$" . wiki-level-4)
    ("^===.*===\\ *$" . wiki-level-3)
    ("^==.*==\\ *$" . wiki-level-2)
    ("^=.*=\\ *$" . wiki-level-1)
    ("^----+\\ *$" . wiki-hr-face)

    ;; Comments
    ("<!-- \\([^->]\\|>\\|-\\([^-]\\|-[^>]\\)\\)*-->" . wiki-comment)

    ("^ .*$" . wiki-pre-face)
    (wiki-do-emphasis-faces)
    ;; (wiki-set-template-face)
    (wiki-do-refs)
    (wiki-activate-external-links)
    (wiki-activate-internal-links)
    (wiki-activate-raw-links)
    ))

(defvar wiki-outline-re "=+.*=+\ *$")

(defvar-local wiki-site nil
  "The identifier of the site of the current wiki buffer.")
(defvar-local wiki-title nil
  "The title of the current wiki buffer.")
(defun wiki-follow-wikilink-action (data)
  "Button action to follow a wikilink.

The button data is passed as DATA."
  (funcall (wiki-site-fetcher wiki-site) (alist-get 'target data)))

(defun wiki-guess-site ()
  "Guess `wiki-site' from the default directory.

This can be overriden with .dir-locals.el."
  (unless wiki-site
    (setq-local wiki-site
                (let ((guessed
                       (intern (replace-regexp-in-string
                                (format
                                 "%s/\\(.+?\\)/.*"
                                 (regexp-quote
                                  (expand-file-name wiki-local-dir)))
                                "\\1"
                                default-directory))))
                  (if (alist-get guessed wiki-sites)
                      guessed
                    'local))))
  )

(defun wiki-guess-title ()
  "Guess `wiki-title' from the file name."
  (unless wiki-title
    (setq-local wiki-title (file-name-base (buffer-file-name)))))

(defun wiki-outline-level ()
  "Determines the outline header level in `outline-mode'."
  (when (looking-at "\\(=+\\).*[^=]\\(=+\\)\\ *$")
    (min (length (match-string 1))
         (length (match-string 2))
         6)))

(defun wiki-do-refs (limit)
  "Process ref tags.

LIMIT is the limit of the search, used for `font-lock-keywords'."
  (let ((ref-counter 0))
    (while (re-search-forward "<ref\\([^>]*\\)>" limit t)
      (let ((start (match-beginning 0))
            (end (if (string-suffix-p "/" (match-string 1))
                     (match-end 0)
                   (when (search-forward "</ref>" limit t)
                     (match-end 0))))
            (next-start (save-excursion
                          (when (re-search-forward "<ref[^>/]*>" limit t)
                            (match-beginning 0)))))
        (cond ((not end) (goto-char limit))
              ((or (not next-start) (>= next-start end))
               (setq ref-counter (1+ ref-counter))
               (let ((original-text
                      (buffer-substring start end)))
                 (put-text-property start end
                                    'display (format "[%d]" ref-counter))
                 (put-text-property start end
                                    'help-echo original-text))
               (add-face-text-property start end 'org-link)
               (goto-char end))
              (t (goto-char next-start)))))))

;; TODO: complete this function.
(defun wiki-set-template-face (limit)
  "Set template faces.

LIMIT is the limit of the search, used for `font-lock-keywords'."
  (while (search-forward "{{" limit t)
    (save-excursion
      (let* ((name-start (point))
             ;; (visible-start name-start)
             ;; (start (progn (backward-char 2) (point)))
             (end (progn (forward-sexp) (point)))
             (visible-end (- end 2))
             (name-end (progn
                         (goto-char name-start)
                         (if (search-forward "|" visible-end t)
                             (1- (point))
                           visible-end))))
        ;; (put-text-property start visible-start 'invisible t)
        ;; (put-text-property visible-end end 'invisible t)
        (add-face-text-property name-start name-end 'wiki-special-keyword)
        (goto-char name-end)
        (while (looking-at "|")
          (wiki-do-one-template-arg visible-end))
        )
      )
    ))

;; TODO: complete this function.
;; We assume the arg name cannot contain (nested) templates
(defun wiki-do-one-template-arg (limit)
  "Process one template arg.

LIMIT is the limit of the search, used for `font-lock-keywords'."
  (let ((found (re-search-forward "|\\ *\\([^|= \t\n]+\\ *[=|]\\)"
                                  limit 'move))
        (name-start (match-beginning 1))
        (name-end (match-end 1)))
    (add-face-text-property name-start name-end 'wiki-special-keyword)
    (when found
      (while (and (not (progn (backward-char 1) (looking-at "|")))
                  (progn (forward-char 1)
                         (re-search-forward "\\({{\\|\\[\\[\\||\\)"
                                            limit t)))
        (setq found (match-string 1))
        (pcase found
          ;; A nested template in arg value, gotta recurse
          ("{{"
           (backward-char 2)
           (let ((right-bound
                  (save-excursion (forward-sexp) (point))))
             (wiki-set-template-face right-bound)))
          ;; A link is found, leave it alone and skip over
          ("[["
           (backward-char 2)
           (forward-sexp))
          ;; Do nothing
          ("|")))))
  )

;; Like `org-do-emphasis-faces'
(defun wiki-do-emphasis-faces (limit)
  "Fix emphasis faces of mediawiki markup.

LIMIT is the limit of the search, used for `font-lock-keywords'."
  (while (re-search-forward "\\(''+\\)[^ \t\n].*?[^ \t\n']\\(''+\\)" limit t)
    (let ((start (match-beginning 0))
          (end (match-end 0)))
      (pcase (min (length (match-string 1)) (length (match-string 2)))
        (2 (add-face-text-property start end 'wiki-italic))
        (3 (add-face-text-property start end 'wiki-bold))
        (_ (add-face-text-property start end 'wiki-bold-italic))
        ))))

;; Like `org-activate-links'
;; TODO: support more types, e.g. interwiki and anchor links.
(defun wiki-activate-links (link-re type limit)
  "Activate links in wiki markup match LINK-RE(gexp) of link TYPE.

LIMIT is the limit of the search, used for `font-lock-keywords'.
Currently supported types are `internal' and `external'."
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward link-re limit t)
      (let ((start (match-beginning 0))
            (end (match-end 0))
            (target-start (match-beginning 1))
            (target-end (match-end 1))
            (label-start (or (match-beginning 2) (match-beginning 1)))
            (label-end (or (match-end 2) (match-end 1)))
            (target (buffer-substring-no-properties (match-beginning 1)
                                                    (match-end 1)))
            )
        (put-text-property start label-start 'invisible t)
        (make-text-button start end
                          'action
                          (if (eq type 'internal)
                              'wiki-follow-wikilink-action
                            'wiki-browse-url-action)
                          'button-data `((target . ,target)))
        (put-text-property start end 'help-echo
                           (format "LINK: %s"
                                   (buffer-substring-no-properties
                                    target-start target-end)))
        (add-face-text-property start end 'org-link)
        (put-text-property label-end end 'invisible t)
        (add-text-properties (1- label-start) label-start
                             '(rear-nonsticky (invisible)))
        (add-text-properties (1- label-end) label-end
                             '(rear-nonsticky (invisible)))
        ))))

(defun wiki-browse-url-action (data)
  "Call `browse-url' on the button DATA."
  (browse-url (alist-get 'target data)))

(defun wiki-activate-internal-links (limit)
  "Activate internal links in mediawiki markup.

LIMIT is the limit of the search, used for `font-lock-keywords'."
  (wiki-activate-links wiki-internal-link-re 'internal limit))

(defun wiki-activate-external-links (limit)
  "Activate external links in mediawiki markup.

LIMIT is the limit of the search, used for `font-lock-keywords'."
  (wiki-activate-links wiki-external-link-re 'external limit))

(defun wiki-activate-raw-links (limit)
  "Activate raw url links in mediawiki markup.

LIMIT is the limit of the search, used for `font-lock-keywords'."
  (wiki-activate-links (format "\\(%s\\)" wiki-url-re) 'external limit))

(define-derived-mode wiki-mode outline-mode "Wiki"
  "A wikitext mode."

  (setq-local comment-start "<!--")
  (setq-local comment-end "-->")

  (setq-local font-lock-defaults
              '(wiki-font-lock-keywords
                nil
                nil
                nil
                (font-lock-extra-managed-props
                 invisible font-lock-face button-data action category
                 button htmlize-link help-echo display)))
  (setq-local outline-regexp wiki-outline-re)
  (setq-local outline-level 'wiki-outline-level)
  ;; We have to do this again because `outline-mode' used the default
  ;; `outline-regexp'.
  (setq-local imenu-generic-expression
	            (list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0))
              imenu-space-replacement nil)
  )

(defun set-wiki-site (site)
  "Set `wiki-site' to SITE."
  (interactive (list
                (completing-read "Set wiki site: "
                                 (mapcar 'car wiki-sites))))
  (setq-local wiki-site (intern site)))

(add-hook 'wiki-mode-hook 'wiki-guess-site)
(add-hook 'wiki-mode-hook 'wiki-guess-title)

(provide 'wiki-markup)
;;; wiki-markup.el ends here