├── .gitignore ├── .gitattributes ├── screenshot ├── edraw-screenshot.gif ├── color-picker-inline.png └── color-picker-minibuffer.png ├── edraw-org-export-odt.el ├── edraw-org-export-latex.el ├── edraw-msg.el ├── msg ├── edraw-msg-tools.el └── edraw-msg-ja.el ├── edraw-mode.el ├── edraw-org-export-html.el ├── edraw-org-edit.el ├── edraw-generator.el ├── edraw-editor-util.el ├── README.org ├── edraw-color-picker-mode.el ├── edraw-widget.el ├── LICENSE └── edraw-import.el /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *.elc 3 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | *.org encoding=utf-8 2 | *.el encoding=utf-8 3 | -------------------------------------------------------------------------------- /screenshot/edraw-screenshot.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/misohena/el-easydraw/master/screenshot/edraw-screenshot.gif -------------------------------------------------------------------------------- /screenshot/color-picker-inline.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/misohena/el-easydraw/master/screenshot/color-picker-inline.png -------------------------------------------------------------------------------- /screenshot/color-picker-minibuffer.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/misohena/el-easydraw/master/screenshot/color-picker-minibuffer.png -------------------------------------------------------------------------------- /edraw-org-export-odt.el: -------------------------------------------------------------------------------- 1 | ;;; edraw-org-export-odt.el --- Export edraw link As ODT in Org -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2025 AKIYAMA Kouhei 4 | 5 | ;; Author: AKIYAMA Kouhei 6 | ;; Keywords: Graphics, Drawing, SVG, Editor, Orgmode 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; 24 | 25 | ;;; Code: 26 | 27 | (require 'ox-odt) 28 | (require 'edraw-org) 29 | 30 | ;;;; Export 31 | 32 | (defun edraw-org-export-odt-link (path _description _back-end info link) 33 | ;; @todo Check inline-image-rules? However, unless it is converted 34 | ;; into an inline image, it will just output base64 data, so I don't 35 | ;; think it is practical. 36 | ;; (when (org-export-inline-image-p 37 | ;; link (plist-get info :odt-inline-image-rules)) 38 | (if-let* ((file (edraw-org-export-get-file-from-edraw-path path))) 39 | (edraw-org-export-link-as-file 40 | link info file 41 | ;; You may process any ODT specific options set in LINK 42 | ;; (e.g.[[edraw:odt-some-option=??;file=...]]) here. 43 | ;; (lambda (link info) .... (org-odt-link--inline-image link info)) 44 | #'org-odt-link--inline-image) 45 | "")) 46 | 47 | (provide 'edraw-org-export-odt) 48 | ;;; edraw-org-export-odt.el ends here 49 | -------------------------------------------------------------------------------- /edraw-org-export-latex.el: -------------------------------------------------------------------------------- 1 | ;;; edraw-org-export-latex.el --- Export edraw link As LaTeX in Org -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2022 AKIYAMA Kouhei 4 | 5 | ;; Author: AKIYAMA Kouhei 6 | ;; Keywords: Graphics, Drawing, SVG, Editor, Orgmode 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; 24 | 25 | ;;; Code: 26 | 27 | (require 'ox-latex) 28 | (require 'edraw-org) 29 | 30 | ;;;; Export 31 | 32 | (defun edraw-org-export-latex-link (path _description _back-end info link) 33 | ;; @todo Check inline-image-rules? However, unless it is converted 34 | ;; into an inline image, it will just output base64 data, so I don't 35 | ;; think it is practical. 36 | ;; (when (org-export-inline-image-p 37 | ;; link (plist-get info :latex-inline-image-rules)) 38 | (if-let* ((file (edraw-org-export-get-file-from-edraw-path path))) 39 | (edraw-org-export-link-as-file 40 | link info file 41 | ;; You may process any LaTeX specific options set in LINK 42 | ;; (e.g.[[edraw:latex-some-option=??;file=...]]) here. 43 | ;; (lambda (link info) .... (org-latex--inline-image link info)) 44 | #'org-latex--inline-image) 45 | "")) 46 | 47 | (provide 'edraw-org-export-latex) 48 | ;;; edraw-org-export-latex.el ends here 49 | -------------------------------------------------------------------------------- /edraw-msg.el: -------------------------------------------------------------------------------- 1 | ;;; edraw-msg.el --- -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2022 AKIYAMA Kouhei 4 | 5 | ;; Author: AKIYAMA Kouhei 6 | ;; Keywords: 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; 24 | 25 | ;;; Code: 26 | 27 | (defgroup edraw-msg nil 28 | "The language of the message text to display." 29 | :tag "Edraw Message Text" 30 | :group 'edraw) 31 | 32 | (defconst edraw-msg-language-file-alist 33 | '(("Japanese" . "msg/edraw-msg-ja"))) 34 | 35 | (defun edraw-msg-file () 36 | (defvar edraw-msg-file) 37 | (cond 38 | ((eq edraw-msg-file 'auto) 39 | (alist-get current-language-environment 40 | edraw-msg-language-file-alist nil nil #'equal)) 41 | ((stringp edraw-msg-file) 42 | edraw-msg-file))) 43 | 44 | (defvar edraw-msg-hash-table nil) 45 | 46 | (defun edraw-msg-load () 47 | (setq edraw-msg-hash-table nil) 48 | (let ((file (edraw-msg-file))) 49 | (when file 50 | (ignore-errors 51 | ;; (setq edraw-msg-hash-table ...) 52 | (load-library file))))) 53 | 54 | (defun edraw-msg-register (hash-table) 55 | (setq edraw-msg-hash-table hash-table)) 56 | 57 | (defun edraw-msg (msgid) 58 | (if edraw-msg-hash-table 59 | (or (gethash msgid edraw-msg-hash-table) 60 | msgid) 61 | msgid)) 62 | 63 | ;;;; Message Catalog File 64 | 65 | ;;@todo add-hook 'set-language-environment-hook ? 66 | 67 | (defun edraw-msg-file-set (sym value) 68 | (set-default-toplevel-value sym value) 69 | (edraw-msg-load)) 70 | 71 | (defcustom edraw-msg-file 'auto 72 | "File name of message catalog." 73 | :group 'edraw-msg 74 | :set 'edraw-msg-file-set ;; (edraw-msg-load) is called immediately!! 75 | :type '(choice (const :tag "Determine by current-language-environment and edraw-msg-language-file-alist" auto) 76 | (const :tag "Disable translation" nil) 77 | (file :tag "File name in load path"))) 78 | 79 | (provide 'edraw-msg) 80 | ;;; edraw-msg.el ends here 81 | -------------------------------------------------------------------------------- /msg/edraw-msg-tools.el: -------------------------------------------------------------------------------- 1 | ;;; edraw-msg-tools.el --- Tools for Translators -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2023 AKIYAMA Kouhei 4 | 5 | ;; Author: AKIYAMA Kouhei 6 | ;; Keywords: 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; 24 | 25 | ;;; Code: 26 | 27 | (require 'seq) 28 | (require 'cl-lib) 29 | 30 | ;;;; Parse Source File 31 | 32 | (defun edraw-msg-collect () 33 | "Return list of messages used in source files." 34 | (seq-uniq 35 | (sort 36 | (edraw-msg-collect-from-dir) 37 | #'string-lessp) 38 | #'string=)) 39 | 40 | (defun edraw-msg-source-files () 41 | "Return list of source files." 42 | (directory-files (file-name-directory (locate-library "edraw")) t "\\.el$")) 43 | 44 | (defun edraw-msg-collect-from-dir () 45 | "Return list of messages used in the source directory." 46 | (cl-loop for source-file in (edraw-msg-source-files) 47 | nconc (edraw-msg-collect-from-file source-file))) 48 | 49 | (defun edraw-msg-collect-from-file (source-file) 50 | "Return list of messages used in the SOURCE-FILE." 51 | (with-temp-buffer 52 | (insert-file-contents source-file) 53 | (goto-char (point-min)) 54 | (cl-loop while (re-search-forward 55 | "(edraw-msg[ \n\t]+\\(\"\\(?:\\\\\"\\|[^\"]\\)+\"\\)" nil t) 56 | collect (match-string-no-properties 1)))) 57 | 58 | ;;;; Search Source 59 | 60 | (defun edraw-msg-search (msg-str) 61 | "Search for places using MSG-STR." 62 | (interactive 63 | (list 64 | (or (save-excursion 65 | (forward-line 0) 66 | (when (looking-at "^[ \t]*\\(\"\\(?:\\\\\"\\|[^\"]\\)*\"\\)") 67 | (match-string 1))) 68 | (concat "\"" (read-string "Message: ") "\"")))) 69 | 70 | (let ((files (edraw-msg-search-from-dir msg-str))) 71 | (cond 72 | ((null files) 73 | (error "Not found")) 74 | 75 | ((and (= (length files) 1) (= (length (cadr (car files))) 1)) 76 | (find-file (caar files)) 77 | (goto-char (point-min)) 78 | (forward-line (1- (car (cadar files))))) 79 | 80 | (t 81 | (ignore-errors 82 | (kill-buffer "*edraw msg search*")) 83 | (let ((buffer (get-buffer-create "*edraw msg search*"))) 84 | (with-current-buffer buffer 85 | (insert "\n") 86 | (cl-loop for (file line-numbers) in files 87 | do (cl-loop for line-number in line-numbers 88 | do 89 | (insert file ":" (number-to-string line-number) ":" "\n"))) 90 | (goto-char (point-min)) 91 | (grep-mode)) 92 | (pop-to-buffer buffer) 93 | (first-error) 94 | ))))) 95 | 96 | (defun edraw-msg-search-from-dir (msg-str) 97 | (cl-loop for source-file in (edraw-msg-source-files) 98 | for line-numbers = (edraw-msg-search-from-file source-file msg-str) 99 | when line-numbers 100 | collect (list source-file line-numbers))) 101 | 102 | (defun edraw-msg-search-from-file (source-file msg-str) 103 | (let ((regexp (concat "(edraw-msg[ \n\t]+" (regexp-quote msg-str)))) 104 | (with-temp-buffer 105 | (insert-file-contents source-file) 106 | (goto-char (point-min)) 107 | (cl-loop while (re-search-forward regexp nil t) 108 | collect (line-number-at-pos (match-beginning 0)))))) 109 | 110 | ;;;; Catalog File Generation 111 | 112 | (defun edraw-msg-make-hash-table () 113 | (interactive) 114 | (insert "(setq 115 | edraw-msg-hash-table 116 | #s(hash-table 117 | size 65 118 | test equal 119 | data 120 | ( 121 | ;; [BEGIN MSG DATA] 122 | ;; [END MSG DATA] 123 | ") 124 | (dolist (msgid (edraw-msg-collect)) 125 | (insert " \"" msgid "\" \"???\"\n")) 126 | (insert " )))")) 127 | 128 | ;;;; Update Catalog File 129 | 130 | (defun edraw-msg-update-catalog-buffer () 131 | (interactive) 132 | (let ((messages (edraw-msg-collect)) 133 | translated 134 | (count-deleted 0) 135 | (count-added 0)) 136 | ;; Delete messages 137 | (goto-char (point-min)) 138 | (re-search-forward ";; *\\[BEGIN MSG DATA\\][^\n]*\n") 139 | (condition-case _err 140 | (while t 141 | (let* ((msgid-end (progn (forward-sexp) (point))) 142 | (msgid-begin (progn (backward-sexp) (point))) 143 | (msgid-str (buffer-substring-no-properties 144 | msgid-begin msgid-end))) 145 | (push msgid-str translated) 146 | (forward-sexp) 147 | (forward-sexp) 148 | (unless (seq-contains-p messages msgid-str #'string=) 149 | (comment-region msgid-begin (point)) 150 | (cl-incf count-deleted)))) 151 | (error nil)) 152 | (setq translated (nreverse translated)) 153 | 154 | ;; Add new messages 155 | (let ((new-messages 156 | (sort (seq-difference messages translated #'string=) 157 | #'string-lessp))) 158 | (goto-char (point-min)) 159 | (re-search-forward ";; *\\[BEGIN MSG DATA\\][^\n]*\n") 160 | (condition-case _err 161 | (while t 162 | (let* ((msgid-end (progn (forward-sexp) (point))) 163 | (msgid-begin (progn (backward-sexp) (point))) 164 | (msgid-str (buffer-substring-no-properties 165 | msgid-begin msgid-end))) 166 | (when (string-lessp (car new-messages) msgid-str) 167 | (insert (car new-messages) " " "nil") 168 | (newline-and-indent) 169 | (cl-incf count-added) 170 | (pop new-messages))) 171 | (forward-sexp) 172 | (forward-sexp)) 173 | (error nil)) 174 | 175 | (dolist (new-msg new-messages) 176 | (newline-and-indent) 177 | (insert new-msg " " "nil") 178 | (cl-incf count-added))) 179 | 180 | (message "%s added, %s deleted" count-added count-deleted))) 181 | 182 | 183 | (provide 'edraw-msg-tools) 184 | ;;; edraw-msg-tools.el ends here 185 | -------------------------------------------------------------------------------- /edraw-mode.el: -------------------------------------------------------------------------------- 1 | ;;; edraw-mode.el --- Edraw File Editing Mode -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2021 AKIYAMA Kouhei 4 | 5 | ;; Author: AKIYAMA Kouhei 6 | ;; Keywords: Graphics, Drawing, SVG 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; (autoload 'edraw-mode "edraw-mode") 24 | ;; (add-to-list 'auto-mode-alist '("\\.edraw\\.svg$" . edraw-mode)) 25 | ;; NOTE: Set later than other modes for .svg such as image-mode. 26 | 27 | ;; 28 | 29 | ;; (autoload 'edraw "edraw-mode" nil t) 30 | ;; M-x edraw 31 | 32 | 33 | ;;; Code: 34 | 35 | (require 'edraw) 36 | (require 'edraw-import) 37 | 38 | (defvar-local edraw-mode-editor nil) 39 | 40 | ;;;###autoload 41 | (defun edraw-mode () 42 | "Major mode for editing edraw SVG files. 43 | 44 | The following commands are available: 45 | 46 | \\{edraw-mode-map}" 47 | (interactive) 48 | 49 | (widen) 50 | 51 | (let* ((svg (edraw-mode--parse-svg)) ;; May throw an error 52 | ;; After SVG parse 53 | (ov (progn 54 | ;; Leave current major mode 55 | (major-mode-suspend) 56 | 57 | ;; Fix source text (If buffer is empty, add dummy text) 58 | ;; and set read-only property 59 | (edraw-mode--text-lock) 60 | 61 | ;; Cover the entire source text 62 | (make-overlay (point-min) (point-max) nil nil t))) 63 | (editor (edraw-editor 64 | :overlay ov 65 | :svg svg 66 | ;; Don't use :document-writer to hide "save" from main menu 67 | ;;:document-writer 'edraw-mode-write-document 68 | ;;:document-writer-accepts-top-level-comments-p t 69 | :menu-filter 70 | (lambda (menu-type items &rest _) 71 | (pcase menu-type 72 | ('main-menu 73 | (append 74 | items 75 | `(((edraw-msg "Save") save-buffer) 76 | ("xml-mode" xml-mode)))) 77 | (_ items)))))) 78 | (setq-local edraw-mode-editor editor) 79 | 80 | ;; Setup Keymap 81 | (edraw-mode-transfer-overlay-keymap-to-local-map editor) 82 | 83 | ;; Setup modification tracking and data saving 84 | (edraw-add-hook editor 'change 'edraw-mode-on-changed) 85 | (add-hook 'before-save-hook 'edraw-mode-on-before-save nil t) 86 | 87 | ;; Setup file name tracking and maintain :base-uri 88 | ;; @todo If default-directory changes, base-uri should also change. 89 | (edraw-mode-update-base-uri) 90 | (add-hook 'after-set-visited-file-name-hook 91 | 'edraw-mode-on-file-name-changed nil t) 92 | 93 | ;; Setup major mode finalization 94 | (add-hook 'change-major-mode-hook 'edraw-mode-finalize-major-mode nil t) 95 | 96 | ;; Start major mode 97 | (setq mode-name "Easy Draw") 98 | (setq major-mode 'edraw-mode) 99 | (setq cursor-type nil) ;;Hide cursor 100 | 101 | ;; Disable context-menu-mode 102 | (setq-local minor-mode-overriding-map-alist 103 | '((context-menu-mode . nil))) 104 | 105 | ;; Ensure the top left corner of the buffer is displayed 106 | (goto-char (point-min)) 107 | (set-window-hscroll (selected-window) 0) 108 | 109 | (run-mode-hooks 'edraw-mode-hook))) 110 | 111 | (defconst edraw-mode--parse-svg--check-edraw-body t) 112 | 113 | (defun edraw-mode--parse-svg () 114 | (let* ((source (buffer-substring-no-properties (point-min) (point-max))) 115 | (svg (edraw-svg-decode-svg source nil t))) 116 | ;; Check SVG 117 | (unless (if (string-empty-p source) ;;@todo check whitespace only? 118 | (null svg) 119 | (and (not (null svg)) 120 | (edraw-dom-element-p svg) 121 | (edraw-dom-tag-eq (car (edraw-dom-split-top-nodes svg)) 122 | 'svg))) 123 | (error "Failed to parse SVG")) 124 | (when (and svg 125 | edraw-mode--parse-svg--check-edraw-body 126 | (not (dom-by-id svg "\\`edraw-body\\'"))) 127 | (error "edraw-mode can only be used for SVG generated by edraw. You may use the `edraw-convert-buffer-to-edraw-svg-xml' command at your own risk.")) 128 | svg)) 129 | 130 | 131 | ;;;; Finalize Major Mode 132 | 133 | (defun edraw-mode-finalize-major-mode () 134 | (edraw-mode-save) 135 | ;; Remove editor overlay 136 | (remove-overlays (point-min) (point-max)) 137 | ;; Remove read only properties 138 | (edraw-mode--text-unlock) 139 | 140 | ;; Remove local change-major-mode-hook (Not needed?) 141 | (remove-hook 'change-major-mode-hook 'edraw-mode-finalize-major-mode t)) 142 | 143 | 144 | 145 | ;;;; Text Modification 146 | 147 | (defvar edraw-mode--text-empty-p nil 148 | "Non-nil means source text is empty and dummy text is added to 149 | show the overlay using display property.") 150 | 151 | (defun edraw-mode--text-lock () 152 | (with-silent-modifications 153 | ;; Empty buffers cannot use display property. 154 | ;; So if the current buffer is empty, adds a dummy character. 155 | (setq edraw-mode--text-empty-p (= (point-min) (point-max))) 156 | (when edraw-mode--text-empty-p 157 | (insert "\n")) 158 | (add-text-properties (point-min) (point-max) 159 | (list 'read-only t 160 | 'front-sticky '(read-only))))) 161 | 162 | (defun edraw-mode--text-unlock () 163 | (with-silent-modifications 164 | (if edraw-mode--text-empty-p 165 | (progn 166 | (erase-buffer) 167 | (setq edraw-mode--text-empty-p nil)) 168 | (remove-list-of-text-properties (point-min) (point-max) 169 | '(read-only front-sticky))))) 170 | 171 | (defun edraw-mode--text-replace (new-text) 172 | (unless (string= (if edraw-mode--text-empty-p "" (buffer-string)) 173 | new-text) 174 | ;; Changed 175 | (let ((inhibit-read-only t)) 176 | (if edraw-mode--text-empty-p 177 | ;; Do not record undo data for deletion of dummy text 178 | (with-silent-modifications 179 | (erase-buffer)) 180 | (erase-buffer)) 181 | (insert new-text) 182 | (edraw-mode--text-lock)))) 183 | 184 | 185 | ;;;; Keymap 186 | 187 | (defvar-local edraw-mode-map nil) 188 | 189 | (defun edraw-mode-transfer-overlay-keymap-to-local-map (editor) 190 | (let* ((ov (edraw-overlay editor)) 191 | (keymap (overlay-get ov 'keymap))) 192 | ;; Transfer overlay's keymap property to local-map. 193 | (setq-local edraw-mode-map keymap) 194 | (use-local-map keymap) 195 | (overlay-put ov 'keymap nil) ;; remove keymap property 196 | ;; Track keymap changes. 197 | ;;(edraw-add-hook editor 'keymap-change 'edraw-mode-on-keymap-change) 198 | 199 | editor)) 200 | 201 | ;; (defun edraw-mode-on-keymap-change (_editor keymap) 202 | ;; (setq-local edraw-mode-map keymap) 203 | ;; (use-local-map keymap) 204 | ;; ;; Return t. EDITOR does not change the overlay's keymap. 205 | ;; t) 206 | 207 | 208 | 209 | ;;;; Modification Tracking and Data Saving 210 | 211 | (defconst edraw-mode-compress-file-p nil) ;;browser does not support svgz 212 | 213 | (defun edraw-mode-on-changed (_type) 214 | (set-buffer-modified-p t)) 215 | 216 | (defun edraw-mode-on-before-save () 217 | (set-buffer-file-coding-system 'utf-8) ;; SVG must be UTF-8 encoded 218 | (edraw-mode-save)) 219 | 220 | (defun edraw-mode-write-document (svg) 221 | (edraw-mode--text-replace (edraw-svg-encode svg nil 222 | edraw-mode-compress-file-p))) 223 | 224 | (defun edraw-mode-save () 225 | (let ((editor edraw-mode-editor)) 226 | ;; Same as edraw-save, but don't use document-writer because it 227 | ;; shows a "save" item in the main menu. 228 | (when (and editor 229 | (edraw-modified-p editor)) 230 | (let ((doc-svg (edraw-document-svg editor t))) 231 | (edraw-mode-write-document doc-svg) 232 | (edraw-set-modified-p editor nil))))) 233 | 234 | ;;;; Base URI 235 | 236 | (defun edraw-mode-on-file-name-changed () 237 | (edraw-mode-update-base-uri)) 238 | 239 | (defun edraw-mode-update-base-uri () 240 | "Update the :base-uri of the editor image. 241 | 242 | :base-uri is the base file name when referring to external 243 | resources such as images. 244 | 245 | The default is the buffer file name, but buffers created with the 246 | `edraw' command do not yet have a buffer file name. 247 | 248 | Therefore external images will not be displayed until the buffer 249 | is saved with a filename. 250 | 251 | This function sets :base-uri to default-directory if the buffer 252 | filename is nil. If non-nil invalidate the :base-uri." 253 | (let ((editor edraw-mode-editor)) 254 | (when editor 255 | (edraw-set-base-uri editor 256 | (and (null (buffer-file-name)) 257 | (expand-file-name "___unnamed___.svg")))))) 258 | 259 | ;;;; Edraw Command 260 | 261 | ;;;###autoload 262 | (defun edraw () 263 | (interactive) 264 | (pop-to-buffer-same-window (generate-new-buffer "new-image.edraw.svg")) 265 | (edraw-mode)) 266 | 267 | (provide 'edraw-mode) 268 | ;;; edraw-mode.el ends here 269 | -------------------------------------------------------------------------------- /edraw-org-export-html.el: -------------------------------------------------------------------------------- 1 | ;;; edraw-org-export-html.el --- Export edraw link As HTML in Org -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2022 AKIYAMA Kouhei 4 | 5 | ;; Author: AKIYAMA Kouhei 6 | ;; Keywords: Graphics, Drawing, SVG, Editor, Orgmode 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; 24 | 25 | ;;; Code: 26 | 27 | (require 'ox-html) 28 | (require 'edraw-org-edit) 29 | 30 | ;;;; Customize 31 | 32 | (define-obsolete-variable-alias 'edraw-org-link-export-data-tag 33 | 'edraw-org-export-html-data-tag "2022-09-22") 34 | (defcustom edraw-org-export-html-data-tag 'svg 35 | "HTML tag used to export data links. 36 | 37 | img = Data URI scheme () 38 | svg = Embed SVG element (...) 39 | " 40 | :group 'edraw-org 41 | :type '(choice (const :tag "" img) 42 | (const :tag "" svg) 43 | (function))) 44 | 45 | (define-obsolete-variable-alias 'edraw-org-link-export-file-tag 46 | 'edraw-org-export-html-file-tag "2022-09-22") 47 | (defcustom edraw-org-export-html-file-tag 'img 48 | "HTML tag used to export file links. 49 | 50 | img = Simple file link (\">) 51 | svg = Embed SVG element (...) 52 | " 53 | :group 'edraw-org 54 | :type '(choice (const :tag "" img) 55 | (const :tag "" svg) 56 | (function))) 57 | 58 | (defcustom edraw-org-export-html-use-viewbox t 59 | "Add viewBox= attribute to svg root elements when SVG export." 60 | :group 'edraw-org 61 | :type '(boolean)) 62 | 63 | ;;;; Export 64 | 65 | (defun edraw-org-export-html-link (path _description _back-end info link) 66 | ;; @todo Check inline-image-rules? However, unless it is converted 67 | ;; into an inline image, it will just output base64 data, so I don't 68 | ;; think it is practical. 69 | ;; (when (org-export-inline-image-p or org-html-inline-image-p? 70 | ;; link (plist-get info :html-inline-image-rules)) 71 | 72 | ;; path is unescaped : \[ \] => [ ] 73 | ;; description is not unescaped : \[ \] => \[ \] 74 | (if-let* ((link-props (edraw-org-link-props-parse path nil t))) 75 | (let ((html-tag (edraw-org-link-prop-html-tag link-props))) 76 | (if-let* ((data (edraw-org-link-prop-data link-props))) 77 | (pcase (or html-tag edraw-org-export-html-data-tag) 78 | ('svg (edraw-org-link-html-link-to-svg link-props link info)) 79 | ('img (edraw-org-link-data-to-img data link info)) 80 | ((and (pred functionp) 81 | func) 82 | (funcall func data)) 83 | (_ (edraw-org-link-html-link-to-svg link-props link info))) 84 | (if-let* ((file (edraw-org-link-prop-file link-props))) 85 | (pcase (or html-tag edraw-org-export-html-file-tag) 86 | ('svg (edraw-org-link-html-link-to-svg link-props link info)) 87 | ('img (edraw-org-link-file-to-img file link info)) 88 | ((and (pred functionp) 89 | func) 90 | (funcall func file)) 91 | (_ (edraw-org-link-file-to-img file link info))) 92 | ""))) 93 | "")) 94 | 95 | (defun edraw-org-link-data-to-data-uri (data) 96 | (with-temp-buffer 97 | (insert data) 98 | (base64-decode-region (point-min) (point-max)) 99 | ;; Web browsers don't support svgz 100 | (when (edraw-buffer-gzip-p) 101 | (edraw-gunzip-buffer) 102 | (encode-coding-region (point-min) (point-max) 'utf-8)) 103 | (base64-encode-region (point-min) (point-max) t) 104 | (goto-char (point-min)) 105 | (insert "data:image/svg+xml;base64,") 106 | (buffer-substring-no-properties (point-min) (point-max)))) 107 | 108 | (defun edraw-org-link-data-to-img (data link info) 109 | (edraw-org-link-html-img (edraw-org-link-data-to-data-uri data) link info)) 110 | 111 | (defun edraw-org-link-file-to-img (file link info) 112 | (edraw-org-link-html-img file link info)) 113 | 114 | (defun edraw-org-link-html-img (src link info) 115 | (org-html-close-tag 116 | "img" 117 | (org-html--make-attribute-string 118 | (org-combine-plists 119 | (list :src src) ;;@todo alt 120 | (edraw-org-link-html-attributes-plist link info))) 121 | info)) 122 | 123 | (defun edraw-org-link-html-link-to-svg (link-props link info) 124 | (let ((svg (edraw-org-link-load-svg link-props t)) 125 | (attributes (edraw-org-link-html-attributes-plist link info)) 126 | (link-ref (org-export-get-reference link info))) 127 | (unless svg 128 | (message "Failed to load SVG %s" (prin1-to-string link-props))) 129 | 130 | ;; Set svg attributes, replace ids and return as string 131 | (edraw-svg-encode 132 | (edraw-org-link-html-convert-svg-for-embed-in-html svg attributes 133 | link-ref) 134 | nil nil))) 135 | 136 | (defun edraw-org-link-html-attributes-plist (link info) 137 | "Return attributes specified by #+ATTR_HTML as a plist." 138 | (when link 139 | ;; NOTE: The code below is a copy from org-html-link function. 140 | (org-combine-plists 141 | ;; Extract attributes from parent's paragraph. HACK: Only 142 | ;; do this for the first link in parent (inner image link 143 | ;; for inline images). This is needed as long as 144 | ;; attributes cannot be set on a per link basis. 145 | (let* ((parent (org-export-get-parent-element link)) 146 | (link (let ((container (org-export-get-parent link))) 147 | (if (and (eq 'link (org-element-type container)) 148 | (org-html-inline-image-p link info)) 149 | container 150 | link)))) 151 | (and (eq link (org-element-map parent 'link #'identity info t)) 152 | (org-export-read-attribute :attr_html parent))) 153 | ;; Also add attributes from link itself. Currently, those 154 | ;; need to be added programmatically before `org-html-link' 155 | ;; is invoked, for example, by backends building upon HTML 156 | ;; export. 157 | (org-export-read-attribute :attr_html link)))) 158 | 159 | (defun edraw-org-link-html-convert-svg-for-embed-in-html (svg 160 | attributes 161 | link-ref) 162 | "Convert SVG into a form that can be embedded in HTML. 163 | 164 | Currently this function does three things: 165 | 166 | If edraw-org-export-html-use-viewbox is non-nil, add a viewBox 167 | attribute to the svg root element. 168 | 169 | Sets the attribute specified by #+ATTR_HTML to the svg root element. 170 | 171 | Guarantees the uniqueness of ids defined by the SVG in the 172 | exported HTML. Add a random string to id." 173 | ;; Discard top-level comments 174 | (setq svg (car (edraw-dom-split-top-nodes svg))) 175 | 176 | ;; Add viewBox= attribute 177 | (when (and edraw-org-export-html-use-viewbox 178 | (null (dom-attr svg 'viewBox))) 179 | (let ((width (dom-attr svg 'width)) 180 | (height (dom-attr svg 'height))) 181 | (dom-set-attribute svg 'viewBox (format "%s %s %s %s" 0 0 width height)))) 182 | 183 | ;; Apply attributes specified by #+ATTR_HTML to the root svg element 184 | (cl-loop for (key value) on attributes by #'cddr 185 | do (dom-set-attribute 186 | svg 187 | (cond 188 | ((keywordp key) (intern (substring (symbol-name key) 1))) 189 | ((stringp key) (intern key)) 190 | (t key)) 191 | value)) 192 | 193 | ;; Replace all ids (Make ids unique in the HTML) 194 | ;; e.g. 195 | ;; #edraw-body => #edraw-orgc4e2460-body 196 | ;; #edraw-defs => #edraw-orgc4e2460-defs 197 | ;; #edraw-def-0-arrow => #edraw-orgc4e2460-def-0-arrow 198 | 199 | (let* ((image-id link-ref) 200 | (id-converter (lambda (id) 201 | (format "edraw-%s-%s" 202 | image-id 203 | (string-remove-prefix "edraw-" id))))) 204 | (edraw-org-link-html-replace-ids svg id-converter)) 205 | svg) 206 | 207 | (defun edraw-org-link-html-replace-ids (svg id-converter) 208 | (let (;; Replace id in definitions 209 | ;; and create id conversion table. 210 | (id-map 211 | (delq nil 212 | (mapcar 213 | (lambda (element) 214 | (when-let* ((old-id (dom-attr element 'id)) 215 | (new-id (funcall id-converter old-id))) 216 | (dom-set-attribute element 'id new-id) 217 | (cons old-id new-id))) 218 | ;; The target elements are: 219 | (append 220 | (list 221 | (edraw-dom-get-by-id svg "edraw-background") 222 | (edraw-dom-get-by-id svg "edraw-body") 223 | (edraw-dom-get-by-id svg "edraw-defs")) 224 | (dom-children (edraw-dom-get-by-id svg "edraw-defs"))))))) 225 | ;; Replace all references 226 | (edraw-org-link-html-replace-id-in-url-references svg id-map))) 227 | 228 | (defun edraw-org-link-html-replace-id-in-url-references (element id-map) 229 | (when (edraw-dom-element-p element) 230 | (dolist (attr (dom-attributes element)) 231 | (let ((key (car attr)) 232 | (value (cdr attr))) 233 | ;;@todo should be limited to url data type attributes such as marker-start, marker-mid, marker-end 234 | (when (and (stringp value) 235 | (string-match "\\` *url *( *#\\([^ )]+\\) *) *\\'" value)) 236 | (when-let* ((old-id (match-string 1 value)) 237 | (new-id (alist-get old-id id-map nil nil #'equal))) 238 | (dom-set-attribute element 239 | key 240 | (format "url(#%s)" new-id)))))) 241 | ;; Children 242 | (dolist (child (dom-children element)) 243 | (edraw-org-link-html-replace-id-in-url-references child id-map)))) 244 | 245 | (provide 'edraw-org-export-html) 246 | ;;; edraw-org-export-html.el ends here 247 | -------------------------------------------------------------------------------- /edraw-org-edit.el: -------------------------------------------------------------------------------- 1 | ;;; edraw-org-edit.el --- Edit edraw link in Org-mode -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2022 AKIYAMA Kouhei 4 | 5 | ;; Author: AKIYAMA Kouhei 6 | ;; Keywords: Graphics, Drawing, SVG, Editor, Orgmode 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; 24 | 25 | ;;; Code: 26 | 27 | (require 'edraw) 28 | (require 'edraw-org) 29 | 30 | (declare-function image-flush "image.c") 31 | 32 | ;;;; Edit edraw link inline 33 | 34 | (defvar edraw-org-enable-modification nil) 35 | 36 | ;;@todo Use edraw-edit-svg? 37 | 38 | ;;;###autoload 39 | (defun edraw-org-edit-link (&optional _path _arg) 40 | "Edit the `edraw:' link at point. 41 | 42 | _PATH and _ARG are not used. These are passed in when called from 43 | org-link, but since these pieces of information aren't quite 44 | enough, this function parses the link at the current position on 45 | its own." 46 | (interactive) 47 | 48 | (require 'edraw) 49 | 50 | ;; Get link object & link properties 51 | (when-let* ((link-object (edraw-org-link-at-point)) 52 | (link-props-place-type (edraw-org-link-object-link-properties 53 | link-object nil))) 54 | 55 | (let* ((link-begin (org-element-property :begin link-object)) 56 | (link-end (org-element-property :end link-object)) 57 | (link-props (nth 0 link-props-place-type))) 58 | ;; Make sure the editor overlay doesn't exist yet 59 | (when (edraw-editor-overlays-in link-begin link-end) 60 | (error "Editor already exists")) 61 | 62 | ;; Hide inline link image if it exists 63 | (when-let* ((image-overlay (edraw-org-link-image-overlay-at link-begin))) 64 | (edraw-org-link-image-set-visible image-overlay nil)) 65 | 66 | ;; Remove mouse-face text property 67 | (edraw-org-link-remove-mouse-face link-begin link-end) 68 | 69 | ;; Create editor 70 | (let* ((editor-overlay (make-overlay link-begin link-end nil t nil)) 71 | (_editor (edraw-editor 72 | :overlay editor-overlay 73 | :svg (edraw-org-link-load-svg link-props t) 74 | :document-writer (edraw-org-link-make-writer 75 | editor-overlay 76 | edraw-org-link-compress-data-p 77 | edraw-org-link-compress-file-p) 78 | :document-writer-accepts-top-level-comments-p t 79 | :menu-filter #'edraw-org-link-editor-menu-filter 80 | :keymap (edraw-org-link-editor-make-keymap 81 | edraw-editor-map)))) 82 | ;;(overlay-put editor-overlay 'evaporate t) 83 | (overlay-put editor-overlay 'modification-hooks 84 | (list (lambda (_ov _after-p _beg _end &optional _len) 85 | (unless edraw-org-enable-modification 86 | (error "There is an edraw-editor within modification range. Please close the editor")))))) 87 | ;; Hook kill buffer 88 | (add-hook 'kill-buffer-query-functions 'edraw-buffer-kill-query nil t) 89 | 90 | (message "%s" (substitute-command-keys "\\[edraw-org-link-finish-edit]:Finish Edit, \\[edraw-org-link-cancel-edit]:Cancel Edit"))))) 91 | 92 | (defun edraw-org-link-load-svg (link-props 93 | &optional accepts-top-level-comments-p) 94 | (if-let* ((data (edraw-org-link-prop-data link-props))) 95 | (edraw-svg-decode-svg data t accepts-top-level-comments-p) 96 | (if-let* ((file (edraw-org-link-prop-file link-props))) 97 | (if (file-exists-p file) 98 | (edraw-svg-read-from-file file accepts-top-level-comments-p))))) 99 | 100 | (defun edraw-org-link-make-writer (editor-overlay data-gzip-p file-gzip-p) 101 | (lambda (svg) 102 | (edraw-org-link-save-svg editor-overlay svg data-gzip-p file-gzip-p))) 103 | 104 | (defun edraw-org-link-save-svg (editor-overlay svg data-gzip-p file-gzip-p) 105 | ;; Move to beginning of editing link 106 | (let ((buffer (overlay-buffer editor-overlay))) 107 | (unless buffer 108 | (error "The editor's overlay has been removed")) 109 | (with-current-buffer buffer 110 | (save-excursion 111 | (goto-char (overlay-start editor-overlay)) 112 | ;; Get link object & parse properties 113 | (let* ((link-object 114 | (or (edraw-org-link-at-point) 115 | (error "The edraw link currently being edited has been lost"))) 116 | (link-begin (org-element-property :begin link-object)) 117 | (link-end (org-element-property :end link-object)) 118 | (link-props-place-type 119 | (or (edraw-org-link-object-link-properties link-object t) 120 | (error "The type of the editing link is not `edraw:'"))) 121 | (link-props (nth 0 link-props-place-type)) 122 | (in-description-p (nth 1 link-props-place-type))) 123 | (if-let* ((file-path (edraw-org-link-prop-file link-props))) 124 | ;; file 125 | (progn 126 | (edraw-svg-write-to-file svg file-path file-gzip-p) ;;signal an error 127 | ;; Update inline image 128 | (image-flush (edraw-org-link-image-create link-props)) ;;update image if overlay already exists 129 | (edraw-org-link-image-update link-begin link-end link-object) ;;create a new overlay if not exists 130 | t) 131 | ;;data 132 | (setf (alist-get "data" link-props nil nil #'string=) 133 | (edraw-svg-encode svg t data-gzip-p)) 134 | (let ((edraw-org-enable-modification t)) ;; call modification hooks(inhibit-modification-hooks=nil) but allow modification. If inhibit-modification-hooks is t, inline images not updated. 135 | (unless (edraw-org-link-replace-object 136 | link-object ;; LINK-OBJECT is invalid after the call 137 | (concat edraw-org-link-type ":" 138 | (edraw-org-link-props-to-string link-props)) 139 | (if in-description-p 'description 'path)) 140 | (error "Failed to replace edraw link"))) 141 | t)))))) 142 | 143 | (defun edraw-org-link-editor-menu-filter (menu-type items) 144 | (pcase menu-type 145 | ('main-menu 146 | (append 147 | items 148 | '(((edraw-msg "Finish Edit") edraw-org-link-finish-edit) 149 | ((edraw-msg "Cancel Edit") edraw-org-link-cancel-edit)))) 150 | (_ items))) 151 | 152 | (defun edraw-org-link-editor-make-keymap (original-keymap) 153 | (let ((km (make-sparse-keymap))) 154 | (set-keymap-parent km original-keymap) 155 | (define-key km (kbd "C-c C-c") 'edraw-org-link-finish-edit) 156 | (define-key km (kbd "C-c C-k") 'edraw-org-link-cancel-edit) 157 | km)) 158 | 159 | (defun edraw-org-link-finish-edit (&optional editor) 160 | (interactive) 161 | (let ((editor (or editor (edraw-current-editor)))) 162 | (when (or (not (edraw-modified-p editor)) 163 | (condition-case err 164 | (edraw-save editor) 165 | (error 166 | (message "Error=%s" (prin1-to-string err)) 167 | (yes-or-no-p 168 | (format 169 | (edraw-msg "Failed to save. %s. Discard changes?") 170 | (error-message-string err)))))) 171 | (edraw-org-link-close-editor editor)))) 172 | 173 | (defun edraw-org-link-cancel-edit (&optional editor) 174 | (interactive) 175 | (when-let* ((editor (or editor (edraw-current-editor)))) 176 | (when (or (null (edraw-modified-p editor)) 177 | (yes-or-no-p (edraw-msg "Discard changes?"))) 178 | (edraw-org-link-close-editor editor)))) 179 | 180 | (defun edraw-org-link-close-editor (editor) 181 | ;; show link image 182 | (when-let* ((editor-overlay (oref editor overlay)) 183 | (buffer (overlay-buffer editor-overlay))) 184 | (with-current-buffer buffer 185 | (save-excursion 186 | ;; Recover inline image 187 | (when-let* ((image-overlay (edraw-org-link-image-overlay-at 188 | (overlay-start editor-overlay)))) 189 | (edraw-org-link-image-set-visible image-overlay t)) 190 | ;; Recover mouse-face 191 | (edraw-org-link-recover-mouse-face (overlay-start editor-overlay) 192 | (overlay-end editor-overlay))))) 193 | ;; delete editor overlay 194 | (edraw-close editor)) 195 | 196 | 197 | ;;;; Edit regular file link inline 198 | 199 | ;;;###autoload 200 | (defun edraw-org-edit-regular-file-link () 201 | "Edit the `file:' link to the .edraw.svg file at point. 202 | 203 | There is a `[[edraw:file=somefile.edraw.svg]]' format for embedding 204 | an external SVG file in an Org document, but if you don't want to 205 | use `edraw:' link type and want to use the regular `file:' link type 206 | ([[file:somefile.edraw.svg]] format), this function might help." 207 | (interactive) 208 | (let* ((link (or (org-element-context) 209 | (error (edraw-msg "No link at point")))) 210 | (type (org-element-property :type link)) 211 | (path (org-element-property :path link)) 212 | (beg (org-element-property :begin link)) 213 | (end (org-element-property :end link))) 214 | (unless (equal type "file") 215 | (error (edraw-msg "The link at point is not of type `file:'"))) 216 | (unless (string-suffix-p ".edraw.svg" path t) 217 | (error (edraw-msg "The extension is not .edraw.svg"))) 218 | (when (edraw-editor-overlays-in beg end) 219 | (error "Editor already exists")) 220 | 221 | ;;Remove org-mode inline image 222 | (edraw-org--remove-org-inline-images beg end) 223 | 224 | (edraw-edit-svg (when (file-exists-p path) 225 | (edraw-svg-read-from-file path t)) 226 | 'edraw-svg 227 | beg end 228 | (lambda (_ok _svg) 229 | ;; Restore org-mode inline image 230 | ;;@todo Add settings? 231 | (org-display-inline-images nil t beg end)) 232 | (lambda (svg) 233 | (edraw-svg-write-to-file svg path nil) 234 | t) 235 | ;; Keep file's top-level comments 236 | t))) 237 | 238 | (defun edraw-org--remove-org-inline-images (beg end) 239 | (if (version<= "9.6" (org-version)) 240 | (with-no-warnings 241 | (org-remove-inline-images beg end)) ;; Can pass BEG and END 242 | ;; Can't pass BEG and END in 9.5 or earlier 243 | (dolist (ov (overlays-in beg end)) 244 | (when (memq ov org-inline-image-overlays) 245 | (setq org-inline-image-overlays (delq ov org-inline-image-overlays)) 246 | (delete-overlay ov))))) 247 | 248 | 249 | ;;;; Link Tools 250 | 251 | ;;;###autoload 252 | (defun edraw-org-link-copy-contents-at-point () 253 | "Copies the contents of the link at point. 254 | 255 | Copies all shapes inside the data to the clipboard. Copied shapes 256 | can be pasted in the editor or in the shape picker (custom shape list)." 257 | (interactive) 258 | (let* ((link-object (edraw-org-link-at-point)) 259 | (props (car (edraw-org-link-object-link-properties link-object nil t))) 260 | (svg (edraw-org-link-load-svg props t))) 261 | (unless link-object 262 | (error (edraw-msg "No link at point"))) 263 | (unless svg 264 | (error (edraw-msg "Link at point does not contain valid data"))) 265 | 266 | (edraw-clipboard-set 267 | 'shape-descriptor-list 268 | (cl-loop for node in (dom-children (edraw-get-document-body svg)) 269 | for desc = (edraw-shape-descriptor-from-svg-element-without-editor 270 | node) 271 | when desc collect desc)))) 272 | 273 | (provide 'edraw-org-edit) 274 | ;;; edraw-org-edit.el ends here 275 | -------------------------------------------------------------------------------- /edraw-generator.el: -------------------------------------------------------------------------------- 1 | ;;; edraw-generator.el --- Shape generators -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2024 AKIYAMA Kouhei 4 | 5 | ;; Author: AKIYAMA Kouhei 6 | ;; Keywords: 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; Define shape generators to be used from `edraw-shape-generator' and 24 | ;; `edraw-editor-tool-generator'. 25 | ;; 26 | ;; This file defines the following generator types. 27 | ;; - latex 28 | ;; - grid 29 | ;; 30 | ;; See `edraw-shape-generator-alist' for a list of generators. 31 | ;; 32 | 33 | ;;; Code: 34 | 35 | ;;;; Declarations 36 | 37 | (require 'edraw) 38 | (require 'edraw-dom-svg) 39 | 40 | (defvar edraw-import-warning-suppress-types) 41 | (autoload 'edraw-import-warning-suppress-types "edraw-import") 42 | (autoload 'edraw-import-svg-string "edraw-import") 43 | 44 | ;;;; LaTeX 45 | 46 | (defgroup edraw-gen-latex nil 47 | "Generate shapes by LaTeX." 48 | :tag "LaTeX Shape Generator" 49 | :prefix "edraw-gen-latex-" 50 | :group 'edraw) 51 | 52 | ;;;;; LaTeX Compilation 53 | 54 | (defcustom edraw-gen-latex-command-latex 55 | "latex -interaction nonstopmode -output-directory ./ %s" 56 | "Command to convert tex file to dvi file." 57 | :group 'edraw-gen-latex 58 | :type 'string) 59 | 60 | (defcustom edraw-gen-latex-command-dvisgm 61 | ;; https://dvisvgm.de/Manpage/ 62 | ;; --no-fonts=1 means to use only `path' elements (no `use' elements). 63 | ;; --scale=1.6 is not necessary as it will be scaled on the Emacs side. 64 | "dvisvgm %s --no-fonts=1 --exact-bbox --output=%s" 65 | "Command to convert dvi file to svg file." 66 | :group 'edraw-gen-latex 67 | :type 'string) 68 | 69 | (defun edraw-gen-latex-compile (tex-src) 70 | (let* ((tex-file-abs (expand-file-name 71 | (make-temp-file "edraw-gen-latex-" nil ".tex" tex-src))) 72 | (tex-file (file-name-nondirectory tex-file-abs)) 73 | (tex-dir (file-name-directory tex-file-abs)) 74 | (tex-base (file-name-base tex-file)) 75 | (dvi-file (concat tex-base ".dvi")) 76 | (svg-file (concat tex-base ".svg")) 77 | (aux-file (concat tex-base ".aux")) 78 | (log-file (concat tex-base ".log")) 79 | (default-directory tex-dir)) 80 | (unwind-protect 81 | (let ((latex-cmd 82 | (format edraw-gen-latex-command-latex tex-file)) 83 | (dvisvgm-cmd 84 | (format edraw-gen-latex-command-dvisgm dvi-file svg-file)) 85 | (outbuf (get-buffer-create "*edraw-gen-latex*"))) 86 | (with-current-buffer outbuf 87 | (erase-buffer)) 88 | (unless (eq (call-process-shell-command latex-cmd nil outbuf) 0) 89 | (pop-to-buffer outbuf) 90 | (error "Error: %s" latex-cmd)) 91 | (unless (eq (call-process-shell-command dvisvgm-cmd nil outbuf) 0) 92 | (pop-to-buffer outbuf) 93 | (error "Error: %s" dvisvgm-cmd)) 94 | (with-temp-buffer 95 | (edraw-insert-xml-file-contents svg-file) 96 | (buffer-string))) 97 | (delete-file svg-file) 98 | (delete-file aux-file) 99 | (delete-file log-file) 100 | (delete-file dvi-file) 101 | (delete-file tex-file)))) 102 | 103 | ;; EXAMPLE: (edraw-gen-latex-compile "\\documentclass{article}\n\\usepackage{amsmath}\n\\usepackage{amssymb}\n\\pagestyle{empty}\n\\begin{document}\n$a=-\\sqrt{2}$\n\\end{document}") 104 | 105 | ;;;;; LaTeX Assembling TeX Source 106 | 107 | (defcustom edraw-gen-latex-tex-preamble-first 108 | '("\\documentclass[fleqn]{article}") 109 | "The beginning of the TeX source." 110 | :group 'edraw-gen-latex 111 | :type '(choice (string) 112 | (repeat (string)))) 113 | 114 | (defcustom edraw-gen-latex-tex-packages 115 | '("\\usepackage[usenames]{color}" 116 | "\\usepackage[normalem]{ulem}" 117 | "\\usepackage{amsmath}" 118 | "\\usepackage{amssymb}") 119 | "Package part of TeX source." 120 | :group 'edraw-gen-latex 121 | :type '(choice (string) 122 | (repeat (string)))) 123 | 124 | (defcustom edraw-gen-latex-tex-style 125 | ;; \\setlength{\\parindent}{0cm} 126 | ;; \\setlength{\\footheight}{0cm} 127 | '("\\pagestyle{empty} 128 | \\setlength{\\textwidth}{\\paperwidth} 129 | \\setlength{\\oddsidemargin}{0pt} 130 | \\setlength{\\evensidemargin}{0pt} 131 | \\setlength{\\textheight}{\\paperheight} 132 | \\setlength{\\topmargin}{0pt} 133 | \\setlength{\\headheight}{0pt} 134 | \\setlength{\\headsep}{0pt} 135 | \\setlength{\\topskip}{0pt} 136 | \\setlength{\\footskip}{0pt} 137 | \\setlength{\\mathindent}{0pt}") 138 | "Style declaration part of TeX source." 139 | :group 'edraw-gen-latex 140 | :type '(choice (string) 141 | (repeat (string)))) 142 | 143 | (defvar edraw-gen-latex-tex-preamble-options nil) 144 | 145 | (defcustom edraw-gen-latex-tex-preamble-last nil 146 | "The end of the preamble part of the TeX source." 147 | :group 'edraw-gen-latex 148 | :type '(choice (string) 149 | (repeat (string)))) 150 | 151 | (defcustom edraw-gen-latex-tex-document-first 152 | '("\\begin{document}") 153 | "The beginning of the documentation part of the TeX source." 154 | :group 'edraw-gen-latex 155 | :type '(choice (string) 156 | (repeat (string)))) 157 | 158 | (defvar edraw-gen-latex-tex-document-body nil) 159 | 160 | (defcustom edraw-gen-latex-tex-document-last 161 | '("\\end{document}") 162 | "The end of the documentation part of the TeX source." 163 | :group 'edraw-gen-latex 164 | :type '(choice (string) 165 | (repeat (string)))) 166 | 167 | (defconst edraw-gen-latex-tex-format 168 | '(edraw-gen-latex-tex-preamble-first 169 | edraw-gen-latex-tex-packages 170 | edraw-gen-latex-tex-style 171 | edraw-gen-latex-tex-preamble-options 172 | edraw-gen-latex-tex-preamble-last 173 | edraw-gen-latex-tex-document-first 174 | edraw-gen-latex-tex-document-body 175 | edraw-gen-latex-tex-document-last)) 176 | 177 | (defun edraw-gen-latex-format (fmt) 178 | (cond 179 | ((stringp fmt) 180 | fmt) 181 | ((null fmt) 182 | nil) 183 | ((listp fmt) 184 | (mapconcat #'identity 185 | (delq nil (mapcar #'edraw-gen-latex-format fmt)) "\n")) 186 | ((symbolp fmt) 187 | (when (boundp fmt) 188 | (edraw-gen-latex-format (symbol-value fmt)))))) 189 | 190 | (defun edraw-gen-latex-assemble (src-code options) 191 | (unless src-code 192 | (error "No latex src-code")) 193 | (let* (;; Indentation 194 | (parindent (alist-get 'parindent options)) 195 | (edraw-gen-latex-tex-preamble-options 196 | (when (numberp parindent) 197 | (concat "\\setlength{\\parindent}{" 198 | (edraw-to-string parindent) 199 | ;;@todo pt? 200 | "pt}"))) 201 | ;; Document body 202 | (edraw-gen-latex-tex-document-body src-code)) 203 | (edraw-gen-latex-format edraw-gen-latex-tex-format))) 204 | 205 | ;; EXAMPLE: (edraw-gen-latex-assemble "$x=\\sqrt{2}$") 206 | 207 | ;;;;; LaTeX Generator Functions 208 | 209 | (defun edraw-gen-latex (src &rest plist) 210 | (unless (string-empty-p src) 211 | (let* ((options (plist-get plist :options)) 212 | ;; Suppress warnings 213 | ;; @todo Problems can occur when ungrouped 214 | (edraw-import-warning-suppress-types 215 | (edraw-import-warning-suppress-types 'path-multiple-subpaths)) 216 | (body (edraw-dom-get-by-id 217 | (edraw-import-svg-string 218 | (edraw-gen-latex-compile 219 | (edraw-gen-latex-assemble 220 | src options))) 221 | "edraw-body")) 222 | ;; Discard unnecessary group element. 223 | (result-element (if (cdr (edraw-dom-children body)) 224 | body 225 | (car (edraw-dom-children body))))) 226 | ;; Remove id attributes 227 | (edraw-dom-remove-attr-from-tree result-element 'id) 228 | 229 | ;; Scaling 230 | (let ((scale (alist-get 'scale options))) 231 | (when (numberp scale) 232 | (edraw-svg-element-transform-multiply 233 | result-element 234 | (edraw-matrix-scale scale scale 1)))) 235 | 236 | result-element))) 237 | 238 | ;; EXAMPLE: (edraw-gen-latex-compile (edraw-gen-latex-assemble "$x=\\sqrt{2}$")) 239 | 240 | (defun edraw-gen-latex-options-info () 241 | (list 242 | (edraw-svg-prop-info 'scale nil 'number nil) 243 | (edraw-svg-prop-info 'parindent nil 'number nil))) 244 | 245 | (defun edraw-gen-latex-defaults () 246 | `((fill . ,edraw-package-default-stroke) 247 | (gen-options 248 | . ,(concat 249 | ;; The coordinate system output by latex and dvisvgm is in pt units. 250 | ;; The default font size is 10pt. Multiply this by 1.6 to 16px. 251 | "scale:1.6" 252 | ";parindent:0")))) 253 | 254 | 255 | ;;;; Grid 256 | 257 | (defconst edraw-gen-grid-max-lines 1000) 258 | 259 | (defun edraw-gen-grid-safety () 260 | 'immediately-applicable) 261 | 262 | (defun edraw-gen-grid (_src &rest plist) 263 | (let* ((options (plist-get plist :options)) 264 | (x-interval (alist-get 'x-interval options)) 265 | (x-min (alist-get 'x-min options)) 266 | (x-max (alist-get 'x-max options)) 267 | (y-interval (alist-get 'y-interval options)) 268 | (y-min (alist-get 'y-min options)) 269 | (y-max (alist-get 'y-max options))) 270 | (when (and (numberp x-min) 271 | (numberp x-max) 272 | (numberp y-min) 273 | (numberp y-max)) 274 | (let ((children 275 | (nconc 276 | (edraw-gen-grid-make-lines x-min x-max x-interval 277 | y-min y-max nil) 278 | (edraw-gen-grid-make-lines y-min y-max y-interval 279 | x-min x-max t)))) 280 | (when children 281 | (edraw-svg-group :children children)))))) 282 | 283 | (defun edraw-gen-grid-make-lines (x-min x-max x-interval y-min y-max transpose) 284 | (when (and (numberp x-interval) 285 | (> x-interval 0) 286 | (> x-max x-min) 287 | (< (/ (- x-max x-min) x-interval) edraw-gen-grid-max-lines)) 288 | (cl-loop for x from x-min to x-max by x-interval 289 | collect 290 | (edraw-svg-path 291 | (concat 292 | "M" 293 | (mapconcat #'edraw-svg-numstr 294 | (if transpose 295 | (list y-min x y-max x) 296 | (list x y-min x y-max)) 297 | " ")))))) 298 | 299 | (defun edraw-gen-grid-options-info () 300 | (list 301 | (edraw-svg-prop-info 'x-interval nil 'number nil) 302 | (edraw-svg-prop-info 'x-min nil 'number nil) 303 | (edraw-svg-prop-info 'x-max nil 'number nil) 304 | (edraw-svg-prop-info 'y-interval nil 'number nil) 305 | (edraw-svg-prop-info 'y-min nil 'number nil) 306 | (edraw-svg-prop-info 'y-max nil 'number nil))) 307 | 308 | (defun edraw-gen-grid-defaults () 309 | `((stroke . "#808080") 310 | (stroke-width . "1") 311 | (gen-options 312 | . "x-interval:20;x-min:0;x-max:100;y-interval:20;y-min:0;y-max:100"))) 313 | 314 | (defun edraw-gen-grid-interactive (editor rect) 315 | (unless rect 316 | (setq rect (edraw-editor-read-rectangle-interactively 317 | (edraw-msg "Drag the grid creation range") 318 | editor))) ;;@todo This code is not used. 319 | 320 | (let* ((click-p (edraw-rect-empty-p rect)) ;;@todo Check the minimum amount of movement that is considered a click 321 | (options 322 | `((x-min . ,(if click-p (read-number (edraw-msg "X Minimum: ") 0) 0)) 323 | (y-min . ,(if click-p (read-number (edraw-msg "Y Minimum: ") 0) 0)) 324 | (x-max . ,(if click-p (read-number (edraw-msg "X Maximum: ") 100) 325 | (edraw-rect-width rect))) 326 | (y-max . ,(if click-p (read-number (edraw-msg "Y Maximum: ") 100) 327 | (edraw-rect-height rect))) 328 | (x-interval . ,(read-number (edraw-msg "X Interval: ") 20)) 329 | (y-interval . ,(read-number (edraw-msg "Y Interval: ") 20))))) 330 | `((gen-src . nil) 331 | (gen-options . ,(mapconcat (lambda (cell) 332 | (format "%s:%s" 333 | (car cell) 334 | (edraw-to-string (cdr cell)))) 335 | options 336 | ";")) 337 | (transform . ,(edraw-svg-transform-from-matrix 338 | (edraw-matrix-translate-xy (edraw-rect-lt rect))))))) 339 | 340 | 341 | (provide 'edraw-generator) 342 | ;;; edraw-generator.el ends here 343 | -------------------------------------------------------------------------------- /edraw-editor-util.el: -------------------------------------------------------------------------------- 1 | ;;; edraw-editor-util.el --- -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2023 AKIYAMA Kouhei 4 | 5 | ;; Author: AKIYAMA Kouhei 6 | ;; Keywords: 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; Utilities for use only while edraw-editor is running. 24 | 25 | ;; Intended for use from edraw-property-editor.el, 26 | ;; edraw-shape-picker.el and edraw.el. Not used from edraw-org.el. 27 | 28 | ;;; Code: 29 | 30 | (require 'eieio) 31 | 32 | ;;;; Buffer Display 33 | 34 | ;; A mechanism for displaying a buffer in a window or frame. 35 | 36 | (defconst edraw-buffer-display-frame-parameters-to-save 37 | '(left top width height z-group) 38 | "Frame parameters to be saved.") 39 | 40 | (defconst edraw-buffer-display-frame-parameters-default 41 | '((z-group . above) ;;top most 42 | (user-position . t) 43 | ;;(left-fringe . 0) 44 | ;;(right-fringe . 0) 45 | (menu-bar-lines . 0) 46 | (tool-bar-lines . 0) 47 | (tab-bar-lines . 0) 48 | ;;(unsplittable . t) 49 | (width . 56) 50 | (height . 30)) 51 | "Default frame parameters.") 52 | 53 | (defclass edraw-buffer-display () 54 | ((buffer :initarg :buffer) 55 | (window :initform nil) 56 | (frame :initform nil) 57 | (frame-mode :initform nil :initarg :frame-mode) 58 | (frame-delete-hook :initform nil) 59 | (frame-parameters-last :initform nil :initarg :frame-parameters-last) 60 | (frame-parameters-to-save 61 | :initform (identity edraw-buffer-display-frame-parameters-to-save) 62 | :initarg :frame-parameters-to-save) 63 | (frame-parameters-default 64 | :initform (identity edraw-buffer-display-frame-parameters-default) 65 | :initarg :frame-parameters-default) 66 | (frame-child-p :initform nil :initarg :frame-child-p) 67 | (frame-mode-line-p :initform nil :initarg :frame-mode-line-p) 68 | (save-function :initform nil :initarg :save-function)) 69 | "A class that controls how the buffer is displayed.") 70 | 71 | (cl-defmethod edraw-destroy ((bd edraw-buffer-display)) 72 | (edraw-unobserve-frame bd)) 73 | 74 | ;;;;; Save Settings 75 | 76 | (cl-defmethod edraw-save-state ((bd edraw-buffer-display) key value) 77 | (with-slots (save-function) bd 78 | (when save-function 79 | (funcall save-function bd key value)))) 80 | 81 | ;;;;; Open Window or Frame 82 | 83 | (cl-defmethod edraw-display-buffer ((bd edraw-buffer-display)) 84 | (with-slots (frame-mode) bd 85 | (if frame-mode 86 | (edraw-open-frame bd) 87 | (edraw-open-window bd)))) 88 | 89 | (cl-defmethod edraw-open-window ((bd edraw-buffer-display)) 90 | (save-selected-window 91 | (with-slots (window buffer) bd 92 | ;; Show mode line 93 | (with-current-buffer buffer 94 | (kill-local-variable 'mode-line-format)) 95 | 96 | (cond 97 | ;; Use existing window 98 | ((and (window-live-p window) 99 | (eq (window-buffer window) buffer)) 100 | (select-window window)) 101 | ;; Create new window 102 | (t 103 | (pop-to-buffer buffer) 104 | (setq window (selected-window)))) 105 | (edraw-buffer-display-fit-window-size-to-content)))) 106 | 107 | (defun edraw-buffer-display-fit-window-size-to-content () 108 | (when-let* ((parent-window (window-parent))) 109 | (let* ((parent-window-height (window-height parent-window)) 110 | (max-height (/ parent-window-height 2))) 111 | (fit-window-to-buffer nil max-height) 112 | (enlarge-window 1)))) 113 | 114 | (cl-defmethod edraw-open-frame ((bd edraw-buffer-display)) 115 | (with-slots (frame window buffer frame-mode-line-p) bd 116 | (if (frame-live-p frame) 117 | ;; Use existing frame 118 | (let ((fwindow (frame-selected-window frame))) 119 | (delete-other-windows fwindow) 120 | (setq window fwindow)) 121 | ;; Create new frame 122 | (setq frame (make-frame (edraw-make-frame-parameters bd))) 123 | (setq window (frame-root-window frame)) 124 | (edraw-observe-frame bd)) 125 | ;; Hide mode line 126 | (unless frame-mode-line-p 127 | (with-current-buffer buffer 128 | (setq-local mode-line-format nil))) 129 | ;; Show buffer 130 | (set-window-buffer window buffer) 131 | (set-window-dedicated-p window t))) 132 | 133 | ;;;;; Observe Frame 134 | 135 | (cl-defmethod edraw-observe-frame ((bd edraw-buffer-display)) 136 | (with-slots (frame-delete-hook) bd 137 | (unless frame-delete-hook 138 | (setq frame-delete-hook 139 | (lambda (frame) (edraw-on-delete-frame bd frame))) 140 | (add-hook 'delete-frame-functions frame-delete-hook)))) 141 | 142 | (cl-defmethod edraw-unobserve-frame ((bd edraw-buffer-display)) 143 | (with-slots (frame-delete-hook) bd 144 | (when frame-delete-hook 145 | (remove-hook 'delete-frame-functions frame-delete-hook) 146 | (setq frame-delete-hook nil)))) 147 | 148 | (cl-defmethod edraw-on-delete-frame ((bd edraw-buffer-display) frame-to-del) 149 | ;; Backup frame parameters 150 | (with-slots (frame window buffer) bd 151 | (when (eq frame-to-del frame) 152 | ;; Save frame position, size, etc. 153 | (edraw-save-frame-parameters bd) 154 | ;; No more observing the frame 155 | (edraw-unobserve-frame bd) 156 | ;; Clear Variables 157 | (setq frame nil 158 | window nil) 159 | ;; Delete buffer 160 | (when (buffer-live-p buffer) 161 | (kill-buffer buffer)))) 162 | nil) 163 | 164 | ;;;;; Frame Parameters 165 | 166 | (cl-defmethod edraw-make-frame-parameters ((bd edraw-buffer-display)) 167 | (with-slots (frame-parameters-last 168 | frame-parameters-default 169 | frame-child-p) 170 | bd 171 | ;;@todo Remove duplicated? Always prefer the first param? 172 | (append frame-parameters-last 173 | frame-parameters-default 174 | (when frame-child-p 175 | (list (cons 'parent-frame (selected-frame))))))) 176 | 177 | (cl-defmethod edraw-get-frame-parameters-last ((bd edraw-buffer-display)) 178 | (oref bd frame-parameters-last)) 179 | 180 | (cl-defmethod edraw-set-frame-parameters-last ((bd edraw-buffer-display) params) 181 | (oset bd frame-parameters-last params)) 182 | 183 | (cl-defmethod edraw-save-frame-parameters ((bd edraw-buffer-display)) 184 | (with-slots (frame 185 | frame-parameters-last 186 | frame-parameters-to-save 187 | buffer) 188 | bd 189 | (when (frame-live-p frame) 190 | (setq frame-parameters-last 191 | (cl-loop for param in (frame-parameters frame) 192 | when (memq (car param) 193 | frame-parameters-to-save) 194 | collect param)) 195 | (edraw-save-state bd 'frame-parameters-last frame-parameters-last)))) 196 | 197 | 198 | ;;;;; Close Window or Frame 199 | 200 | (cl-defmethod edraw-close ((bd edraw-buffer-display)) 201 | (with-slots (frame window buffer) bd 202 | ;; close window 203 | (edraw-delete-display bd) 204 | 205 | ;; delete buffer 206 | (when (buffer-live-p buffer) 207 | (kill-buffer buffer)))) 208 | 209 | (cl-defmethod edraw-delete-display ((bd edraw-buffer-display)) 210 | (with-slots (frame window buffer) bd 211 | (cond 212 | ;; Delete frame 213 | (frame 214 | (edraw-save-frame-parameters bd) ;; Save position 215 | (edraw-unobserve-frame bd) ;; Keep buffer 216 | (when (frame-live-p frame) 217 | (delete-frame frame)) 218 | (setq frame nil 219 | window nil)) 220 | ;; Delete window 221 | (window 222 | (when (and (window-live-p window) 223 | buffer 224 | (eq (window-buffer window) buffer) 225 | (window-parent window)) 226 | (delete-window window)) 227 | (setq window nil))))) 228 | 229 | (cl-defmethod edraw-set-frame-parameter ((bd edraw-buffer-display) 230 | parameter value) 231 | (with-slots (frame) bd 232 | (when frame 233 | (set-frame-parameter frame parameter value)))) 234 | 235 | (cl-defmethod edraw-get-frame-parameter ((bd edraw-buffer-display) 236 | parameter) 237 | (with-slots (frame) bd 238 | (when frame 239 | (frame-parameter frame parameter)))) 240 | 241 | ;;;;; Frame Mode 242 | 243 | (cl-defmethod edraw-get-frame-mode ((bd edraw-buffer-display)) 244 | (oref bd frame-mode)) 245 | 246 | (cl-defmethod edraw-toggle-frame-mode ((bd edraw-buffer-display)) 247 | (with-slots (frame-mode) bd 248 | (edraw-delete-display bd) 249 | (setq frame-mode (not frame-mode)) 250 | (edraw-display-buffer bd) 251 | (edraw-save-state bd 'frame-mode frame-mode))) 252 | 253 | (cl-defmethod edraw-set-frame-mode ((bd edraw-buffer-display) mode) 254 | (unless (eq (edraw-get-frame-mode bd) mode) 255 | (edraw-toggle-frame-mode bd))) 256 | 257 | ;;;;; Frame Mode Line 258 | 259 | (cl-defmethod edraw-get-frame-mode-line-p ((bd edraw-buffer-display)) 260 | (oref bd frame-mode-line-p)) 261 | 262 | (cl-defmethod edraw-toggle-frame-mode-line-p ((bd edraw-buffer-display)) 263 | (with-slots (buffer frame frame-mode-line-p) bd 264 | (setq frame-mode-line-p (not frame-mode-line-p)) 265 | (when frame 266 | (with-current-buffer buffer 267 | (if frame-mode-line-p 268 | (kill-local-variable 'mode-line-format) 269 | (setq-local mode-line-format nil)) 270 | (redraw-display))) 271 | (edraw-save-state bd 'frame-mode-line-p frame-mode-line-p))) 272 | 273 | (cl-defmethod edraw-set-frame-mode-line-p ((bd edraw-buffer-display) flag) 274 | (unless (eq flag (oref bd frame-mode-line-p)) 275 | (edraw-toggle-frame-mode-line-p bd))) 276 | 277 | ;;;;; Frame Child 278 | 279 | (cl-defmethod edraw-get-frame-child-p ((bd edraw-buffer-display)) 280 | (oref bd frame-child-p)) 281 | 282 | (cl-defmethod edraw-toggle-frame-child-p ((bd edraw-buffer-display)) 283 | (with-slots (frame frame-child-p frame-parameters-last) bd 284 | (setq frame-child-p (not frame-child-p)) 285 | (when frame 286 | (edraw-delete-display bd) 287 | ;; Reset position 288 | (setf (alist-get 'left frame-parameters-last nil t) nil) 289 | (setf (alist-get 'top frame-parameters-last nil t) nil) 290 | (edraw-display-buffer bd)) 291 | (edraw-save-state bd 'frame-child-p frame-child-p))) 292 | 293 | (cl-defmethod edraw-set-frame-child-p ((bd edraw-buffer-display) flag) 294 | (unless (eq flag (oref bd frame-child-p)) 295 | (edraw-toggle-frame-child-p bd))) 296 | 297 | 298 | 299 | ;;;; UI State Store 300 | 301 | (defcustom edraw-ui-state-file 302 | (locate-user-emacs-file "edraw-ui-state.config") 303 | "Default UI state file." 304 | :type 'file 305 | :group 'edraw-editor) 306 | 307 | (defvar edraw-ui-state-object nil 308 | "Default UI state object.") 309 | 310 | (defun edraw-ui-state-object-default () 311 | (or edraw-ui-state-object 312 | (setq edraw-ui-state-object (edraw-ui-state)))) 313 | 314 | (defclass edraw-ui-state () 315 | ((store :initform nil) 316 | (file :initarg file :initform 'default))) 317 | 318 | (cl-defmethod edraw-clear ((ui-state edraw-ui-state)) 319 | (oset ui-state store nil)) 320 | 321 | (cl-defgeneric edraw-ui-state-get (ui-state domain key &optional default)) 322 | 323 | (cl-defmethod edraw-ui-state-get ((ui-state edraw-ui-state) 324 | domain key &optional default) 325 | (edraw-ui-state-prepare ui-state) 326 | (alist-get key (alist-get domain (oref ui-state store)) default)) 327 | 328 | (cl-defgeneric edraw-ui-state-set (ui-state domain key value)) 329 | 330 | (cl-defmethod edraw-ui-state-set ((ui-state edraw-ui-state) 331 | domain key value) 332 | (edraw-ui-state-prepare ui-state) 333 | (setf (alist-get key (alist-get domain (oref ui-state store))) value)) 334 | 335 | (cl-defmethod edraw-ui-state-prepare ((ui-state edraw-ui-state)) 336 | (edraw-ui-state-load ui-state)) 337 | 338 | (cl-defmethod edraw-ui-state-file ((ui-state edraw-ui-state)) 339 | (let ((file (oref ui-state file))) 340 | (pcase file 341 | ((pred stringp) file) 342 | ('default edraw-ui-state-file)))) 343 | 344 | (cl-defgeneric edraw-ui-state-load (ui-state)) 345 | 346 | (cl-defmethod edraw-ui-state-load ((ui-state edraw-ui-state)) 347 | (with-slots (store) ui-state 348 | (unless store 349 | (when-let* ((file (edraw-ui-state-file ui-state))) 350 | (setq store (edraw-ui-state-file-load file)))))) 351 | 352 | (cl-defgeneric edraw-ui-state-save (ui-state)) 353 | 354 | (cl-defmethod edraw-ui-state-save ((ui-state edraw-ui-state)) 355 | (when-let* ((file (edraw-ui-state-file ui-state))) 356 | (edraw-ui-state-file-save file (oref ui-state store)))) 357 | 358 | (defun edraw-ui-state-file-load (file) 359 | (condition-case _err 360 | (with-temp-buffer 361 | (insert-file-contents file) 362 | (goto-char (point-min)) 363 | (read (current-buffer))) 364 | (error (list (cons 'edraw-ui-state (list (cons 'version 1))))))) 365 | 366 | (defun edraw-ui-state-file-save (file store) 367 | (with-temp-file file 368 | (insert ";;; Edraw UI State --- -*- mode: lisp-data -*-\n") 369 | (pp store (current-buffer)))) 370 | 371 | 372 | 373 | (provide 'edraw-editor-util) 374 | ;;; edraw-editor-util.el ends here 375 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+TITLE: Emacs Easy Draw 2 | 3 | Emacs Easy Draw is a drawing tool that runs inside Emacs. 4 | 5 | [[file:./screenshot/edraw-screenshot.gif]] 6 | 7 | * Requirements 8 | - Emacs 27.2 9 | - Image support 10 | - SVG support 11 | - gzip and gunzip(or zlib support) 12 | - libxml support 13 | 14 | * Screenshots 15 | 16 | [[https://github.com/misohena/el-easydraw/wiki/Screenshots]] 17 | 18 | * Use In Org-Mode - edraw-org.el 19 | ** Config 20 | 21 | #+begin_src emacs-lisp 22 | (with-eval-after-load 'org 23 | (require 'edraw-org) 24 | (edraw-org-setup-default)) 25 | ;; When using the org-export-in-background option (when using the 26 | ;; asynchronous export function), the following settings are 27 | ;; required. This is because Emacs started in a separate process does 28 | ;; not load org.el but only ox.el. 29 | (with-eval-after-load "ox" 30 | (require 'edraw-org) 31 | (edraw-org-setup-exporter)) 32 | #+end_src 33 | 34 | ** Usage 35 | 36 | To start drawing, type ~[​[edraw:]]~ and type =C-c C-o= on the link. 37 | 38 | Draw something and type =C-c C-c= and the data will be saved in the buffer. 39 | 40 | ** Link Notation 41 | 42 | #+begin_src org 43 | Bracket Links: 44 | 45 | [​[edraw:file=./example.edraw.svg]​] 46 | 47 | [​[edraw:data=​]] 48 | 49 | [​[*Example][edraw:file=./example.edraw.svg]​] 50 | 51 | [​[*Example][edraw:data=]​] 52 | 53 | Angle Links: 54 | 55 | 56 | 57 | > 58 | 59 | Plain Links: 60 | 61 | edraw:file=./example.edraw.svg 62 | 63 | edraw:data= 64 | #+end_src 65 | 66 | Path Syntax: 67 | 68 | : edraw:=;=;...;= 69 | 70 | Note: If Base64 data is included in a plain link, the trailing symbol (= or +) may not be included in the range of the plain link. In that case, by specifying a dummy property at the end, you can include the entire thing in a plain link. 71 | 72 | #+begin_src org 73 | edraw:data=H4sIAGAXVWYAA22O0Q7CIAxFf4X0XcpmYsIC+5cpCEQEA2Swvxed0RcfmtvbnttU5NWQdvchS7ClPCbEWiutRxqTwZExhp2AHZmad+H2Dxw45/jeAqlOFSthYAyI1c7Y8jGrTtnF0B0dYBaGOCVBq7TUwzmqrY+SvhRydd5LSFr94if2PftqNwljl7YLzgJNr/7n/AQMbuxHzwAAAA==;eop=1 is a red rectangle. 74 | # `eop' means end of path 75 | #+end_src 76 | 77 | ** Inline Images 78 | 79 | To toggle the inline display mode, type =M-x edraw-org-link-image-mode= 80 | 81 | ** Edit Image 82 | 83 | To edit the image, do one of the following on the link: 84 | 85 | - =M-x edraw-org-edit-link= 86 | - =C-c C-o= 87 | - Right click on image (The right-click menu also provides some other useful functions for links) 88 | 89 | ** Export 90 | *** As HTML 91 | Customization Variables: 92 | 93 | - edraw-org-export-html-data-tag :: HTML tag used to export data links. (svg or img) 94 | - edraw-org-export-html-file-tag :: HTML tag used to export file links. (svg or img) 95 | - edraw-org-export-html-use-viewbox :: Add viewBox= attribute to svg root elements when SVG export. 96 | 97 | Link Properties: 98 | 99 | - html-tag :: 100 | HTML tag used to export the link. (svg or img) 101 | 102 | Example: 103 | #+begin_src org 104 | [[edraw:html-tag=img;data=]] 105 | #+end_src 106 | 107 | *** As LaTeX 108 | I have a minimal implementation, but I don't use LaTeX usually, so there may be some problems. 109 | 110 | =[[edraw:data=]]= format creates a temporary file when exporting as LaTeX. Please let me know if there is a better way in LaTeX. 111 | 112 | *** As ODT 113 | 114 | As with the LaTeX export, the =[[edraw:data=]]= format creates a temporary SVG file. 115 | 116 | ** Regular File Link Support 117 | 118 | You can also edit regular file links inline. 119 | 120 | For example, create a link like this: 121 | 122 | #+begin_src org 123 | [​[file:example.edraw.svg]​] 124 | #+end_src 125 | 126 | Then do =M-x edraw-org-edit-regular-file-link= on this link and the drawing editor will appear in its place. 127 | 128 | Inline display after editing is possible with org-toggle-inline-images. You can also use [[https://github.com/misohena/org-inline-image-fix#automatic-image-update][org-flyimage]] if you want to display images automatically. 129 | 130 | The normal file link has the following drawbacks compared to the edraw link format. 131 | 132 | - No detailed settings for HTML export. 133 | - SVG data cannot be embedded inside org files. 134 | 135 | Data URI links are technically [[https://github.com/misohena/org-inline-image-fix#data-uri-supportorg-datauri-imageel][possible]], but inline editing of Data URI links is not implemented. 136 | 137 | On the other hand, regular file links have the advantage that they can be exported in many formats. 138 | 139 | * Edit a Single Edraw File - edraw-mode.el 140 | 141 | The data that Emacs Easy Draw handles is a small subset of the SVG specification. The recommended file extension is .edraw.svg. 142 | 143 | Emacs Easy Draw cannot edit general SVG data, but the data it outputs can be viewed by web browsers and other software that can handle SVG. 144 | 145 | ** Open .edraw.svg files using edraw-mode 146 | 147 | To open a file with the extension .edraw.svg using edraw-mode, add the following setting to init.el. 148 | 149 | #+begin_src emacs-lisp 150 | (autoload 'edraw-mode "edraw-mode") 151 | (add-to-list 'auto-mode-alist '("\\.edraw\\.svg$" . edraw-mode)) 152 | #+end_src 153 | 154 | NOTE: Setup later than other modes for .svg such as image-mode. 155 | 156 | If you don't like the long .edraw.svg extension, you can put a comment specifying the mode at the top of the file. 157 | 158 | : 159 | : ]*-->[\n\t ]*\\)*:10px, C-u :Numerical input) | 186 | | M-left, M-up, M-right, M-down | Duplicate selected objects and move (M-S-:10px, C-u M-:Numerical input) | 187 | | mouse-3 on shapes, anchor points, background, shape picker, or edraw links | Show context menu | 188 | | C-u mouse-3 | Show context menu (Ignore invisible/unpickable states) | 189 | | (Select Tool) C-down-mouse-1 | Add/Remove clicked shape to selection list | 190 | | (Select Tool) M-drag-mouse-1 | Duplicate dragged shape | 191 | | (Path Tool) C-u down-mouse-1 | Ignore existing points (Avoid connecting or moving existing points) | 192 | | S-drag-mouse-1 | 45 degree unit movement or square specification | 193 | | Middle-drag | Scroll | 194 | | C-wheel-up, C-wheel-down | Zoom | 195 | | (In Property Editor) Middle-click | Close window | 196 | | (In Shape Picker) Middle-click | Close window | 197 | 198 | * Emacs Lisp 199 | 200 | The following code is an example of inserting an editor into a buffer from Emacs Lisp. 201 | 202 | #+begin_src emacs-lisp 203 | (require 'edraw) 204 | 205 | (progn 206 | (insert " ") 207 | (let ((editor (edraw-editor 208 | ;; Make an overlay that covers " " 209 | ;; 'evaporate means automatic deletion 210 | :overlay (let ((overlay (make-overlay (1- (point)) (point)))) 211 | (overlay-put overlay 'evaporate t) 212 | overlay) 213 | ;; Initial SVG 214 | :svg (edraw-svg-create 215 | 400 300 216 | (edraw-svg-group 217 | :id "edraw-body" ;; g#edraw-body is the edit target area 218 | (edraw-svg-rect 100 100 200 100 :fill "blue"))) 219 | ;; Function called when saving 220 | :document-writer (lambda (svg &rest _) 221 | (pop-to-buffer "*svg output*") 222 | (erase-buffer) 223 | (edraw-svg-print svg nil nil 0)) 224 | ;; Add one item to the main menu 225 | :menu-filter (lambda (menu-type items &rest _) 226 | (pcase menu-type 227 | ('main-menu 228 | (append 229 | items 230 | `(((edraw-msg "Close") (lambda (editor) (edraw-close editor)))))) 231 | (_ items))) 232 | ;; Add key binding 233 | :keymap (let ((km (make-sparse-keymap))) 234 | (set-keymap-parent km edraw-editor-map) 235 | (define-key km (kbd "C-c C-c") (lambda () (interactive) (edraw-close (edraw-editor-at)))) 236 | km) 237 | ))) 238 | ;; Manipulate the editor object if necessary 239 | ;; Set user extra data 240 | (edraw-set-extra-prop editor 'my-extra-data 12345) 241 | editor 242 | nil)) 243 | #+end_src 244 | 245 | * Color Picker 246 | 247 | edraw-color-picker.el provides a color picker library and several commands. 248 | 249 | Commands to replace or insert the selected color in the buffer: 250 | 251 | - edraw-color-picker-replace-or-insert-color-at 252 | - edraw-color-picker-replace-color-at 253 | - edraw-color-picker-insert-color-at 254 | 255 | edraw-color-picker-mode.el defines two minor modes, edraw-color-picker-mode and edraw-color-picker-global-mode, which make it easy to use these commands in any buffer. 256 | 257 | edraw-color-picker-mode adds key bindings for these commands in the buffer. You can customize the bindings flexibly with: 258 | 259 | M-x customize-variable edraw-color-picker-mode-custom-bindings 260 | 261 | You can also bind specific keys for specific major modes. This mode also provides a context menu. 262 | 263 | edraw-color-picker-global-mode enables edraw-color-picker-mode in all buffers. If you want to enable it only for specific major modes, you can configure it with: 264 | 265 | M-x customize-variable edraw-color-picker-global-modes 266 | 267 | To use edraw-color-picker-global-mode, add the following to your init.el: 268 | 269 | #+begin_src elisp 270 | (require 'edraw-color-picker-mode) 271 | (edraw-color-picker-global-mode) 272 | #+end_src 273 | 274 | You can also manually bind each command without using these minor modes. For example, to open the color picker with mouse-1 and C-c C-o in css-mode and mhtml-mode, configure it as follows. 275 | 276 | #+begin_src elisp 277 | (autoload 'edraw-color-picker-replace-color-at "edraw-color-picker" nil t) 278 | (autoload 'edraw-color-picker-replace-or-insert-color-at "edraw-color-picker" nil t) 279 | 280 | (defun my-edraw-color-picker-add-keys (map) 281 | ;; Replaces the color of the clicked location 282 | (define-key map [mouse-1] #'edraw-color-picker-replace-color-at) 283 | ;; C-c C-o replaces the color in place or adds color 284 | (define-key map (kbd "C-c C-o") 285 | #'edraw-color-picker-replace-or-insert-color-at)) 286 | 287 | (defun my-edraw-color-picker-enable () 288 | (my-edraw-color-picker-add-keys (current-local-map))) 289 | 290 | (add-hook 'css-mode-hook 'my-edraw-color-picker-enable) 291 | (add-hook 'mhtml-mode-hook 'my-edraw-color-picker-enable) 292 | #+end_src 293 | 294 | Settings for use with Customize buffer: 295 | 296 | #+begin_src elisp 297 | (with-eval-after-load "cus-edit" 298 | ;; Add keys to the field key map 299 | (my-edraw-color-picker-add-keys custom-field-keymap)) 300 | #+end_src 301 | 302 | #+CAPTION: Show color picker inline 303 | [[file:./screenshot/color-picker-inline.png]] 304 | 305 | edraw-color-picker.el also provides the following functions for use from Emacs Lisp. 306 | 307 | Show color picker in minibuffer: 308 | - (edraw-color-picker-read-color) 309 | 310 | #+CAPTION: Show color picker in minibuffer 311 | [[file:./screenshot/color-picker-minibuffer.png]] 312 | 313 | A function that opens a color picker near the point: 314 | - edraw-color-picker-open-near-point 315 | 316 | A function that displays a color picker using an overlay: 317 | - edraw-color-picker-overlay 318 | 319 | The core class of the color picker: 320 | - edraw-color-picker 321 | 322 | 323 | 324 | * License 325 | 326 | This software is licensed under GPLv3. You are free to use, modify and distribute this software. 327 | 328 | If you wish to register this software in any package archive, please fork this repository, make the necessary modifications to fit the package archive's requirements, and submit the registration on your own. Also continue with the necessary maintenance. You don't need my permission. 329 | 330 | I also welcome you to publish your improved version. If that works better than mine, I might start using it too. I may suddenly be unable to develop, and I cannot guarantee any continued development. This software is the result of what I want, so please add what you want yourself. 331 | 332 | I am not proficient in English, so please do not expect continuous communication in English. I have spent a long time using translation software to write this text, but I am not confident that the intended meaning is accurately conveyed. I don't think it has ended up with the opposite meaning, but subtle nuances may be missing. 333 | -------------------------------------------------------------------------------- /edraw-color-picker-mode.el: -------------------------------------------------------------------------------- 1 | ;;; edraw-color-picker-mode.el --- Use color picker in any buffer -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2025 AKIYAMA Kouhei 4 | 5 | ;; Author: AKIYAMA Kouhei 6 | ;; Keywords: Color Picker 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; This file defines minor modes that enable a color picker in any buffer. 24 | ;; 25 | ;; It provides the following two minor modes: 26 | ;; - `edraw-color-picker-mode' 27 | ;; - `edraw-color-picker-global-mode' 28 | 29 | ;; * `edraw-color-picker-mode' 30 | ;; 31 | ;; `edraw-color-picker-mode' binds commands provided by 32 | ;; edraw-color-picker.el to keys in the buffer where the mode is 33 | ;; turned on. These commands replace or insert text representing 34 | ;; colors. 35 | ;; 36 | ;; Note: If you prefer to manually bind these commands to your desired keymap 37 | ;; (e.g., by adding hooks in init.el), this minor mode is generally unnecessary. 38 | ;; 39 | ;; Configuring key bindings: 40 | ;; 41 | ;; Via Customize: 42 | ;; M-x customize-variable edraw-color-picker-mode-custom-bindings 43 | ;; 44 | ;; Then, turn on `edraw-color-picker-mode' in the desired buffer: 45 | ;; 46 | ;; M-x edraw-color-picker-mode 47 | 48 | ;; * `edraw-color-picker-global-mode' 49 | ;; 50 | ;; `edraw-color-picker-global-mode' is a global minor mode that turns 51 | ;; on `edraw-color-picker-mode' across all buffers. 52 | ;; 53 | ;; Configuring enabled major modes: 54 | ;; 55 | ;; M-x customize-variable edraw-color-picker-global-modes 56 | ;; 57 | ;; Then, turn on `edraw-color-picker-global-mode' after Emacs starts: 58 | ;; 59 | ;; M-x edraw-color-picker-global-mode 60 | ;; 61 | ;; Or, add the following to your init.el: 62 | ;; 63 | ;; (require 'edraw-color-picker-mode) 64 | ;; (edraw-color-picker-global-mode) 65 | 66 | ;;; Code: 67 | 68 | (require 'cl-lib) 69 | 70 | ;;;; Declarations 71 | 72 | (autoload 'edraw-color-picker-insert-color-at 73 | "edraw-color-picker" nil t) 74 | (autoload 'edraw-color-picker-replace-color-at 75 | "edraw-color-picker" nil t) 76 | (autoload 'edraw-color-picker-replace-or-insert-color-at 77 | "edraw-color-picker" nil t) 78 | 79 | (autoload 'edraw-color-info-at "edraw-color") 80 | 81 | (defgroup edraw-color-picker-mode nil 82 | "Use color picker in any buffer." 83 | :tag "Edraw Color Picker Mode" 84 | :group 'edraw) 85 | 86 | ;;;; Minor mode (edraw-color-picker-mode) 87 | ;;;;; Customization variables 88 | 89 | (defvar edraw-color-picker-mode-custom-bindings) 90 | 91 | (defcustom edraw-color-picker-mode-use-context-menu t 92 | "Non-nil means add color picker related menu items to the context menu." 93 | :group 'edraw-color-picker-mode 94 | :type 'boolean) 95 | 96 | ;;;;; Minor mode maps 97 | 98 | (defvar edraw-color-picker-mode-menu-map 99 | (easy-menu-create-menu 100 | "Color Picker" 101 | '(["Insert color" edraw-color-picker-insert-color-at] 102 | ["Replace color at point" edraw-color-picker-replace-color-at] 103 | ["Replace or insert color at point" 104 | edraw-color-picker-replace-or-insert-color-at])) 105 | "Menu of command `edraw-color-picker-mode'.") 106 | 107 | (defalias 'edraw-color-picker-mode--cusmap-global-map (make-sparse-keymap)) 108 | 109 | (defvar edraw-color-picker-mode-map 110 | (let ((km (make-composed-keymap 111 | (list 'edraw-color-picker-mode--cusmap-global-map)))) 112 | km) 113 | "The keymap used by `edraw-color-picker-mode'. 114 | \\{edraw-color-picker-mode-map}") 115 | 116 | ;;;;; Minor mode definition 117 | 118 | ;;;###autoload 119 | (define-minor-mode edraw-color-picker-mode 120 | "Toggle color picker support for any buffer. 121 | 122 | `edraw-color-picker-mode' is a minor mode that enables replacing or 123 | inserting color text using a color picker in any buffer. 124 | 125 | The following keybindings are available in `edraw-color-picker-mode' 126 | \\{edraw-color-picker-mode-map} 127 | The buffer local bindings: 128 | \\{edraw-color-picker-mode--cusmap-buffer-local-keymap} 129 | \(you can change the binding by M-x customize-variable 130 | `edraw-color-picker-mode-custom-bindings'" 131 | :group 'edraw-color-picker-mode 132 | 133 | (cond 134 | (edraw-color-picker-mode 135 | ;; Turn-on 136 | (edraw-color-picker-mode--cusmap-activate-local-keymap) 137 | (add-hook 'change-major-mode-hook #'edraw-color-picker-mode--teardown 138 | nil t) 139 | (when edraw-color-picker-mode-use-context-menu 140 | (add-hook 'context-menu-functions #'edraw-color-picker-mode-context-menu 141 | 10 t))) 142 | (t 143 | ;; Turn-off 144 | (remove-hook 'context-menu-functions #'edraw-color-picker-mode-context-menu 145 | t) 146 | (remove-hook 'change-major-mode-hook #'edraw-color-picker-mode--teardown t) 147 | (edraw-color-picker-mode--teardown)))) 148 | 149 | (defun edraw-color-picker-mode--teardown () 150 | (when (edraw-color-picker-mode--cusmap-deactivate-local-keymap) 151 | (edraw-color-picker-mode--cusmap-clean-unused-minor-mode))) 152 | 153 | ;;;;; Custom Keymap 154 | 155 | ;; The following is the mechanism required to achieve different 156 | ;; keymaps per buffer via defcustom. 157 | 158 | (defvar-local edraw-color-picker-mode--cusmap-buffer-local-keymap nil 159 | "The local keymap for the current buffer. 160 | This is only there to be referenced from the docstring of 161 | `edraw-color-picker-mode' function. 162 | Do not modify the contents of this keymap directly. Even the key 163 | bindings of unrelated buffers may change.") 164 | 165 | (defvar-local edraw-color-picker-mode--cusmap-buffer-local-minor-mode nil 166 | "The name of the minor mode that implements the buffer-local keymap.") 167 | 168 | (defun edraw-color-picker-mode--cusmap-needs-local-map-p () 169 | "Return non-nil if the current buffer needs a buffer-local keymap." 170 | (cl-loop for (condition . command) 171 | in edraw-color-picker-mode-custom-bindings 172 | when (eq (edraw-color-picker-mode--cusmap-test condition 'all) 173 | 'local) 174 | return t)) 175 | 176 | (defun edraw-color-picker-mode--cusmap-create-keymap (scope) 177 | "Create a keymap based on `edraw-color-picker-mode-custom-bindings'. 178 | 179 | SCOPE is one of the symbols `all', `global', or `local'." 180 | (let ((keymap (make-sparse-keymap))) 181 | (cl-loop for (condition . command) 182 | in edraw-color-picker-mode-custom-bindings 183 | when (edraw-color-picker-mode--cusmap-test condition scope) 184 | do 185 | (let* ((keyspec (if (consp condition) (cdr condition) condition)) 186 | (key (if (stringp keyspec) (kbd keyspec) keyspec))) 187 | (define-key keymap key command))) 188 | keymap)) 189 | 190 | (defun edraw-color-picker-mode--cusmap-test (condition scope) 191 | "Return non-nil if CONDITION is true. 192 | 193 | CONDITION is the condition part specified in 194 | `edraw-color-picker-mode-custom-bindings'. 195 | 196 | SCOPE is one of the symbols `all', `global', or `local'. 197 | 198 | `global' : Ignore conditions that are true only under certain conditions. 199 | `local' : Ignore conditions that are true all the time. 200 | `all' : Consider all conditions." 201 | (if (and (memq scope '(all global)) 202 | (or (stringp condition) (vectorp condition))) 203 | 'global 204 | (when (memq scope '(all local)) 205 | (pcase condition 206 | ;; (MODE . KEY) 207 | (`(,(and (pred symbolp) mode) . ,_key) 208 | (when (derived-mode-p mode) 'local)) 209 | ;; ((pred FUNCTION ARG...) . KEY) 210 | (`((pred ,function . ,args) . ,_key) 211 | (when (apply function args) 'local)) 212 | ;; ((MODE...) . KEY) 213 | (`(,(and (pred consp) modes) . ,_key) 214 | (when (apply #'derived-mode-p modes) 'local)) 215 | (_ nil))))) 216 | 217 | (defun edraw-color-picker-mode--cusmap-keymap-to-minor-mode-map (keymap) 218 | "Convert a KEYMAP to a minor mode map." 219 | ;; Find an existing minor mode that matches KEYMAP. 220 | (let ((mmm-or-new-id 221 | (edraw-color-picker-mode--cusmap-find-minor-mode-map keymap))) 222 | (if (consp mmm-or-new-id) 223 | ;; If found, return minor mode map. 224 | mmm-or-new-id 225 | ;; If not found, create a new minor mode. 226 | (edraw-color-picker-mode--cusmap-create-new-minor-mode-map 227 | keymap mmm-or-new-id)))) 228 | 229 | (defconst edraw-color-picker-mode--cusmap-minor-mode-regexp 230 | "\\`edraw-color-picker-mode-local-\\([0-9]+\\)-mode\\'") 231 | 232 | (defconst edraw-color-picker-mode--cusmap-minor-mode-format 233 | "edraw-color-picker-mode-local-%d-mode") 234 | 235 | (defun edraw-color-picker-mode--cusmap-find-minor-mode-map (keymap) 236 | "Find a minor mode map in `minor-mode-map-alist' whose name was generated 237 | by `edraw-color-picker-mode--cusmap-create-new-minor-mode-map' and whose 238 | keymap matches KEYMAP. If found, return (varname . keymap). If not 239 | found, return a integer that can be used for a new definition." 240 | (cl-loop for mmm in minor-mode-map-alist 241 | for (mmm-varname . mmm-keymap) = mmm 242 | for mmm-varname-str = (symbol-name mmm-varname) 243 | when (string-match 244 | edraw-color-picker-mode--cusmap-minor-mode-regexp 245 | mmm-varname-str) 246 | if (equal mmm-keymap keymap) 247 | return mmm 248 | else 249 | maximize (string-to-number (match-string 1 mmm-varname-str)) 250 | into max-id 251 | finally return (1+ (or max-id -1)))) 252 | 253 | (defun edraw-color-picker-mode--cusmap-create-new-minor-mode-map (keymap id) 254 | "Create a minor mode map to realize the buffer-local KEYMAP. 255 | ID is an integer that is an unused minor mode ID. 256 | Return the entry of the form (varname . KEYMAP) that was added to 257 | `minor-mode-map-alist'." 258 | (let* ((varname 259 | (intern 260 | (format edraw-color-picker-mode--cusmap-minor-mode-format id))) 261 | (mmm (cons varname keymap))) 262 | ;; Create buffer local variable 263 | (set varname nil) 264 | (make-variable-buffer-local varname) 265 | ;; Add KEYMAP to `minor-mode-map-alist' 266 | (push mmm minor-mode-map-alist) 267 | mmm)) 268 | 269 | (defun edraw-color-picker-mode--cusmap-activate-local-keymap () 270 | "Enable local keymap in current buffer." 271 | ;; Disable the current local keymap 272 | (edraw-color-picker-mode--cusmap-deactivate-local-keymap) 273 | 274 | ;; Set a new local keymap minor mode if needed 275 | (when (edraw-color-picker-mode--cusmap-needs-local-map-p) 276 | (let* ((keymap (edraw-color-picker-mode--cusmap-create-keymap 'local)) 277 | (mmm ;; MMM is a cons cell used in `minor-mode-map-alist' 278 | (edraw-color-picker-mode--cusmap-keymap-to-minor-mode-map keymap)) 279 | (mmm-varname (car mmm)) 280 | (mmm-keymap (cdr mmm))) 281 | ;; Turn on local keymap minor mode 282 | (set mmm-varname t) 283 | ;; Record the name of the local keymap minor mode used in the buffer 284 | (setq edraw-color-picker-mode--cusmap-buffer-local-minor-mode 285 | mmm-varname 286 | ;; Use MMM-KEYMAP instead of KEYMAP for reduce memory 287 | edraw-color-picker-mode--cusmap-buffer-local-keymap 288 | mmm-keymap)))) 289 | 290 | (defun edraw-color-picker-mode--cusmap-deactivate-local-keymap () 291 | "Disable local keymap in current buffer." 292 | (when edraw-color-picker-mode--cusmap-buffer-local-minor-mode 293 | ;; Turn off local keymap minor mode 294 | (kill-local-variable 295 | edraw-color-picker-mode--cusmap-buffer-local-minor-mode) 296 | (setq edraw-color-picker-mode--cusmap-buffer-local-minor-mode nil 297 | edraw-color-picker-mode--cusmap-buffer-local-keymap nil) 298 | t)) 299 | 300 | (defun edraw-color-picker-mode--cusmap-clean-unused-minor-mode () 301 | "Remove unused local keymap minor modes." 302 | (let (used-minor-modes) 303 | ;; Enumerate used local keymap minor mode names 304 | (dolist (buffer (buffer-list)) 305 | (let ((varname (buffer-local-value 306 | 'edraw-color-picker-mode--cusmap-buffer-local-minor-mode 307 | buffer))) 308 | (when (and varname (not (memq varname used-minor-modes))) 309 | (push varname used-minor-modes)))) 310 | ;; Delete unused local keymap minor mode in `minor-mode-map-alist' 311 | (setq minor-mode-map-alist 312 | (cl-delete-if 313 | (lambda (varname-keymap) 314 | (let ((varname (car varname-keymap))) 315 | (when (and 316 | (string-match-p 317 | "\\`edraw-color-picker-mode-local-\\([0-9]+\\)-mode\\'" 318 | (symbol-name varname)) 319 | (not (memq varname used-minor-modes))) 320 | (makunbound varname) 321 | t))) 322 | minor-mode-map-alist)))) 323 | 324 | (defun edraw-color-picker-mode--cusmap-update-global-map () 325 | "Update the keymap to be used commonly in all buffers." 326 | (fset 'edraw-color-picker-mode--cusmap-global-map 327 | (edraw-color-picker-mode--cusmap-create-keymap 'global))) 328 | 329 | (defun edraw-color-picker-mode--cusmap-update-all-keymaps () 330 | "Update all keymaps." 331 | (edraw-color-picker-mode--cusmap-update-global-map) 332 | 333 | (dolist (buffer (buffer-list)) 334 | (with-current-buffer buffer 335 | (if edraw-color-picker-mode 336 | (edraw-color-picker-mode--cusmap-activate-local-keymap) 337 | (edraw-color-picker-mode--cusmap-deactivate-local-keymap)))) 338 | 339 | (edraw-color-picker-mode--cusmap-clean-unused-minor-mode)) 340 | 341 | (defun edraw-color-picker-mode-update-custom-map () 342 | "Update all keymaps set by the customization variable 343 | `edraw-color-picker-mode-custom-bindings'." 344 | (edraw-color-picker-mode--cusmap-update-all-keymaps)) 345 | 346 | ;;;;; Customization Variable for custom keymap 347 | 348 | ;; Note: The following customization variable must be placed after the 349 | ;; definition of the function `edraw-color-picker-mode-update-custom-map'. 350 | (defcustom edraw-color-picker-mode-custom-bindings 351 | '(("C-c C-." . edraw-color-picker-replace-or-insert-color-at) 352 | ("M-S-" . edraw-color-picker-replace-color-at)) 353 | "A list of key bindings for `edraw-color-picker-mode'. 354 | 355 | Each element of the list is a cons cell where the car is a condition and 356 | the cdr is a command. 357 | 358 | The condition is either a key or a mode-specific key. 359 | 360 | A key is a string passed to the kbd function. 361 | 362 | A mode-specific key is a cons cell where the car is a list of major mode 363 | symbols and the cdr is a key. 364 | 365 | `edraw-color-picker-mode-keys' : ( ... ) 366 | 367 | : ( . ) 368 | 369 | : | 370 | 371 | : ( . ) 372 | 373 | : Pass to `kbd'. 374 | : Pass to `derived-mode-p'." 375 | :group 'edraw-color-picker-mode 376 | :type '(repeat 377 | :tag "Bindings" 378 | (cons 379 | :tag "Binding" 380 | (choice :tag "Condition" 381 | (string :tag "Key") 382 | (cons 383 | :tag "Specific major-mode" 384 | (repeat :tag "Major-modes" (symbol :tag "Mode")) 385 | (string :tag "Key"))) 386 | (choice :tag "Command" 387 | (const 388 | :tag "Insert color" 389 | edraw-color-picker-insert-color-at) 390 | (const 391 | :tag "Replace color" 392 | edraw-color-picker-replace-color-at) 393 | (const 394 | :tag "Replace or insert color" 395 | edraw-color-picker-replace-or-insert-color-at) 396 | (function :tag "Command")))) 397 | :risky t 398 | :set 399 | (lambda (variable value) 400 | (set-default variable value) 401 | (when (fboundp 'edraw-color-picker-mode-update-custom-map) 402 | (edraw-color-picker-mode-update-custom-map)) 403 | value)) 404 | 405 | ;;;;; Context menu 406 | 407 | (defun edraw-color-picker-mode-context-menu (menu click) 408 | (let* ((posn (event-end click)) 409 | (buffer (window-buffer (posn-window posn))) 410 | (point (posn-point posn)) 411 | (color-info (with-current-buffer buffer 412 | (edraw-color-info-at point)))) 413 | 414 | (define-key-after menu [separator-edraw-color-picker] menu-bar-separator) 415 | (if color-info 416 | (define-key-after 417 | menu [edraw-color-picker-replace] 418 | '(menu-item "Replace Color" edraw-color-picker-replace-color-at 419 | :help "Replace the color text using color picker")) 420 | (define-key-after 421 | menu [edraw-color-picker-insert] 422 | '(menu-item "Insert Color" edraw-color-picker-insert-color-at 423 | :help "Insert color text using color picker")))) 424 | menu) 425 | 426 | 427 | ;;;; Global minor mode (edraw-color-picker-global-mode) 428 | 429 | (defcustom edraw-color-picker-global-modes t 430 | "Modes in which `edraw-color-picker-mode' is turned on in 431 | `edraw-color-picker-global-mode'. 432 | 433 | nil : None 434 | t : All modes 435 | (MODE ... ) : Specific MODEs 436 | (not (MODE ... )) : Not specific MODEs" 437 | :group 'edraw-color-picker-mode 438 | :type '(choice (const :tag "None" nil) 439 | (const :tag "All modes" t) 440 | (cons :tag "Not modes" 441 | (const :format "" not) 442 | (repeat :tag "Modes" (symbol :tag "Mode"))) 443 | (repeat :tag "Modes" (symbol :tag "Mode")))) 444 | 445 | ;;;###autoload 446 | (define-globalized-minor-mode edraw-color-picker-global-mode 447 | edraw-color-picker-mode 448 | edraw-color-picker-global-mode--turn-on 449 | :group 'edraw-color-picker-mode 450 | (cond 451 | (edraw-color-picker-global-mode 452 | (easy-menu-add-item 453 | nil '("Tools") edraw-color-picker-mode-menu-map)) 454 | (t 455 | (easy-menu-remove-item 456 | nil '("Tools") (cadr edraw-color-picker-mode-menu-map))))) 457 | 458 | (defun edraw-color-picker-global-mode--turn-on () 459 | (when (edraw-color-picker-global-mode--target-mode-p) 460 | (edraw-color-picker-mode))) 461 | 462 | (defun edraw-color-picker-global-mode--target-mode-p () 463 | (pcase edraw-color-picker-global-modes 464 | ('nil nil) 465 | ('t t) 466 | (`(not . ,(and (pred listp) modes)) (not (memq major-mode modes))) 467 | ((and (pred listp) modes) (memq major-mode modes)))) 468 | 469 | 470 | (provide 'edraw-color-picker-mode) 471 | ;;; edraw-color-picker-mode.el ends here 472 | -------------------------------------------------------------------------------- /msg/edraw-msg-ja.el: -------------------------------------------------------------------------------- 1 | ;;; edraw-msg-ja.el --- Japanese Message Catalog -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2023 AKIYAMA Kouhei 4 | 5 | ;; Author: AKIYAMA Kouhei 6 | ;; Keywords: 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; 24 | 25 | ;;; Code: 26 | 27 | (defvar edraw-msg-hash-table nil) 28 | 29 | (setq 30 | edraw-msg-hash-table 31 | #s(hash-table 32 | test equal 33 | data 34 | ( 35 | ;; (load-library (expand-file-name "./edraw-msg-tools.el")) 36 | ;; (edraw-msg-update-catalog-buffer) 37 | ;; M-x edraw-msg-search at point 38 | ;; [BEGIN MSG DATA] 39 | "%" "%" 40 | "%s (%g,%g)-(%g,%g) selected" "%s (%g,%g)-(%g,%g)を選択中" 41 | "%s Selected Shapes" "%s個の選択図形" 42 | "%s Source Code: " "%s ソースコード: " 43 | "%s objects (%g,%g)-(%g,%g) selected" "%s個のオブジェクト(%g,%g)-(%g,%g)を選択中" 44 | "%s objects selected" "%s個のオブジェクトを選択中" 45 | "%s shapes" "%s個の図形" 46 | "%s selected" "%sを選択中" 47 | "(Initial %s Marker Default)" "(編集開始時の%sマーカーのデフォルト)" 48 | "(Initial %s Shape Default)" "(編集開始時の%s図形のデフォルト)" 49 | "(Initial %s Tool Default)" "(編集開始時の%sツールのデフォルト)" 50 | "" "<無名>" 51 | "Actions" "操作" 52 | "Adjust to Pixel Grid" "ピクセルグリッドに合わせる" 53 | "Already an SVG for Edraw" "既にedraw用のSVGです" 54 | "Already glued" "すでに接着されています" 55 | "Amplitude: " "振幅: " 56 | "Anchor (%g,%g) selected" "アンカー(%g,%g)を選択中" 57 | "Anchor Points" "アンカーポイント" 58 | "Anchor" "アンカー" 59 | "Angle Unit" "角度の単位" 60 | "Angle: " "角度: " 61 | "Apply group's transform property to children?" "グループのtransformプロパティをグループ内に適用しますか?" 62 | "Apply transform property to anchors" "transformプロパティをアンカーポイントへ適用" 63 | "Apply" "適用" 64 | "Arrow" "矢印" 65 | "Aspect Ratio: " "縦横比" 66 | "Auto" "自動" 67 | "Background Color: " "背景色: " 68 | "Blue..." "青..." 69 | "Blue[0~255|0.0~1.0]: " "青[0~255|0.0~1.0]: " 70 | "Brightness..." "明度..." 71 | "Bring Forward" "手前へ" 72 | "Brightness[0.0~1.0]: " "明るさ[0.0~1.0]: " 73 | "Bring to Front" "最前面へ" 74 | "CSS Style parsing error: %s" "CSSスタイル解析エラー: %s" 75 | "Cancel Edit" "編集をキャンセル" 76 | "Cannot glue because it would create a circular reference" "循環参照になるため接着できません" 77 | "Change Text: " "テキスト変更: " 78 | "Change to Current Color" "現在の色に変更" 79 | "Child Frame" "子フレーム" 80 | "Choose" "選択" 81 | "Circle" "円" 82 | "Clear All States" "全状態をクリア" 83 | "Clear Temporary States" "一時状態をクリア" 84 | "Clear..." "クリア..." 85 | "Click:" "クリック:" 86 | "Close Path" "パスを閉じる" 87 | "Close Related Windows" "関連ウィンドウを閉じる" 88 | "Close" "閉じる" 89 | "Closed" "閉じました" 90 | "Coil Line" "コイル線" 91 | "Color Components" "色成分" 92 | "Color Name Usage" "色名の使用" 93 | "Color Name..." "色名..." 94 | "Color Picker Menu" "カラーピッカーメニュー" 95 | "Color Name: " "色名: " 96 | "Color" "色" 97 | "Combine Paths" "パスの結合" 98 | "Connected" "接続しました" 99 | "Continue" "継続" 100 | "Convert To Path" "パスへ変換" 101 | "Convert To [[edraw:data=]]" "[[edraw:data=]]形式へ変換" 102 | "Convert To [[edraw:file=]]" "[[edraw:file=]]形式へ変換" 103 | "Convert To [[file:]]" "[[file:]]形式へ変換" 104 | "Convert contents back to text format? " "バッファの内容をテキスト形式に戻しますか?" 105 | "Copied %s entries" "%s項目をコピーしました" 106 | "Copied %s" "%sをコピーしました" 107 | "Copy Contents" "内容をコピー" 108 | "Copy" "コピー" 109 | "Crop..." "切り抜き..." 110 | "Custom Shape Tool" "カスタムシェイプツール" 111 | "Custom shapes have unsaved changes." "カスタムシェイプに未保存の変更があります" 112 | "Cut %s entries" "%s項目をカットしました" 113 | "Cut %s" "%sをカットしました" 114 | "Cut" "カット" 115 | "Decrease Opacity by %d" "不透明度を%d減らす" 116 | "Default Config" "デフォルト設定" 117 | "Decrease X by %d" "Xを%d減らす" 118 | "Defaults" "デフォルト" 119 | "Decrease Y by %d" "Yを%d減らす" 120 | "Delete Point" "点を削除" 121 | "Decrease Z by %d" "Zを%d減らす" 122 | "Delete Preset" "プリセット削除" 123 | "Delete" "削除" 124 | "Delete..." "削除..." 125 | "Delta X: " "X移動量: " 126 | "Delta Y: " "Y移動量: " 127 | "Deselect All" "全選択解除" 128 | "Deselect" "選択解除" 129 | "Direction(degrees): " "方向(度): " 130 | "Disabled" "不許可" 131 | "Discard `use' element with unsupported format" "未対応形式の`use'要素を破棄" 132 | "Discard changes?" "変更を破棄しますか?" 133 | "Discard unsupported attribute: %s" "未対応の属性を破棄: %s" 134 | "Do you want to close the current document?" "現在のドキュメントを閉じますか?" 135 | "Discard unsupported element: %s" "未対応の要素を破棄: %s" 136 | "Do you want to delete all presets?" "全てのプリセットを削除しますか?" 137 | "Do you want to overwrite?" "上書きしますか?" 138 | "Do you want to restore the palette to its initial state?" "パレットを初期状態へ戻しますか?" 139 | "Document Height [px|%]: " "ドキュメント高さ [px|%]: " 140 | "Document Quick" "ドキュメント クイック" 141 | "Document Width [px|%]: " "ドキュメント幅 [px|%]: " 142 | "Document" "ドキュメント" 143 | "Drag the cropping range." "切り抜き範囲をドラッグで指定してください。" 144 | "Drag the grid creation range" "グリッドを作成する範囲をドラッグしてください" 145 | "Duplicate" "複製" 146 | "Duplicated %s shapes" "%s個の図形を複製" 147 | "Edit" "編集" 148 | "Edraw editor has unsaved changes. Discard changes ?" "エディタには未保存の変更があります。変更を破棄しますか?" 149 | "Ellipse Tool" "楕円ツール" 150 | "Ellipse" "楕円" 151 | "Empty SVG data" "空のSVGデータ" 152 | "Empty `points' attribute: %s" "属性`points'が空: %s" 153 | "Empty path data" "空のパスデータ" 154 | "Empty shape" "空の図形" 155 | "Empty shapes cannot be registered" "空の図形は登録できません" 156 | "Enabled" "許可" 157 | "End Marker" "終点マーカー" 158 | "Evaluate this generator's code on your system?" "あなたのシステムでこのジェネレータのコードを評価しますか?" 159 | "Export SVG" "SVGをエクスポート" 160 | "Export Section" "セクションをエクスポート" 161 | "Export to Buffer" "バッファへ書き出し" 162 | "Export to File..." "ファイルへ書き出し..." 163 | "Failed to delete entry" "項目の削除に失敗しました" 164 | "Failed to find insertion point" "挿入場所の特定に失敗しました" 165 | "Failed to get image size" "画像サイズの取得に失敗しました" 166 | "Failed to save. %s. Discard changes?" "保存に失敗しました。変更を破棄しますか?" 167 | "File `%s' exists; overwrite? " "ファイル `%s' はすでに存在します。上書きしますか?" 168 | "File does not exist" "ファイルが存在しません" 169 | "Fill" "塗り" 170 | "Fill..." "塗り..." 171 | "Find File" "ファイルを開く" 172 | "Finish Edit" "編集終了" 173 | "Fold All Sections" "全セクション折りたたみ" 174 | "Font Size..." "フォントサイズ..." 175 | "Font Size: " "フォントサイズ: " 176 | "Formatting" "書式" 177 | "Frame" "フレーム" 178 | "Freehand Tool" "手書きツール" 179 | "Generate Shape Along Path" "パスに沿った図形を生成" 180 | "Generation error: %s" "生成エラー: %s" 181 | "Glue Point: " "接着点: " 182 | "Glue Position" "接着位置" 183 | "Glue position type" "接着位置タイプ" 184 | "Glue to selected or overlapped shape" "選択または重なり図形と接着" 185 | "Generator Tool" "生成ツール" 186 | "Glue" "接着" 187 | "Glued Text: " "接着テキスト: " 188 | "Green..." "緑..." 189 | "Green[0~255|0.0~1.0]: " "緑[0~255|0.0~1.0]: " 190 | "Grid Interval: " "グリッド間隔: " 191 | "Grid" "グリッド" 192 | "Group" "グループ化" 193 | "HEX" "HEX" 194 | "Handle (%g,%g) selected" "ハンドル(%g,%g)を選択中" 195 | "HSL" "HSL" 196 | "Handle" "ハンドル" 197 | "HWB" "HWB" 198 | "Href..." "Href..." 199 | "History" "履歴" 200 | "Hue[deg]: " "色相[度]: " 201 | "Hue..." "色相..." 202 | "ID `%s' is already in use, so remove it" "ID`%s'はすでに使われているので除去します" 203 | "If you import diagrams generated with other software into Edraw, they may not be displayed correctly or the editing operation may become unstable. The original information is lost in the converted data. Do you want to convert to a format for Edraw?" "他のソフトウェアで生成した図をedrawで読み込んだ場合、正しく表示されなかったり、編集動作が不安定になる場合があります。変換後のデータからは元の情報が失われます。edrawのための形式へ変換しますか？" 204 | "Image File: " "画像ファイル: " 205 | "Image Tool" "画像ツール" 206 | "Import Section Before" "この前にセクションをインポート" 207 | "Import Section" "セクションをインポート" 208 | "Import from File..." "ファイルからインポート..." 209 | "Increase Opacity by %d" "不透明度を%d増やす" 210 | "Input name: " "名前入力: " 211 | "Increase X by %d" "Xを%d増やす" 212 | "Insert New Section Before" "この前に新しいセクションを挿入" 213 | "Increase Y by %d" "Yを%d増やす" 214 | "Insert New Section" "新しいセクションを挿入" 215 | "Increase Z by %d" "Zを%d増やす" 216 | "Insert New Shape Before" "この前に新しい図形を挿入" 217 | "Increase/Decrease" "増減" 218 | "Insert New Shape" "新しい図形を挿入" 219 | "Insert Point Before" "この前に点を追加" 220 | "Invalid number" "無効な数値" 221 | "Invalid value" "無効な値" 222 | "Invalid view size" "無効なビューサイズ" 223 | "Invisible" "非表示" 224 | "Keep unsupported attribute: %s" "未対応の属性を維持: %s" 225 | "LAB" "LAB" 226 | "Link at point does not contain valid data" "この場所のリンクに有効なデータが含まれていません" 227 | "Keep unsupported element: %s" "未対応の要素を維持: %s" 228 | "LCH" "LCH" 229 | "Load Preset" "プリセット読み込み" 230 | "Load colors from file: " "色の読み込み元ファイル: " 231 | "Load..." "読み込み..." 232 | "Main Menu" "メインメニュー" 233 | "Major Grid Every N Lines: " "主グリッド線の周期(本数): " 234 | "Make Corner" "角にする" 235 | "Make Smooth" "滑らかにする" 236 | "Marker Type" "マーカータイプ" 237 | "Marker" "マーカー" 238 | "Marker type: " "マーカータイプ: " 239 | "Menu" "メニュー" 240 | "Mode Line" "モードライン表示" 241 | "More..." "その他..." 242 | "Move Backward Same Level" "同じ階層の後ろへ移動" 243 | "Move Backward" "後ろへ移動" 244 | "Move Forward Same Level" "同じ階層の前へ移動" 245 | "Move Forward" "前へ移動" 246 | "Move by Coordinates..." "座標による移動..." 247 | "Moved anchor to (%s,%s)" "アンカーを(%s,%s)へ移動" 248 | "Moving Distance: " "移動距離: " 249 | "Moved by (%s,%s)" "移動量:(%s,%s)" 250 | "Moved handle to (%s,%s)" "ハンドルを(%s,%s)へ移動" 251 | "Next Color" "次の色" 252 | "Next Type" "次の種類へ変更" 253 | "Next" "次" 254 | "No `points' attribute: %s" "属性`points'がありません: %s" 255 | "No editor here" "ここにエディタはありません" 256 | "No entries at point" "この場所に項目がありません" 257 | "No glue target" "接着先がありません" 258 | "No group selected" "グループが選択されていません" 259 | "No link at point" "この場所にリンクがありません" 260 | "No need to convert" "変換の必要がありません" 261 | "No need to rotate" "回転の必要がありません" 262 | "No need to scale" "拡大縮小の必要がありません" 263 | "No objects selected" "選択オブジェクトなし" 264 | "No path selected" "パスが選択されていません" 265 | "No redo data" "やり直しデータがありません" 266 | "No shape selected" "図形が選択されていません" 267 | "No shapes" "図形がありません" 268 | "No target object" "対象オブジェクト無し" 269 | "No undo data" "取り消しデータがありません" 270 | "No" "いいえ" 271 | "None" "なし" 272 | "Not SVG data" "SVGデータではありません" 273 | "Not SVG for Edraw" "edraw用のSVGではありません" 274 | "Not a number" "数値ではない" 275 | "OKLAB" "OKLAB" 276 | "Opacity[0.0~1.0]: " "不透明度[0.0~1.0]: " 277 | "OKLCH" "OKLCH" 278 | "Open Path" "パスを開く" 279 | "Opacity..." "不透明度..." 280 | "Origin X(left, center, right, %, or ): " "原点X(left, center, right, <百分率>%, or <座標値>): " 281 | "Output Format (CSS)" "出力書式(CSS)" 282 | "Overwrite Preset" "プリセットの上書き" 283 | "Output Format (Emacs)" "出力書式(Emacs)" 284 | "Overwrite?" "上書きしますか?" 285 | "Origin X: " "原点X: " 286 | "Overwrite..." "上書き..." 287 | "Palette Color #%d" "パレット色#%d" 288 | "Palette" "パレット" 289 | "Parsing error: %s" "解析エラー: %s" 290 | "Paste Before" "直前にペースト" 291 | "Origin Y(top, center, bottom, %, or ): " "原点Y(top, center, bottom, <百分率>%, または <座標値>): " 292 | "Paste" "ペースト" 293 | "Origin Y: " "原点Y: " 294 | "Path Tool" "パスツール" 295 | "Path data does not start with M" "パスデータがMで始まっていません" 296 | "Path" "パス" 297 | "Percentage Unit" "割合の単位" 298 | "Please enter a integer or empty." "整数か空を入力してください" 299 | "Please enter a integer." "整数を入力してください" 300 | "Please enter a number or empty." "数値か空を入力してください" 301 | "Please enter a number, %s, or empty." "数値か%s、または空を入力してください" 302 | "Please enter a number." "数値を入力してください" 303 | "Pointer Input Disabled" "ポインター入力無効" 304 | "Preset %s exists. Do you want to overwrite?" "プリセット %s は存在しています。上書きしますか?" 305 | "Preset" "プリセット" 306 | "Prev" "前" 307 | "Previous Color" "前の色" 308 | "Properties of %s" "%sのプロパティ一覧" 309 | "Properties..." "プロパティ一覧..." 310 | "Property Editor" "プロパティエディタ" 311 | "Property(Empty:End): " "プロパティ(空:指定終了): " 312 | "Property: " "プロパティ: " 313 | "RGB" "RGB" 314 | "Range:" "範囲:" 315 | "Recent Color #%d" "最近使った色#%d" 316 | "Rect Tool" "矩形ツール" 317 | "Rect" "矩形" 318 | "Red..." "赤..." 319 | "Red[0~255|0.0~1.0]: " "赤[0~255|0.0~1.0]: " 320 | "Redo" "やり直し" 321 | "Reference Point: " "基準点: " 322 | "Regenerate" "再生成" 323 | "Rename Preset" "プリセット改名" 324 | "Rename" "改名" 325 | "Rename preset %s to: " "プリセット %s を次の名前に改名: " 326 | "Rename..." "改名..." 327 | "Reset Scroll and Zoom" "スクロールとズームをリセット" 328 | "Reset View" "表示をリセット" 329 | "Reset to Default" "デフォルトに戻す" 330 | "Resize..." "リサイズ..." 331 | "Reverse Path Direction" "パスの向きを反転" 332 | "Rotate %.2fdeg" "回転 %.2f度" 333 | "Rotate All..." "全回転..." 334 | "Rotate..." "回転..." 335 | "SVG viewBox ([ ] or empty): " "SVG viewBox ([ ] or 空): " 336 | "Saturation..." "彩度..." 337 | "Saturation[0.0~1.0]: " "彩度[0.0~1.0]: " 338 | "Save as Initial %s Default" "編集開始時の%sのデフォルトとして保存" 339 | "Save as Initial %s Marker Default" "編集開始時の%sマーカーのデフォルトとして保存" 340 | "Save as Initial %s Shape Default" "編集開始時の%s図形のデフォルトとして保存" 341 | "Save colors to file: " "色の保存先ファイル: " 342 | "Save preset named: " "プリセットを次の名前で保存: " 343 | "Save..." "保存..." 344 | "Save" "保存" 345 | "Scale %.2f%% %.2f%%" "拡大率 %.2f%% %.2f%%" 346 | "Scale All..." "全拡大縮小..." 347 | "Scale X [px|%]: " "X拡大率 [px|%]: " 348 | "Scale..." "拡大縮小..." 349 | "Scale Y [px|%]: " "Y拡大率 [px|%]: " 350 | "Scroll and Zoom" "スクロールとズーム" 351 | "Search Object" "オブジェクトの検索" 352 | "Select %s" "%sを選択" 353 | "Select All" "全選択" 354 | "Select Next Above" "一つ手前を選択" 355 | "Select Next Below" "一つ奥を選択" 356 | "Select Tool" "選択ツール" 357 | "Select an object" "図形を一つ選択してください" 358 | "Select generator type" "生成タイプを選択してください" 359 | "Select" "選択" 360 | "Selected Object" "選択オブジェクト" 361 | "Send Backward" "後へ" 362 | "Send to Back" "最背面へ" 363 | "Set Background..." "背景設定..." 364 | "Set Glue Position..." "接着位置設定..." 365 | "Set Grid Interval..." "グリッド間隔設定..." 366 | "Set Marker..." "マーカー設定..." 367 | "Set Property" "プロパティ設定" 368 | "Set View Size..." "表示サイズ設定..." 369 | "Set as default" "デフォルトとして設定" 370 | "Set" "設定" 371 | "Shape name: " "図形名: " 372 | "Shape" "図形" 373 | "Show SVG" "SVGを表示" 374 | "Special Preset" "特殊プリセット" 375 | "Split Path at Point" "この点でパスを分割" 376 | "Split Subpath at Point" "この点でサブパスを分割" 377 | "Split Subpaths" "サブパス毎に分割" 378 | "Start Marker" "始点マーカー" 379 | "Stroke" "線" 380 | "Stroke..." "線..." 381 | "Support for `style' attributes is insufficient and may cause display and operation problems" "style属性のサポートは不十分であり、表示や操作に支障を来す可能性があります" 382 | "Temporary State" "一時状態" 383 | "Text Tool" "テキストツール" 384 | "Text" "テキスト" 385 | "Text..." "テキスト..." 386 | "Text: " "テキスト: " 387 | "The buffer has been killed" "バッファが既に削除されています" 388 | "The crop range is empty." "切り抜き範囲が空です。" 389 | "The empty shapes cannot be transformed" "空の図形は変形できません" 390 | "The extension is not .edraw.svg" "拡張子が .edraw.svg ではありません" 391 | "The link at point is not of type `file:'" "ポイントにあるリンクが `file:' タイプではありません" 392 | "The operation is not supported on this object" "このオブジェクトではその操作はサポートされていません" 393 | "The root entry cannot be deleted" "ルート項目は削除できません" 394 | "This shape picker is not connected to an editor" "このシェイプピッカーはエディタと接続されていません" 395 | "To Frame" "フレーム化" 396 | "To Window" "ウィンドウ化" 397 | "Top Most" "最前面" 398 | "Transform Method" "変形方式" 399 | "Transform" "変形" 400 | "Transform..." "変形..." 401 | "Translate All..." "全平行移動..." 402 | "Translate..." "平行移動..." 403 | "Transparent BG" "透明背景" 404 | "Unable to cut root entry" "ルート項目はカットできません" 405 | "Undo" "取り消し" 406 | "Unglue All" "全接着解除" 407 | "Unglue" "接着解除" 408 | "Ungroup" "グループ解除" 409 | "Unknown type of shape definition" "知らない図形型" 410 | "Unsupported SVG element: %s" "未対応のSVG要素: %s" 411 | "Unsupported path command: `%s'" "未対応のパスコマンド: `%s'" 412 | "Unsupported unit" "未対応の単位" 413 | "View Box..." "viewBox=..." 414 | "View Height: " "表示高さ: " 415 | "View Width: " "表示幅: " 416 | "View" "表示" 417 | "WARNING: Images in other directories cannot be displayed for security reasons" "警告: 他のディレクトリにある画像はセキュリティ上の理由で表示できません" 418 | "Wavelength: " "波長: " 419 | "Write edraw file: " "出力edrawファイル: " 420 | "Wavy Line" "波線" 421 | "X Interval: " "X 間隔: " 422 | "X Maximum: " "X 最大値: " 423 | "X Minimum: " "X 最小値: " 424 | "X: " "X: " 425 | "Y Interval: " "Y 間隔: " 426 | "Y Maximum: " "Y 最大値: " 427 | "Y Minimum: " "Y 最小値: " 428 | "Y: " "Y: " 429 | "Yes" "はい" 430 | "Z-Order" "重ね順" 431 | "Zigzag Line" "ジグザグ線" 432 | "Zoom In" "ズームイン" 433 | "Zoom Out" "ズームアウト" 434 | "[Custom Shape Tool] Click:Add shape(original size), Drag:Add shape(specified size), S-Drag:Square" "[カスタム図形ツール] クリック:図形追加(元サイズ), ドラッグ:図形追加(指定サイズ), S-ドラッグ:正方形指定" 435 | "[Ellipse Tool] Drag:Add ellipse, S-Drag:Square" "[楕円ツール] ドラッグ:楕円追加, S-ドラッグ:正方形指定" 436 | "[Freehand Tool] Drag:Add path" "[手書きツール] ドラッグ:パス追加" 437 | "[Generator Tool] Click:Add generator shape" "[生成ツール] Click:生成図形を追加" 438 | "[Image Tool] Click:Add image(original size), Drag:Add image(specified size), S-Drag:Square" "[画像ツール] クリック:画像追加(元サイズ), ドラッグ:画像追加(指定サイズ), S-ドラッグ:正方形指定" 439 | "[Path Tool] Click:Add Anchor, Drag:Add Anchor and Handles, a:New Path 440 | (On Endpoint) Click:Continue/Connect, C-u Click:Add Anchor 441 | (On Point) Click:Select, Drag:Move / (On Handle) M-Drag:Move 442 | (On Anchor) M-Click:Make Corner, M-Drag:Recreate Handles 443 | (On Another Shape) C-Click:Glue / S-Click/drag: Limit to 45 degrees" "[パスツール] クリック:アンカー追加, ドラッグ:アンカーとハンドル追加, a:新パス 444 | (端点上) クリック:継続・接続, C-u クリック:アンカー追加(接続回避) 445 | (点上) クリック:選択, ドラッグ:移動 / (ハンドル点上) M-ドラッグ:移動 446 | (アンカー点上) M-クリック:角にする, M-ドラッグ:ハンドル再作成 447 | (他図形上) C-クリック:接着 / S-クリック・ドラッグ: 45度単位指定" 448 | "[Rect Tool] Drag:Add rect, S-Drag:Square" "[矩形ツール] ドラッグ:矩形追加, S-ドラッグ:正方形指定" 449 | "[Select Tool] Click:Select, Drag:Range select or Move, M-Drag:Duplicate and move, S-Click:45-degree, Double Click:Properties" "[選択ツール] クリック:選択, ドラッグ:範囲指定または移動, M-ドラッグ:複製移動, S-クリック:45度単位, ダブルクリック:プロパティエディタ" 450 | "[Text Tool] Click:Add or Change, C-u Click:Add, C-Click:Glue" "[テキストツール] クリック:テキスト追加・変更, C-u クリック:追加のみ C-クリック:接着" 451 | "\"transform\" Property" "\"transform\"プロパティ" 452 | "a:auto t:transform property p:anchor points" "a:自動 t:transformプロパティ p:アンカーポイント" 453 | "all, none, property names separated by spaces, or empty: " "all, none, 空白区切りのプロパティ名列, or 空: " 454 | "deg" "deg" 455 | "edraw-import: %s warnings raised" "edraw-import: %s 件の警告が発生しました" 456 | "grad" "grad" 457 | "q/R-Click:Cancel, RET/Dbl-Click:Commit,\ns:Scale(%.2f%% %.2f%%), r:Rotate(%.2fdeg), t:Translate,\no:Origin(%s %s), m:Transform Method(%s)" "q/右クリック:キャンセル, RET/ダブルクリック:確定,\ns:拡大縮小(%.2f%% %.2f%%), r:回転(%.2f度), t:平行移動,\no:原点(%s %s), m:変形方式(%s)" 458 | "r-click:quit, drag:Scroll, wheel:Zoom,\nSPC/q/C-g:quit, [S|C|M-]arrow keys:Scroll, +/-:Zoom, 0:reset" "右クリック:終了, ドラッグ:スクロール, ホイール:ズーム,\nSPC/q/C-g:終了, [S|C|M-]矢印キー:スクロール, +/-:ズーム, 0:リセット" 459 | "rad" "rad" 460 | "turn" "turn" 461 | ;; [END MSG DATA] 462 | ))) 463 | 464 | ;;(provide 'edraw-msg-ja) 465 | ;;; edraw-msg-ja.el ends here 466 | -------------------------------------------------------------------------------- /edraw-widget.el: -------------------------------------------------------------------------------- 1 | ;;; edraw-widget.el --- Widget -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2024 AKIYAMA Kouhei 4 | 5 | ;; Author: AKIYAMA Kouhei 6 | ;; Keywords: 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; 24 | 25 | ;;; Code: 26 | (require 'wid-edit) 27 | (require 'edraw-color-picker) 28 | (require 'edraw-dom-svg) 29 | 30 | 31 | 32 | ;;;; `edraw-web-color' Widget 33 | 34 | ;; Example: 35 | ;; (progn (pop-to-buffer (generate-new-buffer "*Widget Example*")) (widget-create 'edraw-web-color) (use-local-map widget-keymap) (widget-setup)) 36 | 37 | (define-widget 'edraw-web-color 'editable-field 38 | "Choose a web color (with sample)." 39 | ;; Derived from `color' widget (wid-edit.el) 40 | :value "black" 41 | :format "%{%t%}: %v %{ %}\n" 42 | :tag "Color" 43 | :value-create 'edraw-widget-web-color-value-create 44 | :size 26 ;; Can contain "rgba(255,255,255,1.2345)" 45 | :completions (cons "none" (mapcar #'car edraw-color-css-color-names)) 46 | :sample-face-get 'edraw-widget-web-color-sample-face-get 47 | :notify 'edraw-widget-web-color-notify 48 | :match #'edraw-widget-web-color-match 49 | :validate #'edraw-widget-web-color-validate 50 | :action 'edraw-widget-web-color-action 51 | :choose-tag " Choose ") 52 | 53 | (defun edraw-widget-web-color-value-create (widget) 54 | (widget-field-value-create widget) 55 | (widget-insert " ") 56 | (widget-create-child-and-convert 57 | widget 'push-button 58 | :tag (widget-get widget :choose-tag) 59 | :action 'edraw-widget-web-color--choose-action) 60 | (widget-insert " ")) 61 | 62 | (defun edraw-widget-web-color-read-color (old-color) 63 | (edraw-color-picker-read-color 64 | nil 65 | old-color 66 | '("" "none") 67 | `((:color-syntax-system . css) 68 | (:no-color . "none")))) 69 | 70 | (defun edraw-widget-web-color--choose-action (widget &optional _event) 71 | (let* ((wp (widget-get widget :parent)) 72 | (old-color (widget-value wp)) 73 | (new-color (edraw-widget-web-color-read-color old-color))) 74 | (widget-value-set wp new-color))) 75 | 76 | (defun edraw-widget-web-color-sample-face-get (widget) 77 | (let ((color (condition-case nil 78 | (car (edraw-color-info-from-string (widget-value widget) 79 | nil 'css 'ws-eos)) 80 | (error (widget-get widget :value))))) 81 | (if color 82 | ;;@todo Use SVG image for sample 83 | (list (cons 'background-color (edraw-to-string-hex (edraw-replace-a color 1.0)))) ;;Force a=1.0 84 | 'default))) 85 | 86 | (defun edraw-widget-web-color-action (widget &optional event) 87 | "Prompt for a color." 88 | (let* ((old-color (widget-value widget)) 89 | (new-color (edraw-widget-web-color-read-color old-color))) 90 | (when new-color 91 | (widget-value-set widget new-color) 92 | (widget-setup) 93 | (widget-apply widget :notify widget event)))) 94 | 95 | (defun edraw-widget-web-color-notify (widget child &optional event) 96 | "Update the sample, and notify the parent." 97 | (overlay-put (widget-get widget :sample-overlay) 98 | 'face (widget-apply widget :sample-face-get)) 99 | (widget-default-notify widget child event)) 100 | 101 | (defun edraw-widget-web-color-match (_widget value) 102 | "Non-nil if VALUE is a defined color or a RGB hex string." 103 | (and (stringp value) 104 | (or (string= value "") 105 | (string= value "none") 106 | (edraw-color-info-from-string value nil 'css 'ws-eos)))) 107 | 108 | (defun edraw-widget-web-color-validate (widget) 109 | "Check that WIDGET's value is a valid color." 110 | (let ((value (widget-value widget))) 111 | (unless (edraw-widget-web-color-match widget value) 112 | (widget-put widget :error (format "Invalid color: %S" value)) 113 | widget))) 114 | 115 | 116 | 117 | ;;;; `edraw-checkbox' Widget 118 | 119 | (define-widget 'edraw-checkbox 'checkbox 120 | "My improved checkbox widget." 121 | :action 'edraw-widget-checkbox-action) 122 | 123 | (defun edraw-widget-checkbox-action (widget &optional event) 124 | "Toggle checkbox, set active state of sibling, and notify parent." 125 | ;; Derived from `widget-checkbox-action' 126 | 127 | ;; Notification should be done after all state changes 128 | ;; (widget-toggle-action widget event) 129 | 130 | ;; Change checkbox state 131 | (widget-value-set widget (not (widget-value widget))) 132 | ;; Change activate state 133 | (let ((sibling (widget-get-sibling widget))) 134 | (when sibling 135 | (if (widget-value widget) 136 | (widget-apply sibling :activate) 137 | (widget-apply sibling :deactivate)) 138 | (widget-clear-undo))) 139 | ;; Finally, call event handlers 140 | (widget-apply widget :notify widget event) 141 | (run-hook-with-args 'widget-edit-functions widget)) 142 | 143 | 144 | 145 | ;;;; Check List 146 | 147 | (defun edraw-widget-checklist-add-item (widget type chosen) 148 | "Create checklist item in WIDGET of type TYPE. 149 | If the item is checked, CHOSEN is a cons whose cdr is the value." 150 | ;; Derived from `widget-checklist-add-item' 151 | 152 | ;; Use edraw-checkbox instead of checkbox. 153 | (cl-letf* ((orig-fun (symbol-function 'widget-create-child-and-convert)) 154 | ((symbol-function 'widget-create-child-and-convert) 155 | (lambda (parent type &rest args) 156 | (when (eq type 'checkbox) 157 | (setq type 'edraw-checkbox)) 158 | (apply orig-fun parent type args)))) 159 | (widget-checklist-add-item widget type chosen))) 160 | 161 | 162 | 163 | ;;;; `edraw-attribute-list' Widget 164 | 165 | (define-widget 'edraw-attribute-list 'checklist 166 | "Widget for editing attributes. 167 | The following properties have special meanings for this widget: 168 | 169 | :value is a plist of attributes. 170 | 171 | :default-attributes, if non-nil, is a plist of defaults for attributes." 172 | :tag "Attributes" 173 | ;; Note: If ":" is not included, a "Bad format" error will occur in 174 | ;; Customize UI (see: cus-edit.el) 175 | :format "%{%t%}:\n%v" 176 | :button-args '(:help-echo "Control whether this attribute has any effect.") 177 | :visibility-button-help-echo "Show or hide all attributes." 178 | :visibility-button-on-tag "Hide Unused Attributes" 179 | :visibility-button-off-tag "Show All Attributes" 180 | :convert-widget 'edraw-widget-attribute-list-convert-widget 181 | :value-create 'edraw-widget-attribute-list-value-create 182 | :greedy t 183 | 184 | :default-attributes nil 185 | :show-all-attributes nil ;; Current state of whether to display all attributes 186 | ) 187 | 188 | (defun edraw-widget-attribute-list-convert-widget (widget) 189 | "Convert :args as widget types in WIDGET." 190 | (widget-put 191 | widget 192 | :args (mapcar (lambda (arg) 193 | (widget-convert 194 | arg 195 | :deactivate 'edraw-widget-attribute-list-deactivate 196 | :activate 'edraw-widget-attribute-list-activate 197 | :delete 'edraw-widget-attribute-list-delete)) 198 | (widget-get widget :args))) 199 | widget) 200 | 201 | (defun edraw-widget-attribute-list-value-create (widget) 202 | ;; Derived from `custom-face-edit-value-create' 203 | (let ((show-all-p (widget-get widget :show-all-attributes))) 204 | ;; First element in line 205 | (unless (looking-back "^ *" (line-beginning-position)) 206 | (insert ?\n)) 207 | 208 | ;; Add extra spaces 209 | (insert-char ?\s (or (widget-get widget :extra-offset) 0));; Fix: Problem when :extra-offset is nil. 210 | 211 | ;; Add item widgets 212 | (let ((alist 213 | (widget-checklist-match-find widget (widget-get widget :value))) 214 | (defaults 215 | (widget-checklist-match-find widget (widget-get 216 | widget :default-attributes)))) 217 | (if (or alist defaults show-all-p) 218 | (dolist (prop (widget-get widget :args)) 219 | (let ((entry (or (assq prop alist) 220 | (assq prop defaults)))) 221 | (if (or entry show-all-p) 222 | ;; Fix: Error when item is cons widget. 223 | ;; Use edraw-checkbox instead of checkbox. 224 | (edraw-widget-checklist-add-item widget prop entry)))) 225 | (insert (propertize "-- Empty --" 'face 'shadow) ?\n))) 226 | 227 | ;; Add visibility toggle button 228 | (let ((indent (widget-get widget :indent))) 229 | (if indent (insert-char ?\s (widget-get widget :indent)))) 230 | (let ((buttons (widget-get widget :buttons))) 231 | (push (widget-create-child-and-convert 232 | widget 'visibility 233 | :help-echo (widget-get widget :visibility-button-help-echo) ;;Fix 234 | :button-face 'edraw-widget-attribute-list-visibility 235 | :pressed-face 'edraw-widget-attribute-list-visibility 236 | :mouse-face 'highlight 237 | :on (widget-get widget :visibility-button-on-tag) ;;Fix 238 | :off (widget-get widget :visibility-button-off-tag) ;;Fix 239 | :on-glyph nil 240 | :off-glyph nil 241 | :always-active t 242 | :action 'edraw-widget-attribute-list-visibility-action 243 | show-all-p) 244 | buttons) 245 | (widget-put widget :buttons buttons)) 246 | (insert ?\n) 247 | (widget-put widget :children (nreverse (widget-get widget :children))))) 248 | 249 | (defface edraw-widget-attribute-list-visibility 250 | '((t :height 0.8 :inherit link)) 251 | "Face for the `edraw-widget-attribute-list-visibility' widget." 252 | :group 'edraw-widget-attribute-list) 253 | 254 | (defun edraw-widget-attribute-list-visibility-action (widget &rest _ignore) 255 | ;; Derived from `custom-face-edit-value-visibility-action' 256 | ;; Toggle hiding of attributes. 257 | (let ((parent (widget-get widget :parent))) 258 | (widget-put parent :show-all-attributes 259 | (not (widget-get parent :show-all-attributes))) 260 | (edraw-widget-attribute-list-redraw parent))) 261 | 262 | (defun edraw-widget-attribute-list-redraw (widget) 263 | "Redraw WIDGET with current settings." 264 | ;; Derived from `custom-redraw' 265 | (let ((line (count-lines (point-min) (point))) 266 | (column (current-column)) 267 | (pos (point)) 268 | (from (marker-position (widget-get widget :from))) 269 | (to (marker-position (widget-get widget :to)))) 270 | (save-excursion 271 | (widget-value-set widget (widget-value widget)) 272 | ;;(edraw-widget-attribute-list-redraw-magic widget) 273 | (widget-setup)) 274 | (when (and (>= pos from) (<= pos to)) 275 | (condition-case nil 276 | (progn 277 | (goto-char (point-min)) 278 | (forward-line (if (> column 0) 279 | (1- line) 280 | line)) 281 | (move-to-column column)) 282 | (error nil))))) 283 | 284 | (defun edraw-widget-attribute-list-deactivate (widget) 285 | "Make edraw-widget-attribute-list widget WIDGET inactive for user modifications." 286 | ;; Derived from `custom-face-edit-deactivate' 287 | (unless (widget-get widget :inactive) 288 | (let ((tag (edraw-widget-attribute-list-attribute-tag widget)) 289 | (from (copy-marker (widget-get widget :from))) 290 | (value (widget-value widget)) 291 | (inhibit-read-only t) 292 | (inhibit-modification-hooks t)) 293 | (save-excursion 294 | (goto-char from) 295 | (widget-default-delete widget) 296 | (insert tag ": " (propertize "--" 'face 'shadow) "\n") 297 | (widget-put widget :inactive 298 | (cons value (cons from (- (point) from)))))))) 299 | 300 | (defun edraw-widget-attribute-list-activate (widget) 301 | "Make edraw-attribute-list widget WIDGET active for user modifications." 302 | ;; Derived from `custom-face-edit-activate' 303 | (let ((inactive (widget-get widget :inactive)) 304 | (inhibit-read-only t) 305 | (inhibit-modification-hooks t)) 306 | (when (consp inactive) 307 | (save-excursion 308 | (goto-char (car (cdr inactive))) 309 | (delete-region (point) (+ (point) (cdr (cdr inactive)))) 310 | (widget-put widget :inactive nil) 311 | (widget-apply widget :create) 312 | (widget-value-set widget (car inactive)) 313 | (widget-setup))))) 314 | 315 | (defun edraw-widget-attribute-list-delete (widget) 316 | "Remove WIDGET from the buffer." 317 | ;; Derived from `custom-face-edit-delete' 318 | (let ((inactive (widget-get widget :inactive)) 319 | (inhibit-read-only t) 320 | (inhibit-modification-hooks t)) 321 | (if (not inactive) 322 | ;; Widget is alive, we don't have to do anything special 323 | (widget-default-delete widget) 324 | ;; WIDGET is already deleted because we did so to deactivate it; 325 | ;; now just get rid of the label we put in its place. 326 | (delete-region (car (cdr inactive)) 327 | (+ (car (cdr inactive)) (cdr (cdr inactive)))) 328 | (widget-put widget :inactive nil)))) 329 | 330 | (defun edraw-widget-attribute-list-attribute-tag (widget) 331 | "Return the first :tag property in WIDGET or one of its children." 332 | ;; Derived from `custom-face-edit-attribute-tag' 333 | (let ((tag (widget-get widget :tag))) 334 | (or (and (not (equal tag "")) tag) 335 | (let ((children (widget-get widget :children))) 336 | (while (and (null tag) children) 337 | (setq tag (edraw-widget-attribute-list-attribute-tag (pop children)))) 338 | tag)))) 339 | 340 | 341 | 342 | ;;;; `edraw-attribute-plist' Widget 343 | 344 | ;; Example: 345 | ;; (progn 346 | ;; (pop-to-buffer (generate-new-buffer "*Widget Example*")) 347 | ;; (widget-create `(edraw-attribute-plist 348 | ;; :tag "Props" 349 | ;; :notify 350 | ;; ,(lambda (w &rest _) (message "%s" (message "%s" (prin1-to-string (widget-value w))))) 351 | ;; :greedy t ;; Use attrs after mismatched 352 | ;; :value (stroke-width 123.45 stroke "red" unknown "uval" fill "green" ) 353 | ;; (fill 354 | ;; (string :tag "Fill" 355 | ;; :help-echo "Fill color")) 356 | ;; (stroke 357 | ;; (string :tag "Stroke" 358 | ;; :help-echo "Stroke color")) 359 | ;; (stroke-width 360 | ;; (number :tag "Stroke Width" 361 | ;; :help-echo "Stroke width")))) 362 | ;; (use-local-map widget-keymap) 363 | ;; (widget-setup)) 364 | 365 | (defun edraw-widget-attribute-plist-args (attributes) 366 | (cl-loop for (key type) in attributes 367 | collect `(group :inline t 368 | :format "%v" 369 | :sibling-args ,(widget-get type :sibling-args) 370 | (const :format "" :value ,key) 371 | ,type))) 372 | 373 | (define-widget 'edraw-attribute-plist 'edraw-attribute-list 374 | "" 375 | :convert-widget 'edraw-widget-attribute-plist-convert) 376 | 377 | (defun edraw-widget-attribute-plist-convert (widget) 378 | (widget-put 379 | widget 380 | :args (edraw-widget-attribute-plist-args (widget-get widget :args))) 381 | widget) 382 | 383 | 384 | 385 | ;;;; `edraw-attribute-alist' Widget 386 | 387 | ;; Example: 388 | ;; (progn 389 | ;; (pop-to-buffer (generate-new-buffer "*Widget Example*")) 390 | ;; (widget-create 'edraw-attribute-alist 391 | ;; :tag "Props" 392 | ;; :format "%v" 393 | ;; :notify 394 | ;; (lambda (w &rest _) (message "%s" (prin1-to-string (widget-value w)))) 395 | ;; :greedy t ;; Use attrs after mismatched 396 | ;; :value '((stroke-width . 123.45) (stroke . "red") (unknown . "uval") (fill . "green")) 397 | ;; '(fill 398 | ;; (string :tag "Fill" 399 | ;; :help-echo "Fill color")) 400 | ;; '(stroke 401 | ;; (string :tag "Stroke" 402 | ;; :help-echo "Stroke color")) 403 | ;; '(stroke-width 404 | ;; (number :tag "Stroke Width" 405 | ;; :help-echo "Stroke width"))) 406 | ;; (use-local-map widget-keymap) 407 | ;; (widget-setup)) 408 | 409 | (defun edraw-widget-attribute-alist-args (attributes) 410 | (cl-loop for (key type) in attributes 411 | collect 412 | `(cons :inline nil 413 | :tag nil 414 | :format "%v" 415 | :sibling-args ,(widget-get type :sibling-args) 416 | :value ,(cons key (widget-get type :value)) 417 | (const :format "" :value ,key) 418 | ,type))) 419 | 420 | (define-widget 'edraw-attribute-alist 'edraw-attribute-list 421 | "" 422 | :convert-widget 'edraw-widget-attribute-alist-convert) 423 | 424 | (defun edraw-widget-attribute-alist-convert (widget) 425 | (widget-put 426 | widget 427 | :args (edraw-widget-attribute-alist-args (widget-get widget :args))) 428 | widget) 429 | 430 | 431 | 432 | ;;;; `edraw-properties' Widget 433 | 434 | ;; Example: 435 | ;; (progn 436 | ;; (pop-to-buffer (generate-new-buffer "*Widget Example*")) 437 | ;; (widget-create '(edraw-properties 438 | ;; :tag "Rect" 439 | ;; :value ((rx . 10) (ry . 20) (fill . "green")) 440 | ;; :svg-tag rect)) 441 | ;; (widget-insert "\n\n") 442 | ;; (use-local-map widget-keymap) 443 | ;; (widget-setup)) 444 | 445 | ;; Example2: 446 | ;; (progn 447 | ;; (pop-to-buffer (generate-new-buffer "*Widget Example*")) 448 | ;; (widget-create (edraw-widget-properties 449 | ;; (edraw-svg-tag-get-property-info-list 'rect) 450 | ;; :value '((rx . 10) (ry . 20) (fill . "green")))) 451 | ;; (widget-insert "\n\n") 452 | ;; (use-local-map widget-keymap) 453 | ;; (widget-setup)) 454 | 455 | (define-widget 'edraw-properties 'edraw-attribute-alist 456 | "" 457 | :format "%t\n%v" 458 | :greedy t 459 | :convert-widget 'edraw-widget-properties-convert-args) 460 | 461 | (defun edraw-widget-properties-convert-args (widget) 462 | (widget-put 463 | widget 464 | :args (edraw-widget-properties-args 465 | (or (when-let* ((svg-tag (widget-get widget :svg-tag))) 466 | (edraw-svg-tag-get-property-info-list svg-tag)) 467 | (widget-get widget :prop-info-list) 468 | (car (widget-get widget :args))))) 469 | widget) 470 | 471 | (defun edraw-widget-properties (prop-info-list &rest args) 472 | `(edraw-attribute-alist 473 | ,@args 474 | :format "%t\n%v" 475 | :args ,(edraw-widget-properties-args prop-info-list))) 476 | 477 | (defun edraw-widget-properties-args (prop-info-list) 478 | (delq nil 479 | (mapcar #'edraw-widget-properties-prop-field 480 | prop-info-list))) 481 | 482 | (defun edraw-widget-properties-prop-field (prop-info) 483 | (unless (edraw-svg-prop-info-required-p prop-info) 484 | (let* ((name (edraw-svg-prop-info-name prop-info)) 485 | (tag (capitalize (symbol-name name))) 486 | (type (edraw-svg-prop-info-type prop-info)) 487 | (number-p (edraw-svg-prop-info-number-p prop-info))) 488 | (cond 489 | ;; Number 490 | (number-p 491 | (list name (list 'number :tag tag))) 492 | ;; String 493 | ((or (eq type 'string) 494 | (eq type 'text) ;;@todo text widget? 495 | (eq type 'font-family)) 496 | (list name (list 'string :tag tag))) 497 | ;; Paint 498 | ((eq type 'paint) 499 | (list name (list 'edraw-web-color :tag tag))) 500 | ;; Choice 501 | ((and (listp type) (eq (car type) 'or)) 502 | (list name (append 503 | (list 'menu-choice :tag tag) 504 | (mapcar (lambda (val) (list 'const val)) (cdr type))))) 505 | ;; Marker? 506 | ;;@todo Support marker 507 | )))) 508 | 509 | 510 | 511 | (provide 'edraw-widget) 512 | ;;; edraw-widget.el ends here 513 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | 635 | Copyright (C) 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | Copyright (C) 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | -------------------------------------------------------------------------------- /edraw-import.el: -------------------------------------------------------------------------------- 1 | ;;; edraw-import.el --- Convert to Edraw SVG -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2024 AKIYAMA Kouhei 4 | 5 | ;; Author: AKIYAMA Kouhei 6 | ;; Keywords: 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; 24 | 25 | ;;; Code: 26 | 27 | (require 'edraw-dom-svg) 28 | 29 | (defgroup edraw-import nil 30 | "Edraw import feature." 31 | :tag "Edraw Import" 32 | :prefix "edraw-import-" 33 | :group 'edraw) 34 | 35 | ;;@todo Unify `edraw-editor-svg-body-id' 36 | (defconst edraw-import-svg-body-id "edraw-body") 37 | (defconst edraw-import-svg-imported-definitions-id "edraw-imported-definitions") 38 | 39 | ;;;; Common 40 | 41 | ;;;###autoload 42 | (defun edraw-convert-file-to-edraw-svg (file) 43 | ;; @todo Select importer that matches file extension. 44 | (edraw-import-svg-file file t)) 45 | 46 | ;;;###autoload 47 | (defun edraw-convert-buffer-to-edraw-svg-xml (buffer output) 48 | (interactive 49 | (list (current-buffer) (current-buffer))) 50 | 51 | ;; @todo Select the importer that matches the buffer mode or file extension. 52 | 53 | (when (and 54 | (called-interactively-p 'interactive) 55 | (not (edraw-import-svg-comfirm))) 56 | (keyboard-quit)) 57 | 58 | (when-let* ((svg (edraw-import-svg-buffer buffer))) 59 | (with-current-buffer output 60 | (erase-buffer) 61 | (edraw-svg-print svg nil nil)))) 62 | 63 | (defun edraw-import-svg-comfirm () 64 | (y-or-n-p 65 | (edraw-msg "If you import diagrams generated with other software into Edraw, they may not be displayed correctly or the editing operation may become unstable. The original information is lost in the converted data. Do you want to convert to a format for Edraw?"))) 66 | 67 | (defun edraw-import-error (string &rest args) 68 | (apply #'error string args)) 69 | 70 | (defvar edraw-import-warning-messages nil) 71 | (defvar edraw-import-warning-count 0) 72 | (defvar edraw-import-warning-blocks 0) 73 | (defvar edraw-import-warning-buffer nil) 74 | (defvar edraw-import-warning-suppress-types nil) 75 | 76 | (defun edraw-import-warning-suppress-types (&rest types) 77 | (nconc 78 | types 79 | edraw-import-warning-suppress-types)) 80 | 81 | (defun edraw-import-display-warning (message &rest args) 82 | (display-warning 'edraw-import 83 | (apply #'format-message message args) 84 | :warning 85 | edraw-import-warning-buffer)) 86 | 87 | (defun edraw-import-warn (type string &rest args) 88 | (unless (memq type edraw-import-warning-suppress-types) 89 | (let ((msg (apply #'format string args))) 90 | (cl-incf edraw-import-warning-count) 91 | (unless (member msg edraw-import-warning-messages) 92 | (push msg edraw-import-warning-messages) 93 | (apply #'edraw-import-display-warning 94 | string args))))) 95 | 96 | (defmacro edraw-import-warning-block (&rest body) 97 | `(progn 98 | (when (= edraw-import-warning-blocks 0) 99 | (setq edraw-import-warning-count 0 100 | edraw-import-warning-messages nil)) 101 | (unwind-protect 102 | (let ((edraw-import-warning-blocks (1+ edraw-import-warning-blocks))) 103 | ,@body) 104 | (when (= edraw-import-warning-blocks 0) 105 | (when (> edraw-import-warning-count 0) 106 | (edraw-import-display-warning 107 | (edraw-msg "edraw-import: %s warnings raised") 108 | edraw-import-warning-count)) 109 | (setq edraw-import-warning-count 0 110 | edraw-import-warning-messages nil))))) 111 | 112 | ;;;; Import From General SVG 113 | 114 | (defcustom edraw-import-svg-level 'strict 115 | "Level to verify and keep unsupported SVG features." 116 | :group 'edraw-import 117 | :type '(choice (const strict) 118 | (const loose))) 119 | 120 | (defcustom edraw-import-svg-keep-unsupported-defs t 121 | "Non-nil means that unsupported definition elements are not discarded." 122 | :group 'edraw-import 123 | :type 'boolean) 124 | 125 | (defcustom edraw-import-svg-remove-referenced-from-use-in-defs t 126 | "Non-nil means that elements used from `use' elements are 127 | removed from within defs elements. 128 | 129 | The importer replaces each `use' element with a clone of the 130 | element it references, so it is usually safe to remove referenced 131 | elements. However, problems can arise if the elements referenced 132 | by the `use' elements are also referenced elsewhere." 133 | :group 'edraw-import 134 | :type 'boolean) 135 | 136 | (defcustom edraw-import-svg-expand-use-element t 137 | "Non-nil means that use elements are replaced with the referenced element." 138 | :group 'edraw-import 139 | :type 'boolean) 140 | 141 | (defcustom edraw-import-svg-style-to-attrs t 142 | "Non-nil means converting style attributes into individual 143 | presentation attributes." 144 | :group 'edraw-import 145 | :type 'boolean) 146 | 147 | (defvar edraw-import-svg-in-defs nil) 148 | 149 | (defun edraw-import-svg-file (file interactively) 150 | (or 151 | ;; SVG for edraw 152 | (let ((svg (edraw-svg-read-from-file file nil))) 153 | (unless svg 154 | (error (edraw-msg "Not SVG data"))) 155 | (when (edraw-dom-get-by-id svg edraw-import-svg-body-id) 156 | svg)) 157 | ;; Convert 158 | ;; Do not use `edraw-svg-read-from-file' as it cannot handle 159 | ;; namespaces correctly. 160 | (progn 161 | (when (and interactively 162 | (not (edraw-import-svg-comfirm))) 163 | (keyboard-quit)) 164 | (edraw-import-svg-dom 165 | (with-temp-buffer 166 | (edraw-insert-xml-file-contents file) 167 | (edraw-import-svg-decode-buffer)))))) 168 | 169 | (defun edraw-import-svg-decode-buffer () 170 | (edraw-xml-escape-ns-buffer) 171 | (edraw-import-svg-unescape-ns-element 172 | (car (edraw-dom-split-top-nodes (libxml-parse-xml-region 173 | (point-min) (point-max)))) 174 | nil)) 175 | 176 | ;;;###autoload 177 | (defun edraw-import-svg-buffer (buffer) 178 | (edraw-import-warning-block 179 | (edraw-import-svg-dom 180 | (with-temp-buffer 181 | (insert-buffer-substring-no-properties buffer) 182 | (edraw-import-svg-decode-buffer))))) 183 | 184 | ;;;###autoload 185 | (defun edraw-import-svg-string (string) 186 | (edraw-import-warning-block 187 | (edraw-import-svg-dom 188 | (with-temp-buffer 189 | (insert string) 190 | (edraw-import-svg-decode-buffer))))) 191 | 192 | (defun edraw-import-svg-dom (dom) 193 | ;; Note: The DOM must be preprocessed using 194 | ;; `edraw-xml-escape-ns-buffer' and 195 | ;; `edraw-import-svg-unescape-ns-element'. 196 | (edraw-import-warning-block 197 | (let* ((svg-comments (edraw-dom-split-top-nodes dom)) 198 | (svg (car svg-comments))) 199 | 200 | (unless (eq (edraw-dom-tag svg) 'svg) 201 | (edraw-import-error (edraw-msg "Not SVG data"))) 202 | 203 | (if (edraw-dom-get-by-id svg edraw-import-svg-body-id) 204 | (progn 205 | (edraw-import-warn 'noconv (edraw-msg "Already an SVG for Edraw")) 206 | dom) 207 | 208 | ;; `edraw-svg-attr-length' requires ability to get parent from 209 | ;; child element only. 210 | (edraw-dom-update-parent-links svg) 211 | 212 | (let* ((edraw-dom-inhibit-parent-links t) ;; Do not create parent links(?) 213 | (context 214 | (list 215 | ;; plist 216 | (list 217 | :dom-original svg 218 | :ids-ref-from-use nil))) 219 | (converted (edraw-import-svg-convert-children svg context)) 220 | (definitions (plist-get (car context) :definitions))) 221 | (edraw-dom-element 222 | 'svg 223 | :attributes 224 | (edraw-import-svg-convert-element-attributes svg context) 225 | :xmlns "http://www.w3.org/2000/svg" 226 | :xmlns:xlink "http://www.w3.org/1999/xlink" 227 | ;; Children 228 | (when definitions 229 | (edraw-import-svg-remove-empty-defs-and-group 230 | (edraw-import-svg-remove-referenced-from-use-in-defs 231 | (edraw-dom-element 'g 232 | :id edraw-import-svg-imported-definitions-id 233 | :children definitions) 234 | context))) 235 | (edraw-dom-element 'g 236 | :id edraw-import-svg-body-id 237 | :children converted))))))) 238 | 239 | (defun edraw-import-svg-remove-empty-defs-and-group (dom) 240 | (if (and (edraw-dom-element-p dom) 241 | (memq (edraw-dom-tag dom) '(defs g))) 242 | (progn 243 | (dolist (child (copy-sequence (edraw-dom-children dom))) 244 | (unless (edraw-import-svg-remove-empty-defs-and-group child) 245 | (edraw-dom-remove-node dom child))) 246 | (if (dom-children dom) 247 | dom 248 | nil)) 249 | dom)) 250 | 251 | ;;;;; Convert Children 252 | 253 | (defun edraw-import-svg-convert-children (parent context) 254 | (let (new-children) 255 | (dolist (node (dom-children parent)) 256 | (if (edraw-dom-element-p node) 257 | (if-let* ((new-node (edraw-import-svg-convert-element node context))) 258 | (if (and (consp new-node) 259 | (consp (car new-node))) 260 | ;; List of node 261 | (dolist (node new-node) 262 | (push node new-children)) 263 | ;; Single node (element or text) 264 | (push new-node new-children)) 265 | ;; Discard element 266 | nil) 267 | (push node new-children))) 268 | (nreverse new-children))) 269 | 270 | ;;;;; Resolve XML Namespace 271 | 272 | (defun edraw-import-svg-unescape-ns-element (elem namespaces) 273 | (let* ((namespaces (nconc 274 | (edraw-xml-collect-ns-decls elem) 275 | namespaces)) 276 | (tag (edraw-import-svg-normalize-name (edraw-dom-tag elem) 277 | namespaces))) 278 | (unless tag 279 | (error "Unexpected xmlns decl in tag name")) 280 | 281 | (edraw-dom-element 282 | tag 283 | :attributes 284 | (cl-loop for (key . value) in (edraw-dom-attributes elem) 285 | for attr-name = (edraw-import-svg-normalize-name key namespaces) 286 | when attr-name ;; Ignore xmlns:= and xmlns= 287 | collect (cons attr-name value)) 288 | :children 289 | (cl-loop for child in (edraw-dom-children elem) 290 | if (edraw-dom-element-p child) 291 | collect (edraw-import-svg-unescape-ns-element child namespaces) 292 | else 293 | collect child)))) 294 | 295 | (defun edraw-import-svg-normalize-name (name-symbol namespaces) 296 | "Normalize the NAME-SYMBOL of tags and attributes. 297 | 298 | SVG names strip the namespace prefix. XLink names begin with 299 | xlink:. In other cases, the namespace URL is appended to the name 300 | in parentheses. 301 | 302 | The result value might look like this: 303 | xmlns : nil 304 | xmlns:? : nil 305 | SVG : rect 306 | XLink : xlink:href 307 | XML : xml:space 308 | Otherwise: :version\\(http://www.inkscape.org/namespaces/inkscape\\) 309 | :hogehoge\\(unknownns\\)" 310 | (let* ((ns-name (edraw-xml-unescape-ns-name name-symbol)) 311 | (ns-prefix (car ns-name)) 312 | (name (cdr ns-name)) 313 | (ns-url (alist-get ns-prefix namespaces 314 | nil nil #'equal))) 315 | (unless (eq ns-prefix 'xmlns) 316 | (pcase ns-url 317 | ('nil (cond 318 | ;; No xmlns declaration for default. SVG? 319 | ((null ns-prefix) 320 | (edraw-import-warn 'no-xmlns-default 321 | "No xmlns declaration for default") 322 | name) 323 | ;; For eample, xml:space, xml:lang 324 | ((equal ns-prefix "xml") 325 | (intern (format "%s:%s" ns-prefix name))) 326 | ;; No xmlns declaration for NS-PREFIX 327 | (t 328 | (edraw-import-warn 'no-xmlns 329 | "No xmlns declaration for `%s'" ns-prefix) 330 | (intern (format ":%s(%s)" name ns-prefix))))) 331 | ("http://www.w3.org/2000/svg" 332 | name) 333 | ("http://www.w3.org/1999/xlink" 334 | (intern (format "xlink:%s" name))) 335 | (_ 336 | ;; Unknown namespace URL 337 | (intern (format ":%s(%s)" name ns-url))))))) 338 | 339 | (defun edraw-import-svg-unknown-ns-name-p (name-symbol) 340 | (string-prefix-p ":" (symbol-name name-symbol))) 341 | 342 | 343 | ;;;;; Convert Element 344 | 345 | (defvar edraw-import-svg-convert-element-alist 346 | '((defs . edraw-import-svg-convert-definition) 347 | (g . edraw-import-svg-convert-group) 348 | (rect . edraw-import-svg-convert-shape) 349 | (ellipse . edraw-import-svg-convert-shape) 350 | (path . edraw-import-svg-convert-shape) 351 | (image . edraw-import-svg-convert-shape) 352 | (circle . edraw-import-svg-convert-circle) 353 | (line . edraw-import-svg-convert-line) 354 | (polyline . edraw-import-svg-convert-poly-shape) 355 | (polygon . edraw-import-svg-convert-poly-shape) 356 | (text . edraw-import-svg-convert-text) 357 | (tspan . edraw-import-svg-convert-tspan) 358 | (comment . edraw-import-svg-convert-comment) 359 | (a . edraw-import-svg-convert-a) 360 | (use . edraw-import-svg-convert-use) 361 | ;; Not supported: 362 | ;; animate 363 | ;; animateMotion 364 | ;; animateTransform 365 | ;; clipPath 366 | ;; desc 367 | ;; fe* 368 | ;; filter 369 | ;; foreignObject 370 | ;; linearGradient 371 | ;; marker 372 | ;; mask 373 | ;; metadata 374 | ;; mpath 375 | ;; pattern 376 | ;; radialGradient 377 | ;; script 378 | ;; set 379 | ;; stop 380 | ;; style 381 | ;; svg 382 | ;; switch 383 | ;; symbol 384 | ;; textPath 385 | ;; view 386 | )) 387 | 388 | (defun edraw-import-svg-convert-element (elem context) 389 | (let ((tag (edraw-dom-tag elem))) 390 | (if-let* ((fun (alist-get tag edraw-import-svg-convert-element-alist))) 391 | (funcall fun elem context) 392 | (if (or (and edraw-import-svg-in-defs 393 | (not (edraw-import-svg-unknown-ns-name-p tag))) 394 | (eq edraw-import-svg-level 'loose)) 395 | (progn 396 | (edraw-import-warn 'keep-unsupported-element 397 | (edraw-msg "Keep unsupported element: %s") tag) 398 | (edraw-import-svg-convert-unsupported-element elem context)) 399 | (edraw-import-warn 'discard-unsupported-element 400 | (edraw-msg "Discard unsupported element: %s") tag) 401 | nil)))) 402 | 403 | (defun edraw-import-svg-convert-comment (_elem _context) 404 | ;; Discard comment 405 | nil) 406 | 407 | (defun edraw-import-svg-convert-a (elem context) 408 | ;; Expose contents 409 | ;; @todo check style? 410 | (edraw-import-svg-convert-children elem context)) 411 | 412 | (defun edraw-import-svg-convert-use (elem context) 413 | ;; https://www.w3.org/TR/SVG11/struct.html#UseElement 414 | (if (not edraw-import-svg-expand-use-element) 415 | (progn 416 | (edraw-import-warn 'discard-unsupported-element 417 | (edraw-msg "Discard unsupported element: %s") 418 | (edraw-dom-tag elem)) 419 | nil) 420 | (let* ((href (or (dom-attr elem 'xlink:href) 421 | (dom-attr elem 'href))) 422 | (x (dom-attr elem 'x)) 423 | (y (dom-attr elem 'y)) 424 | ;;(width (dom-attr elem 'width)) 425 | ;;(height (dom-attr elem 'height)) 426 | (ref-id (and (stringp href) 427 | (not (string-empty-p href)) 428 | (= (aref href 0) ?#) 429 | (substring href 1))) 430 | (ref-elem (and ref-id 431 | (edraw-dom-get-by-id 432 | (plist-get (car context) :dom-original) ref-id))) 433 | (supported-tag (and ref-elem 434 | (memq (edraw-dom-tag ref-elem) 435 | '(id 436 | rect ellipse path text image g 437 | circle line polyline polygon 438 | ;;@todo tspan? 439 | ;;@todo a? 440 | ;; Reject symbol and svg 441 | )))) 442 | (recursive (and ref-elem 443 | (memq ref-elem 444 | (plist-get (car context) :use-converting-elements)))) 445 | (converted-ref-elem 446 | (and supported-tag 447 | (not recursive) 448 | (edraw-import-svg-convert-element 449 | ref-elem 450 | (list 451 | (edraw-plist-put 452 | (car context) :use-converting-elements 453 | (cons ref-elem 454 | (plist-get (car context) :use-converting-elements)))))))) 455 | ;;(message "href=%s ref-id=%s ref=elem=%s supported-tag=%s recursive=%s" href ref-id ref-elem supported-tag recursive) 456 | (unless converted-ref-elem 457 | (edraw-import-warn 458 | 'discard-unsupported-element ;;@todo unsupported-element-format? 459 | (edraw-msg "Discard `use' element with unsupported format"))) 460 | 461 | (when converted-ref-elem 462 | (let* ((new-attributes (seq-filter 463 | (lambda (attr) 464 | (and (not (edraw-dom-attr-internal-p (car 465 | attr))) 466 | (not (memq (car attr) 467 | '(id x y width height 468 | href xlink:href 469 | transform))))) 470 | (dom-attributes elem))) 471 | (old-transform (dom-attr elem 'transform)) ;;@todo Consider style's transform 472 | (new-transform (if (or x y) 473 | (concat old-transform ;; or nil 474 | (when old-transform " ") 475 | "translate(" 476 | (edraw-to-string (or x 0)) ;; edraw-svg-numstr? for matrix 477 | "," 478 | (edraw-to-string (or y 0)) ;; edraw-svg-numstr? for matrix 479 | ")") 480 | old-transform))) 481 | (when new-transform 482 | (push (cons 'transform new-transform) new-attributes)) 483 | ;; Do not use GV version of plist-get 484 | ;;(push ref-id (plist-get (car context) :ids-ref-from-use)) 485 | (setcar context 486 | (plist-put (car context) 487 | :ids-ref-from-use 488 | (cons 489 | ref-id 490 | (plist-get (car context) :ids-ref-from-use)))) 491 | 492 | (edraw-dom-element 'g 493 | :attributes new-attributes 494 | converted-ref-elem)))))) 495 | 496 | (defun edraw-import-svg-remove-referenced-from-use-in-defs (dom context) 497 | (when edraw-import-svg-remove-referenced-from-use-in-defs 498 | (dolist (id (plist-get (car context) :ids-ref-from-use)) 499 | (let* ((referenced (edraw-dom-get-by-id dom id)) 500 | (p referenced)) 501 | (when referenced 502 | (while (and (setq p (edraw-dom-parent dom p)) 503 | (not (eq (edraw-dom-tag p) 'defs)))) 504 | (when p 505 | (edraw-dom-remove-node dom referenced)))))) 506 | dom) 507 | 508 | (defun edraw-import-svg-convert-definition (elem context) 509 | ;; Do not use GV version of plist-get 510 | ;; (push 511 | ;; (let ((edraw-import-svg-in-defs edraw-import-svg-keep-unsupported-defs)) 512 | ;; (edraw-dom-element 513 | ;; (edraw-dom-tag elem) 514 | ;; :attributes (edraw-import-svg-convert-element-attributes elem context) 515 | ;; :children (edraw-import-svg-convert-children elem context))) 516 | ;; (plist-get (car context) :definitions)) 517 | (setcar 518 | context 519 | (plist-put 520 | (car context) 521 | :definitions 522 | (cons 523 | (let ((edraw-import-svg-in-defs edraw-import-svg-keep-unsupported-defs)) 524 | (edraw-dom-element 525 | (edraw-dom-tag elem) 526 | :attributes (edraw-import-svg-convert-element-attributes elem context) 527 | :children (edraw-import-svg-convert-children elem context))) 528 | (plist-get (car context) :definitions)))) 529 | nil) 530 | 531 | (defun edraw-import-svg-convert-unsupported-element (elem context) 532 | (edraw-dom-element 533 | (edraw-dom-tag elem) 534 | :attributes (edraw-import-svg-convert-element-attributes elem context) 535 | :children (edraw-import-svg-convert-children elem context))) 536 | 537 | (defun edraw-import-svg-convert-group (elem context) 538 | (edraw-dom-element 539 | (edraw-dom-tag elem) 540 | :attributes (edraw-import-svg-convert-element-attributes elem context) 541 | :children (edraw-import-svg-convert-children elem context))) 542 | 543 | (defun edraw-import-svg-convert-shape (elem context) 544 | (edraw-dom-element 545 | (edraw-dom-tag elem) 546 | :attributes (edraw-import-svg-convert-element-attributes elem context))) 547 | 548 | (defun edraw-import-svg-convert-circle (elem context) 549 | (let ((r (dom-attr elem 'r))) 550 | (when r 551 | (edraw-dom-element 552 | 'ellipse 553 | :rx r 554 | :ry r 555 | :attributes (edraw-import-svg-convert-element-attributes 556 | elem context '(r)))))) 557 | 558 | (defun edraw-import-svg-convert-line (elem context) 559 | (let ((x1 (edraw-svg-attr-length elem 'x1)) 560 | (y1 (edraw-svg-attr-length elem 'y1)) 561 | (x2 (edraw-svg-attr-length elem 'x2)) 562 | (y2 (edraw-svg-attr-length elem 'y2))) 563 | (when (and x1 y1 x2 y2) 564 | (edraw-dom-element 565 | 'path 566 | :d (edraw-path-d-from-command-list `((M ,x1 ,y1 ,x2 ,y2))) 567 | :attributes (edraw-import-svg-convert-element-attributes 568 | elem context '(x1 y1 x2 y2)))))) 569 | 570 | (defun edraw-import-svg-convert-poly-shape (elem context) ;; polyline or polygon 571 | (let* ((closepath (eq (edraw-dom-tag elem) 'polygon)) 572 | (points-attr (dom-attr elem 'points)) 573 | (points (edraw-svg-parse-points (or points-attr "")))) 574 | (cond 575 | ((null points-attr) 576 | (edraw-import-warn 'no-points-attr 577 | (edraw-msg "No `points' attribute: %s") 578 | (edraw-dom-tag elem)) 579 | nil) 580 | ((null points) 581 | (edraw-import-warn 'no-points-attr ;; empty-points-attr? 582 | (edraw-msg "Empty `points' attribute: %s") 583 | (edraw-dom-tag elem)) 584 | nil) 585 | (t 586 | (edraw-dom-element 587 | 'path 588 | :d (edraw-path-d-from-command-list 589 | (nconc 590 | (list (cons 'M (cl-loop for (x . y) in points 591 | collect x collect y))) 592 | (when closepath (list (list 'Z))))) 593 | :attributes (edraw-import-svg-convert-element-attributes 594 | elem context '(points))))))) 595 | 596 | (defun edraw-import-svg-convert-text (elem context) 597 | ;;@todo Extract text attributes from style properties? Should edraw-dom-svg.el parse style? 598 | (edraw-dom-element 599 | (edraw-dom-tag elem) 600 | :attributes (edraw-import-svg-convert-element-attributes elem context) 601 | :children (edraw-import-svg-convert-children elem context))) 602 | 603 | (defun edraw-import-svg-convert-tspan (elem context) 604 | (edraw-dom-element 605 | (edraw-dom-tag elem) 606 | :attributes (edraw-import-svg-convert-element-attributes elem context) 607 | :children (edraw-import-svg-convert-children elem context))) 608 | 609 | 610 | ;;;;; Convert Attribute 611 | 612 | (defun edraw-import-svg-convert-element-attributes (elem context &optional 613 | exclude-attrs) 614 | ;; Do not use GV version of plist-get 615 | ;; (cl-letf (((plist-get (car context) :override-attrs) nil)) 616 | (let ((old-override-attrs (plist-get (car context) :override-attrs))) 617 | (setcar context (plist-put (car context) :override-attrs nil)) 618 | (unwind-protect 619 | (let ((new-attrs 620 | (edraw-import-svg-convert-attributes 621 | (if exclude-attrs 622 | (cl-loop for kv in (edraw-dom-attributes elem) 623 | unless (memq (car kv) exclude-attrs) 624 | collect kv) 625 | (edraw-dom-attributes elem)) 626 | elem 627 | context))) 628 | ;; Override attributes 629 | (cl-loop for (pname . pvalue) in (plist-get (car context) :override-attrs) 630 | do (setf (alist-get pname new-attrs) pvalue)) 631 | new-attrs) 632 | (setcar context (plist-put (car context) 633 | :override-attrs 634 | old-override-attrs))))) 635 | 636 | (defun edraw-import-svg-convert-attributes (attributes elem context) 637 | (cl-loop for (k . v) in attributes 638 | for new-attr = (edraw-import-svg-convert-attribute k v elem context) 639 | when new-attr 640 | collect new-attr)) 641 | 642 | (defvar edraw-import-svg-convert-attributes-alist 643 | ;; https://developer.mozilla.org/ja/docs/Web/SVG/Attribute 644 | '((class . edraw-import-svg-convert-attr-keep) 645 | (id . edraw-import-svg-convert-attr-keep) 646 | (opacity . edraw-import-svg-convert-attr-keep) 647 | (fill . edraw-import-svg-convert-attr-keep) 648 | (fill-opacity . edraw-import-svg-convert-attr-keep) 649 | (fill-rule . edraw-import-svg-convert-attr-keep) 650 | (stroke . edraw-import-svg-convert-attr-keep) 651 | (stroke-opacity . edraw-import-svg-convert-attr-keep) 652 | (stroke-width . edraw-import-svg-convert-attr-keep) 653 | (stroke-dasharray . edraw-import-svg-convert-attr-keep) 654 | (stroke-dashoffset . edraw-import-svg-convert-attr-keep) 655 | (stroke-linecap . edraw-import-svg-convert-attr-keep) 656 | (stroke-linejoin . edraw-import-svg-convert-attr-keep) 657 | (stroke-miterlimit . edraw-import-svg-convert-attr-keep) 658 | 659 | (style . edraw-import-svg-convert-attr-style) 660 | (transform . edraw-import-svg-convert-attr-keep) 661 | ;; geometry 662 | (x . edraw-import-svg-convert-attr-keep) ;;@todo check text's x 663 | (y . edraw-import-svg-convert-attr-keep) ;;@todo check text's y 664 | (cx . edraw-import-svg-convert-attr-keep) 665 | (cy . edraw-import-svg-convert-attr-keep) 666 | (width . edraw-import-svg-convert-attr-keep) 667 | (height . edraw-import-svg-convert-attr-keep) 668 | (r . edraw-import-svg-convert-attr-keep) 669 | (rx . edraw-import-svg-convert-attr-keep) 670 | (ry . edraw-import-svg-convert-attr-keep) 671 | ;; path 672 | (d . edraw-import-svg-convert-attr-d) 673 | (marker-start . edraw-import-svg-convert-attr-keep) ;;@todo check 674 | (marker-mid . edraw-import-svg-convert-attr-keep) ;;@todo check 675 | (marker-end . edraw-import-svg-convert-attr-keep) ;;@todo check 676 | ;; text 677 | (dx . edraw-import-svg-convert-attr-keep) 678 | (dy . edraw-import-svg-convert-attr-keep) 679 | (font-family . edraw-import-svg-convert-attr-keep) 680 | (font-size . edraw-import-svg-convert-attr-keep) 681 | (font-weight . edraw-import-svg-convert-attr-keep) 682 | (font-style . edraw-import-svg-convert-attr-keep) 683 | (text-decoration . edraw-import-svg-convert-attr-keep) 684 | (text-anchor . edraw-import-svg-convert-attr-keep) 685 | (writing-mode . edraw-import-svg-convert-attr-keep) 686 | ;; image 687 | (xlink:href . edraw-import-svg-convert-attr-keep) 688 | (href . edraw-import-svg-convert-attr-keep) 689 | (preserveAspectRatio . edraw-import-svg-convert-attr-keep) ;; svg or image 690 | ;; svg 691 | (viewBox . edraw-import-svg-convert-attr-keep) 692 | (version . edraw-import-svg-convert-attr-keep) 693 | (xmlns . edraw-import-svg-convert-attr-keep) 694 | (xmlns:xlink . edraw-import-svg-convert-attr-keep) 695 | ;; Inkscape 696 | (:role\(http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd\) 697 | . edraw-import-svg-convert-attr-inkscape-role) 698 | )) 699 | 700 | (defun edraw-import-svg-convert-attribute (attr-name value elem context) 701 | (let ((fun (alist-get attr-name 702 | edraw-import-svg-convert-attributes-alist))) 703 | (cond 704 | (fun 705 | (funcall fun attr-name value elem context)) 706 | ;; Ignore internal attribute 707 | ((edraw-dom-attr-internal-p attr-name) 708 | nil) 709 | ;; Keep data attribute 710 | ((string-prefix-p "data-" (symbol-name attr-name)) 711 | (cons attr-name value)) 712 | ;; Unsupported attribute 713 | (t 714 | (if (or (and edraw-import-svg-in-defs 715 | (not (edraw-import-svg-unknown-ns-name-p attr-name))) 716 | (eq edraw-import-svg-level 'loose)) 717 | (progn 718 | (edraw-import-warn 'keep-unsupported-attribute 719 | (edraw-msg "Keep unsupported attribute: %s") 720 | attr-name) 721 | (cons attr-name value)) 722 | (edraw-import-warn 'discard-unsupported-attribute 723 | (edraw-msg "Discard unsupported attribute: %s") 724 | attr-name) 725 | nil))))) 726 | 727 | (defun edraw-import-svg-convert-attr-keep (attr-name value _elem _context) 728 | (cons attr-name value)) 729 | 730 | (defconst edraw-import-svg-style-props 731 | '((opacity (rect circle ellipse path text image g line polyline polygon)) 732 | (fill (rect circle ellipse path text g line polyline polygon)) 733 | (fill-opacity (rect circle ellipse path text g line polyline polygon)) 734 | (stroke (rect circle ellipse path text g line polyline polygon)) 735 | (stroke-opacity (rect circle ellipse path text g line polyline polygon)) 736 | (stroke-width (rect circle ellipse path text g line polyline polygon)) 737 | (stroke-dasharray (rect circle ellipse path text g line polyline polygon)) 738 | (stroke-dashoffset (rect circle ellipse path text g line polyline polygon)) 739 | ;;(transform (rect circle ellipse path text image g line polyline polygon)) 740 | ;; path 741 | (fill-rule (path g line polyline polygon)) 742 | (stroke-linecap (path g line polyline polygon)) 743 | (stroke-linejoin (path g line polyline polygon)) 744 | (stroke-miterlimit (path g line polyline polygon)) 745 | ;; text 746 | (font-family (text)) 747 | (font-size (text)) 748 | (font-weight (text)) 749 | (font-style (text)) 750 | (text-decoration (text)) 751 | (text-anchor (text)) 752 | ;;(writing-mode (text)) 753 | )) 754 | 755 | (defun edraw-import-svg-convert-attr-style (attr-name value elem context) 756 | (edraw-import-warn 'poorly-supported-attribute 757 | (edraw-msg "Support for `style' attributes is insufficient and may cause display and operation problems")) 758 | 759 | ;; Convert style attribute to presentation attributes 760 | (if edraw-import-svg-style-to-attrs 761 | ;; https://www.w3.org/TR/SVG11/styling.html 762 | ;; https://www.w3.org/TR/SVG2/styling.html#PresentationAttributes 763 | (condition-case err 764 | (let ((tag (edraw-dom-tag elem)) 765 | new-value 766 | override-attrs) 767 | 768 | (cl-loop for (pname-token . pvalue-range) 769 | in (edraw-css-split-decl-list value (list 0)) 770 | ;; https://www.w3.org/TR/SVG11/styling.html#CaseSensitivity 771 | ;; @todo Convert property name case ( Fill: => fill= ) 772 | ;; @todo Convert property value case ( Italic => italic ) 773 | for pname = (intern (edraw-css-token-value value pname-token)) 774 | for pinfo = (alist-get pname edraw-import-svg-style-props) 775 | if (memq tag (car pinfo)) ;; Use presentation attr 776 | do (push (cons pname 777 | ;; @todo Check value format 778 | (substring value 779 | (car pvalue-range) 780 | (cdr pvalue-range))) 781 | override-attrs) 782 | else ;; Use style attr 783 | do (setq new-value 784 | (concat new-value (and new-value ";") 785 | (substring value 786 | (cadr pname-token) 787 | (cdr pvalue-range))))) 788 | ;; Do not use GV version of plist-get 789 | ;; (setf (plist-get (car context) :override-attrs) 790 | ;; (append 791 | ;; (plist-get (car context) :override-attrs) 792 | ;; override-attrs)) 793 | (setcar context (plist-put 794 | (car context) 795 | :override-attrs 796 | (append 797 | (plist-get (car context) :override-attrs) 798 | override-attrs))) 799 | (cons attr-name new-value)) 800 | (error 801 | (edraw-import-warn 'css-error 802 | (edraw-msg "CSS Style parsing error: %s") err) 803 | (cons attr-name value))) 804 | (cons attr-name value))) 805 | 806 | (defun edraw-import-svg-convert-attr-d (attr-name value _elem _context) 807 | ;; Check unsupported path data (A command) 808 | (let ((cmds (condition-case err 809 | (edraw-path-d-parse value) 810 | (error 811 | (edraw-import-warn 'path-syntax 812 | (edraw-msg "Parsing error: %s") err) 813 | (setq value nil) ;;Discard 814 | nil)))) 815 | ;; Check empty path data 816 | (unless cmds 817 | (setq value nil cmds nil) ;;Discard 818 | (edraw-import-warn 'path-empty (edraw-msg "Empty path data"))) 819 | 820 | ;; Check unsupported path command 821 | ;;@todo Call `edraw-path-cmdlist-from-d'? 822 | (when-let* ((c (seq-find (lambda (cmd) 823 | (not (memq 824 | (car cmd) 825 | '(M m Z z L l H h V v C c S s Q q T t)))) 826 | cmds))) 827 | ;; As of 2024-03-11, if there is an unsupported command, an 828 | ;; error will occur during editing, so discard it. 829 | (unless (eq edraw-import-svg-level 'loose) 830 | (setq value nil cmds nil)) ;;Discard 831 | (edraw-import-warn 'path-unsupported-command 832 | (edraw-msg "Unsupported path command: `%s'") (car c))) 833 | 834 | ;; Check not start with M 835 | (when (and cmds (not (memq (caar cmds) '(M m)))) 836 | (setq value nil cmds nil) ;;Discard 837 | (edraw-import-warn 'path-not-start-m 838 | (edraw-msg "Path data does not start with M")))) 839 | 840 | (when value 841 | (cons attr-name value))) 842 | 843 | (defun edraw-import-svg-convert-attr-inkscape-role (attr-name 844 | value elem _context) 845 | (if (and (eq (edraw-dom-tag elem) 'tspan) 846 | (string= value "line")) 847 | (cons 'class "edraw-text-line") ;;@todo If elem already has a class? 848 | ;; Otherwise discard 849 | (edraw-import-warn 'discard-unsupported-attribute 850 | (edraw-msg "Discard unsupported attribute: %s") 851 | attr-name) 852 | nil)) 853 | 854 | ;;;; XML 855 | 856 | ;;@todo Use xmltok.el? 857 | 858 | ;; https://www.w3.org/TR/xml/#NT-S 859 | (defconst edraw-xml-re-wsp "[ \t\r\n]+") 860 | (defconst edraw-xml-re-wsp-opt "[ \t\r\n]*") 861 | ;; https://www.w3.org/TR/xml/#NT-Name 862 | (defconst edraw-xml-re-name "\\(?:[_[:alpha:]][-._[:alnum:]]*\\)") 863 | (defconst edraw-xml-re-name-with-colon 864 | (concat 865 | ;; (1)(:(2))? 866 | "\\(?:\\(" edraw-xml-re-name "\\)\\(?::\\(" edraw-xml-re-name "\\)\\)?\\)")) 867 | (defconst edraw-xml-re-start 868 | (concat 869 | "<\\(?:" 870 | ;; (1) 871 | "\\(!--\\)" "\\|" 872 | ;; (2) 873 | "\\(!\\[CDATA\\[\\)" "\\|" 874 | ;; (3) 875 | "\\(\\?\\)" "\\|" 876 | ;; (4):(5) 877 | edraw-xml-re-name-with-colon 878 | "\\|" 879 | ;; (6):(7) 880 | "\\(?:/" edraw-xml-re-name-with-colon "\\)" 881 | "\\)")) 882 | ;; https://www.w3.org/TR/xml/#NT-Attribute 883 | (defconst edraw-xml-re-attr 884 | (concat 885 | edraw-xml-re-wsp 886 | ;; (1):(2) 887 | edraw-xml-re-name-with-colon 888 | edraw-xml-re-wsp-opt 889 | "=" 890 | edraw-xml-re-wsp-opt 891 | ;; (3)"..." or '...' 892 | "\\(\\(?:\"[^<&\"]*\"\\)\\|\\(?:'[^<&']*'\\)\\)")) 893 | (defconst edraw-xml-re-tag-close 894 | (concat "\\(?:" edraw-xml-re-wsp-opt "/>\\|>\\)")) 895 | 896 | (defun edraw-xml-escape-ns-buffer () 897 | "Replace tag names and attribute names related to namespace. 898 | 899 | `libxml-parse-xml-region' removes all elements related to the 900 | namespace, so replace tag and attribute names to avoid this. 901 | 902 | Make the following substitutions: 903 | 904 | <(ns):(tag) => <_ns-(ns)--(tag) 905 | _ns-(ns)--(attr) 907 | xmlns:(ns)= => _ns-xmlns--(ns) 908 | xmlns= => _ns-xmlns-- 909 | 910 | To split an escaped name string on a colon, use `edraw-xml-unescape-ns-name'." 911 | (save-excursion 912 | (goto-char (point-min)) 913 | (while (re-search-forward edraw-xml-re-start nil t) ;; Skip CharData 914 | (cond 915 | ((match-beginning 1) 916 | (search-forward "-->")) ;; error if not found 917 | ((match-beginning 2) 918 | (search-forward "]]>")) ;; error if not found 919 | ((match-beginning 3) 920 | (search-forward "?>")) ;; error if not found 921 | ((match-beginning 6) 922 | ;; Replace ")) ;; error if not found 927 | ((match-beginning 4) 928 | ;; Replace <(4):(5) with <_ns-(4)--(5) 929 | (when (match-beginning 5) 930 | (replace-match 931 | (concat "<" "_ns-" (match-string 4) "--" (match-string 5)) t)) 932 | 933 | ;; Replace attribute names 934 | (save-match-data 935 | (while (looking-at edraw-xml-re-attr) 936 | (goto-char (match-end 0)) 937 | ;; Replace (1):(2)= with _ns-(1)--(2)= 938 | ;; Replace (1:xmlns)= with _ns-(1:xmlns)--= 939 | (when (or (match-beginning 2) 940 | (equal (match-string 1) "xmlns")) 941 | (let (;;(ns-url (substring (match-string 3) 1 -1)) 942 | (name1 (match-string 1)) 943 | (name2 (match-string 2))) 944 | (save-excursion 945 | (delete-region (match-beginning 1) (or (match-end 2) 946 | (match-end 1))) 947 | (goto-char (match-beginning 1)) 948 | (insert (concat "_ns-" name1 "--" name2))))))) 949 | 950 | (unless (looking-at edraw-xml-re-tag-close) 951 | (error "XML syntax error: tag not closed")) 952 | (goto-char (match-end 0))))))) 953 | 954 | (defun edraw-xml-unescape-ns-name (name) 955 | (let ((name-str (symbol-name name))) 956 | (if (string-match "\\`_ns-\\(.+\\)--\\(.*\\)\\'" name-str) 957 | (let ((name1 (match-string 1 name-str)) 958 | (name2 (match-string 2 name-str))) 959 | (if (string= name1 "xmlns") 960 | ;; ('xmlns . "name"-or-nil) 961 | (cons (intern name1) 962 | (and (not (string-empty-p name2)) name2)) 963 | ;; ("name" . attr-or-tag) 964 | (cons name1 (intern name2)))) 965 | ;; (nil . attr-or-tag) 966 | (cons nil name)))) 967 | 968 | (defun edraw-xml-collect-ns-decls (elem) 969 | "Collect namespace declarations from DOM element ELEM. 970 | 971 | Return ((prefix-symbol-or-nil . url-string) ...)" 972 | (when (edraw-dom-element-p elem) 973 | (cl-loop for (key . value) in (edraw-dom-attributes elem) 974 | for (name1 . name2) = (edraw-xml-unescape-ns-name key) 975 | when (eq name1 'xmlns) collect (cons name2 value)))) 976 | 977 | (provide 'edraw-import) 978 | ;;; edraw-import.el ends here 979 | --------------------------------------------------------------------------------