308 lines
10 KiB
EmacsLisp
308 lines
10 KiB
EmacsLisp
;;; 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: 2020-02-28 16:09:02
|
|
;; By: Andy Stewart
|
|
;; URL: http://www.emacswiki.org/emacs/download/eaf-mindmap.el
|
|
;; Keywords:
|
|
;; Compatibility: GNU Emacs 26.3
|
|
;;
|
|
;; 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:
|
|
|
|
(dbus-register-signal
|
|
:session "com.lazycat.eaf" "/com/lazycat/eaf"
|
|
"com.lazycat.eaf" "export_org_json"
|
|
#'eaf--export-org-json)
|
|
|
|
(defun eaf--export-org-json (org-json-content org-file-path)
|
|
(let (org-parse-data)
|
|
(with-temp-buffer
|
|
(insert org-json-content)
|
|
(beginning-of-buffer)
|
|
(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))))
|
|
(beginning-of-buffer)
|
|
(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)))))
|
|
(when (> (length header-string) 2)
|
|
(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))
|
|
))
|
|
|
|
(provide 'eaf-mindmap)
|
|
|
|
;;; eaf-mindmap.el ends here
|