Andy Stewart
6 years ago
parent
e534166b01
commit
d97540a4c4
2 changed files with 308 additions and 218 deletions
@ -0,0 +1,307 @@ |
||||
;;; 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 |
||||
Loading…
Reference in new issue