(defgroup ligature nil
  "Support for font ligatures"
  :version "28.1"
  :prefix "ligature-")

(defcustom ligature-arrows
  (list "-->" "<!--" "->>" "<<-" "->" "<-"
	"<-<" ">>-" ">-" "<~>" "-<" "-<<"
	"<=>" "=>" "<=<" "<<=" "<==" "<==>" "==>" "=>>" ">=>" ">>="
	"<-|" "<=|"  "|=>" "|->" "<~~" "<~"  "~~>"
	"~>" "<->")
  "Arrow ligatures."
  :type '(repeat string))

(defcustom ligature-misc
  (list "..<"  "~-" "-~" "~@"  "-|" "_|_" "|-" "||-" "|=" "||="
	".?" "?="  "<|>" "<:" ":<" ":>" ">:"
	".=" ".-" "__" "<<<" ">>>" "<<" ">>" "~~"
	"<$>" "<$" "$>" "<+>" "<+" "+>" "<*>" "<*" "*>" "</" "</>" "/>"
	"|}" "{|" "[<" ">]" ":?>" ":?"  "[||]" "?:" "?."
	"|>" "<|" "||>" "<||" "|||>" "<|||::=" "|]" "[|"
	"#{" "#[" "]#" "#(" "#?" "#_" "#_(" "#:" "#!" "#=")
  "Miscellaneous ligatures."
  :type '(repeat string))

(defcustom ligature-relations
  (list "==" "!=" "<=" ">=" "=:=" "!==" "===" "<>" "/==" "=!=" "=/=" "~=" ":="
	"/=" "^=")
  "Relation ligatures."
  :type '(repeat string))

(defcustom ligature-operators
  (list "&&" "&&&" "||" "++" "--" "!!" "::" "+++" "??" ":::" "***" "---"
	"/\\" "\\/")
  "Operator ligatures."
  :type '(repeat string))

(defcustom ligature-comments-c-like
  (list "//" "///" "/**" "/*" "*/")
  "Ligatures for comments in C-like languages."
  :type '(repeat string))

(defcustom ligature-comments-xml-like
  (list "<!--" "-->")
  "Ligatures for comments in XML-like languages."
  :type '(repeat string))

(defcustom ligature-hashes
  (list "##" "###" "####")
  "Ligatures for comments in languages with # being the comment character."
  :type '(repeat string))

(defcustom ligature-dots
  (list "..." "..")
  "Dot ligatures."
  :type '(repeat string))

(defcustom ligature-semicolons
  (list ";;" ";;;")
  "Ligatures for comments in lisp languages."
  :type '(repeat string))

(defun ligature--get-all ()
  (append ligature-arrows
	  ligature-relations
	  ligature-operators
	  ligature-misc
	  ligature-dots
	  ligature-comments-c-like
	  ligature-comments-xml-like
	  ligature-hashes
	  ligature-semicolons))

(defun ligature--apply (ligatures)
  (let ((groups (seq-group-by #'string-to-char ligatures)))
    (dolist (group groups)
      (let ((c (car group))
	    (rx (regexp-opt (mapcar (lambda (s) (substring s 1))
				    (cdr group)))))
	(set-char-table-range composition-function-table
			      c `([,(concat "." rx) 0 compose-gstring-for-graphic]))))))

(define-minor-mode ligature-minor-mode
  "A mode for font ligatures."
  nil "" nil
  (if ligature-minor-mode
      (progn
        (when (minibufferp)
          (error "Cannot use ligature-minor-mode in minibuffer"))
        ;; FIXME: This doesn't work.  When enabled, there will be a local
        ;; variable but the global value is the same (and also includes the
        ;; ligature composition rules).
        (ligature--apply (ligature--get-all)))
    ;; FIXME: Even if the above worked, this could remove much more than this
    ;; mode added itself.
    (kill-local-variable 'composition-function-table)))

(defun ligature-minor-mode--apply-if-possible ()
  (unless (minibufferp)
    (ligature-minor-mode)))

(define-globalized-minor-mode global-ligature-minor-mode
  ligature-minor-mode
  ligature-minor-mode--apply-if-possible)

(provide 'ligature)