;; -*- coding: utf-8; lexical-binding: t; -*-
;; 2011-07-15 , 2020-04-12
;; spec at http://xahlee.org/comp/validate_matching_brackets.html
;; by Xah Lee.

;; go thru a file, check if all brackets are properly matched.
;; e.g. good: (…{…}… “…”…)
;; bad: ( [)]
;; bad: ( ( )

(setq inputFile "xx_test_file.txt" ) ; a test file.
(setq inputDir "/Users/xah/web/ergoemacs_org/emacs/") ; must end in slash

(defvar matchPairs '() "a alist. For each pair, the car is opening char, cdr is closing char.")
(setq matchPairs '(
                   ;; ("(" . ")")
                   ;; ("{" . "}")
                   ;; ("[" . "]")
                   ;; ("“" . "”")
                   ;; ("‹" . "›")
                   ;; ("«" . "»")
                   ("【" . "】")
                   ;; ("〖" . "〗")
                   ;; ("〈" . "〉")
                   ;; ("《" . "》")
                   ;; ("「" . "」")
                   ;; ("『" . "』")
                   )
      )

(defvar searchRegex "" "regex string of all pairs to search.")
(setq searchRegex "")
(mapc
 (lambda (mypair) ""
   (setq searchRegex (concat searchRegex (regexp-quote (car mypair)) "|" (regexp-quote (cdr mypair)) "|") )
   )
 matchPairs)

(setq searchRegex (substring searchRegex 0 -1)) ; remove the ending “|”

(setq searchRegex (replace-regexp-in-string "|" "\\|" searchRegex t t)) ; change | to \\| for regex “or” operation

(defun my-process-file (fPath)
  "Process the file at FPATH …"
  (let (myBuffer myStack $char $pos)

    (setq myStack '()) ; each entry is a vector [char position]
    (setq $char "")     ; the current char found

    (when t
      ;; (not (string-match "/xx" fPath)) ; in case you want to skip certain files

      (setq myBuffer (get-buffer-create " myTemp"))
      (set-buffer myBuffer)
      (insert-file-contents fPath nil nil nil t)

      (goto-char 1)
      (while (re-search-forward searchRegex nil t)
        (setq $pos (point))
        (setq $char (buffer-substring-no-properties $pos (- $pos 1)))

        ;; (princ (format "-----------------------------\nfound char: %s\n" $char) )

        (let ((isClosingCharQ nil) (matchedOpeningChar nil))
          (setq isClosingCharQ (rassoc $char matchPairs))
          (when isClosingCharQ (setq matchedOpeningChar (car isClosingCharQ)))

          ;; (princ (format "isClosingCharQ is: %s\n" isClosingCharQ) )
          ;; (princ (format "matchedOpeningChar is: %s\n" matchedOpeningChar) )

          (if
              (and
               (car myStack) ; not empty
               (equal (elt (car myStack) 0) matchedOpeningChar ))
              (progn
                ;; (princ (format "matched this top item on stack: %s\n" (car myStack)) )
                (setq myStack (cdr myStack)))
            (progn
              ;; (princ (format "did not match this top item on stack: %s\n" (car myStack)) )
              (setq myStack (cons (vector $char $pos) myStack)))))
        ;; (princ "current stack: " )
        ;; (princ myStack )
        ;; (terpri )
        )

      (when (not (equal myStack nil))
        (princ "Error file: ")
        (princ fPath)
        (print (car myStack)))
      (kill-buffer myBuffer))))

(let (outputBuffer)
  (setq outputBuffer "*xah match pair output*" )
  (with-output-to-temp-buffer outputBuffer
    ;; (my-process-file inputFile) ; use this to test one one single file
    (mapc 'my-process-file
          (directory-files-recursively inputDir "\\.html$" )) ; do all HTML files
    (princ "Done deal!")))