elisp/anki-editor
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Cleanup

Browse source
This commit is contained in:
orgtre 2022-11-03 19:18:04 +01:00
parent bbe09ae0ea
commit 080d0f465a
1 changed files with 299 additions and 235 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

344
anki-editor.el
View file

@ -1,20 +1,30 @@
;;; anki-editor.el --- Minor mode for making Anki cards with Org -*- lexical-binding: t; -*- ;;; anki-editor.el --- Minor mode for making Anki cards with Org -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2018-2019 Lei Tan <louietanlei[at]gmail[dot]com> ;; Copyright (C) 2018-2022 Lei Tan <louietanlei[at]gmail[dot]com>
;;
;; Description: Make Anki Cards in Org-mode
;; Author: Lei Tan ;; Author: Lei Tan
;; Version: 0.3.3 ;; Version: 0.3.3
;; Package-Requires: ((emacs "25.1"))
;; URL: https://github.com/louietan/anki-editor ;; URL: https://github.com/louietan/anki-editor
;; Package-Requires: ((emacs "25.1"))
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or (at
;; your option) any later version.
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; ;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary: ;;; Commentary:
;; ;;
;; This package is for users of both Emacs and Anki, who'd like to ;; This package is for users of both Emacs and Anki, who'd like to
;; make Anki cards in Org mode. With this package, Anki cards can be ;; make Anki cards in Org mode. With this package, Anki cards can be
;; made from an Org buffer like below: (inspired by org-drill) ;; made from an Org buffer like below (inspired by org-drill):
;; ;;
;; * Sample :emacs:lisp:programming: ;; * Sample :emacs:lisp:programming:
;; :PROPERTIES: ;; :PROPERTIES:
@ -33,29 +43,13 @@
;; translated to Anki style. ;; translated to Anki style.
;; ;;
;; For this package to work, you have to setup these external dependencies: ;; For this package to work, you have to setup these external dependencies:
;; - curl ;; - Anki
;; - AnkiConnect, an Anki addon that runs an RPC server over HTTP to expose ;; - AnkiConnect, an Anki addon that runs an RPC server over HTTP to expose
;; Anki functions as APIs, ;; Anki functions as APIs, for installation instructions see
;; see https://github.com/FooSoft/anki-connect#installation ;; https://github.com/FooSoft/anki-connect#installation
;; for installation instructions ;; - curl
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or (at
;; your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code: ;;; Code:
(require 'cl-lib) (require 'cl-lib)
@ -68,38 +62,32 @@
"Customizations for anki-editor." "Customizations for anki-editor."
:group 'org) :group 'org)
(defcustom anki-editor-break-consecutive-braces-in-latex (defcustom anki-editor-break-consecutive-braces-in-latex nil
nil "If non-nil, automatically separate consecutive `}' in latex by spaces.
"If non-nil, consecutive `}' will be automatically separated by spaces to prevent early-closing of cloze. This prevents early closing of cloze."
See https://apps.ankiweb.net/docs/manual.html#latex-conflicts."
:type 'boolean) :type 'boolean)
(defcustom anki-editor-org-tags-as-anki-tags (defcustom anki-editor-org-tags-as-anki-tags t
t
"If nil, tags of entries won't be counted as Anki tags." "If nil, tags of entries won't be counted as Anki tags."
:type 'boolean) :type 'boolean)
(defcustom anki-editor-protected-tags (defcustom anki-editor-protected-tags '("marked" "leech")
'("marked" "leech") "A list of protected tags to not delete from Anki.
"A list of tags that won't be deleted from Anki even though These won't be deleted from Anki even when they're absent in Org entries.
they're absent in Org entries, such as special tags `marked', Useful for special tags like `marked' and `leech'."
`leech'."
:type '(repeat string)) :type '(repeat string))
(defcustom anki-editor-ignored-org-tags (defcustom anki-editor-ignored-org-tags
(append org-export-select-tags org-export-exclude-tags) (append org-export-select-tags org-export-exclude-tags)
"A list of Org tags that are ignored when constructing notes "A list of Org tags that are ignored when constructing notes."
form entries."
:type '(repeat string)) :type '(repeat string))
(defcustom anki-editor-api-host (defcustom anki-editor-api-host "127.0.0.1"
"127.0.0.1" "The network address AnkiConnect is listening on."
"The network address AnkiConnect is listening."
:type 'string) :type 'string)
(defcustom anki-editor-api-port (defcustom anki-editor-api-port "8765"
"8765" "The port number AnkiConnect is listening on."
"The port number AnkiConnect is listening."
:type 'string) :type 'string)
(defcustom anki-editor-latex-style 'builtin (defcustom anki-editor-latex-style 'builtin
@ -108,18 +96,19 @@ form entries."
(const :tag "MathJax" mathjax))) (const :tag "MathJax" mathjax)))
(defcustom anki-editor-include-default-style t (defcustom anki-editor-include-default-style t
"Wheter or not to include `org-html-style-default' when using `anki-editor-copy-styles'. "Whether to include the default style with `anki-editor-copy-styles'.
The default style is specified in `org-html-style-default'.
For example, you might want to turn this off when you are going to For example, you might want to turn this off when you are going to
provide your custom styles in `anki-editor-html-head'." provide your custom styles in `anki-editor-html-head'."
:type 'boolean) :type 'boolean)
(defcustom anki-editor-html-head nil (defcustom anki-editor-html-head nil
"Additional html tags to append to card stylings when using `anki-editor-copy-styles'. "Additional html tags to append with `anki-editor-copy-styles'.
For example, you can put custom styles or scripts in this variable." Can be used to add custom styles and scripts to card styles."
:type 'string) :type 'string)
(defcustom anki-editor-note-match nil (defcustom anki-editor-note-match nil
"Additional matching string for mapping through anki note headings. "Additional matching string for mapping through Anki note headings.
A leading logical operator like `+' or `&' is required." A leading logical operator like `+' or `&' is required."
:type 'string) :type 'string)
@ -136,7 +125,8 @@ See `anki-editor-insert-note', whose behavior this controls."
(defcustom anki-editor-default-note-type "Basic" (defcustom anki-editor-default-note-type "Basic"
"Default note type when creating anki-editor notes in org. "Default note type when creating anki-editor notes in org.
Only used when no ANKI_DEFAULT_NOTE_TYPE property is inherited.") Only used when no ANKI_DEFAULT_NOTE_TYPE property is inherited."
:type 'string)
;;; AnkiConnect ;;; AnkiConnect
@ -150,16 +140,15 @@ Only used when no ANKI_DEFAULT_NOTE_TYPE property is inherited.")
data success _error data success _error
(parser 'buffer-string) (parser 'buffer-string)
&allow-other-keys) &allow-other-keys)
"This is a simplistic little function to make http requests using cURL. "Fetch URL using curl.
The api is borrowed from request.el. It exists because The api is borrowed from request.el."
request.el's sync mode calls cURL asynchronously under the hood, ;; This exists because request.el's sync mode calls curl asynchronously under
which doesn't work on some machines (like mine) where the process ;; the hood, which doesn't work on some machines (like mine) where the process
sentinel never gets called. After some debugging of Emacs, it ;; sentinel never gets called. After some debugging of Emacs, it seems that in
seems that in 'process.c' the pselect syscall to the file ;; 'process.c' the pselect syscall to the file descriptor of inotify used by
descriptor of inotify used by 'autorevert' always returns a ;; 'autorevert' always returns a nonzero value and causes 'status_notify' never
nonzero value and causes 'status_notify' never being called. To ;; being called. To determine whether it's a bug in Emacs and make a patch
determine whether it's a bug in Emacs and make a patch requires ;; requires more digging.
more digging."
(let ((tempfile (make-temp-file "emacs-anki-editor")) (let ((tempfile (make-temp-file "emacs-anki-editor"))
(responsebuf (generate-new-buffer " *anki-editor-curl*"))) (responsebuf (generate-new-buffer " *anki-editor-curl*")))
(when data (when data
@ -198,17 +187,20 @@ more digging."
:type "POST" :type "POST"
:parser 'json-read :parser 'json-read
:data (json-encode payload) :data (json-encode payload)
:success (cl-function (lambda (&key data &allow-other-keys) :success (cl-function
(lambda (&key data &allow-other-keys)
(setq reply data))) (setq reply data)))
:error (cl-function (lambda (&key error-thrown &allow-other-keys) :error (cl-function
(lambda (&key error-thrown &allow-other-keys)
(setq err (string-trim (cdr error-thrown))))) (setq err (string-trim (cdr error-thrown)))))
:sync t) :sync t)
(when err (error "Error communicating with AnkiConnect using cURL: %s" err)) (when err
(error "Error communicating with AnkiConnect using cURL: %s" err))
(or reply (error "Got empty reply from AnkiConnect")))) (or reply (error "Got empty reply from AnkiConnect"))))
(defun anki-editor-api-call-result (&rest args) (defun anki-editor-api-call-result (&rest args)
"Invoke AnkiConnect with ARGS, return the result from response "Invoke AnkiConnect with ARGS and return the result from response.
or raise an error." Raise an error if applicable."
(let-alist (apply #'anki-editor-api-call args) (let-alist (apply #'anki-editor-api-call args)
(when .error (error .error)) (when .error (error .error))
.result)) .result))
@ -225,7 +217,7 @@ of these calls in the same order."
'multi 'multi
:actions (nreverse :actions (nreverse
;; Here we make a vector from the action list, ;; Here we make a vector from the action list,
;; or `json-encode' will consider it as an association list. ;; or `json-encode' will consider it as an alist.
(vconcat (vconcat
--anki-editor-var-multi-actions--)))) --anki-editor-var-multi-actions--))))
(cl-loop for result in --anki-editor-var-multi-results-- (cl-loop for result in --anki-editor-var-multi-results--
@ -291,7 +283,8 @@ The result is the path to the newly stored media file."
(defconst anki-editor--audio-extensions (defconst anki-editor--audio-extensions
'(".mp3" ".3gp" ".flac" ".m4a" ".oga" ".ogg" ".opus" ".spx" ".wav")) '(".mp3" ".3gp" ".flac" ".m4a" ".oga" ".ogg" ".opus" ".spx" ".wav"))
(cl-macrolet ((with-table (table) (cl-macrolet
((with-table (table)
`(cl-loop for delims in ,table `(cl-loop for delims in ,table
collect collect
(list (concat "^" (regexp-quote (cl-first delims))) (list (concat "^" (regexp-quote (cl-first delims)))
@ -316,6 +309,7 @@ The result is the path to the newly stored media file."
"$" "\\)"))))) "$" "\\)")))))
(defun anki-editor--translate-latex-fragment (latex-code) (defun anki-editor--translate-latex-fragment (latex-code)
"Translate LATEX-CODE fragment to html."
(cl-loop for delims in (cl-ecase anki-editor-latex-style (cl-loop for delims in (cl-ecase anki-editor-latex-style
(builtin anki-editor--native-latex-delimiters) (builtin anki-editor--native-latex-delimiters)
(mathjax anki-editor--mathjax-delimiters)) (mathjax anki-editor--mathjax-delimiters))
@ -329,7 +323,9 @@ The result is the path to the newly stored media file."
finally return latex-code)) finally return latex-code))
(defun anki-editor--translate-latex-env (latex-code) (defun anki-editor--translate-latex-env (latex-code)
(setq latex-code (replace-regexp-in-string "\n" "<br>" (org-html-encode-plain-text latex-code))) "Translate LATEX-CODE environment to html."
(setq latex-code (replace-regexp-in-string
"\n" "<br>" (org-html-encode-plain-text latex-code)))
(cl-ecase anki-editor-latex-style (cl-ecase anki-editor-latex-style
(builtin (concat "[latex]<br>" latex-code "[/latex]")) (builtin (concat "[latex]<br>" latex-code "[/latex]"))
(mathjax (concat "\\[<br>" latex-code "\\]")))) (mathjax (concat "\\[<br>" latex-code "\\]"))))
@ -346,9 +342,12 @@ CONTENTS is nil. INFO is a plist holding contextual information."
code))) code)))
(defun anki-editor--ox-html-link (oldfun link desc info) (defun anki-editor--ox-html-link (oldfun link desc info)
"When LINK is a link to local file, transcodes it to html and stores the target file to Anki, otherwise calls OLDFUN for help. "Export LINK and its target.
When LINK is a link to local file, transcode it to html
and store the target file to Anki, otherwise call OLDFUN for help.
The implementation is borrowed and simplified from ox-html." The implementation is borrowed and simplified from ox-html."
(or (catch 'giveup (or
(catch 'giveup
(unless (plist-get info :anki-editor-mode) (unless (plist-get info :anki-editor-mode)
(throw 'giveup nil)) (throw 'giveup nil))
@ -366,9 +365,11 @@ The implementation is borrowed and simplified from ox-html."
(when (and home (when (and home
(plist-get info :html-link-use-abs-url) (plist-get info :html-link-use-abs-url)
(file-name-absolute-p raw-path)) (file-name-absolute-p raw-path))
(setq raw-path (concat (file-name-as-directory home) raw-path))) (setq raw-path
(concat (file-name-as-directory home) raw-path)))
;; storing file to Anki and return the modified path ;; storing file to Anki and return the modified path
(anki-editor-api--store-media-file (expand-file-name (url-unhex-string raw-path))))) (anki-editor-api--store-media-file
(expand-file-name (url-unhex-string raw-path)))))
(t (throw 'giveup nil)))) (t (throw 'giveup nil))))
(attributes-plist (attributes-plist
(let* ((parent (org-export-get-parent-element link)) (let* ((parent (org-export-get-parent-element link))
@ -411,6 +412,7 @@ The implementation is borrowed and simplified from ox-html."
(funcall oldfun link desc info))) (funcall oldfun link desc info)))
(defun anki-editor--export-string (src fmt) (defun anki-editor--export-string (src fmt)
"Export string SRC and format it if FMT."
(cl-ecase fmt (cl-ecase fmt
('nil src) ('nil src)
('t (or (org-export-string-as src ('t (or (org-export-string-as src
@ -440,9 +442,12 @@ The implementation is borrowed and simplified from ox-html."
id model deck fields tags) id model deck fields tags)
(defvar anki-editor--collection-data-updated nil (defvar anki-editor--collection-data-updated nil
"Whether or not collection data is updated from Anki. Used by `anki-editor--with-collection-data-updated' to avoid unnecessary updates.") "Whether or not collection data is updated from Anki.
Used by `anki-editor--with-collection-data-updated'
to avoid unnecessary updates.")
;; The following variables should only be used inside `anki-editor--with-collection-data-updated'. ;; The following variables should only be used inside
;; `anki-editor--with-collection-data-updated'.
(defvar anki-editor--model-names nil (defvar anki-editor--model-names nil
"Note types from Anki.") "Note types from Anki.")
@ -452,7 +457,6 @@ The implementation is borrowed and simplified from ox-html."
(defmacro anki-editor--with-collection-data-updated (&rest body) (defmacro anki-editor--with-collection-data-updated (&rest body)
"Execute BODY with collection data updated from Anki. "Execute BODY with collection data updated from Anki.
Note that since we have no idea of whether BODY will update collection Note that since we have no idea of whether BODY will update collection
data, BODY might read out-dated data. This doesn't matter right now data, BODY might read out-dated data. This doesn't matter right now
as note types won't change in BODY." as note types won't change in BODY."
@ -467,16 +471,21 @@ as note types won't change in BODY."
(setq anki-editor--collection-data-updated t (setq anki-editor--collection-data-updated t
anki-editor--model-names models anki-editor--model-names models
anki-editor--model-fields anki-editor--model-fields
(cl-loop for flds in (eval `(anki-editor-api-with-multi (cl-loop
,@(cl-loop for mod in models for flds in (eval `(anki-editor-api-with-multi
collect `(anki-editor-api-enqueue 'modelFieldNames :modelName ,mod)))) ,@(cl-loop
for mod in models
collect `(anki-editor-api-enqueue
'modelFieldNames
:modelName ,mod))))
for mod in models for mod in models
collect (cons mod flds))) collect (cons mod flds)))
,@body) ,@body)
(setq anki-editor--collection-data-updated nil))))) (setq anki-editor--collection-data-updated nil)))))
(defun anki-editor-map-note-entries (func &optional match scope &rest skip) (defun anki-editor-map-note-entries (func &optional match scope &rest skip)
"Simple wrapper that calls `org-map-entries' with entries that match "Apply FUNC to each anki-editor note matching MATCH in SCOPE.
Simple wrapper that calls `org-map-entries' with entries that match
`ANKI_NOTE_TYPE<>\"\"', `anki-editor-note-match' and MATCH. `ANKI_NOTE_TYPE<>\"\"', `anki-editor-note-match' and MATCH.
A leading logical operator like `+' or `&' is required in MATCH." A leading logical operator like `+' or `&' is required in MATCH."
;; disable property inheritance temporarily, or all subheadings of a ;; disable property inheritance temporarily, or all subheadings of a
@ -530,6 +539,7 @@ see `anki-editor-insert-note' which wraps this function."
(anki-editor--update-note note)))) (anki-editor--update-note note))))
(defun anki-editor--set-note-id (id) (defun anki-editor--set-note-id (id)
"Set note-id of anki-editor note at point to ID."
(unless id (unless id
(error "Note creation failed for unknown reason")) (error "Note creation failed for unknown reason"))
(org-set-property anki-editor-prop-note-id (number-to-string id))) (org-set-property anki-editor-prop-note-id (number-to-string id)))
@ -548,17 +558,21 @@ see `anki-editor-insert-note' which wraps this function."
(defun anki-editor--update-note (note) (defun anki-editor--update-note (note)
"Request AnkiConnect for updating fields, deck, and tags of NOTE." "Request AnkiConnect for updating fields, deck, and tags of NOTE."
(let* ((oldnote (caar (anki-editor-api-with-multi (let* ((oldnote (caar (anki-editor-api-with-multi
(anki-editor-api-enqueue 'notesInfo (anki-editor-api-enqueue
'notesInfo
:notes (list (string-to-number :notes (list (string-to-number
(anki-editor-note-id note)))) (anki-editor-note-id note))))
(anki-editor-api-enqueue 'updateNoteFields (anki-editor-api-enqueue
'updateNoteFields
:note (anki-editor-api--note note))))) :note (anki-editor-api--note note)))))
(tagsadd (cl-set-difference (anki-editor-note-tags note) (tagsadd (cl-set-difference (anki-editor-note-tags note)
(alist-get 'tags oldnote) (alist-get 'tags oldnote)
:test 'string=)) :test 'string=))
(tagsdel (thread-first (alist-get 'tags oldnote) (tagsdel (thread-first (alist-get 'tags oldnote)
(cl-set-difference (anki-editor-note-tags note) :test 'string=) (cl-set-difference (anki-editor-note-tags note)
(cl-set-difference anki-editor-protected-tags :test 'string=)))) :test 'string=)
(cl-set-difference anki-editor-protected-tags
:test 'string=))))
(anki-editor-api-with-multi (anki-editor-api-with-multi
(anki-editor-api-enqueue 'changeDeck (anki-editor-api-enqueue 'changeDeck
:cards (alist-get 'cards oldnote) :cards (alist-get 'cards oldnote)
@ -589,7 +603,8 @@ see `anki-editor-insert-note' which wraps this function."
((pred (string= anki-editor-prop-deck)) (anki-editor-deck-names)) ((pred (string= anki-editor-prop-deck)) (anki-editor-deck-names))
((pred (string= anki-editor-prop-note-type)) (anki-editor-note-types)) ((pred (string= anki-editor-prop-note-type)) (anki-editor-note-types))
((pred (string= anki-editor-prop-format)) (list "t" "nil")) ((pred (string= anki-editor-prop-format)) (list "t" "nil"))
((pred (string-match-p (format "%s\\+?" anki-editor-prop-tags))) (anki-editor-all-tags)) ((pred (string-match-p (format "%s\\+?" anki-editor-prop-tags)))
(anki-editor-all-tags))
(_ nil))) (_ nil)))
(defun anki-editor-is-valid-org-tag (tag) (defun anki-editor-is-valid-org-tag (tag)
@ -612,8 +627,10 @@ see `anki-editor-insert-note' which wraps this function."
(when (and (anki-editor--enable-tag-completion) (when (and (anki-editor--enable-tag-completion)
(not just-align)) (not just-align))
(setq anki-editor--anki-tags-cache (anki-editor-all-tags)) (setq anki-editor--anki-tags-cache (anki-editor-all-tags))
(when (cl-notevery #'anki-editor-is-valid-org-tag anki-editor--anki-tags-cache) (when (cl-notevery #'anki-editor-is-valid-org-tag
(warn "Some tags from Anki contain characters that are not valid in Org tags.")))) anki-editor--anki-tags-cache)
(warn (concat "Some tags from Anki contain characters that are not"
"valid in Org tags.")))))
(defun anki-editor--get-buffer-tags (oldfun) (defun anki-editor--get-buffer-tags (oldfun)
"Append tags from Anki to the result of applying OLDFUN." "Append tags from Anki to the result of applying OLDFUN."
@ -663,7 +680,8 @@ see `anki-editor-insert-note' which wraps this function."
(exported-fields (mapcar (lambda (x) (exported-fields (mapcar (lambda (x)
(cons (cons
(car x) (car x)
(anki-editor--export-string (cdr x) format))) (anki-editor--export-string (cdr x)
format)))
fields))) fields)))
(unless deck (user-error "Missing deck")) (unless deck (user-error "Missing deck"))
(unless note-type (user-error "Missing note type")) (unless note-type (user-error "Missing note type"))
@ -681,7 +699,8 @@ see `anki-editor-insert-note' which wraps this function."
(append tags (org-get-tags)) (append tags (org-get-tags))
tags))) tags)))
(defun anki-editor--entry-get-multivalued-property-with-inheritance (pom property) (defun anki-editor--entry-get-multivalued-property-with-inheritance (pom
property)
"Return a list of values in a multivalued property with inheritance." "Return a list of values in a multivalued property with inheritance."
(let* ((value (org-entry-get pom property t)) (let* ((value (org-entry-get pom property t))
(values (and value (split-string value)))) (values (and value (split-string value))))
@ -692,7 +711,8 @@ see `anki-editor-insert-note' which wraps this function."
Return a list of cons of (FIELD-NAME . FIELD-CONTENT)." Return a list of cons of (FIELD-NAME . FIELD-CONTENT)."
(save-excursion (save-excursion
(cl-loop with inhibit-message = t ; suppress echo message from `org-babel-exp-src-block' (cl-loop with inhibit-message = t
;; suppress echo message from `org-babel-exp-src-block'
initially (unless (org-goto-first-child) initially (unless (org-goto-first-child)
(cl-return)) (cl-return))
for last-pt = (point) for last-pt = (point)
@ -703,15 +723,19 @@ Return a list of cons of (FIELD-NAME . FIELD-CONTENT)."
;; which we'd like to ignore, here we skip these ;; which we'd like to ignore, here we skip these
;; elements and reset contents-begin. ;; elements and reset contents-begin.
for begin = (save-excursion for begin = (save-excursion
(cl-loop for eoh = (org-element-property :contents-begin element) (cl-loop for eoh = (org-element-property
:contents-begin element)
then (org-element-property :end subelem) then (org-element-property :end subelem)
while eoh while eoh
for subelem = (progn for subelem = (progn
(goto-char eoh) (goto-char eoh)
(org-element-context)) (org-element-context))
while (memq (org-element-type subelem) while (memq
(org-element-type subelem)
'(drawer planning property-drawer)) '(drawer planning property-drawer))
finally return (and eoh (org-element-property :begin subelem)))) finally return (and eoh
(org-element-property
:begin subelem))))
for end = (org-element-property :contents-end element) for end = (org-element-property :contents-end element)
for raw = (or (and begin for raw = (or (and begin
end end
@ -736,7 +760,8 @@ Return a list of cons of (FIELD-NAME . FIELD-CONTENT)."
Leading whitespace, drawers, and planning content is skipped." Leading whitespace, drawers, and planning content is skipped."
(save-excursion (save-excursion
(let* ((element (org-element-at-point)) (let* ((element (org-element-at-point))
(begin (cl-loop for eoh = (org-element-property :contents-begin element) (begin (cl-loop for eoh = (org-element-property
:contents-begin element)
then (org-element-property :end subelem) then (org-element-property :end subelem)
while eoh while eoh
for subelem = (progn for subelem = (progn
@ -744,15 +769,19 @@ Leading whitespace, drawers, and planning content is skipped."
(org-element-context)) (org-element-context))
while (memq (org-element-type subelem) while (memq (org-element-type subelem)
'(drawer planning property-drawer)) '(drawer planning property-drawer))
finally return (and eoh (org-element-property :begin subelem)))) finally return (and eoh (org-element-property
(end (cl-loop for eoh = (org-element-property :contents-begin element) :begin subelem))))
(end (cl-loop for eoh = (org-element-property
:contents-begin element)
then (org-element-property :end nextelem) then (org-element-property :end nextelem)
while eoh while eoh
for nextelem = (progn for nextelem = (progn
(goto-char eoh) (goto-char eoh)
(org-element-at-point)) (org-element-at-point))
while (not (memq (org-element-type nextelem) '(headline))) while (not (memq (org-element-type nextelem)
finally return (and eoh (org-element-property :begin nextelem)))) '(headline)))
finally return (and eoh (org-element-property
:begin nextelem))))
(contents-raw (or (and begin (contents-raw (or (and begin
end end
(buffer-substring-no-properties (buffer-substring-no-properties
@ -799,7 +828,7 @@ Return a list of cons of (FIELD-NAME . FIELD-CONTENT)."
nil nil #'string=))))) nil nil #'string=)))))
(cond ((equal 0 (length fields-missing)) (cond ((equal 0 (length fields-missing))
(when (< 0 (length fields-extra)) (when (< 0 (length fields-extra))
(user-error "Failed to map all subheadings to a field."))) (user-error "Failed to map all subheadings to a field")))
((equal 1 (length fields-missing)) ((equal 1 (length fields-missing))
(if (equal 0 (length fields-extra)) (if (equal 0 (length fields-extra))
(if (equal "" (string-trim content-before-subheading)) (if (equal "" (string-trim content-before-subheading))
@ -860,7 +889,8 @@ Return a list of cons of (FIELD-NAME . FIELD-CONTENT)."
heading) heading)
fields))))) fields)))))
((< 2 (length fields-missing)) ((< 2 (length fields-missing))
(user-error "Cannot map note fields: More than two fields missing."))) (user-error (concaat "Cannot map note fields: "
"more than two fields missing"))))
fields))) fields)))
(defun anki-editor--concat-fields (field-names field-alist level) (defun anki-editor--concat-fields (field-names field-alist level)
@ -868,7 +898,8 @@ Return a list of cons of (FIELD-NAME . FIELD-CONTENT)."
(let ((format (anki-editor-entry-format))) (let ((format (anki-editor-entry-format)))
(cl-loop for f in field-names (cl-loop for f in field-names
concat (concat (make-string (+ 1 level) ?*) " " f "\n\n" concat (concat (make-string (+ 1 level) ?*) " " f "\n\n"
(string-trim (alist-get f field-alist nil nil #'string=)) (string-trim (alist-get f field-alist nil nil
#'string=))
"\n\n")))) "\n\n"))))
@ -891,14 +922,16 @@ Return a list of cons of (FIELD-NAME . FIELD-CONTENT)."
(append org-properties-postprocess-alist (append org-properties-postprocess-alist
(list (cons anki-editor-prop-tags (list (cons anki-editor-prop-tags
(lambda (value) (lambda (value)
(anki-editor--concat-multivalued-property-value anki-editor-prop-tags value))) (anki-editor--concat-multivalued-property-value
anki-editor-prop-tags value)))
(cons anki-editor-prop-tags-plus (cons anki-editor-prop-tags-plus
(lambda (value) (lambda (value)
(anki-editor--concat-multivalued-property-value anki-editor-prop-tags-plus value)))))) (anki-editor--concat-multivalued-property-value
anki-editor-prop-tags-plus value))))))
;;;###autoload ;;;###autoload
(define-minor-mode anki-editor-mode (define-minor-mode anki-editor-mode
"anki-editor-mode" "A minor mode for making Anki cards with Org."
:lighter " anki-editor" :lighter " anki-editor"
(if anki-editor-mode (anki-editor-setup-minor-mode) (if anki-editor-mode (anki-editor-setup-minor-mode)
(anki-editor-teardown-minor-mode))) (anki-editor-teardown-minor-mode)))
@ -906,14 +939,16 @@ Return a list of cons of (FIELD-NAME . FIELD-CONTENT)."
(defun anki-editor-setup-minor-mode () (defun anki-editor-setup-minor-mode ()
"Set up this minor mode." "Set up this minor mode."
(anki-editor-api-check) (anki-editor-api-check)
(add-hook 'org-property-allowed-value-functions #'anki-editor--get-allowed-values-for-property nil t) (add-hook 'org-property-allowed-value-functions
#'anki-editor--get-allowed-values-for-property nil t)
(advice-add 'org-set-tags :before #'anki-editor--before-set-tags) (advice-add 'org-set-tags :before #'anki-editor--before-set-tags)
(advice-add 'org-get-buffer-tags :around #'anki-editor--get-buffer-tags) (advice-add 'org-get-buffer-tags :around #'anki-editor--get-buffer-tags)
(advice-add 'org-html-link :around #'anki-editor--ox-html-link)) (advice-add 'org-html-link :around #'anki-editor--ox-html-link))
(defun anki-editor-teardown-minor-mode () (defun anki-editor-teardown-minor-mode ()
"Tear down this minor mode." "Tear down this minor mode."
(remove-hook 'org-property-allowed-value-functions #'anki-editor--get-allowed-values-for-property t)) (remove-hook 'org-property-allowed-value-functions
#'anki-editor--get-allowed-values-for-property t))
;;; Commands ;;; Commands
@ -926,7 +961,7 @@ Return a list of cons of (FIELD-NAME . FIELD-CONTENT)."
(push (point-marker) anki-editor--note-markers)) (push (point-marker) anki-editor--note-markers))
(defun anki-editor-push-notes (&optional scope match) (defun anki-editor-push-notes (&optional scope match)
"Build notes from headings that match MATCH within SCOPE and push them to Anki. "Build notes from headings that MATCH within SCOPE and push them to Anki.
The default search condition `&ANKI_NOTE_TYPE<>\"\"' will always The default search condition `&ANKI_NOTE_TYPE<>\"\"' will always
be appended to MATCH. be appended to MATCH.
@ -955,7 +990,8 @@ of that heading."
(t nil)))) (t nil))))
(unwind-protect (unwind-protect
(progn (progn
(anki-editor-map-note-entries #'anki-editor--collect-note-marker match scope) (anki-editor-map-note-entries
#'anki-editor--collect-note-marker match scope)
(setq anki-editor--note-markers (reverse anki-editor--note-markers)) (setq anki-editor--note-markers (reverse anki-editor--note-markers))
(let ((count 0) (let ((count 0)
(failed 0)) (failed 0))
@ -963,17 +999,23 @@ of that heading."
(anki-editor--with-collection-data-updated (anki-editor--with-collection-data-updated
(cl-loop with bar-width = 30 (cl-loop with bar-width = 30
for marker in anki-editor--note-markers for marker in anki-editor--note-markers
for progress = (/ (float (cl-incf count)) (length anki-editor--note-markers)) for progress = (/ (float (cl-incf count))
(length anki-editor--note-markers))
do do
(goto-char marker) (goto-char marker)
(message "Uploading notes in buffer %s%s [%s%s] %d/%d (%.2f%%)" (message
"Uploading notes in buffer %s%s [%s%s] %d/%d (%.2f%%)"
(marker-buffer marker) (marker-buffer marker)
(if (zerop failed) (if (zerop failed)
"" ""
(propertize (format " %d failed" failed) (propertize (format " %d failed" failed)
'face `(:foreground "red"))) 'face `(:foreground "red")))
(make-string (truncate (* bar-width progress)) ?#) (make-string (truncate (* bar-width progress))
(make-string (- bar-width (truncate (* bar-width progress))) ?.) ?#)
(make-string (- bar-width
(truncate (* bar-width
progress)))
?.)
count count
(length anki-editor--note-markers) (length anki-editor--note-markers)
(* 100 progress)) (* 100 progress))
@ -981,15 +1023,22 @@ of that heading."
(condition-case-unless-debug err (condition-case-unless-debug err
(anki-editor--push-note (anki-editor-note-at-point)) (anki-editor--push-note (anki-editor-note-at-point))
(error (cl-incf failed) (error (cl-incf failed)
(anki-editor--set-failure-reason (error-message-string err)))) (anki-editor--set-failure-reason
(error-message-string err))))
;; free marker ;; free marker
(set-marker marker nil)))) (set-marker marker nil))))
(message (message
(cond (cond
((zerop (length anki-editor--note-markers)) "Nothing to push") ((zerop (length anki-editor--note-markers))
((zerop failed) (format "Successfully pushed %d notes to Anki" count)) "Nothing to push")
(t (format "Pushed %d notes to Anki, with %d failed. Check property drawers for details. ((zerop failed)
When you have fixed those issues, try re-push the failed ones with `anki-editor-retry-failed-notes'." (format "Successfully pushed %d notes to Anki" count))
(t
(format (concat "Pushed %d notes to Anki, with %d failed. "
"Check property drawers for details. "
"\nWhen you have fixed those issues, "
"try re-push the failed ones with "
"\n`anki-editor-retry-failed-notes'.")
count failed)))))) count failed))))))
;; clean up markers ;; clean up markers
(cl-loop for m in anki-editor--note-markers (cl-loop for m in anki-editor--note-markers
@ -1011,7 +1060,7 @@ subtree associated with the first heading that has one."
(org-entry-get nil anki-editor-prop-note-type))) (org-entry-get nil anki-editor-prop-note-type)))
(org-up-heading-safe))) (org-up-heading-safe)))
(if (not note-type) (if (not note-type)
(user-error "No note to push found.") (user-error "No note to push found")
(anki-editor--push-note (anki-editor-note-at-point)) (anki-editor--push-note (anki-editor-note-at-point))
(message "Successfully pushed note at point to Anki."))))) (message "Successfully pushed note at point to Anki.")))))
@ -1022,16 +1071,20 @@ subtree associated with the first heading that has one."
(defun anki-editor-retry-failed-notes (&optional scope) (defun anki-editor-retry-failed-notes (&optional scope)
"Retry pushing notes marked as failed. "Retry pushing notes marked as failed.
This command just calls `anki-editor-submit' with match string This command just calls `anki-editor-push-notes' with match string
matching non-empty `ANKI_FAILURE_REASON' properties." matching non-empty `ANKI_FAILURE_REASON' properties."
(interactive) (interactive)
(anki-editor-push-notes scope (concat anki-editor-prop-failure-reason "<>\"\""))) (anki-editor-push-notes scope
(concat anki-editor-prop-failure-reason "<>\"\"")))
(defun anki-editor-delete-notes (noteids) (defun anki-editor-delete-notes (noteids)
"Delete notes in NOTEIDS or the note at point." "Delete notes in NOTEIDS or the note at point."
(interactive (list (list (org-entry-get nil anki-editor-prop-note-id)))) (interactive (list (list (org-entry-get nil anki-editor-prop-note-id))))
(when (or (not (called-interactively-p 'interactive)) (when (or (not (called-interactively-p 'interactive))
(yes-or-no-p (format "Do you really want to delete note %s? The deletion can't be undone. " (nth 0 noteids)))) (yes-or-no-p
(format (concat "Do you really want to delete note %s? "
"This can't be undone.")
(nth 0 noteids))))
(anki-editor-api-call-result 'deleteNotes (anki-editor-api-call-result 'deleteNotes
:notes noteids) :notes noteids)
(org-entry-delete nil anki-editor-prop-note-id) (org-entry-delete nil anki-editor-prop-note-id)
@ -1124,11 +1177,13 @@ Otherwise this command is like `anki-editor-set-note-type'."
(anki-editor-cloze (region-beginning) (region-end) arg hint)) (anki-editor-cloze (region-beginning) (region-end) arg hint))
(defun anki-editor-cloze-dwim (&optional arg hint) (defun anki-editor-cloze-dwim (&optional arg hint)
"Cloze current active region or a word the under the cursor" "Cloze current active region or a word the under the cursor."
(interactive "p\nsHint (optional): ") (interactive "p\nsHint (optional): ")
(cond (cond
((region-active-p) (anki-editor-cloze (region-beginning) (region-end) arg hint)) ((region-active-p)
((thing-at-point 'word) (let ((bounds (bounds-of-thing-at-point 'word))) (anki-editor-cloze (region-beginning) (region-end) arg hint))
((thing-at-point 'word)
(let ((bounds (bounds-of-thing-at-point 'word)))
(anki-editor-cloze (car bounds) (cdr bounds) arg hint))) (anki-editor-cloze (car bounds) (cdr bounds) arg hint)))
(t (user-error "Nothing to create cloze from")))) (t (user-error "Nothing to create cloze from"))))
@ -1147,7 +1202,8 @@ Otherwise this command is like `anki-editor-set-note-type'."
(interactive) (interactive)
(org-export-to-buffer (org-export-to-buffer
anki-editor--ox-anki-html-backend anki-editor--ox-anki-html-backend
"*AnkiEditor HTML Output*" nil t nil t anki-editor--ox-export-ext-plist #'html-mode)) "*AnkiEditor HTML Output*" nil t nil t
anki-editor--ox-export-ext-plist #'html-mode))
(defun anki-editor-convert-region-to-html () (defun anki-editor-convert-region-to-html ()
"Convert and replace region to HTML." "Convert and replace region to HTML."
@ -1169,11 +1225,11 @@ Otherwise this command is like `anki-editor-set-note-type'."
(if (<= anki-editor-api-version ver) (if (<= anki-editor-api-version ver)
(when (called-interactively-p 'interactive) (when (called-interactively-p 'interactive)
(message "AnkiConnect v.%d is running" ver)) (message "AnkiConnect v.%d is running" ver))
(user-error "anki-editor requires minimal version %d of AnkiConnect installed" (user-error "anki-editor requires at least version %d of AnkiConnect"
anki-editor-api-version)))) anki-editor-api-version))))
(defun anki-editor-sync-collections () (defun anki-editor-sync-collections ()
"Synchronizes the local anki collections with ankiweb." "Synchronizes the local Anki collections with AnkiWeb."
(interactive) (interactive)
(anki-editor-api-call-result 'sync)) (anki-editor-api-call-result 'sync))
@ -1181,7 +1237,9 @@ Otherwise this command is like `anki-editor-set-note-type'."
"Open Anki Browser with QUERY. "Open Anki Browser with QUERY.
When called interactively, it will try to set QUERY to current When called interactively, it will try to set QUERY to current
note or deck." note or deck."
(interactive (list (pcase (org-entry-get-with-inheritance anki-editor-prop-note-id) (interactive
(list
(pcase (org-entry-get-with-inheritance anki-editor-prop-note-id)
((and (pred stringp) nid) (format "nid:%s" nid)) ((and (pred stringp) nid) (format "nid:%s" nid))
(_ (format "deck:%s" (_ (format "deck:%s"
(or (org-entry-get-with-inheritance anki-editor-prop-deck) (or (org-entry-get-with-inheritance anki-editor-prop-deck)
@ -1189,8 +1247,7 @@ note or deck."
(anki-editor-api-call 'guiBrowse :query (or query ""))) (anki-editor-api-call 'guiBrowse :query (or query "")))
(defun anki-editor-gui-add-cards () (defun anki-editor-gui-add-cards ()
"Open Anki Add Cards dialog with presets from current note "Open Anki Add Cards dialog with presets from current note entry."
entry."
(interactive) (interactive)
(anki-editor-api-call-result 'guiAddCards (anki-editor-api-call-result 'guiAddCards
:note (append :note (append
@ -1211,16 +1268,20 @@ entry."
(defvar anki-editor--style-end "<!-- Emacs Org-mode }} -->\n<style>") (defvar anki-editor--style-end "<!-- Emacs Org-mode }} -->\n<style>")
(defun anki-editor-copy-styles () (defun anki-editor-copy-styles ()
"Copy `org-html-style-default' and `anki-editor-html-head' to Anki card stylings." "Copy `org-html-style-default' and `anki-editor-html-head' to Anki."
(interactive) (interactive)
(let ((head (concat (org-element-normalize-string anki-editor--style-start) (let ((head (concat (org-element-normalize-string anki-editor--style-start)
(org-element-normalize-string (format "<!-- Updated: %s -->" (current-time-string))) (org-element-normalize-string
(format "<!-- Updated: %s -->" (current-time-string)))
(when anki-editor-include-default-style (when anki-editor-include-default-style
(org-element-normalize-string org-html-style-default)) (org-element-normalize-string org-html-style-default))
(org-element-normalize-string anki-editor-html-head) (org-element-normalize-string anki-editor-html-head)
anki-editor--style-end))) anki-editor--style-end)))
(cl-loop for model in (anki-editor-note-types) (cl-loop for model in (anki-editor-note-types)
for style = (let* ((css (alist-get 'css (anki-editor-api-call-result 'modelStyling :modelName model))) for style = (let* ((css (alist-get
'css
(anki-editor-api-call-result
'modelStyling :modelName model)))
(start (string-match (start (string-match
(regexp-quote anki-editor--style-start) (regexp-quote anki-editor--style-start)
css)) css))
@ -1231,7 +1292,8 @@ entry."
(progn (progn
(cl-incf end (length anki-editor--style-end)) (cl-incf end (length anki-editor--style-end))
;; skip whitespaces ;; skip whitespaces
(when-let ((newend (string-match "[[:graph:]]" css end))) (when-let ((newend (string-match
"[[:graph:]]" css end)))
(setq end newend)) (setq end newend))
(concat (concat
(substring css 0 start) (substring css 0 start)
@ -1239,16 +1301,18 @@ entry."
css)) css))
do do
(message "Updating styles for \"%s\"..." model) (message "Updating styles for \"%s\"..." model)
(anki-editor-api-call-result 'updateModelStyling (anki-editor-api-call-result
'updateModelStyling
:model (list :name model :model (list :name model
:css (concat (concat head "\n\n") style))) :css (concat (concat head "\n\n") style)))
finally do (message "Updating styles...Done")))) finally do (message "Updating styles...Done"))))
(defun anki-editor-remove-styles () (defun anki-editor-remove-styles ()
"Remove from card stylings html tags generated by this mode." "Remove html tags generated by this mode from card styles."
(interactive) (interactive)
(cl-loop for model in (anki-editor-note-types) (cl-loop for model in (anki-editor-note-types)
for css = (alist-get 'css (anki-editor-api-call-result 'modelStyling :modelName model)) for css = (alist-get 'css (anki-editor-api-call-result
'modelStyling :modelName model))
for start = (string-match for start = (string-match
(regexp-quote anki-editor--style-start) (regexp-quote anki-editor--style-start)
css) css)
@ -1273,5 +1337,5 @@ entry."
(provide 'anki-editor) (provide 'anki-editor)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; anki-editor.el ends here ;;; anki-editor.el ends here