eaf-mindmap.el

;;; eaf-mindmap.el --- Simple description

;; Filename: eaf-mindmap.el
;; Description: Simple description
;; Author: Andy Stewart <lazycat.manatee@gmail.com>
;; Maintainer: Andy Stewart <lazycat.manatee@gmail.com>
;; Copyright (C) 2020, Andy Stewart, all rights reserved.
;; Created: 2020-02-28 16:09:02
;; Version: 0.1
;; Last-Updated: Tue Jan 19 01:15:47 2021 (-0500)
;;           By: Mingde (Matthew) Zeng
;; URL: http://www.emacswiki.org/emacs/download/eaf-mindmap.el
;; Keywords:
;; Compatibility: emacs-version >= 27
;;
;; Features that might be required by this library:
;;
;;
;;

;;; This file is NOT part of GNU Emacs

;;; License
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.

;; This program 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 General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.

;;; Commentary:
;;
;; Simple description
;;

;;; Installation:
;;
;; Put eaf-mindmap.el to your load-path.
;; The load-path is usually ~/elisp/.
;; It's set in your ~/.emacs like this:
;; (add-to-list 'load-path (expand-file-name "~/elisp"))
;;
;; And the following to your ~/.emacs startup file.
;;
;; (require 'eaf-mindmap)
;;
;; No need more.

;;; Customize:
;;
;;
;;
;; All of the above can customize by:
;;      M-x customize-group RET eaf-mindmap RET
;;

;;; Change log:
;;
;; 2020/02/28
;;      * First released.
;;

;;; Acknowledgements:
;;
;;
;;

;;; TODO
;;
;;
;;

;;; Require
(require 'json)

;;; Code:

(defcustom eaf-mindmap-dark-mode "follow"
  ""
  :type 'string)

(defcustom eaf-mindmap-save-path "~/Documents"
  ""
  :type 'string)

(defcustom eaf-mindmap-edit-mode nil
  ""
  :type 'boolean)


(defcustom eaf-mindmap-keybinding
  '(("TAB" . "add_sub_node")
    ("RET" . "add_brother_node")
    ("<deletechar>" . "remove_node")
    ("M-m" . "update_node_topic")
    ("M-e" . "update_node_topic_inline")
    ("M-r" . "refresh_page")
    ("C--" . "zoom_out")
    ("C-=" . "zoom_in")
    ("C-0" . "zoom_reset")
    ("M-q" . "add_multiple_sub_nodes")
    ("M-RET" . "add_multiple_brother_nodes")
    ("M-i" . "add_multiple_middle_nodes")
    ("M-j" . "select_down_node")
    ("M-k" . "select_up_node")
    ("M-h" . "select_left_node")
    ("M-l" . "select_right_node")
    ("C-n" . "eaf-send-down-key")
    ("C-p" . "eaf-send-up-key")
    ("C-f" . "eaf-send-right-key")
    ("C-b" . "eaf-send-left-key")
    ("SPC" . "insert_or_toggle_node_selection")
    ("x" . "insert_or_close_buffer")
    ("j" . "insert_or_select_down_node")
    ("k" . "insert_or_select_up_node")
    ("h" . "insert_or_select_left_node")
    ("l" . "insert_or_select_right_node")
    ("w" . "insert_or_copy_node_topic")
    ("y" . "insert_or_paste_node_topic")
    ("W" . "insert_or_cut_node_tree")
    ("Y" . "insert_or_paste_node_tree")
    ("J" . "insert_or_select_left_tab")
    ("K" . "insert_or_select_right_tab")
    ("-" . "insert_or_zoom_out")
    ("=" . "insert_or_zoom_in")
    ("0" . "insert_or_zoom_reset")
    ("d" . "insert_or_remove_node")
    ("D" . "insert_or_remove_middle_node")
    ("i" . "insert_or_add_middle_node")
    ("f" . "insert_or_update_node_topic")
    ("t" . "insert_or_toggle_node")
    ("b" . "insert_or_change_node_background")
    ("c" . "insert_or_change_background_color")
    ("C" . "insert_or_change_text_color")
    ("1" . "insert_or_save_screenshot")
    ("2" . "insert_or_save_file")
    ("3" . "insert_or_save_org_file")
    ("4" . "insert_or_save_freemind_file")
    ("M-o" . "eval_js")
    ("M-O" . "eval_js_file")
    ("<f12>" . "open_devtools")
    ("5" . "jump_to_keywords")
    )
  "The keybinding of EAF Mindmap."
  :type 'cons)

(defcustom eaf-mindmap-extension-list
  '("emm" "mm")
  "The extension list of mindmap application."
  :type 'cons)

(defun eaf--export-org-json (org-json-content org-file-path)
  (let (org-parse-data)
    (with-temp-buffer
      (insert org-json-content)
      (goto-char (point-min))
      (let* ((json (json-read))
             (root-node-name (cdr (assoc 'topic (assoc 'data json))))
             (children-node (cdr (assoc 'children (assoc 'data json)))))
        ;; (message "%s" (org-json-decode (cdr (assoc 'data json))))
        (insert (org-json-decode (cdr (assoc 'data json))))
        (goto-char (point-min))
        (while (search-forward-regexp "\\*\\s-topic\\s-\"" nil t)
          (let ((header-string (buffer-substring (save-excursion
                                                   (beginning-of-line)
                                                   (point))
                                                 (save-excursion
                                                   (beginning-of-line)
                                                   (search-forward-regexp "\\*\\s-" nil t)
                                                   (point)
                                                   )))
                (content-string (buffer-substring (point)
                                                  (save-excursion
                                                    (end-of-line)
                                                    (backward-char 1)
                                                    (point)))))
            (let ((loop-times (/ (- (length header-string) 1) 2)))
              (while (> loop-times 0)
                (setq loop-times (- loop-times 1))
                (setq header-string (string-remove-prefix "*" header-string))))
            (setq org-parse-data (concat org-parse-data (format "%s%s\n" header-string content-string)))))

        (with-temp-file org-file-path
          (insert org-parse-data))
        ))))

(defun json-read-r ()
  (let ((json-object-type 'alist))
    (let ((r (json-read)))
      (if (listp r) (reverse r) r))))

(defun org-json-raw ()
  (let (p1)
    (goto-char (point-min))
    (re-search-forward "[ \n\t]*")
    (beginning-of-line)
    (delete-region (point-min) (point))
    (if (re-search-forward "\\`#\\+begin_src" nil t)
        ;; string
        (progn
          (if (re-search-forward "^#\\+end_src" nil t)
              (progn (beginning-of-line)
                     (setq p1 (point)))
            (setq p1 (point-max)))
          (goto-char (point-min))
          (forward-line 1)
          (buffer-substring-no-properties (point) p1))
      (goto-char (point-min))
      (json-read-r))))

(defun org-json-entry (str)
  (let (lv header has-body p0 p1)
    (with-temp-buffer
      (insert str)
      (goto-char (point-min))
      (end-of-line)
      (setq header (buffer-substring (point-min) (point)))
      ;; delete header
      (delete-region (point-min) (point))
      ;; process header
      (string-match "^\\(\\*+\\) +\\(.+?\\) *$" header)
      (setq lv (length (match-string 1 header)))
      ;; remove '*'
      (setq header (match-string 2 header))
      (goto-char (point-min))
      (if (re-search-forward "\\`[ \n\t]*\\'" nil t)
          (list lv header)              ; body is empty
        (list lv header (org-json-raw))))))

(defun org-json-entries ()
  (let (p0 pl)
    ;; get all entries
    (setq pl (let (ret tmp)
               (goto-char (point-min))
               (while (re-search-forward "^\*+ " nil t)
                 (setq tmp (point))
                 (beginning-of-line)
                 (setq ret (cons (point) ret))
                 (goto-char tmp))
               (setq ret (cons (point-max) ret))
               (reverse ret)))
    (setq p0 (car pl))
    (mapcar (lambda (p1)
              (prog1 (org-json-entry
                      (buffer-substring-no-properties p0 p1))
                (setq p0 p1)))
            (cdr pl))))

(defun org-json-split-header (lst &optional ret)
  "Split header for the return of `org-json-entries'."
  (if (null lst) (reverse ret)
    (let (e0 e1 lst1)
      (setq e0 (car lst))
      (setq lst1 (cdr lst))
      (setq e1 (if lst1 (car lst1)
                 '(0 "" "")))
      (if (>= (car e0) (car e1))
          ;; no child
          (when (= (length e0) 2)
            ;; split header
            (if (string-match "^\\(.+?\\)[ \n\t]+\\(.+\\)$" (nth 1 e0))
                (setq e0 (list (nth 0 e0)
                               (match-string 1 (nth 1 e0))
                               (with-temp-buffer
                                 (insert (match-string 2 (nth 1 e0)))
                                 (goto-char (point-min))
                                 (json-read-r))))
              (setq e0 (list (nth 0 e0) (nth 1 e0) :json-null))))
        (when (> (length e0) 2)
          ;; drop unnecessary elem
          (setq e0 (list (nth 0 e0)
                         (nth 1 e0)))))
      (org-json-split-header lst1 (cons e0 ret)))))

(defun org-json-gen-alist (lst)
  "generate alist from return of `org-json-gen-alist',
actural call `org-json-gen-alist1' to work."
  (cdr (org-json-gen-alist1 lst 1)))

(defun org-json-gen-alist1 (lst lv &optional ret)
  (if (or (null lst)
          (< (car (car lst)) lv))
      ;; return list . ret
      (cons lst (reverse ret))
    ;; not return
    (let (e r1 kv)
      ;; r1 is return of children
      ;; kv is key-value pair
      (setq e (car lst))
      (if (> (length e) 2)
          ;; no child
          (progn (setq kv (cons (nth 1 e)
                                (nth 2 e)))
                 (org-json-gen-alist1 (cdr lst) lv (cons kv ret)))

        (setq r1 (org-json-gen-alist1 (cdr lst) (1+ lv)))
        ;; convert to array if necessray
        (let ((seq (mapcar 'car (cdr r1))))
          (when (equal (mapcar 'number-to-string
                               (number-sequence 0 (1- (length seq))))
                       seq)
            (setq r1 (cons (car r1)
                           (vconcat (mapcar 'cdr (cdr r1)))))))
        (setq kv (cons (nth 1 e) (cdr r1)))
        (org-json-gen-alist1 (car r1) lv
                             (cons kv ret))))))


(defun org-json-encode ()
  (save-excursion
    (org-json-gen-alist
     (org-json-split-header
      (org-json-entries)))))

(defun org-json-decode (obj &optional lv)
  "Decode json object to org at level `lv'."
  (unless lv (setq lv 1))
  (cond ((stringp obj) (if (string-match "\n\\'" obj)
                           ;; end with '\n' using #+begin_src block
                           (concat "#+begin_src\n"
                                   obj
                                   "#+end_src")
                         (concat "\""
                                 (replace-regexp-in-string
                                  "\"" "\""
                                  (replace-regexp-in-string
                                   "\\\\" "\\\\" obj))
                                 "\"")))
        ((numberp obj) (number-to-string obj))
        ((vectorp obj) (if (= (length obj) 0)
                           "[]"
                         (let ((n 0) ns)
                           (mapconcat
                            (lambda (x)
                              (prog1
                                  (org-json-kv-decode
                                   (cons (number-to-string n)
                                         x)
                                   lv)
                                (setq n (1+ n))))
                            obj "\n"))))
        ((equal obj json-null) "{}")
        ((listp obj) (mapconcat
                      (lambda (x)
                        (org-json-kv-decode x lv))
                      obj "\n"))
        ((equal obj t) "true")
        ((equal obj json-false) "false")
        (t (error "org-json-decode type error: %S" obj))))

(defun org-json-kv-decode (kv lv)
  "Decode a key-value pair."
  (let ((k (car kv))
        (v (cdr kv))
        h ks vs)
    (setq ks (cond ((symbolp k) (symbol-name k))
                   ((stringp k) k)
                   ((numberp k) (number-to-string k))
                   (t (error "org-json-kv-decode key type error: %S" k))))
    (setq h (concat (make-string lv ?*) " " ks))
    (setq vs (org-json-decode v (1+ lv)))
    (if (string-match "\n" vs)
        (concat h "\n" vs)
      (concat h " " vs))
    ))

(defun eaf--add-multiple-sub-nodes (buffer-id)
  "EAF Browser: edit FOCUS-TEXT with Emacs's BUFFER-ID."
  (eaf-edit-buffer-popup buffer-id "eaf-%s-add-multiple-sub-nodes" "mindmap-sub" ""))

(defun eaf--add-multiple-brother-nodes (buffer-id)
  "EAF Browser: edit FOCUS-TEXT with Emacs's BUFFER-ID."
  (eaf-edit-buffer-popup buffer-id "eaf-%s-add-multiple-brother-nodes" "mindmap-brother" ""))

(defun eaf--add-multiple-middle-nodes (buffer-id)
  "EAF Browser: edit FOCUS-TEXT with Emacs's BUFFER-ID."
  (eaf-edit-buffer-popup buffer-id "eaf-%s-add-multiple-middle-nodes" "mindmap-middle" ""))

;;;###autoload
(defun eaf-open-mindmap (file)
  "Open a given Mindmap FILE."
  (interactive "F[EAF/mindmap] Select Mindmap file: ")
  (eaf-open file "mindmap"))

(defalias 'eaf-create-mindmap 'eaf-open-mindmap "For compatibility")

(add-to-list 'eaf-app-binding-alist '("mindmap" . eaf-mindmap-keybinding))

(setq path (concat (file-name-directory load-file-name) "buffer.py"))
(add-to-list 'eaf-app-module-path-alist '("mindmap" . path))

(add-to-list 'eaf-app-extensions-alist '("mindmap" . eaf-mindmap-extension-list))

(defun eaf-mindmap-confirm-sub-nodes ()
  (eaf-call-async "execute_function_with_args"
                  eaf--buffer-id
                  "update_multiple_sub_nodes"
                  (buffer-string)))
(add-to-list 'eaf-edit-confirm-function-alist '("mindmap-sub" . eaf-mindmap-confirm-sub-nodes))

(defun eaf-mindmap-confirm-brother-nodes ()
  (eaf-call-async "execute_function_with_args"
                  eaf--buffer-id
                  "update_multiple_brother_nodes"
                  (buffer-string)))
(add-to-list 'eaf-edit-confirm-function-alist '("mindmap-brother" . eaf-mindmap-confirm-brother-nodes))

(defun eaf-mindmap-confirm-middle-nodes ()
  (eaf-call-async "execute_function_with_args"
                  eaf--buffer-id
                  "update_multiple_middle_nodes"
                  (buffer-string)))
(add-to-list 'eaf-edit-confirm-function-alist '("mindmap-middle" . eaf-mindmap-confirm-middle-nodes))


(defun eaf-mindmap--search-succesive (keywords)
  (when keywords
    (search-forward (car keywords))
    (eaf-mindmap--search-succesive (cdr keywords))))


(defun eaf-mindmap--search-succesive-in-file (file keywords)
  (with-current-buffer (find-file-other-window file)
    (goto-char (point-min))
    (eaf-mindmap--search-succesive keywords)))


(defun eaf-mindmap--write-content-to-file (file content)
  (with-current-buffer (find-file-noselect file)
    (erase-buffer)
    (goto-char (point-min))
    (insert content)
    (save-buffer)))


(provide 'eaf-mindmap)

;;; eaf-mindmap.el ends here