123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417 |
- ;; -*- coding: utf-8-unix -*-
- ;;; org-drill.el - Self-testing using spaced repetition
- ;;;
- ;;; Copyright (C) 2010-2015 Paul Sexton
- ;;;
- ;;; Author: Paul Sexton <eeeickythump@gmail.com>
- ;;; Version: 2.4.7
- ;;; Keywords: flashcards, memory, learning, memorization
- ;;; Repository at http://bitbucket.org/eeeickythump/org-drill/
- ;;;
- ;;; This file is not part of GNU Emacs.
- ;;;
- ;;; 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 distaributed in the hope that it will be useful,
- ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- ;;; GNU General Public License for more details.
- ;;;
- ;;; You should have received a copy of the GNU General Public License
- ;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
- ;;;
- ;;;
- ;;; Synopsis
- ;;; ========
- ;;;
- ;;; Uses the SuperMemo spaced repetition algorithms to conduct interactive
- ;;; "drill sessions", where the material to be remembered is presented to the
- ;;; student in random order. The student rates his or her recall of each item,
- ;;; and this information is used to schedule the item for later revision.
- ;;;
- ;;; Each drill session can be restricted to topics in the current buffer
- ;;; (default), one or several files, all agenda files, or a subtree. A single
- ;;; topic can also be drilled.
- ;;;
- ;;; Different "card types" can be defined, which present their information to
- ;;; the student in different ways.
- ;;;
- ;;; See the file README.org for more detailed documentation.
- (eval-when-compile (require 'cl))
- (eval-when-compile (require 'hi-lock))
- (require 'cl-lib)
- (require 'hi-lock)
- (require 'org)
- (require 'org-id)
- (require 'org-learn)
- (require 'savehist)
- (defgroup org-drill nil
- "Options concerning interactive drill sessions in Org mode (org-drill)."
- :tag "Org-Drill"
- :group 'org-link)
- (defcustom org-drill-question-tag
- "drill"
- "Tag which topics must possess in order to be identified as review topics
- by `org-drill'."
- :group 'org-drill
- :type 'string)
- (defcustom org-drill-maximum-items-per-session
- 30
- "Each drill session will present at most this many topics for review.
- Nil means unlimited."
- :group 'org-drill
- :type '(choice integer (const nil)))
- (defcustom org-drill-maximum-duration
- 20
- "Maximum duration of a drill session, in minutes.
- Nil means unlimited."
- :group 'org-drill
- :type '(choice integer (const nil)))
- (defcustom org-drill-failure-quality
- 2
- "If the quality of recall for an item is this number or lower,
- it is regarded as an unambiguous failure, and the repetition
- interval for the card is reset to 0 days. If the quality is higher
- than this number, it is regarded as successfully recalled, but the
- time interval to the next repetition will be lowered if the quality
- was near to a fail.
- By default this is 2, for SuperMemo-like behaviour. For
- Mnemosyne-like behaviour, set it to 1. Other values are not
- really sensible."
- :group 'org-drill
- :type '(choice (const 2) (const 1)))
- (defcustom org-drill-forgetting-index
- 10
- "What percentage of items do you consider it is 'acceptable' to
- forget each drill session? The default is 10%. A warning message
- is displayed at the end of the session if the percentage forgotten
- climbs above this number."
- :group 'org-drill
- :type 'integer)
- (defcustom org-drill-leech-failure-threshold
- 15
- "If an item is forgotten more than this many times, it is tagged
- as a 'leech' item."
- :group 'org-drill
- :type '(choice integer (const nil)))
- (defcustom org-drill-leech-method
- 'skip
- "How should 'leech items' be handled during drill sessions?
- Possible values:
- - nil :: Leech items are treated the same as normal items.
- - skip :: Leech items are not included in drill sessions.
- - warn :: Leech items are still included in drill sessions,
- but a warning message is printed when each leech item is
- presented."
- :group 'org-drill
- :type '(choice (const warn) (const skip) (const nil)))
- (defface org-drill-visible-cloze-face
- '((t (:foreground "darkseagreen")))
- "The face used to hide the contents of cloze phrases."
- :group 'org-drill)
- (defface org-drill-visible-cloze-hint-face
- '((t (:foreground "dark slate blue")))
- "The face used to hide the contents of cloze phrases."
- :group 'org-drill)
- (defface org-drill-hidden-cloze-face
- '((t (:foreground "deep sky blue" :background "blue")))
- "The face used to hide the contents of cloze phrases."
- :group 'org-drill)
- (defcustom org-drill-use-visible-cloze-face-p
- nil
- "Use a special face to highlight cloze-deleted text in org mode
- buffers?"
- :group 'org-drill
- :type 'boolean)
- (defcustom org-drill-hide-item-headings-p
- nil
- "Conceal the contents of the main heading of each item during drill
- sessions? You may want to enable this behaviour if item headings or tags
- contain information that could 'give away' the answer."
- :group 'org-drill
- :type 'boolean)
- (defcustom org-drill-new-count-color
- "royal blue"
- "Foreground colour used to display the count of remaining new items
- during a drill session."
- :group 'org-drill
- :type 'color)
- (defcustom org-drill-mature-count-color
- "green"
- "Foreground colour used to display the count of remaining mature items
- during a drill session. Mature items are due for review, but are not new."
- :group 'org-drill
- :type 'color)
- (defcustom org-drill-failed-count-color
- "red"
- "Foreground colour used to display the count of remaining failed items
- during a drill session."
- :group 'org-drill
- :type 'color)
- (defcustom org-drill-done-count-color
- "sienna"
- "Foreground colour used to display the count of reviewed items
- during a drill session."
- :group 'org-drill
- :type 'color)
- (defcustom org-drill-left-cloze-delimiter
- "["
- "String used within org buffers to delimit cloze deletions."
- :group 'org-drill
- :type 'string)
- (defcustom org-drill-right-cloze-delimiter
- "]"
- "String used within org buffers to delimit cloze deletions."
- :group 'org-drill
- :type 'string)
- (setplist 'org-drill-cloze-overlay-defaults
- `(display ,(format "%s...%s"
- org-drill-left-cloze-delimiter
- org-drill-right-cloze-delimiter)
- face org-drill-hidden-cloze-face
- window t))
- (setplist 'org-drill-hidden-text-overlay
- '(invisible t))
- (setplist 'org-drill-replaced-text-overlay
- '(display "Replaced text"
- face default
- window t))
- (add-hook 'org-font-lock-set-keywords-hook 'org-drill-add-cloze-fontification)
- (defvar org-drill-hint-separator "||"
- "String which, if it occurs within a cloze expression, signifies that the
- rest of the expression after the string is a `hint', to be displayed instead of
- the hidden cloze during a test.")
- (defun org-drill--compute-cloze-regexp ()
- (concat "\\("
- (regexp-quote org-drill-left-cloze-delimiter)
- "[[:cntrl:][:graph:][:space:]]+?\\)\\(\\|"
- (regexp-quote org-drill-hint-separator)
- ".+?\\)\\("
- (regexp-quote org-drill-right-cloze-delimiter)
- "\\)"))
- (defun org-drill--compute-cloze-keywords ()
- (list (list (org-drill--compute-cloze-regexp)
- (copy-list '(1 'org-drill-visible-cloze-face nil))
- (copy-list '(2 'org-drill-visible-cloze-hint-face t))
- (copy-list '(3 'org-drill-visible-cloze-face nil))
- )))
- (defvar-local org-drill-cloze-regexp
- (org-drill--compute-cloze-regexp))
- (defvar-local org-drill-cloze-keywords
- (org-drill--compute-cloze-keywords))
- ;; Variables defining what keys can be pressed during drill sessions to quit the
- ;; session, edit the item, etc.
- (defvar org-drill--quit-key ?q
- "If this character is pressed during a drill session, quit the session.")
- (defvar org-drill--edit-key ?e
- "If this character is pressed during a drill session, suspend the session
- with the cursor at the current item..")
- (defvar org-drill--help-key ??
- "If this character is pressed during a drill session, show help.")
- (defvar org-drill--skip-key ?s
- "If this character is pressed during a drill session, skip to the next
- item.")
- (defvar org-drill--tags-key ?t
- "If this character is pressed during a drill session, edit the tags for
- the current item.")
- (defvar org-drill--pronounce-key ?p
- "If this character is pressed during a drill session, pronounce for
- the current item.")
- (defcustom org-drill-card-type-alist
- '((nil org-drill-present-simple-card)
- ("simple" org-drill-present-simple-card)
- ("twosided" org-drill-present-two-sided-card nil t)
- ("multisided" org-drill-present-multi-sided-card nil t)
- ("hide1cloze" org-drill-present-multicloze-hide1)
- ("hide2cloze" org-drill-present-multicloze-hide2)
- ("show1cloze" org-drill-present-multicloze-show1)
- ("show2cloze" org-drill-present-multicloze-show2)
- ("multicloze" org-drill-present-multicloze-hide1)
- ("hidefirst" org-drill-present-multicloze-hide-first)
- ("hidelast" org-drill-present-multicloze-hide-last)
- ("hide1_firstmore" org-drill-present-multicloze-hide1-firstmore)
- ("show1_lastmore" org-drill-present-multicloze-show1-lastmore)
- ("show1_firstless" org-drill-present-multicloze-show1-firstless)
- ("conjugate"
- org-drill-present-verb-conjugation
- org-drill-show-answer-verb-conjugation)
- ("decline_noun"
- org-drill-present-noun-declension
- org-drill-show-answer-noun-declension)
- ("spanish_verb" org-drill-present-spanish-verb)
- ("translate_number" org-drill-present-translate-number))
- "Alist associating card types with presentation functions. Each
- entry in the alist takes the form:
- ;;; (CARDTYPE QUESTION-FN [ANSWER-FN DRILL-EMPTY-P])
- Where CARDTYPE is a string or nil (for default), and QUESTION-FN
- is a function which takes no arguments and returns a boolean
- value.
- When supplied, ANSWER-FN is a function that takes one argument --
- that argument is a function of no arguments, which when called,
- prompts the user to rate their recall and performs rescheduling
- of the drill item. ANSWER-FN is called with the point on the
- active item's heading, just prior to displaying the item's
- 'answer'. It can therefore be used to modify the appearance of
- the answer. ANSWER-FN must call its argument before returning.
- When supplied, DRILL-EMPTY-P is a boolean value, default nil.
- When non-nil, cards of this type will be presented during tests
- even if their bodies are empty."
- :group 'org-drill
- :type '(alist :key-type (choice string (const nil))
- :value-type function))
- (defcustom org-drill-scope
- 'file
- "The scope in which to search for drill items when conducting a
- drill session. This can be any of:
- file The current buffer, respecting the restriction if any.
- This is the default.
- tree The subtree started with the entry at point
- file-no-restriction The current buffer, without restriction
- file-with-archives The current buffer, and any archives associated with it.
- agenda All agenda files
- agenda-with-archives All agenda files with any archive files associated
- with them.
- directory All files with the extension '.org' in the same
- directory as the current file (includes the current
- file if it is an .org file.)
- (FILE1 FILE2 ...) If this is a list, all files in the list will be scanned.
- "
- ;; Note -- meanings differ slightly from the argument to org-map-entries:
- ;; 'file' means current file/buffer, respecting any restriction
- ;; 'file-no-restriction' means current file/buffer, ignoring restrictions
- ;; 'directory' means all *.org files in current directory
- :group 'org-drill
- :type '(choice (const :tag "The current buffer, respecting the restriction if any." file)
- (const :tag "The subtree started with the entry at point" tree)
- (const :tag "The current buffer, without restriction" file-no-restriction)
- (const :tag "The current buffer, and any archives associated with it." file-with-archives)
- (const :tag "All agenda files" agenda)
- (const :tag "All agenda files with any archive files associated with them." agenda-with-archives)
- (const :tag "All files with the extension '.org' in the same directory as the current file (includes the current file if it is an .org file.)" directory)
- (repeat :tag "List of files to scan for drill items." file)))
- (defcustom org-drill-match
- nil
- "If non-nil, a string specifying a tags/property/TODO query. During
- drill sessions, only items that match this query will be considered."
- :group 'org-drill
- :type '(choice (const nil) string))
- (defcustom org-drill-save-buffers-after-drill-sessions-p
- t
- "If non-nil, prompt to save all modified buffers after a drill session
- finishes."
- :group 'org-drill
- :type 'boolean)
- (defcustom org-drill-spaced-repetition-algorithm
- 'sm5
- "Which SuperMemo spaced repetition algorithm to use for scheduling items.
- Available choices are:
- - SM2 :: the SM2 algorithm, used in SuperMemo 2.0
- - SM5 :: the SM5 algorithm, used in SuperMemo 5.0
- - Simple8 :: a modified version of the SM8 algorithm. SM8 is used in
- SuperMemo 98. The version implemented here is simplified in that while it
- 'learns' the difficulty of each item using quality grades and number of
- failures, it does not modify the matrix of values that
- governs how fast the inter-repetition intervals increase. A method for
- adjusting intervals when items are reviewed early or late has been taken
- from SM11, a later version of the algorithm, and included in Simple8."
- :group 'org-drill
- :type '(choice (const sm2) (const sm5) (const simple8)))
- (defcustom org-drill-optimal-factor-matrix
- nil
- "Obsolete and will be removed in future. The SM5 optimal factor
- matrix data is now stored in the variable
- `org-drill-sm5-optimal-factor-matrix'."
- :group 'org-drill
- :type 'sexp)
- (defvar org-drill-sm5-optimal-factor-matrix
- nil
- "DO NOT CHANGE THE VALUE OF THIS VARIABLE.
- Persistent matrix of optimal factors, used by the SuperMemo SM5
- algorithm. The matrix is saved at the end of each drill session.
- Over time, values in the matrix will adapt to the individual user's
- pace of learning.")
- (add-to-list 'savehist-additional-variables
- 'org-drill-sm5-optimal-factor-matrix)
- (unless savehist-mode
- (savehist-mode 1))
- (defun org-drill--transfer-optimal-factor-matrix ()
- (if (and org-drill-optimal-factor-matrix
- (null org-drill-sm5-optimal-factor-matrix))
- (setq org-drill-sm5-optimal-factor-matrix
- org-drill-optimal-factor-matrix)))
- (add-hook 'after-init-hook 'org-drill--transfer-optimal-factor-matrix)
- (defcustom org-drill-sm5-initial-interval
- 4.0
- "In the SM5 algorithm, the initial interval after the first
- successful presentation of an item is always 4 days. If you wish to change
- this, you can do so here."
- :group 'org-drill
- :type 'float)
- (defcustom org-drill-add-random-noise-to-intervals-p
- nil
- "If true, the number of days until an item's next repetition
- will vary slightly from the interval calculated by the SM2
- algorithm. The variation is very small when the interval is
- small, but scales up with the interval."
- :group 'org-drill
- :type 'boolean)
- (defcustom org-drill-adjust-intervals-for-early-and-late-repetitions-p
- nil
- "If true, when the student successfully reviews an item 1 or more days
- before or after the scheduled review date, this will affect that date of
- the item's next scheduled review, according to the algorithm presented at
- [[http://www.supermemo.com/english/algsm11.htm#Advanced%20repetitions]].
- Items that were reviewed early will have their next review date brought
- forward. Those that were reviewed late will have their next review
- date postponed further.
- Note that this option currently has no effect if the SM2 algorithm
- is used."
- :group 'org-drill
- :type 'boolean)
- (defcustom org-drill-cloze-text-weight
- 4
- "For card types 'hide1_firstmore', 'show1_lastmore' and 'show1_firstless',
- this number determines how often the 'less favoured' situation
- should arise. It will occur 1 in every N trials, where N is the
- value of the variable.
- For example, with the hide1_firstmore card type, the first piece
- of clozed text should be hidden more often than the other
- pieces. If this variable is set to 4 (default), the first item
- will only be shown 25% of the time (1 in 4 trials). Similarly for
- show1_lastmore, the last item will be shown 75% of the time, and
- for show1_firstless, the first item would only be shown 25% of the
- time.
- If the value of this variable is NIL, then weighting is disabled, and
- all weighted card types are treated as their unweighted equivalents."
- :group 'org-drill
- :type '(choice integer (const nil)))
- (defcustom org-drill-cram-hours
- 12
- "When in cram mode, items are considered due for review if
- they were reviewed at least this many hours ago."
- :group 'org-drill
- :type 'integer)
- ;;; NEW items have never been presented in a drill session before.
- ;;; MATURE items HAVE been presented at least once before.
- ;;; - YOUNG mature items were scheduled no more than
- ;;; ORG-DRILL-DAYS-BEFORE-OLD days after their last
- ;;; repetition. These items will have been learned 'recently' and will have a
- ;;; low repetition count.
- ;;; - OLD mature items have intervals greater than
- ;;; ORG-DRILL-DAYS-BEFORE-OLD.
- ;;; - OVERDUE items are past their scheduled review date by more than
- ;;; LAST-INTERVAL * (ORG-DRILL-OVERDUE-INTERVAL-FACTOR - 1) days,
- ;;; regardless of young/old status.
- (defcustom org-drill-days-before-old
- 10
- "When an item's inter-repetition interval rises above this value in days,
- it is no longer considered a 'young' (recently learned) item."
- :group 'org-drill
- :type 'integer)
- (defcustom org-drill-overdue-interval-factor
- 1.2
- "An item is considered overdue if its scheduled review date is
- more than (ORG-DRILL-OVERDUE-INTERVAL-FACTOR - 1) * LAST-INTERVAL
- days in the past. For example, a value of 1.2 means an additional
- 20% of the last scheduled interval is allowed to elapse before
- the item is overdue. A value of 1.0 means no extra time is
- allowed at all - items are immediately considered overdue if
- there is even one day's delay in reviewing them. This variable
- should never be less than 1.0."
- :group 'org-drill
- :type 'float)
- (defcustom org-drill-learn-fraction
- 0.5
- "Fraction between 0 and 1 that governs how quickly the spaces
- between successive repetitions increase, for all items. The
- default value is 0.5. Higher values make spaces increase more
- quickly with each successful repetition. You should only change
- this in small increments (for example 0.05-0.1) as it has an
- exponential effect on inter-repetition spacing."
- :group 'org-drill
- :type 'float)
- (defcustom org-drill-entry-before-hook nil
- "A hook to run functions when every org-drill entry."
- :group 'org-drill
- :type 'hook)
- (defcustom org-drill-entry-after-hook nil
- "A hook to run functions when every org-drill entry."
- :group 'org-drill
- :type 'hook)
- (defcustom org-drill-auto-pronounce t
- "Auto pronounce org-drill word if non-nil."
- :group 'org-drill
- :type 'boolean
- :safe #'booleanp)
- (defcustom org-drill-pronounce-command (executable-find "espeak")
- "Org-drill pronounce command."
- :group 'org-drill
- :type 'string)
- (defcustom org-drill-pronounce-command-args
- (if (string= org-drill-pronounce-command "/usr/bin/espeak")
- "-v en")
- "Org-drill pronounce command arguments."
- :group 'org-drill
- :type 'string)
- (defvar drill-answer nil
- "Global variable that can be bound to a correct answer when an
- item is being presented. If this variable is non-nil, the default
- presentation function will show its value instead of the default
- behaviour of revealing the contents of the drilled item.
- This variable is useful for card types that compute their answers
- -- for example, a card type that asks the student to translate a
- random number to another language. ")
- (defvar *org-drill-session-qualities* nil)
- (defvar *org-drill-start-time* 0)
- (defvar *org-drill-new-entries* nil)
- (defvar *org-drill-dormant-entry-count* 0)
- (defvar *org-drill-due-entry-count* 0)
- (defvar *org-drill-overdue-entry-count* 0)
- (defvar *org-drill-due-tomorrow-count* 0)
- (defvar *org-drill-overdue-entries* nil
- "List of markers for items that are considered 'overdue', based on
- the value of ORG-DRILL-OVERDUE-INTERVAL-FACTOR.")
- (defvar *org-drill-young-mature-entries* nil
- "List of markers for mature entries whose last inter-repetition
- interval was <= ORG-DRILL-DAYS-BEFORE-OLD days.")
- (defvar *org-drill-old-mature-entries* nil
- "List of markers for mature entries whose last inter-repetition
- interval was greater than ORG-DRILL-DAYS-BEFORE-OLD days.")
- (defvar *org-drill-failed-entries* nil)
- (defvar *org-drill-again-entries* nil)
- (defvar *org-drill-done-entries* nil)
- (defvar *org-drill-current-item* nil
- "Set to the marker for the item currently being tested.")
- (defvar *org-drill-cram-mode* nil
- "Are we in 'cram mode', where all items are considered due
- for review unless they were already reviewed in the recent past?")
- (defvar org-drill-scheduling-properties
- '("LEARN_DATA" "DRILL_LAST_INTERVAL" "DRILL_REPEATS_SINCE_FAIL"
- "DRILL_TOTAL_REPEATS" "DRILL_FAILURE_COUNT" "DRILL_AVERAGE_QUALITY"
- "DRILL_EASE" "DRILL_LAST_QUALITY" "DRILL_LAST_REVIEWED"))
- (defvar org-drill--lapse-very-overdue-entries-p nil
- "If non-nil, entries more than 90 days overdue are regarded as 'lapsed'.
- This means that when the item is eventually re-tested it will be
- treated as 'failed' (quality 2) for rescheduling purposes,
- regardless of whether the test was successful.")
- ;;; Make the above settings safe as file-local variables.
- (put 'org-drill-question-tag 'safe-local-variable 'stringp)
- (put 'org-drill-maximum-items-per-session 'safe-local-variable
- '(lambda (val) (or (integerp val) (null val))))
- (put 'org-drill-maximum-duration 'safe-local-variable
- '(lambda (val) (or (integerp val) (null val))))
- (put 'org-drill-failure-quality 'safe-local-variable 'integerp)
- (put 'org-drill-forgetting-index 'safe-local-variable 'integerp)
- (put 'org-drill-leech-failure-threshold 'safe-local-variable 'integerp)
- (put 'org-drill-leech-method 'safe-local-variable
- '(lambda (val) (memq val '(nil skip warn))))
- (put 'org-drill-use-visible-cloze-face-p 'safe-local-variable 'booleanp)
- (put 'org-drill-hide-item-headings-p 'safe-local-variable 'booleanp)
- (put 'org-drill-spaced-repetition-algorithm 'safe-local-variable
- '(lambda (val) (memq val '(simple8 sm5 sm2))))
- (put 'org-drill-sm5-initial-interval 'safe-local-variable 'floatp)
- (put 'org-drill-add-random-noise-to-intervals-p 'safe-local-variable 'booleanp)
- (put 'org-drill-adjust-intervals-for-early-and-late-repetitions-p
- 'safe-local-variable 'booleanp)
- (put 'org-drill-cram-hours 'safe-local-variable 'integerp)
- (put 'org-drill-learn-fraction 'safe-local-variable 'floatp)
- (put 'org-drill-days-before-old 'safe-local-variable 'integerp)
- (put 'org-drill-overdue-interval-factor 'safe-local-variable 'floatp)
- (put 'org-drill-scope 'safe-local-variable
- '(lambda (val) (or (symbolp val) (listp val))))
- (put 'org-drill-match 'safe-local-variable
- '(lambda (val) (or (stringp val) (null val))))
- (put 'org-drill-save-buffers-after-drill-sessions-p 'safe-local-variable 'booleanp)
- (put 'org-drill-cloze-text-weight 'safe-local-variable
- '(lambda (val) (or (null val) (integerp val))))
- (put 'org-drill-left-cloze-delimiter 'safe-local-variable 'stringp)
- (put 'org-drill-right-cloze-delimiter 'safe-local-variable 'stringp)
- ;;;; Utilities ================================================================
- (defun free-marker (m)
- (set-marker m nil))
- (defmacro pop-random (place)
- (let ((idx (cl-gensym)))
- `(if (null ,place)
- nil
- (let ((,idx (random* (length ,place))))
- (prog1 (nth ,idx ,place)
- (setq ,place (append (subseq ,place 0 ,idx)
- (subseq ,place (1+ ,idx)))))))))
- (defmacro push-end (val place)
- "Add VAL to the end of the sequence stored in PLACE. Return the new
- value."
- `(setq ,place (append ,place (list ,val))))
- (defun shuffle-list (list)
- "Randomly permute the elements of LIST (all permutations equally likely)."
- ;; Adapted from 'shuffle-vector' in cookie1.el
- (let ((i 0)
- j
- temp
- (len (length list)))
- (while (< i len)
- (setq j (+ i (random* (- len i))))
- (setq temp (nth i list))
- (setf (nth i list) (nth j list))
- (setf (nth j list) temp)
- (setq i (1+ i))))
- list)
- (defun round-float (floatnum fix)
- "Round the floating point number FLOATNUM to FIX decimal places.
- Example: (round-float 3.56755765 3) -> 3.568"
- (let ((n (expt 10 fix)))
- (/ (float (round (* floatnum n))) n)))
- (defun command-keybinding-to-string (cmd)
- "Return a human-readable description of the key/keys to which the command
- CMD is bound, or nil if it is not bound to a key."
- (let ((key (where-is-internal cmd overriding-local-map t)))
- (if key (key-description key))))
- (defun time-to-inactive-org-timestamp (time)
- (format-time-string
- (concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]")
- time))
- (defun time-to-active-org-timestamp (time)
- (format-time-string
- (concat "<" (substring (cdr org-time-stamp-formats) 1 -1) ">")
- time))
- (defun org-map-drill-entries (func &optional scope drill-match &rest skip)
- "Like `org-map-entries', but only drill entries are processed."
- (let ((org-drill-scope (or scope org-drill-scope))
- (org-drill-match (or drill-match org-drill-match)))
- (apply 'org-map-entries func
- (concat "+" org-drill-question-tag
- (if (and (stringp org-drill-match)
- (not (member '(?+ ?- ?|) (elt org-drill-match 0))))
- "+" "")
- (or org-drill-match ""))
- (case org-drill-scope
- (file nil)
- (file-no-restriction 'file)
- (directory
- (directory-files (file-name-directory (buffer-file-name))
- t "\\.org$"))
- (t org-drill-scope))
- skip)))
- (defmacro with-hidden-cloze-text (&rest body)
- `(progn
- (org-drill-hide-clozed-text)
- (unwind-protect
- (progn
- ,@body)
- (org-drill-unhide-clozed-text))))
- (defmacro with-hidden-cloze-hints (&rest body)
- `(progn
- (org-drill-hide-cloze-hints)
- (unwind-protect
- (progn
- ,@body)
- (org-drill-unhide-text))))
- (defmacro with-hidden-comments (&rest body)
- `(progn
- (if org-drill-hide-item-headings-p
- (org-drill-hide-heading-at-point))
- (org-drill-hide-comments)
- (unwind-protect
- (progn
- ,@body)
- (org-drill-unhide-text))))
- (defun org-drill-days-since-last-review ()
- "Nil means a last review date has not yet been stored for
- the item.
- Zero means it was reviewed today.
- A positive number means it was reviewed that many days ago.
- A negative number means the date of last review is in the future --
- this should never happen."
- (let ((datestr (org-entry-get (point) "DRILL_LAST_REVIEWED")))
- (when datestr
- (- (time-to-days (current-time))
- (time-to-days (apply 'encode-time
- (org-parse-time-string datestr)))))))
- (defun org-drill-hours-since-last-review ()
- "Like `org-drill-days-since-last-review', but return value is
- in hours rather than days."
- (let ((datestr (org-entry-get (point) "DRILL_LAST_REVIEWED")))
- (when datestr
- (floor
- (/ (- (time-to-seconds (current-time))
- (time-to-seconds (apply 'encode-time
- (org-parse-time-string datestr))))
- (* 60 60))))))
- (defun org-drill-entry-p (&optional marker)
- "Is MARKER, or the point, in a 'drill item'? This will return nil if
- the point is inside a subheading of a drill item -- to handle that
- situation use `org-part-of-drill-entry-p'."
- (save-excursion
- (when marker
- (org-drill-goto-entry marker))
- (member org-drill-question-tag (org-get-tags nil t))))
- (defun org-drill-goto-entry (marker)
- (switch-to-buffer (marker-buffer marker))
- (goto-char marker))
- (defun org-part-of-drill-entry-p ()
- "Is the current entry either the main heading of a 'drill item',
- or a subheading within a drill item?"
- (or (org-drill-entry-p)
- ;; Does this heading INHERIT the drill tag
- (member org-drill-question-tag (org-get-tags))))
- (defun org-drill-goto-drill-entry-heading ()
- "Move the point to the heading which holds the :drill: tag for this
- drill entry."
- (unless (org-at-heading-p)
- (org-back-to-heading))
- (unless (org-part-of-drill-entry-p)
- (error "Point is not inside a drill entry"))
- (while (not (org-drill-entry-p))
- (unless (org-up-heading-safe)
- (error "Cannot find a parent heading that is marked as a drill entry"))))
- (defun org-drill-entry-leech-p ()
- "Is the current entry a 'leech item'?"
- (and (org-drill-entry-p)
- (member "leech" (org-get-tags nil t))))
- ;; (defun org-drill-entry-due-p ()
- ;; (cond
- ;; (*org-drill-cram-mode*
- ;; (let ((hours (org-drill-hours-since-last-review)))
- ;; (and (org-drill-entry-p)
- ;; (or (null hours)
- ;; (>= hours org-drill-cram-hours)))))
- ;; (t
- ;; (let ((item-time (org-get-scheduled-time (point))))
- ;; (and (org-drill-entry-p)
- ;; (or (not (eql 'skip org-drill-leech-method))
- ;; (not (org-drill-entry-leech-p)))
- ;; (or (null item-time) ; not scheduled
- ;; (not (minusp ; scheduled for today/in past
- ;; (- (time-to-days (current-time))
- ;; (time-to-days item-time))))))))))
- (defun org-drill-entry-days-overdue ()
- "Returns:
- - NIL if the item is not to be regarded as scheduled for review at all.
- This is the case if it is not a drill item, or if it is a leech item
- that we wish to skip, or if we are in cram mode and have already reviewed
- the item within the last few hours.
- - 0 if the item is new, or if it scheduled for review today.
- - A negative integer - item is scheduled that many days in the future.
- - A positive integer - item is scheduled that many days in the past."
- (cond
- (*org-drill-cram-mode*
- (let ((hours (org-drill-hours-since-last-review)))
- (and (org-drill-entry-p)
- (or (null hours)
- (>= hours org-drill-cram-hours))
- 0)))
- (t
- (let ((item-time (org-get-scheduled-time (point))))
- (cond
- ((or (not (org-drill-entry-p))
- (and (eql 'skip org-drill-leech-method)
- (org-drill-entry-leech-p)))
- nil)
- ((null item-time) ; not scheduled -> due now
- 0)
- (t
- (- (time-to-days (current-time))
- (time-to-days item-time))))))))
- (defun org-drill-entry-overdue-p (&optional days-overdue last-interval)
- "Returns true if entry that is scheduled DAYS-OVERDUE dasy in the past,
- and whose last inter-repetition interval was LAST-INTERVAL, should be
- considered 'overdue'. If the arguments are not given they are extracted
- from the entry at point."
- (unless days-overdue
- (setq days-overdue (org-drill-entry-days-overdue)))
- (unless last-interval
- (setq last-interval (org-drill-entry-last-interval 1)))
- (and (numberp days-overdue)
- (> days-overdue 1) ; enforce a sane minimum 'overdue' gap
- ;;(> due org-drill-days-before-overdue)
- (> (/ (+ days-overdue last-interval 1.0) last-interval)
- org-drill-overdue-interval-factor)))
- (defun org-drill-entry-due-p ()
- (let ((due (org-drill-entry-days-overdue)))
- (and (not (null due))
- (not (minusp due)))))
- (defun org-drill-entry-new-p ()
- (and (org-drill-entry-p)
- (let ((item-time (org-get-scheduled-time (point))))
- (null item-time))))
- (defun org-drill-entry-last-quality (&optional default)
- (let ((quality (org-entry-get (point) "DRILL_LAST_QUALITY")))
- (if quality
- (string-to-number quality)
- default)))
- (defun org-drill-entry-failure-count ()
- (let ((quality (org-entry-get (point) "DRILL_FAILURE_COUNT")))
- (if quality
- (string-to-number quality)
- 0)))
- (defun org-drill-entry-average-quality (&optional default)
- (let ((val (org-entry-get (point) "DRILL_AVERAGE_QUALITY")))
- (if val
- (string-to-number val)
- (or default nil))))
- (defun org-drill-entry-last-interval (&optional default)
- (let ((val (org-entry-get (point) "DRILL_LAST_INTERVAL")))
- (if val
- (string-to-number val)
- (or default 0))))
- (defun org-drill-entry-repeats-since-fail (&optional default)
- (let ((val (org-entry-get (point) "DRILL_REPEATS_SINCE_FAIL")))
- (if val
- (string-to-number val)
- (or default 0))))
- (defun org-drill-entry-total-repeats (&optional default)
- (let ((val (org-entry-get (point) "DRILL_TOTAL_REPEATS")))
- (if val
- (string-to-number val)
- (or default 0))))
- (defun org-drill-entry-ease (&optional default)
- (let ((val (org-entry-get (point) "DRILL_EASE")))
- (if val
- (string-to-number val)
- default)))
- ;;; From http://www.supermemo.com/english/ol/sm5.htm
- (defun org-drill-random-dispersal-factor ()
- "Returns a random number between 0.5 and 1.5."
- (let ((a 0.047)
- (b 0.092)
- (p (- (random* 1.0) 0.5)))
- (cl-flet ((sign (n)
- (cond ((zerop n) 0)
- ((plusp n) 1)
- (t -1))))
- (/ (+ 100 (* (* (/ -1 b) (log (- 1 (* (/ b a ) (abs p)))))
- (sign p)))
- 100.0))))
- (defun pseudonormal (mean variation)
- "Random numbers in a pseudo-normal distribution with mean MEAN, range
- MEAN-VARIATION to MEAN+VARIATION"
- (+ (random* variation)
- (random* variation)
- (- variation)
- mean))
- (defun org-drill-early-interval-factor (optimal-factor
- optimal-interval
- days-ahead)
- "Arguments:
- - OPTIMAL-FACTOR: interval-factor if the item had been tested
- exactly when it was supposed to be.
- - OPTIMAL-INTERVAL: interval for next repetition (days) if the item had been
- tested exactly when it was supposed to be.
- - DAYS-AHEAD: how many days ahead of time the item was reviewed.
- Returns an adjusted optimal factor which should be used to
- calculate the next interval, instead of the optimal factor found
- in the matrix."
- (let ((delta-ofmax (* (1- optimal-factor)
- (/ (+ optimal-interval
- (* 0.6 optimal-interval) -1) (1- optimal-interval)))))
- (- optimal-factor
- (* delta-ofmax (/ days-ahead (+ days-ahead (* 0.6 optimal-interval)))))))
- (defun org-drill-get-item-data ()
- "Returns a list of 6 items, containing all the stored recall
- data for the item at point:
- - LAST-INTERVAL is the interval in days that was used to schedule the item's
- current review date.
- - REPEATS is the number of items the item has been successfully recalled without
- without any failures. It is reset to 0 upon failure to recall the item.
- - FAILURES is the total number of times the user has failed to recall the item.
- - TOTAL-REPEATS includes both successful and unsuccessful repetitions.
- - AVERAGE-QUALITY is the mean quality of recall of the item over
- all its repetitions, successful and unsuccessful.
- - EASE is a number reflecting how easy the item is to learn. Higher is easier.
- "
- (let ((learn-str (org-entry-get (point) "LEARN_DATA"))
- (repeats (org-drill-entry-total-repeats :missing)))
- (cond
- (learn-str
- (let ((learn-data (or (and learn-str
- (read learn-str))
- (copy-list initial-repetition-state))))
- (list (nth 0 learn-data) ; last interval
- (nth 1 learn-data) ; repetitions
- (org-drill-entry-failure-count)
- (nth 1 learn-data)
- (org-drill-entry-last-quality)
- (nth 2 learn-data) ; EF
- )))
- ((not (eql :missing repeats))
- (list (org-drill-entry-last-interval)
- (org-drill-entry-repeats-since-fail)
- (org-drill-entry-failure-count)
- (org-drill-entry-total-repeats)
- (org-drill-entry-average-quality)
- (org-drill-entry-ease)))
- (t ; virgin item
- (list 0 0 0 0 nil nil)))))
- (defun org-drill-store-item-data (last-interval repeats failures
- total-repeats meanq
- ease)
- "Stores the given data in the item at point."
- (org-entry-delete (point) "LEARN_DATA")
- (org-set-property "DRILL_LAST_INTERVAL"
- (number-to-string (round-float last-interval 4)))
- (org-set-property "DRILL_REPEATS_SINCE_FAIL" (number-to-string repeats))
- (org-set-property "DRILL_TOTAL_REPEATS" (number-to-string total-repeats))
- (org-set-property "DRILL_FAILURE_COUNT" (number-to-string failures))
- (org-set-property "DRILL_AVERAGE_QUALITY"
- (number-to-string (round-float meanq 3)))
- (org-set-property "DRILL_EASE"
- (number-to-string (round-float ease 3))))
- ;;; SM2 Algorithm =============================================================
- (defun determine-next-interval-sm2 (last-interval n ef quality
- failures meanq total-repeats)
- "Arguments:
- - LAST-INTERVAL -- the number of days since the item was last reviewed.
- - REPEATS -- the number of times the item has been successfully reviewed
- - EF -- the 'easiness factor'
- - QUALITY -- 0 to 5
- Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), where:
- - INTERVAL is the number of days until the item should next be reviewed
- - REPEATS is incremented by 1.
- - EF is modified based on the recall quality for the item.
- - OF-MATRIX is not modified."
- (assert (> n 0))
- (assert (and (>= quality 0) (<= quality 5)))
- (if (<= quality org-drill-failure-quality)
- ;; When an item is failed, its interval is reset to 0,
- ;; but its EF is unchanged
- (list -1 1 ef (1+ failures) meanq (1+ total-repeats)
- org-drill-sm5-optimal-factor-matrix)
- ;; else:
- (let* ((next-ef (modify-e-factor ef quality))
- (interval
- (cond
- ((<= n 1) 1)
- ((= n 2)
- (cond
- (org-drill-add-random-noise-to-intervals-p
- (case quality
- (5 6)
- (4 4)
- (3 3)
- (2 1)
- (t -1)))
- (t 6)))
- (t (* last-interval next-ef)))))
- (list (if org-drill-add-random-noise-to-intervals-p
- (+ last-interval (* (- interval last-interval)
- (org-drill-random-dispersal-factor)))
- interval)
- (1+ n)
- next-ef
- failures meanq (1+ total-repeats)
- org-drill-sm5-optimal-factor-matrix))))
- ;;; SM5 Algorithm =============================================================
- (defun initial-optimal-factor-sm5 (n ef)
- (if (= 1 n)
- org-drill-sm5-initial-interval
- ef))
- (defun get-optimal-factor-sm5 (n ef of-matrix)
- (let ((factors (assoc n of-matrix)))
- (or (and factors
- (let ((ef-of (assoc ef (cdr factors))))
- (and ef-of (cdr ef-of))))
- (initial-optimal-factor-sm5 n ef))))
- (defun inter-repetition-interval-sm5 (last-interval n ef &optional of-matrix)
- (let ((of (get-optimal-factor-sm5 n ef (or of-matrix
- org-drill-sm5-optimal-factor-matrix))))
- (if (= 1 n)
- of
- (* of last-interval))))
- (defun determine-next-interval-sm5 (last-interval n ef quality
- failures meanq total-repeats
- of-matrix &optional delta-days)
- (if (zerop n) (setq n 1))
- (if (null ef) (setq ef 2.5))
- (assert (> n 0))
- (assert (and (>= quality 0) (<= quality 5)))
- (unless of-matrix
- (setq of-matrix org-drill-sm5-optimal-factor-matrix))
- (setq of-matrix (cl-copy-tree of-matrix))
- (setq meanq (if meanq
- (/ (+ quality (* meanq total-repeats 1.0))
- (1+ total-repeats))
- quality))
- (let ((next-ef (modify-e-factor ef quality))
- (old-ef ef)
- (new-of (modify-of (get-optimal-factor-sm5 n ef of-matrix)
- quality org-drill-learn-fraction))
- (interval nil))
- (when (and org-drill-adjust-intervals-for-early-and-late-repetitions-p
- delta-days (minusp delta-days))
- (setq new-of (org-drill-early-interval-factor
- (get-optimal-factor-sm5 n ef of-matrix)
- (inter-repetition-interval-sm5
- last-interval n ef of-matrix)
- delta-days)))
- (setq of-matrix
- (set-optimal-factor n next-ef of-matrix
- (round-float new-of 3))) ; round OF to 3 d.p.
- (setq ef next-ef)
- (cond
- ;; "Failed" -- reset repetitions to 0,
- ((<= quality org-drill-failure-quality)
- (list -1 1 old-ef (1+ failures) meanq (1+ total-repeats)
- of-matrix)) ; Not clear if OF matrix is supposed to be
- ; preserved
- ;; For a zero-based quality of 4 or 5, don't repeat
- ;; ((and (>= quality 4)
- ;; (not org-learn-always-reschedule))
- ;; (list 0 (1+ n) ef failures meanq
- ;; (1+ total-repeats) of-matrix)) ; 0 interval = unschedule
- (t
- (setq interval (inter-repetition-interval-sm5
- last-interval n ef of-matrix))
- (if org-drill-add-random-noise-to-intervals-p
- (setq interval (* interval (org-drill-random-dispersal-factor))))
- (list interval
- (1+ n)
- ef
- failures
- meanq
- (1+ total-repeats)
- of-matrix)))))
- ;;; Simple8 Algorithm =========================================================
- (defun org-drill-simple8-first-interval (failures)
- "Arguments:
- - FAILURES: integer >= 0. The total number of times the item has
- been forgotten, ever.
- Returns the optimal FIRST interval for an item which has previously been
- forgotten on FAILURES occasions."
- (* 2.4849 (exp (* -0.057 failures))))
- (defun org-drill-simple8-interval-factor (ease repetition)
- "Arguments:
- - EASE: floating point number >= 1.2. Corresponds to `AF' in SM8 algorithm.
- - REPETITION: the number of times the item has been tested.
- 1 is the first repetition (ie the second trial).
- Returns:
- The factor by which the last interval should be
- multiplied to give the next interval. Corresponds to `RF' or `OF'."
- (+ 1.2 (* (- ease 1.2) (expt org-drill-learn-fraction (log repetition 2)))))
- (defun org-drill-simple8-quality->ease (quality)
- "Returns the ease (`AF' in the SM8 algorithm) which corresponds
- to a mean item quality of QUALITY."
- (+ (* 0.0542 (expt quality 4))
- (* -0.4848 (expt quality 3))
- (* 1.4916 (expt quality 2))
- (* -1.2403 quality)
- 1.4515))
- (defun determine-next-interval-simple8 (last-interval repeats quality
- failures meanq totaln
- &optional delta-days)
- "Arguments:
- - LAST-INTERVAL -- the number of days since the item was last reviewed.
- - REPEATS -- the number of times the item has been successfully reviewed
- - EASE -- the 'easiness factor'
- - QUALITY -- 0 to 5
- - DELTA-DAYS -- how many days overdue was the item when it was reviewed.
- 0 = reviewed on the scheduled day. +N = N days overdue.
- -N = reviewed N days early.
- Returns the new item data, as a list of 6 values:
- - NEXT-INTERVAL
- - REPEATS
- - EASE
- - FAILURES
- - AVERAGE-QUALITY
- - TOTAL-REPEATS.
- See the documentation for `org-drill-get-item-data' for a description of these."
- (assert (>= repeats 0))
- (assert (and (>= quality 0) (<= quality 5)))
- (assert (or (null meanq) (and (>= meanq 0) (<= meanq 5))))
- (let ((next-interval nil))
- (setf meanq (if meanq
- (/ (+ quality (* meanq totaln 1.0)) (1+ totaln))
- quality))
- (cond
- ((<= quality org-drill-failure-quality)
- (incf failures)
- (setf repeats 0
- next-interval -1))
- ((or (zerop repeats)
- (zerop last-interval))
- (setf next-interval (org-drill-simple8-first-interval failures))
- (incf repeats)
- (incf totaln))
- (t
- (let* ((use-n
- (if (and
- org-drill-adjust-intervals-for-early-and-late-repetitions-p
- (numberp delta-days) (plusp delta-days)
- (plusp last-interval))
- (+ repeats (min 1 (/ delta-days last-interval 1.0)))
- repeats))
- (factor (org-drill-simple8-interval-factor
- (org-drill-simple8-quality->ease meanq) use-n))
- (next-int (* last-interval factor)))
- (when (and org-drill-adjust-intervals-for-early-and-late-repetitions-p
- (numberp delta-days) (minusp delta-days))
- ;; The item was reviewed earlier than scheduled.
- (setf factor (org-drill-early-interval-factor
- factor next-int (abs delta-days))
- next-int (* last-interval factor)))
- (setf next-interval next-int)
- (incf repeats)
- (incf totaln))))
- (list
- (if (and org-drill-add-random-noise-to-intervals-p
- (plusp next-interval))
- (* next-interval (org-drill-random-dispersal-factor))
- next-interval)
- repeats
- (org-drill-simple8-quality->ease meanq)
- failures
- meanq
- totaln
- )))
- ;;; Essentially copied from `org-learn.el', but modified to
- ;;; optionally call the SM2 or simple8 functions.
- (defun org-drill-smart-reschedule (quality &optional days-ahead)
- "If DAYS-AHEAD is supplied it must be a positive integer. The
- item will be scheduled exactly this many days into the future."
- (let ((delta-days (- (time-to-days (current-time))
- (time-to-days (or (org-get-scheduled-time (point))
- (current-time)))))
- (ofmatrix org-drill-sm5-optimal-factor-matrix)
- ;; Entries can have weights, 1 by default. Intervals are divided by the
- ;; item's weight, so an item with a weight of 2 will have all intervals
- ;; halved, meaning you will end up reviewing it twice as often.
- ;; Useful for entries which randomly present any of several facts.
- (weight (org-entry-get (point) "DRILL_CARD_WEIGHT")))
- (if (stringp weight)
- (setq weight (read weight)))
- (destructuring-bind (last-interval repetitions failures
- total-repeats meanq ease)
- (org-drill-get-item-data)
- (destructuring-bind (next-interval repetitions ease
- failures meanq total-repeats
- &optional new-ofmatrix)
- (case org-drill-spaced-repetition-algorithm
- (sm5 (determine-next-interval-sm5 last-interval repetitions
- ease quality failures
- meanq total-repeats ofmatrix))
- (sm2 (determine-next-interval-sm2 last-interval repetitions
- ease quality failures
- meanq total-repeats))
- (simple8 (determine-next-interval-simple8 last-interval repetitions
- quality failures meanq
- total-repeats
- delta-days)))
- (if (numberp days-ahead)
- (setq next-interval days-ahead))
- (if (and (null days-ahead)
- (numberp weight) (plusp weight)
- (not (minusp next-interval)))
- (setq next-interval
- (max 1.0 (+ last-interval
- (/ (- next-interval last-interval) weight)))))
- (org-drill-store-item-data next-interval repetitions failures
- total-repeats meanq ease)
- (if (eql 'sm5 org-drill-spaced-repetition-algorithm)
- (setq org-drill-sm5-optimal-factor-matrix new-ofmatrix))
- (cond
- ((= 0 days-ahead)
- (org-schedule '(4)))
- ((minusp days-ahead)
- (org-schedule nil (current-time)))
- (t
- (org-schedule nil (time-add (current-time)
- (days-to-time
- (round next-interval))))))))))
- (defun org-drill-hypothetical-next-review-date (quality)
- "Returns an integer representing the number of days into the future
- that the current item would be scheduled, based on a recall quality
- of QUALITY."
- (let ((weight (org-entry-get (point) "DRILL_CARD_WEIGHT")))
- (destructuring-bind (last-interval repetitions failures
- total-repeats meanq ease)
- (org-drill-get-item-data)
- (if (stringp weight)
- (setq weight (read weight)))
- (destructuring-bind (next-interval repetitions ease
- failures meanq total-repeats
- &optional ofmatrix)
- (case org-drill-spaced-repetition-algorithm
- (sm5 (determine-next-interval-sm5 last-interval repetitions
- ease quality failures
- meanq total-repeats
- org-drill-sm5-optimal-factor-matrix))
- (sm2 (determine-next-interval-sm2 last-interval repetitions
- ease quality failures
- meanq total-repeats))
- (simple8 (determine-next-interval-simple8 last-interval repetitions
- quality failures meanq
- total-repeats)))
- (cond
- ((not (plusp next-interval))
- 0)
- ((and (numberp weight) (plusp weight))
- (+ last-interval
- (max 1.0 (/ (- next-interval last-interval) weight))))
- (t
- next-interval))))))
- (defun org-drill-hypothetical-next-review-dates ()
- (let ((intervals nil))
- (dotimes (q 6)
- (push (max (or (car intervals) 0)
- (org-drill-hypothetical-next-review-date q))
- intervals))
- (reverse intervals)))
- (defun org-drill-reschedule ()
- "Returns quality rating (0-5), or nil if the user quit."
- (let ((ch nil)
- (input nil)
- (next-review-dates (org-drill-hypothetical-next-review-dates))
- (key-prompt (format "(0-5, %c=help, %c=pronounce, %c=edit, %c=tags, %c=quit)"
- org-drill--help-key
- org-drill--pronounce-key
- org-drill--edit-key
- org-drill--tags-key
- org-drill--quit-key)))
- (save-excursion
- (while (not (memq ch (list org-drill--quit-key
- org-drill--edit-key
- 7 ; C-g
- ?0 ?1 ?2 ?3 ?4 ?5)))
- (setq input (read-key-sequence
- (if (eq ch org-drill--help-key)
- (format "0-2 Means you have forgotten the item.
- 3-5 Means you have remembered the item.
- 0 - Completely forgot.
- 1 - Even after seeing the answer, it still took a bit to sink in.
- 2 - After seeing the answer, you remembered it.
- 3 - It took you awhile, but you finally remembered. (+%s days)
- 4 - After a little bit of thought you remembered. (+%s days)
- 5 - You remembered the item really easily. (+%s days)
- How well did you do? %s"
- (round (nth 3 next-review-dates))
- (round (nth 4 next-review-dates))
- (round (nth 5 next-review-dates))
- key-prompt)
- (format "How well did you do? %s" key-prompt))
- (when (eq ch org-drill--pronounce-key)
- (org-drill-pronounce-word))))
- (cond
- ((stringp input)
- (setq ch (elt input 0)))
- ((and (vectorp input) (symbolp (elt input 0)))
- (case (elt input 0)
- (up (ignore-errors (forward-line -1)))
- (down (ignore-errors (forward-line 1)))
- (left (ignore-errors (backward-char)))
- (right (ignore-errors (forward-char)))
- (prior (ignore-errors (scroll-down))) ; pgup
- (next (ignore-errors (scroll-up))))) ; pgdn
- ((and (vectorp input) (listp (elt input 0))
- (eventp (elt input 0)))
- (case (car (elt input 0))
- (wheel-up (ignore-errors (mwheel-scroll (elt input 0))))
- (wheel-down (ignore-errors (mwheel-scroll (elt input 0)))))))
- (if (eql ch org-drill--tags-key)
- (org-set-tags-command))))
- (cond
- ((and (>= ch ?0) (<= ch ?5))
- (let ((quality (- ch ?0))
- (failures (org-drill-entry-failure-count)))
- (unless *org-drill-cram-mode*
- (save-excursion
- (let ((quality (if (org-drill--entry-lapsed-p) 2 quality)))
- (org-drill-smart-reschedule quality
- (nth quality next-review-dates))))
- (push quality *org-drill-session-qualities*)
- (cond
- ((<= quality org-drill-failure-quality)
- (when org-drill-leech-failure-threshold
- ;;(setq failures (if failures (string-to-number failures) 0))
- ;; (org-set-property "DRILL_FAILURE_COUNT"
- ;; (format "%d" (1+ failures)))
- (if (> (1+ failures) org-drill-leech-failure-threshold)
- (org-toggle-tag "leech" 'on))))
- (t
- (let ((scheduled-time (org-get-scheduled-time (point))))
- (when scheduled-time
- (message "Next review in %d days"
- (- (time-to-days scheduled-time)
- (time-to-days (current-time))))
- (sit-for 0.5)))))
- (org-set-property "DRILL_LAST_QUALITY" (format "%d" quality))
- (org-set-property "DRILL_LAST_REVIEWED"
- (time-to-inactive-org-timestamp (current-time))))
- quality))
- ((= ch org-drill--edit-key)
- 'edit)
- (t
- nil))))
- ;; (defun org-drill-hide-all-subheadings-except (heading-list)
- ;; "Returns a list containing the position of each immediate subheading of
- ;; the current topic."
- ;; (let ((drill-entry-level (org-current-level))
- ;; (drill-sections nil)
- ;; (drill-heading nil))
- ;; (org-show-subtree)
- ;; (save-excursion
- ;; (org-map-entries
- ;; (lambda ()
- ;; (when (and (not (org-invisible-p))
- ;; (> (org-current-level) drill-entry-level))
- ;; (setq drill-heading (org-get-heading t))
- ;; (unless (and (= (org-current-level) (1+ drill-entry-level))
- ;; (member drill-heading heading-list))
- ;; (hide-subtree))
- ;; (push (point) drill-sections)))
- ;; "" 'tree))
- ;; (reverse drill-sections)))
- (defun org-drill-hide-subheadings-if (test)
- "TEST is a function taking no arguments. TEST will be called for each
- of the immediate subheadings of the current drill item, with the point
- on the relevant subheading. TEST should return nil if the subheading is
- to be revealed, non-nil if it is to be hidden.
- Returns a list containing the position of each immediate subheading of
- the current topic."
- (let ((drill-entry-level (org-current-level))
- (drill-sections nil))
- (org-show-subtree)
- (save-excursion
- (org-map-entries
- (lambda ()
- (when (and (not (org-invisible-p))
- (> (org-current-level) drill-entry-level))
- (when (or (/= (org-current-level) (1+ drill-entry-level))
- (funcall test))
- (hide-subtree))
- (push (point) drill-sections)))
- nil 'tree))
- (reverse drill-sections)))
- (defun org-drill-hide-all-subheadings-except (heading-list)
- (org-drill-hide-subheadings-if
- (lambda () (let ((drill-heading (org-get-heading t)))
- (not (member drill-heading heading-list))))))
- (defun org-drill-presentation-prompt (&rest fmt-and-args)
- (let* ((item-start-time (current-time))
- (input nil)
- (ch nil)
- (last-second 0)
- (mature-entry-count (+ (length *org-drill-young-mature-entries*)
- (length *org-drill-old-mature-entries*)
- (length *org-drill-overdue-entries*)))
- (status (first (org-drill-entry-status)))
- (prompt
- (if fmt-and-args
- (apply 'format
- (first fmt-and-args)
- (rest fmt-and-args))
- (format (concat "Press key for answer, "
- "%c=pronounce, %c=edit, %c=tags, %c=skip, %c=quit.")
- org-drill--pronounce-key
- org-drill--edit-key
- org-drill--tags-key
- org-drill--skip-key
- org-drill--quit-key))))
- (setq prompt
- (format "%s %s %s %s %s %s"
- (propertize
- (char-to-string
- (cond
- ((eql status :failed) ?F)
- (*org-drill-cram-mode* ?C)
- (t
- (case status
- (:new ?N) (:young ?Y) (:old ?o) (:overdue ?!)
- (t ??)))))
- 'face `(:foreground
- ,(case status
- (:new org-drill-new-count-color)
- ((:young :old) org-drill-mature-count-color)
- ((:overdue :failed) org-drill-failed-count-color)
- (t org-drill-done-count-color))))
- (propertize
- (number-to-string (length *org-drill-done-entries*))
- 'face `(:foreground ,org-drill-done-count-color)
- 'help-echo "The number of items you have reviewed this session.")
- (propertize
- (number-to-string (+ (length *org-drill-again-entries*)
- (length *org-drill-failed-entries*)))
- 'face `(:foreground ,org-drill-failed-count-color)
- 'help-echo (concat "The number of items that you failed, "
- "and need to review again."))
- (propertize
- (number-to-string mature-entry-count)
- 'face `(:foreground ,org-drill-mature-count-color)
- 'help-echo "The number of old items due for review.")
- (propertize
- (number-to-string (length *org-drill-new-entries*))
- 'face `(:foreground ,org-drill-new-count-color)
- 'help-echo (concat "The number of new items that you "
- "have never reviewed."))
- prompt))
- (if (and (eql 'warn org-drill-leech-method)
- (org-drill-entry-leech-p))
- (setq prompt (concat
- (propertize "!!! LEECH ITEM !!!
- You seem to be having a lot of trouble memorising this item.
- Consider reformulating the item to make it easier to remember.\n"
- 'face '(:foreground "red"))
- prompt)))
- (while (memq ch '(nil org-drill--tags-key org-drill--pronounce-key))
- (setq ch nil)
- (while (not (input-pending-p))
- (let ((elapsed (time-subtract (current-time) item-start-time)))
- (message (concat (if (>= (time-to-seconds elapsed) (* 60 60))
- "++:++ "
- (format-time-string "%M:%S " elapsed))
- prompt))
- (sit-for 1)))
- (setq input (read-key-sequence nil))
- (if (stringp input) (setq ch (elt input 0)))
- (if (eql ch org-drill--tags-key)
- (org-set-tags-command))
- (when (eq ch org-drill--pronounce-key)
- (org-drill-pronounce-word)))
- (case ch
- (org-drill--quit-key nil)
- (org-drill--edit-key 'edit)
- (org-drill--skip-key 'skip)
- (otherwise t))))
- (defun org-pos-in-regexp (pos regexp &optional nlines)
- (save-excursion
- (goto-char pos)
- (org-in-regexp regexp nlines)))
- (defun org-drill-hide-region (beg end &optional text)
- "Hide the buffer region between BEG and END with an 'invisible text'
- visual overlay, or with the string TEXT if it is supplied."
- (let ((ovl (make-overlay beg end)))
- (overlay-put ovl 'category
- 'org-drill-hidden-text-overlay)
- (overlay-put ovl 'priority 9999)
- (when (stringp text)
- (overlay-put ovl 'invisible nil)
- (overlay-put ovl 'face 'default)
- (overlay-put ovl 'display text))))
- (defun org-drill-hide-heading-at-point (&optional text)
- (unless (org-at-heading-p)
- (error "Point is not on a heading."))
- (save-excursion
- (let ((beg (point)))
- (end-of-line)
- (org-drill-hide-region beg (point) text))))
- (defun org-drill-hide-comments ()
- (save-excursion
- (while (re-search-forward "^#.*$" nil t)
- (org-drill-hide-region (match-beginning 0) (match-end 0)))))
- (defun org-drill-unhide-text ()
- ;; This will also unhide the item's heading.
- (save-excursion
- (dolist (ovl (overlays-in (point-min) (point-max)))
- (when (eql 'org-drill-hidden-text-overlay (overlay-get ovl 'category))
- (delete-overlay ovl)))))
- (defun org-drill-hide-clozed-text ()
- (save-excursion
- (while (re-search-forward org-drill-cloze-regexp nil t)
- ;; Don't hide:
- ;; - org links, partly because they might contain inline
- ;; images which we want to keep visible.
- ;; - LaTeX math fragments
- ;; - the contents of SRC blocks
- (unless (save-match-data
- (or (org-pos-in-regexp (match-beginning 0)
- org-bracket-link-regexp 1)
- (org-in-src-block-p)
- (org-inside-LaTeX-fragment-p)))
- (org-drill-hide-matched-cloze-text)))))
- (defun org-drill-hide-matched-cloze-text ()
- "Hide the current match with a 'cloze' visual overlay."
- (let ((ovl (make-overlay (match-beginning 0) (match-end 0)))
- (hint-sep-pos (string-match-p (regexp-quote org-drill-hint-separator)
- (match-string 0))))
- (overlay-put ovl 'category
- 'org-drill-cloze-overlay-defaults)
- (overlay-put ovl 'priority 9999)
- (when (and hint-sep-pos
- (> hint-sep-pos 1))
- (let ((hint (substring-no-properties
- (match-string 0)
- (+ hint-sep-pos (length org-drill-hint-separator))
- (1- (length (match-string 0))))))
- (overlay-put
- ovl 'display
- ;; If hint is like `X...' then display [X...]
- ;; otherwise display [...X]
- (format (if (string-match-p (regexp-quote "...") hint) "[%s]" "[%s...]")
- hint))))))
- (defun org-drill-hide-cloze-hints ()
- (save-excursion
- (while (re-search-forward org-drill-cloze-regexp nil t)
- (unless (or (save-match-data
- (org-pos-in-regexp (match-beginning 0)
- org-bracket-link-regexp 1))
- (null (match-beginning 2))) ; hint subexpression matched
- (org-drill-hide-region (match-beginning 2) (match-end 2))))))
- (defmacro with-replaced-entry-text (text &rest body)
- "During the execution of BODY, the entire text of the current entry is
- concealed by an overlay that displays the string TEXT."
- `(progn
- (org-drill-replace-entry-text ,text)
- (unwind-protect
- (progn
- ,@body)
- (org-drill-unreplace-entry-text))))
- (defmacro with-replaced-entry-text-multi (replacements &rest body)
- "During the execution of BODY, the entire text of the current entry is
- concealed by an overlay that displays the overlays in REPLACEMENTS."
- `(progn
- (org-drill-replace-entry-text ,replacements t)
- (unwind-protect
- (progn
- ,@body)
- (org-drill-unreplace-entry-text))))
- (defun org-drill-replace-entry-text (text &optional multi-p)
- "Make an overlay that conceals the entire text of the item, not
- including properties or the contents of subheadings. The overlay shows
- the string TEXT.
- If MULTI-P is non-nil, TEXT must be a list of values which are legal
- for the `display' text property. The text of the item will be temporarily
- replaced by all of these items, in the order in which they appear in
- the list.
- Note: does not actually alter the item."
- (cond
- ((and multi-p
- (listp text))
- (org-drill-replace-entry-text-multi text))
- (t
- (let ((ovl (make-overlay (point-min)
- (save-excursion
- (outline-next-heading)
- (point)))))
- (overlay-put ovl 'priority 9999)
- (overlay-put ovl 'category
- 'org-drill-replaced-text-overlay)
- (overlay-put ovl 'display text)))))
- (defun org-drill-unreplace-entry-text ()
- (save-excursion
- (dolist (ovl (overlays-in (point-min) (point-max)))
- (when (eql 'org-drill-replaced-text-overlay (overlay-get ovl 'category))
- (delete-overlay ovl)))))
- (defun org-drill-replace-entry-text-multi (replacements)
- "Make overlays that conceal the entire text of the item, not
- including properties or the contents of subheadings. The overlay shows
- the string TEXT.
- Note: does not actually alter the item."
- (let ((ovl nil)
- (p-min (point-min))
- (p-max (save-excursion
- (outline-next-heading)
- (point))))
- (assert (>= (- p-max p-min) (length replacements)))
- (dotimes (i (length replacements))
- (setq ovl (make-overlay (+ p-min (* 2 i))
- (if (= i (1- (length replacements)))
- p-max
- (+ p-min (* 2 i) 1))))
- (overlay-put ovl 'priority 9999)
- (overlay-put ovl 'category
- 'org-drill-replaced-text-overlay)
- (overlay-put ovl 'display (nth i replacements)))))
- (defmacro with-replaced-entry-heading (heading &rest body)
- `(progn
- (org-drill-replace-entry-heading ,heading)
- (unwind-protect
- (progn
- ,@body)
- (org-drill-unhide-text))))
- (defun org-drill-replace-entry-heading (heading)
- "Make an overlay that conceals the heading of the item. The overlay shows
- the string TEXT.
- Note: does not actually alter the item."
- (org-drill-hide-heading-at-point heading))
- (defun org-drill-unhide-clozed-text ()
- (save-excursion
- (dolist (ovl (overlays-in (point-min) (point-max)))
- (when (eql 'org-drill-cloze-overlay-defaults (overlay-get ovl 'category))
- (delete-overlay ovl)))))
- (defun org-drill-get-entry-text (&optional keep-properties-p)
- (let ((text (org-agenda-get-some-entry-text (point-marker) 100)))
- (if keep-properties-p
- text
- (substring-no-properties text))))
- ;; (defun org-entry-empty-p ()
- ;; (zerop (length (org-drill-get-entry-text))))
- ;; This version is about 5x faster than the old version, above.
- (defun org-entry-empty-p ()
- (save-excursion
- (org-back-to-heading t)
- (let ((lim (save-excursion
- (outline-next-heading) (point))))
- (if (fboundp 'org-end-of-meta-data-and-drawers)
- (org-end-of-meta-data-and-drawers) ; function removed Feb 2015
- (org-end-of-meta-data t))
- (or (>= (point) lim)
- (null (re-search-forward "[[:graph:]]" lim t))))))
- (defun org-drill-entry-empty-p () (org-entry-empty-p))
- ;;; Presentation functions ====================================================
- ;;
- ;; Each of these is called with point on topic heading. Each needs to show the
- ;; topic in the form of a 'question' or with some information 'hidden', as
- ;; appropriate for the card type. The user should then be prompted to press a
- ;; key. The function should then reveal either the 'answer' or the entire
- ;; topic, and should return t if the user chose to see the answer and rate their
- ;; recall, nil if they chose to quit.
- (defun org-drill-present-simple-card ()
- (with-hidden-comments
- (with-hidden-cloze-hints
- (with-hidden-cloze-text
- (org-drill-hide-all-subheadings-except nil)
- (org-drill--show-latex-fragments) ; overlay all LaTeX fragments with images
- (ignore-errors
- (org-display-inline-images t))
- (org-cycle-hide-drawers 'all)
- (prog1 (org-drill-presentation-prompt)
- (org-drill-hide-subheadings-if 'org-drill-entry-p))))))
- (defun org-drill-present-default-answer (reschedule-fn)
- (cond
- (drill-answer
- (with-replaced-entry-text
- (format "\nAnswer:\n\n %s\n" drill-answer)
- (prog1
- (funcall reschedule-fn)
- (setq drill-answer nil))))
- (t
- (org-drill-hide-subheadings-if 'org-drill-entry-p)
- (org-drill-unhide-clozed-text)
- (org-drill--show-latex-fragments)
- (ignore-errors
- (org-display-inline-images t))
- (org-cycle-hide-drawers 'all)
- (with-hidden-cloze-hints
- (funcall reschedule-fn)))))
- (defun org-drill--show-latex-fragments ()
- (org-remove-latex-fragment-image-overlays)
- (if (fboundp 'org-toggle-latex-fragment)
- (org-toggle-latex-fragment '(4))
- (org-preview-latex-fragment '(4))))
- (defun org-drill-present-two-sided-card ()
- (with-hidden-comments
- (with-hidden-cloze-hints
- (with-hidden-cloze-text
- (let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
- (when drill-sections
- (save-excursion
- (goto-char (nth (random* (min 2 (length drill-sections)))
- drill-sections))
- (org-show-subtree)))
- (org-drill--show-latex-fragments)
- (ignore-errors
- (org-display-inline-images t))
- (org-cycle-hide-drawers 'all)
- (prog1 (org-drill-presentation-prompt)
- (org-drill-hide-subheadings-if 'org-drill-entry-p)))))))
- (defun org-drill-present-multi-sided-card ()
- (with-hidden-comments
- (with-hidden-cloze-hints
- (with-hidden-cloze-text
- (let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
- (when drill-sections
- (save-excursion
- (goto-char (nth (random* (length drill-sections)) drill-sections))
- (org-show-subtree)))
- (org-drill--show-latex-fragments)
- (ignore-errors
- (org-display-inline-images t))
- (org-cycle-hide-drawers 'all)
- (prog1 (org-drill-presentation-prompt)
- (org-drill-hide-subheadings-if 'org-drill-entry-p)))))))
- (defun org-drill-present-multicloze-hide-n (number-to-hide
- &optional
- force-show-first
- force-show-last
- force-hide-first)
- "Hides NUMBER-TO-HIDE pieces of text that are marked for cloze deletion,
- chosen at random.
- If NUMBER-TO-HIDE is negative, show only (ABS NUMBER-TO-HIDE) pieces,
- hiding all the rest.
- If FORCE-HIDE-FIRST is non-nil, force the first piece of text to be one of
- the hidden items.
- If FORCE-SHOW-FIRST is non-nil, never hide the first piece of text.
- If FORCE-SHOW-LAST is non-nil, never hide the last piece of text.
- If the number of text pieces in the item is less than
- NUMBER-TO-HIDE, then all text pieces will be hidden (except the first or last
- items if FORCE-SHOW-FIRST or FORCE-SHOW-LAST is non-nil)."
- (with-hidden-comments
- (with-hidden-cloze-hints
- (let ((item-end nil)
- (match-count 0)
- (body-start (or (cdr (org-get-property-block))
- (point))))
- (if (and force-hide-first force-show-first)
- (error "FORCE-HIDE-FIRST and FORCE-SHOW-FIRST are mutually exclusive"))
- (org-drill-hide-all-subheadings-except nil)
- (save-excursion
- (outline-next-heading)
- (setq item-end (point)))
- (save-excursion
- (goto-char body-start)
- (while (re-search-forward org-drill-cloze-regexp item-end t)
- (let ((in-regexp? (save-match-data
- (org-pos-in-regexp (match-beginning 0)
- org-bracket-link-regexp 1))))
- (unless (or in-regexp?
- (org-inside-LaTeX-fragment-p))
- (incf match-count)))))
- (if (minusp number-to-hide)
- (setq number-to-hide (+ match-count number-to-hide)))
- (when (plusp match-count)
- (let* ((positions (shuffle-list (loop for i from 1
- to match-count
- collect i)))
- (match-nums nil)
- (cnt nil))
- (if force-hide-first
- ;; Force '1' to be in the list, and to be the first item
- ;; in the list.
- (setq positions (cons 1 (remove 1 positions))))
- (if force-show-first
- (setq positions (remove 1 positions)))
- (if force-show-last
- (setq positions (remove match-count positions)))
- (setq match-nums
- (subseq positions
- 0 (min number-to-hide (length positions))))
- ;; (dolist (pos-to-hide match-nums)
- (save-excursion
- (goto-char body-start)
- (setq cnt 0)
- (while (re-search-forward org-drill-cloze-regexp item-end t)
- (unless (save-match-data
- (or (org-pos-in-regexp (match-beginning 0)
- org-bracket-link-regexp 1)
- (org-inside-LaTeX-fragment-p)))
- (incf cnt)
- (if (memq cnt match-nums)
- (org-drill-hide-matched-cloze-text)))))))
- ;; (loop
- ;; do (re-search-forward org-drill-cloze-regexp
- ;; item-end t pos-to-hide)
- ;; while (org-pos-in-regexp (match-beginning 0)
- ;; org-bracket-link-regexp 1))
- ;; (org-drill-hide-matched-cloze-text)))))
- (org-drill--show-latex-fragments)
- (ignore-errors
- (org-display-inline-images t))
- (org-cycle-hide-drawers 'all)
- (prog1 (org-drill-presentation-prompt)
- (org-drill-hide-subheadings-if 'org-drill-entry-p)
- (org-drill-unhide-clozed-text))))))
- (defun org-drill-present-multicloze-hide-nth (to-hide)
- "Hide the TO-HIDE'th piece of clozed text. 1 is the first piece. If
- TO-HIDE is negative, count backwards, so -1 means the last item, -2
- the second to last, etc."
- (with-hidden-comments
- (with-hidden-cloze-hints
- (let ((item-end nil)
- (match-count 0)
- (body-start (or (cdr (org-get-property-block))
- (point)))
- (cnt 0))
- (org-drill-hide-all-subheadings-except nil)
- (save-excursion
- (outline-next-heading)
- (setq item-end (point)))
- (save-excursion
- (goto-char body-start)
- (while (re-search-forward org-drill-cloze-regexp item-end t)
- (let ((in-regexp? (save-match-data
- (org-pos-in-regexp (match-beginning 0)
- org-bracket-link-regexp 1))))
- (unless (or in-regexp?
- (org-inside-LaTeX-fragment-p))
- (incf match-count)))))
- (if (minusp to-hide)
- (setq to-hide (+ 1 to-hide match-count)))
- (cond
- ((or (not (plusp match-count))
- (> to-hide match-count))
- nil)
- (t
- (save-excursion
- (goto-char body-start)
- (setq cnt 0)
- (while (re-search-forward org-drill-cloze-regexp item-end t)
- (unless (save-match-data
- ;; Don't consider this a cloze region if it is part of an
- ;; org link, or if it occurs inside a LaTeX math
- ;; fragment
- (or (org-pos-in-regexp (match-beginning 0)
- org-bracket-link-regexp 1)
- (org-inside-LaTeX-fragment-p)))
- (incf cnt)
- (if (= cnt to-hide)
- (org-drill-hide-matched-cloze-text)))))))
- (org-drill--show-latex-fragments)
- (ignore-errors
- (org-display-inline-images t))
- (org-cycle-hide-drawers 'all)
- (prog1 (org-drill-presentation-prompt)
- (org-drill-hide-subheadings-if 'org-drill-entry-p)
- (org-drill-unhide-clozed-text))))))
- (defun org-drill-present-multicloze-hide1 ()
- "Hides one of the pieces of text that are marked for cloze deletion,
- chosen at random."
- (org-drill-present-multicloze-hide-n 1))
- (defun org-drill-present-multicloze-hide2 ()
- "Hides two of the pieces of text that are marked for cloze deletion,
- chosen at random."
- (org-drill-present-multicloze-hide-n 2))
- (defun org-drill-present-multicloze-hide-first ()
- "Hides the first piece of text that is marked for cloze deletion."
- (org-drill-present-multicloze-hide-nth 1))
- (defun org-drill-present-multicloze-hide-last ()
- "Hides the last piece of text that is marked for cloze deletion."
- (org-drill-present-multicloze-hide-nth -1))
- (defun org-drill-present-multicloze-hide1-firstmore ()
- "Commonly, hides the FIRST piece of text that is marked for
- cloze deletion. Uncommonly, hide one of the other pieces of text,
- chosen at random.
- The definitions of 'commonly' and 'uncommonly' are determined by
- the value of `org-drill-cloze-text-weight'."
- ;; The 'firstmore' and 'lastmore' functions used to randomly choose whether
- ;; to hide the 'favoured' piece of text. However even when the chance of
- ;; hiding it was set quite high (80%), the outcome was too unpredictable over
- ;; the small number of repetitions where most learning takes place for each
- ;; item. In other words, the actual frequency during the first 10 repetitions
- ;; was often very different from 80%. Hence we use modulo instead.
- (cond
- ((null org-drill-cloze-text-weight)
- ;; Behave as hide1cloze
- (org-drill-present-multicloze-hide1))
- ((not (and (integerp org-drill-cloze-text-weight)
- (plusp org-drill-cloze-text-weight)))
- (error "Illegal value for org-drill-cloze-text-weight: %S"
- org-drill-cloze-text-weight))
- ((zerop (mod (1+ (org-drill-entry-total-repeats 0))
- org-drill-cloze-text-weight))
- ;; Uncommonly, hide any item except the first
- (org-drill-present-multicloze-hide-n 1 t))
- (t
- ;; Commonly, hide first item
- (org-drill-present-multicloze-hide-first))))
- (defun org-drill-present-multicloze-show1-lastmore ()
- "Commonly, hides all pieces except the last. Uncommonly, shows
- any random piece. The effect is similar to 'show1cloze' except
- that the last item is much less likely to be the item that is
- visible.
- The definitions of 'commonly' and 'uncommonly' are determined by
- the value of `org-drill-cloze-text-weight'."
- (cond
- ((null org-drill-cloze-text-weight)
- ;; Behave as show1cloze
- (org-drill-present-multicloze-show1))
- ((not (and (integerp org-drill-cloze-text-weight)
- (plusp org-drill-cloze-text-weight)))
- (error "Illegal value for org-drill-cloze-text-weight: %S"
- org-drill-cloze-text-weight))
- ((zerop (mod (1+ (org-drill-entry-total-repeats 0))
- org-drill-cloze-text-weight))
- ;; Uncommonly, show any item except the last
- (org-drill-present-multicloze-hide-n -1 nil nil t))
- (t
- ;; Commonly, show the LAST item
- (org-drill-present-multicloze-hide-n -1 nil t))))
- (defun org-drill-present-multicloze-show1-firstless ()
- "Commonly, hides all pieces except one, where the shown piece
- is guaranteed NOT to be the first piece. Uncommonly, shows any
- random piece. The effect is similar to 'show1cloze' except that
- the first item is much less likely to be the item that is
- visible.
- The definitions of 'commonly' and 'uncommonly' are determined by
- the value of `org-drill-cloze-text-weight'."
- (cond
- ((null org-drill-cloze-text-weight)
- ;; Behave as show1cloze
- (org-drill-present-multicloze-show1))
- ((not (and (integerp org-drill-cloze-text-weight)
- (plusp org-drill-cloze-text-weight)))
- (error "Illegal value for org-drill-cloze-text-weight: %S"
- org-drill-cloze-text-weight))
- ((zerop (mod (1+ (org-drill-entry-total-repeats 0))
- org-drill-cloze-text-weight))
- ;; Uncommonly, show the first item
- (org-drill-present-multicloze-hide-n -1 t))
- (t
- ;; Commonly, show any item, except the first
- (org-drill-present-multicloze-hide-n -1 nil nil t))))
- (defun org-drill-present-multicloze-show1 ()
- "Similar to `org-drill-present-multicloze-hide1', but hides all
- the pieces of text that are marked for cloze deletion, except for one
- piece which is chosen at random."
- (org-drill-present-multicloze-hide-n -1))
- (defun org-drill-present-multicloze-show2 ()
- "Similar to `org-drill-present-multicloze-show1', but reveals two
- pieces rather than one."
- (org-drill-present-multicloze-hide-n -2))
- (defun org-drill-present-card-using-text (question &optional answer)
- "Present the string QUESTION as the only visible content of the card.
- If ANSWER is supplied, set the global variable `drill-answer' to its value."
- (if answer (setq drill-answer answer))
- (with-hidden-comments
- (with-replaced-entry-text
- (concat "\n" question)
- (org-drill-hide-all-subheadings-except nil)
- (org-cycle-hide-drawers 'all)
- (ignore-errors
- (org-display-inline-images t))
- (prog1 (org-drill-presentation-prompt)
- (org-drill-hide-subheadings-if 'org-drill-entry-p)))))
- (defun org-drill-present-card-using-multiple-overlays (replacements &optional answer)
- "TEXTS is a list of valid values for the 'display' text property.
- Present these overlays, in sequence, as the only
- visible content of the card.
- If ANSWER is supplied, set the global variable `drill-answer' to its value."
- (if answer (setq drill-answer answer))
- (with-hidden-comments
- (with-replaced-entry-text-multi
- replacements
- (org-drill-hide-all-subheadings-except nil)
- (org-cycle-hide-drawers 'all)
- (ignore-errors
- (org-display-inline-images t))
- (prog1 (org-drill-presentation-prompt)
- (org-drill-hide-subheadings-if 'org-drill-entry-p)))))
- (defun org-drill-pronounce-word ()
- "Pronounce word after querying."
- (interactive)
- (start-process-shell-command
- "org-drill pronounce"
- nil
- (concat org-drill-pronounce-command
- " " org-drill-pronounce-command-args " "
- (shell-quote-argument
- (substring-no-properties (org-get-heading t t t t))))))
- (defun org-drill-entry ()
- "Present the current topic for interactive review, as in `org-drill'.
- Review will occur regardless of whether the topic is due for review or whether
- it meets the definition of a 'review topic' used by `org-drill'.
- Returns a quality rating from 0 to 5, or nil if the user quit, or the symbol
- EDIT if the user chose to exit the drill and edit the current item. Choosing
- the latter option leaves the drill session suspended; it can be resumed
- later using `org-drill-resume'.
- See `org-drill' for more details."
- (interactive)
- (org-drill-goto-drill-entry-heading)
- ;;(unless (org-part-of-drill-entry-p)
- ;; (error "Point is not inside a drill entry"))
- ;;(unless (org-at-heading-p)
- ;; (org-back-to-heading))
- (let ((card-type (org-entry-get (point) "DRILL_CARD_TYPE" t))
- (answer-fn 'org-drill-present-default-answer)
- (present-empty-cards nil)
- (cont nil)
- ;; fontification functions in `outline-view-change-hook' can cause big
- ;; slowdowns, so we temporarily bind this variable to nil here.
- (outline-view-change-hook nil))
- (setq drill-answer nil)
- (org-save-outline-visibility t
- (save-restriction
- (org-narrow-to-subtree)
- (org-show-subtree)
- (org-cycle-hide-drawers 'all)
- (let ((presentation-fn
- (cdr (assoc card-type org-drill-card-type-alist))))
- (if (listp presentation-fn)
- (psetq answer-fn (or (second presentation-fn)
- 'org-drill-present-default-answer)
- present-empty-cards (third presentation-fn)
- presentation-fn (first presentation-fn)))
- (when org-drill-auto-pronounce (org-drill-pronounce-word))
- (run-hook-with-args 'org-drill-entry-before-hook)
- (prog1
- (cond
- ((null presentation-fn)
- (message "%s:%d: Unrecognised card type '%s', skipping..."
- (buffer-name) (point) card-type)
- (sit-for 0.5)
- 'skip)
- (t
- (setq cont (funcall presentation-fn))
- (cond
- ((not cont)
- (message "Quit")
- nil)
- ((eql cont 'edit)
- 'edit)
- ((eql cont 'skip)
- 'skip)
- (t
- (save-excursion
- (funcall answer-fn
- (lambda () (org-drill-reschedule))))))))
- (run-hook-with-args 'org-drill-entry-after-hook)
- (org-remove-latex-fragment-image-overlays)))))))
- (defun org-drill-entries-pending-p ()
- (or *org-drill-again-entries*
- *org-drill-current-item*
- (and (not (org-drill-maximum-item-count-reached-p))
- (not (org-drill-maximum-duration-reached-p))
- (or *org-drill-new-entries*
- *org-drill-failed-entries*
- *org-drill-young-mature-entries*
- *org-drill-old-mature-entries*
- *org-drill-overdue-entries*
- *org-drill-again-entries*))))
- (defun org-drill-pending-entry-count ()
- (+ (if (markerp *org-drill-current-item*) 1 0)
- (length *org-drill-new-entries*)
- (length *org-drill-failed-entries*)
- (length *org-drill-young-mature-entries*)
- (length *org-drill-old-mature-entries*)
- (length *org-drill-overdue-entries*)
- (length *org-drill-again-entries*)))
- (defun org-drill-maximum-duration-reached-p ()
- "Returns true if the current drill session has continued past its
- maximum duration."
- (and org-drill-maximum-duration
- (not *org-drill-cram-mode*)
- *org-drill-start-time*
- (> (- (float-time (current-time)) *org-drill-start-time*)
- (* org-drill-maximum-duration 60))))
- (defun org-drill-maximum-item-count-reached-p ()
- "Returns true if the current drill session has reached the
- maximum number of items."
- (and org-drill-maximum-items-per-session
- (not *org-drill-cram-mode*)
- (>= (length *org-drill-done-entries*)
- org-drill-maximum-items-per-session)))
- (defun org-drill-pop-next-pending-entry ()
- (block org-drill-pop-next-pending-entry
- (let ((m nil))
- (while (or (null m)
- (not (org-drill-entry-p m)))
- (setq
- m
- (cond
- ;; First priority is items we failed in a prior session.
- ((and *org-drill-failed-entries*
- (not (org-drill-maximum-item-count-reached-p))
- (not (org-drill-maximum-duration-reached-p)))
- (pop-random *org-drill-failed-entries*))
- ;; Next priority is overdue items.
- ((and *org-drill-overdue-entries*
- (not (org-drill-maximum-item-count-reached-p))
- (not (org-drill-maximum-duration-reached-p)))
- ;; We use `pop', not `pop-random', because we have already
- ;; sorted overdue items into a random order which takes
- ;; number of days overdue into account.
- (pop *org-drill-overdue-entries*))
- ;; Next priority is 'young' items.
- ((and *org-drill-young-mature-entries*
- (not (org-drill-maximum-item-count-reached-p))
- (not (org-drill-maximum-duration-reached-p)))
- (pop-random *org-drill-young-mature-entries*))
- ;; Next priority is newly added items, and older entries.
- ;; We pool these into a single group.
- ((and (or *org-drill-new-entries*
- *org-drill-old-mature-entries*)
- (not (org-drill-maximum-item-count-reached-p))
- (not (org-drill-maximum-duration-reached-p)))
- (cond
- ((< (random* (+ (length *org-drill-new-entries*)
- (length *org-drill-old-mature-entries*)))
- (length *org-drill-new-entries*))
- (pop-random *org-drill-new-entries*))
- (t
- (pop-random *org-drill-old-mature-entries*))))
- ;; After all the above are done, last priority is items
- ;; that were failed earlier THIS SESSION.
- (*org-drill-again-entries*
- (pop *org-drill-again-entries*))
- (t ; nothing left -- return nil
- (return-from org-drill-pop-next-pending-entry nil)))))
- m)))
- (defun org-drill-entries (&optional resuming-p)
- "Returns nil, t, or a list of markers representing entries that were
- 'failed' and need to be presented again before the session ends.
- RESUMING-P is true if we are resuming a suspended drill session."
- (block org-drill-entries
- (while (org-drill-entries-pending-p)
- (let ((m (cond
- ((or (not resuming-p)
- (null *org-drill-current-item*)
- (not (org-drill-entry-p *org-drill-current-item*)))
- (org-drill-pop-next-pending-entry))
- (t ; resuming a suspended session.
- (setq resuming-p nil)
- *org-drill-current-item*))))
- (setq *org-drill-current-item* m)
- (unless m
- (error "Unexpectedly ran out of pending drill items"))
- (save-excursion
- (org-drill-goto-entry m)
- (cond
- ((not (org-drill-entry-due-p))
- ;; The entry is not due anymore. This could arise if the user
- ;; suspends a drill session, then drills an individual entry,
- ;; then resumes the session.
- (message "Entry no longer due, skipping...")
- (sit-for 0.3)
- nil)
- (t
- (setq result (org-drill-entry))
- (cond
- ((null result)
- (message "Quit")
- (setq end-pos :quit)
- (return-from org-drill-entries nil))
- ((eql result 'edit)
- (setq end-pos (point-marker))
- (return-from org-drill-entries nil))
- ((eql result 'skip)
- (setq *org-drill-current-item* nil)
- nil) ; skip this item
- (t
- (cond
- ((<= result org-drill-failure-quality)
- (if *org-drill-again-entries*
- (setq *org-drill-again-entries*
- (shuffle-list *org-drill-again-entries*)))
- (push-end m *org-drill-again-entries*))
- (t
- (push m *org-drill-done-entries*)))
- (setq *org-drill-current-item* nil))))))))))
- (defun org-drill-final-report ()
- (let ((pass-percent
- (round (* 100 (count-if (lambda (qual)
- (> qual org-drill-failure-quality))
- *org-drill-session-qualities*))
- (max 1 (length *org-drill-session-qualities*))))
- (prompt nil)
- (max-mini-window-height 0.6))
- (setq prompt
- (format
- "%d items reviewed. Session duration %s.
- Recall of reviewed items:
- Excellent (5): %3d%% | Near miss (2): %3d%%
- Good (4): %3d%% | Failure (1): %3d%%
- Hard (3): %3d%% | Abject failure (0): %3d%%
- You successfully recalled %d%% of reviewed items (quality > %s)
- %d/%d items still await review (%s, %s, %s, %s, %s).
- Tomorrow, %d more items will become due for review.
- Session finished. Press a key to continue..."
- (length *org-drill-done-entries*)
- (format-seconds "%h:%.2m:%.2s"
- (- (float-time (current-time)) *org-drill-start-time*))
- (round (* 100 (count 5 *org-drill-session-qualities*))
- (max 1 (length *org-drill-session-qualities*)))
- (round (* 100 (count 2 *org-drill-session-qualities*))
- (max 1 (length *org-drill-session-qualities*)))
- (round (* 100 (count 4 *org-drill-session-qualities*))
- (max 1 (length *org-drill-session-qualities*)))
- (round (* 100 (count 1 *org-drill-session-qualities*))
- (max 1 (length *org-drill-session-qualities*)))
- (round (* 100 (count 3 *org-drill-session-qualities*))
- (max 1 (length *org-drill-session-qualities*)))
- (round (* 100 (count 0 *org-drill-session-qualities*))
- (max 1 (length *org-drill-session-qualities*)))
- pass-percent
- org-drill-failure-quality
- (org-drill-pending-entry-count)
- (+ (org-drill-pending-entry-count)
- *org-drill-dormant-entry-count*)
- (propertize
- (format "%d failed"
- (+ (length *org-drill-failed-entries*)
- (length *org-drill-again-entries*)))
- 'face `(:foreground ,org-drill-failed-count-color))
- (propertize
- (format "%d overdue"
- (length *org-drill-overdue-entries*))
- 'face `(:foreground ,org-drill-failed-count-color))
- (propertize
- (format "%d new"
- (length *org-drill-new-entries*))
- 'face `(:foreground ,org-drill-new-count-color))
- (propertize
- (format "%d young"
- (length *org-drill-young-mature-entries*))
- 'face `(:foreground ,org-drill-mature-count-color))
- (propertize
- (format "%d old"
- (length *org-drill-old-mature-entries*))
- 'face `(:foreground ,org-drill-mature-count-color))
- *org-drill-due-tomorrow-count*
- ))
- (while (not (input-pending-p))
- (message "%s" prompt)
- (sit-for 0.5))
- (read-char-exclusive)
- (if (and *org-drill-session-qualities*
- (< pass-percent (- 100 org-drill-forgetting-index)))
- (read-char-exclusive
- (format
- "%s
- You failed %d%% of the items you reviewed during this session.
- %d (%d%%) of all items scanned were overdue.
- Are you keeping up with your items, and reviewing them
- when they are scheduled? If so, you may want to consider
- lowering the value of `org-drill-learn-fraction' slightly in
- order to make items appear more frequently over time."
- (propertize "WARNING!" 'face 'org-warning)
- (- 100 pass-percent)
- *org-drill-overdue-entry-count*
- (round (* 100 *org-drill-overdue-entry-count*)
- (+ *org-drill-dormant-entry-count*
- *org-drill-due-entry-count*)))
- ))))
- (defun org-drill-free-markers (markers)
- "MARKERS is a list of markers, all of which will be freed (set to
- point nowhere). Alternatively, MARKERS can be 't', in which case
- all the markers used by Org-Drill will be freed."
- (dolist (m (if (eql t markers)
- (append *org-drill-done-entries*
- *org-drill-new-entries*
- *org-drill-failed-entries*
- *org-drill-again-entries*
- *org-drill-overdue-entries*
- *org-drill-young-mature-entries*
- *org-drill-old-mature-entries*)
- markers))
- (free-marker m)))
- ;;; overdue-data is a list of entries, each entry has the form (POS DUE AGE)
- ;;; where POS is a marker pointing to the start of the entry, and
- ;;; DUE is a number indicating how many days ago the entry was due.
- ;;; AGE is the number of days elapsed since item creation (nil if unknown).
- ;;; if age > lapse threshold (default 90), sort by age (oldest first)
- ;;; if age < lapse threshold, sort by due (biggest first)
- (defun org-drill-order-overdue-entries (overdue-data)
- (let* ((lapsed-days (if org-drill--lapse-very-overdue-entries-p
- 90 most-positive-fixnum))
- (not-lapsed (remove-if (lambda (a) (> (or (second a) 0) lapsed-days))
- overdue-data))
- (lapsed (remove-if-not (lambda (a) (> (or (second a) 0)
- lapsed-days)) overdue-data)))
- (setq *org-drill-overdue-entries*
- (mapcar 'first
- (append
- (sort (shuffle-list not-lapsed)
- (lambda (a b) (> (second a) (second b))))
- (sort lapsed
- (lambda (a b) (> (third a) (third b)))))))))
- (defun org-drill--entry-lapsed-p ()
- (let ((lapsed-days 90))
- (and org-drill--lapse-very-overdue-entries-p
- (> (or (org-drill-entry-days-overdue) 0) lapsed-days))))
- (defun org-drill-entry-days-since-creation (&optional use-last-interval-p)
- "If USE-LAST-INTERVAL-P is non-nil, and DATE_ADDED is missing, use the
- value of DRILL_LAST_INTERVAL instead (as the item's age must be at least
- that many days)."
- (let ((timestamp (org-entry-get (point) "DATE_ADDED")))
- (cond
- (timestamp
- (- (org-time-stamp-to-now timestamp)))
- (use-last-interval-p
- (+ (or (org-drill-entry-days-overdue) 0)
- (read (or (org-entry-get (point) "DRILL_LAST_INTERVAL") "0"))))
- (t nil))))
- (defun org-drill-entry-status ()
- "Returns a list (STATUS DUE AGE) where DUE is the number of days overdue,
- zero being due today, -1 being scheduled 1 day in the future.
- AGE is the number of days elapsed since the item was created (nil if unknown).
- STATUS is one of the following values:
- - nil, if the item is not a drill entry, or has an empty body
- - :unscheduled
- - :future
- - :new
- - :failed
- - :overdue
- - :young
- - :old
- "
- (save-excursion
- (unless (org-at-heading-p)
- (org-back-to-heading))
- (let ((due (org-drill-entry-days-overdue))
- (age (org-drill-entry-days-since-creation t))
- (last-int (org-drill-entry-last-interval 1)))
- (list
- (cond
- ((not (org-drill-entry-p))
- nil)
- ((and (org-entry-empty-p)
- (let* ((card-type (org-entry-get (point) "DRILL_CARD_TYPE" nil))
- (dat (cdr (assoc card-type org-drill-card-type-alist))))
- (or (null card-type)
- (not (third dat)))))
- ;; body is empty, and this is not a card type where empty bodies are
- ;; meaningful, so skip it.
- nil)
- ((null due) ; unscheduled - usually a skipped leech
- :unscheduled)
- ;; ((eql -1 due)
- ;; :tomorrow)
- ((minusp due) ; scheduled in the future
- :future)
- ;; The rest of the stati all denote 'due' items ==========================
- ((<= (org-drill-entry-last-quality 9999)
- org-drill-failure-quality)
- ;; Mature entries that were failed last time are
- ;; FAILED, regardless of how young, old or overdue
- ;; they are.
- :failed)
- ((org-drill-entry-new-p)
- :new)
- ((org-drill-entry-overdue-p due last-int)
- ;; Overdue status overrides young versus old
- ;; distinction.
- ;; Store marker + due, for sorting of overdue entries
- :overdue)
- ((<= (org-drill-entry-last-interval 9999)
- org-drill-days-before-old)
- :young)
- (t
- :old))
- due age))))
- (defun org-drill-progress-message (collected scanned)
- (when (zerop (% scanned 50))
- (let* ((meter-width 40)
- (sym1 (if (oddp (floor scanned (* 50 meter-width))) ?| ?.))
- (sym2 (if (eql sym1 ?.) ?| ?.)))
- (message "Collecting due drill items:%4d %s%s"
- collected
- (make-string (% (ceiling scanned 50) meter-width)
- sym2)
- (make-string (- meter-width (% (ceiling scanned 50) meter-width))
- sym1)))))
- (defun org-map-drill-entry-function ()
- (org-drill-progress-message
- (+ (length *org-drill-new-entries*)
- (length *org-drill-overdue-entries*)
- (length *org-drill-young-mature-entries*)
- (length *org-drill-old-mature-entries*)
- (length *org-drill-failed-entries*))
- (incf cnt))
- (cond
- ((not (org-drill-entry-p))
- nil) ; skip
- (t
- (when (and (not warned-about-id-creation)
- (null (org-id-get)))
- (message (concat "Creating unique IDs for items "
- "(slow, but only happens once)"))
- (sit-for 0.5)
- (setq warned-about-id-creation t))
- (org-id-get-create) ; ensure drill entry has unique ID
- (destructuring-bind (status due age)
- (org-drill-entry-status)
- (case status
- (:unscheduled
- (incf *org-drill-dormant-entry-count*))
- ;; (:tomorrow
- ;; (incf *org-drill-dormant-entry-count*)
- ;; (incf *org-drill-due-tomorrow-count*))
- (:future
- (incf *org-drill-dormant-entry-count*)
- (if (eq -1 due)
- (incf *org-drill-due-tomorrow-count*)))
- (:new
- (push (point-marker) *org-drill-new-entries*))
- (:failed
- (push (point-marker) *org-drill-failed-entries*))
- (:young
- (push (point-marker) *org-drill-young-mature-entries*))
- (:overdue
- (push (list (point-marker) due age) overdue-data))
- (:old
- (push (point-marker) *org-drill-old-mature-entries*))
- )))))
- (defun org-drill (&optional scope drill-match resume-p)
- "Begin an interactive 'drill session'. The user is asked to
- review a series of topics (headers). Each topic is initially
- presented as a 'question', often with part of the topic content
- hidden. The user attempts to recall the hidden information or
- answer the question, then presses a key to reveal the answer. The
- user then rates his or her recall or performance on that
- topic. This rating information is used to reschedule the topic
- for future review.
- Org-drill proceeds by:
- - Finding all topics (headings) in SCOPE which have either been
- used and rescheduled before, or which have a tag that matches
- `org-drill-question-tag'.
- - All matching topics which are either unscheduled, or are
- scheduled for the current date or a date in the past, are
- considered to be candidates for the drill session.
- - If `org-drill-maximum-items-per-session' is set, a random
- subset of these topics is presented. Otherwise, all of the
- eligible topics will be presented.
- SCOPE determines the scope in which to search for
- questions. It accepts the same values as `org-drill-scope',
- which see.
- DRILL-MATCH, if supplied, is a string specifying a tags/property/
- todo query. Only items matching the query will be considered.
- It accepts the same values as `org-drill-match', which see.
- If RESUME-P is non-nil, resume a suspended drill session rather
- than starting a new one."
- (interactive)
- ;; Check org version. Org 7.9.3f introduced a backwards-incompatible change
- ;; to the arguments accepted by `org-schedule'. At the time of writing there
- ;; are still lots of people using versions of org older than this.
- (let ((majorv (first (mapcar 'string-to-number (split-string (org-release) "[.]")))))
- (if (and (< majorv 8)
- (not (string-match-p "universal prefix argument" (documentation 'org-schedule))))
- (read-char-exclusive
- (format "Warning: org-drill requires org mode 7.9.3f or newer. Scheduling of failed cards will not
- work correctly with older versions of org mode. Your org mode version (%s) appears to be older than
- 7.9.3f. Please consider installing a more recent version of org mode." (org-release)))))
- (let ((end-pos nil)
- (overdue-data nil)
- (cnt 0))
- (block org-drill
- (unless resume-p
- (org-drill-free-markers t)
- (setq *org-drill-current-item* nil
- *org-drill-done-entries* nil
- *org-drill-dormant-entry-count* 0
- *org-drill-due-entry-count* 0
- *org-drill-due-tomorrow-count* 0
- *org-drill-overdue-entry-count* 0
- *org-drill-new-entries* nil
- *org-drill-overdue-entries* nil
- *org-drill-young-mature-entries* nil
- *org-drill-old-mature-entries* nil
- *org-drill-failed-entries* nil
- *org-drill-again-entries* nil)
- (setq *org-drill-session-qualities* nil)
- (setq *org-drill-start-time* (float-time (current-time))))
- (setq *random-state* (make-random-state t)) ; reseed RNG
- (unwind-protect
- (save-excursion
- (unless resume-p
- (let ((org-trust-scanner-tags t)
- (warned-about-id-creation nil))
- (org-map-drill-entries
- 'org-map-drill-entry-function
- scope drill-match)
- (org-drill-order-overdue-entries overdue-data)
- (setq *org-drill-overdue-entry-count*
- (length *org-drill-overdue-entries*))))
- (setq *org-drill-due-entry-count* (org-drill-pending-entry-count))
- (cond
- ((and (null *org-drill-current-item*)
- (null *org-drill-new-entries*)
- (null *org-drill-failed-entries*)
- (null *org-drill-overdue-entries*)
- (null *org-drill-young-mature-entries*)
- (null *org-drill-old-mature-entries*))
- (message "I did not find any pending drill items."))
- (t
- (org-drill-entries resume-p)
- (message "Drill session finished!"))))
- (progn
- (unless end-pos
- (setq *org-drill-cram-mode* nil)
- (org-drill-free-markers *org-drill-done-entries*)))))
- (cond
- (end-pos
- (when (markerp end-pos)
- (org-drill-goto-entry end-pos)
- (org-reveal)
- (org-show-entry))
- (let ((keystr (command-keybinding-to-string 'org-drill-resume)))
- (message
- "You can continue the drill session with the command `org-drill-resume'.%s"
- (if keystr (format "\nYou can run this command by pressing %s." keystr)
- ""))))
- (t
- (org-drill-final-report)
- (if (eql 'sm5 org-drill-spaced-repetition-algorithm)
- (org-drill-save-optimal-factor-matrix))
- (if org-drill-save-buffers-after-drill-sessions-p
- (save-some-buffers))
- (message "Drill session finished!")
- ))))
- (defun org-drill-save-optimal-factor-matrix ()
- (savehist-autosave))
- (defun org-drill-cram (&optional scope drill-match)
- "Run an interactive drill session in 'cram mode'. In cram mode,
- all drill items are considered to be due for review, unless they
- have been reviewed within the last `org-drill-cram-hours'
- hours."
- (interactive)
- (setq *org-drill-cram-mode* t)
- (org-drill scope drill-match))
- (defun org-drill-tree ()
- "Run an interactive drill session using drill items within the
- subtree at point."
- (interactive)
- (org-drill 'tree))
- (defun org-drill-directory ()
- "Run an interactive drill session using drill items from all org
- files in the same directory as the current file."
- (interactive)
- (org-drill 'directory))
- (defun org-drill-again (&optional scope drill-match)
- "Run a new drill session, but try to use leftover due items that
- were not reviewed during the last session, rather than scanning for
- unreviewed items. If there are no leftover items in memory, a full
- scan will be performed."
- (interactive)
- (setq *org-drill-cram-mode* nil)
- (cond
- ((plusp (org-drill-pending-entry-count))
- (org-drill-free-markers *org-drill-done-entries*)
- (if (markerp *org-drill-current-item*)
- (free-marker *org-drill-current-item*))
- (setq *org-drill-start-time* (float-time (current-time))
- *org-drill-done-entries* nil
- *org-drill-current-item* nil)
- (org-drill scope drill-match t))
- (t
- (org-drill scope drill-match))))
- (defun org-drill-resume ()
- "Resume a suspended drill session. Sessions are suspended by
- exiting them with the `edit' or `quit' options."
- (interactive)
- (cond
- ((org-drill-entries-pending-p)
- (org-drill nil nil t))
- ((and (plusp (org-drill-pending-entry-count))
- ;; Current drill session is finished, but there are still
- ;; more items which need to be reviewed.
- (y-or-n-p (format
- "You have finished the drill session. However, %d items still
- need reviewing. Start a new drill session? "
- (org-drill-pending-entry-count))))
- (org-drill-again))
- (t
- (message "You have finished the drill session."))))
- (defun org-drill-relearn-item ()
- "Make the current item due for revision, and set its last interval to 0.
- Makes the item behave as if it has been failed, without actually recording a
- failure. This command can be used to 'reset' repetitions for an item."
- (interactive)
- (org-drill-smart-reschedule 4 0))
- (defun org-drill-strip-entry-data ()
- (dolist (prop org-drill-scheduling-properties)
- (org-delete-property prop))
- (org-schedule '(4)))
- (defun org-drill-strip-all-data (&optional scope)
- "Delete scheduling data from every drill entry in scope. This
- function may be useful if you want to give your collection of
- entries to someone else. Scope defaults to the current buffer,
- and is specified by the argument SCOPE, which accepts the same
- values as `org-drill-scope'."
- (interactive)
- (when (yes-or-no-p
- "Delete scheduling data from ALL items in scope: are you sure?")
- (cond
- ((null scope)
- ;; Scope is the current buffer. This means we can use
- ;; `org-delete-property-globally', which is faster.
- (dolist (prop org-drill-scheduling-properties)
- (org-delete-property-globally prop))
- (org-map-drill-entries (lambda () (org-schedule '(4))) scope))
- (t
- (org-map-drill-entries 'org-drill-strip-entry-data scope)))
- (message "Done.")))
- (defun org-drill-add-cloze-fontification ()
- ;; Compute local versions of the regexp for cloze deletions, in case
- ;; the left and right delimiters are redefined locally.
- (setq-local org-drill-cloze-regexp (org-drill--compute-cloze-regexp))
- (setq-local org-drill-cloze-keywords (org-drill--compute-cloze-keywords))
- (when org-drill-use-visible-cloze-face-p
- (add-to-list 'org-font-lock-extra-keywords
- (first org-drill-cloze-keywords))))
- ;; Can't add to org-mode-hook, because local variables won't have been loaded
- ;; yet.
- ;; (defun org-drill-add-cloze-fontification ()
- ;; (when (eql major-mode 'org-mode)
- ;; ;; Compute local versions of the regexp for cloze deletions, in case
- ;; ;; the left and right delimiters are redefined locally.
- ;; (setq-local org-drill-cloze-regexp (org-drill--compute-cloze-regexp))
- ;; (setq-local org-drill-cloze-keywords (org-drill--compute-cloze-keywords))
- ;; (when org-drill-use-visible-cloze-face-p
- ;; (font-lock-add-keywords nil ;'org-mode
- ;; org-drill-cloze-keywords
- ;; nil))))
- ;; XXX
- ;; (add-hook 'hack-local-variables-hook
- ;; 'org-drill-add-cloze-fontification)
- ;;
- ;; (org-drill-add-cloze-fontification)
- ;;; Synching card collections =================================================
- (defvar *org-drill-dest-id-table* (make-hash-table :test 'equal))
- (defun org-drill-copy-entry-to-other-buffer (dest &optional path)
- "Copy the subtree at point to the buffer DEST. The copy will receive
- the tag 'imported'."
- (block org-drill-copy-entry-to-other-buffer
- (save-excursion
- (let ((src (current-buffer))
- (m nil))
- (cl-flet ((paste-tree-here (&optional level)
- (org-paste-subtree level)
- (org-drill-strip-entry-data)
- (org-toggle-tag "imported" 'on)
- (org-map-drill-entries
- (lambda ()
- (let ((id (org-id-get)))
- (org-drill-strip-entry-data)
- (unless (gethash id *org-drill-dest-id-table*)
- (puthash id (point-marker)
- *org-drill-dest-id-table*))))
- 'tree)))
- (unless path
- (setq path (org-get-outline-path)))
- (org-copy-subtree)
- (switch-to-buffer dest)
- (setq m
- (condition-case nil
- (org-find-olp path t)
- (error ; path does not exist in DEST
- (return-from org-drill-copy-entry-to-other-buffer
- (cond
- ((cdr path)
- (org-drill-copy-entry-to-other-buffer
- dest (butlast path)))
- (t
- ;; We've looked all the way up the path
- ;; Default to appending to the end of DEST
- (goto-char (point-max))
- (newline)
- (paste-tree-here)))))))
- (goto-char m)
- (outline-next-heading)
- (newline)
- (forward-line -1)
- (paste-tree-here (1+ (or (org-current-level) 0)))
- )))))
- (defun org-drill-merge-buffers (src &optional dest ignore-new-items-p)
- "SRC and DEST are two org mode buffers containing drill items.
- For each drill item in DEST that shares an ID with an item in SRC,
- overwrite scheduling data in DEST with data taken from the item in SRC.
- This is intended for use when two people are sharing a set of drill items,
- one person has made some updates to the item set, and the other person
- wants to migrate to the updated set without losing their scheduling data.
- By default, any drill items in SRC which do not exist in DEST are
- copied into DEST. We attempt to place the copied item in the
- equivalent location in DEST to its location in SRC, by matching
- the heading hierarchy. However if IGNORE-NEW-ITEMS-P is non-nil,
- we simply ignore any items that do not exist in DEST, and do not
- copy them across."
- (interactive "bImport scheduling info from which buffer?")
- (unless dest
- (setq dest (current-buffer)))
- (setq src (get-buffer src)
- dest (get-buffer dest))
- (when (yes-or-no-p
- (format
- (concat "About to overwrite all scheduling data for drill items in `%s' "
- "with information taken from matching items in `%s'. Proceed? ")
- (buffer-name dest) (buffer-name src)))
- ;; Compile list of all IDs in the destination buffer.
- (clrhash *org-drill-dest-id-table*)
- (with-current-buffer dest
- (org-map-drill-entries
- (lambda ()
- (let ((this-id (org-id-get)))
- (when this-id
- (puthash this-id (point-marker) *org-drill-dest-id-table*))))
- 'file))
- ;; Look through all entries in source buffer.
- (with-current-buffer src
- (org-map-drill-entries
- (lambda ()
- (let ((id (org-id-get))
- (last-quality nil) (last-reviewed nil)
- (scheduled-time nil))
- (cond
- ((or (null id)
- (not (org-drill-entry-p)))
- nil)
- ((gethash id *org-drill-dest-id-table*)
- ;; This entry matches an entry in dest. Retrieve all its
- ;; scheduling data, then go to the matching location in dest
- ;; and write the data.
- (let ((marker (gethash id *org-drill-dest-id-table*)))
- (destructuring-bind (last-interval repetitions failures
- total-repeats meanq ease)
- (org-drill-get-item-data)
- (setq last-reviewed (org-entry-get (point) "DRILL_LAST_REVIEWED")
- last-quality (org-entry-get (point) "DRILL_LAST_QUALITY")
- scheduled-time (org-get-scheduled-time (point)))
- (save-excursion
- ;; go to matching entry in destination buffer
- (switch-to-buffer (marker-buffer marker))
- (goto-char marker)
- (org-drill-strip-entry-data)
- (unless (zerop total-repeats)
- (org-drill-store-item-data last-interval repetitions failures
- total-repeats meanq ease)
- (if last-quality
- (org-set-property "LAST_QUALITY" last-quality)
- (org-delete-property "LAST_QUALITY"))
- (if last-reviewed
- (org-set-property "LAST_REVIEWED" last-reviewed)
- (org-delete-property "LAST_REVIEWED"))
- (if scheduled-time
- (org-schedule nil scheduled-time)))))
- (remhash id *org-drill-dest-id-table*)
- (free-marker marker)))
- (t
- ;; item in SRC has ID, but no matching ID in DEST.
- ;; It must be a new item that does not exist in DEST.
- ;; Copy the entire item to the *end* of DEST.
- (unless ignore-new-items-p
- (org-drill-copy-entry-to-other-buffer dest))))))
- 'file))
- ;; Finally: there may be some items in DEST which are not in SRC, and
- ;; which have been scheduled by another user of DEST. Clear out the
- ;; scheduling info from all the unmatched items in DEST.
- (with-current-buffer dest
- (maphash (lambda (id m)
- (goto-char m)
- (org-drill-strip-entry-data)
- (free-marker m))
- *org-drill-dest-id-table*))))
- ;;; Card types for learning languages =========================================
- ;;; Get spell-number.el from:
- ;;; http://www.emacswiki.org/emacs/spell-number.el
- (autoload 'spelln-integer-in-words "spell-number")
- ;;; `conjugate' card type =====================================================
- ;;; See spanish.org for usage
- (defvar org-drill-verb-tense-alist
- '(("present" "tomato")
- ("simple present" "tomato")
- ("present indicative" "tomato")
- ;; past tenses
- ("past" "purple")
- ("simple past" "purple")
- ("preterite" "purple")
- ("imperfect" "darkturquoise")
- ("present perfect" "royalblue")
- ;; future tenses
- ("future" "green")
- ;; moods (backgrounds).
- ("indicative" nil) ; default
- ("subjunctive" "medium blue")
- ("conditional" "grey30")
- ("negative imperative" "red4")
- ("positive imperative" "darkgreen")
- )
- "Alist where each entry has the form (TENSE COLOUR), where
- TENSE is a string naming a tense in which verbs can be
- conjugated, and COLOUR is a string specifying a foreground colour
- which will be used by `org-drill-present-verb-conjugation' and
- `org-drill-show-answer-verb-conjugation' to fontify the verb and
- the name of the tense.")
- (defun org-drill-get-verb-conjugation-info ()
- "Auxiliary function used by `org-drill-present-verb-conjugation' and
- `org-drill-show-answer-verb-conjugation'."
- (let ((infinitive (org-entry-get (point) "VERB_INFINITIVE" t))
- (inf-hint (org-entry-get (point) "VERB_INFINITIVE_HINT" t))
- (translation (org-entry-get (point) "VERB_TRANSLATION" t))
- (tense (org-entry-get (point) "VERB_TENSE" nil))
- (mood (org-entry-get (point) "VERB_MOOD" nil))
- (highlight-face nil))
- (unless (and infinitive translation (or tense mood))
- (error "Missing information for verb conjugation card (%s, %s, %s, %s) at %s"
- infinitive translation tense mood (point)))
- (setq tense (if tense (downcase (car (read-from-string tense))))
- mood (if mood (downcase (car (read-from-string mood))))
- infinitive (car (read-from-string infinitive))
- inf-hint (if inf-hint (car (read-from-string inf-hint)))
- translation (car (read-from-string translation)))
- (setq highlight-face
- (list :foreground
- (or (second (assoc-string tense org-drill-verb-tense-alist t))
- "hotpink")
- :background
- (second (assoc-string mood org-drill-verb-tense-alist t))))
- (setq infinitive (propertize infinitive 'face highlight-face))
- (setq translation (propertize translation 'face highlight-face))
- (if tense (setq tense (propertize tense 'face highlight-face)))
- (if mood (setq mood (propertize mood 'face highlight-face)))
- (list infinitive inf-hint translation tense mood)))
- (defun org-drill-present-verb-conjugation ()
- "Present a drill entry whose card type is 'conjugate'."
- (cl-flet ((tense-and-mood-to-string
- (tense mood)
- (cond
- ((and tense mood)
- (format "%s tense, %s mood" tense mood))
- (tense
- (format "%s tense" tense))
- (mood
- (format "%s mood" mood)))))
- (destructuring-bind (infinitive inf-hint translation tense mood)
- (org-drill-get-verb-conjugation-info)
- (org-drill-present-card-using-text
- (cond
- ((zerop (random* 2))
- (format "\nTranslate the verb\n\n%s\n\nand conjugate for the %s.\n\n"
- infinitive (tense-and-mood-to-string tense mood)))
- (t
- (format "\nGive the verb that means\n\n%s %s\n
- and conjugate for the %s.\n\n"
- translation
- (if inf-hint (format " [HINT: %s]" inf-hint) "")
- (tense-and-mood-to-string tense mood))))))))
- (defun org-drill-show-answer-verb-conjugation (reschedule-fn)
- "Show the answer for a drill item whose card type is 'conjugate'.
- RESCHEDULE-FN must be a function that calls `org-drill-reschedule' and
- returns its return value."
- (destructuring-bind (infinitive inf-hint translation tense mood)
- (org-drill-get-verb-conjugation-info)
- (with-replaced-entry-heading
- (format "%s of %s ==> %s\n\n"
- (capitalize
- (cond
- ((and tense mood)
- (format "%s tense, %s mood" tense mood))
- (tense
- (format "%s tense" tense))
- (mood
- (format "%s mood" mood))))
- infinitive translation)
- (org-cycle-hide-drawers 'all)
- (funcall reschedule-fn))))
- ;;; `decline_noun' card type ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (defvar org-drill-noun-gender-alist
- '(("masculine" "dodgerblue")
- ("masc" "dodgerblue")
- ("male" "dodgerblue")
- ("m" "dodgerblue")
- ("feminine" "orchid")
- ("fem" "orchid")
- ("female" "orchid")
- ("f" "orchid")
- ("neuter" "green")
- ("neutral" "green")
- ("neut" "green")
- ("n" "green")
- ))
- (defun org-drill-get-noun-info ()
- "Auxiliary function used by `org-drill-present-noun-declension' and
- `org-drill-show-answer-noun-declension'."
- (let ((noun (org-entry-get (point) "NOUN" t))
- (noun-hint (org-entry-get (point) "NOUN_HINT" t))
- (noun-root (org-entry-get (point) "NOUN_ROOT" t))
- (noun-gender (org-entry-get (point) "NOUN_GENDER" t))
- (translation (org-entry-get (point) "NOUN_TRANSLATION" t))
- (highlight-face nil))
- (unless (and noun translation)
- (error "Missing information for `decline_noun' card (%s, %s, %s, %s) at %s"
- noun translation noun-hint noun-root (point)))
- (setq noun-root (if noun-root (car (read-from-string noun-root)))
- noun (car (read-from-string noun))
- noun-gender (downcase (car (read-from-string noun-gender)))
- noun-hint (if noun-hint (car (read-from-string noun-hint)))
- translation (car (read-from-string translation)))
- (setq highlight-face
- (list :foreground
- (or (second (assoc-string noun-gender
- org-drill-noun-gender-alist t))
- "red")))
- (setq noun (propertize noun 'face highlight-face))
- (setq translation (propertize translation 'face highlight-face))
- (list noun noun-root noun-gender noun-hint translation)))
- (defun org-drill-present-noun-declension ()
- "Present a drill entry whose card type is 'decline_noun'."
- (destructuring-bind (noun noun-root noun-gender noun-hint translation)
- (org-drill-get-noun-info)
- (let* ((props (org-entry-properties (point)))
- (definite
- (cond
- ((assoc "DECLINE_DEFINITE" props)
- (propertize (if (org-entry-get (point) "DECLINE_DEFINITE")
- "definite" "indefinite")
- 'face 'warning))
- (t nil)))
- (plural
- (cond
- ((assoc "DECLINE_PLURAL" props)
- (propertize (if (org-entry-get (point) "DECLINE_PLURAL")
- "plural" "singular")
- 'face 'warning))
- (t nil))))
- (org-drill-present-card-using-text
- (cond
- ((zerop (random* 2))
- (format "\nTranslate the noun\n\n%s (%s)\n\nand list its declensions%s.\n\n"
- noun noun-gender
- (if (or plural definite)
- (format " for the %s %s form" definite plural)
- "")))
- (t
- (format "\nGive the noun that means\n\n%s %s\n
- and list its declensions%s.\n\n"
- translation
- (if noun-hint (format " [HINT: %s]" noun-hint) "")
- (if (or plural definite)
- (format " for the %s %s form" definite plural)
- ""))))))))
- (defun org-drill-show-answer-noun-declension (reschedule-fn)
- "Show the answer for a drill item whose card type is 'decline_noun'.
- RESCHEDULE-FN must be a function that calls `org-drill-reschedule' and
- returns its return value."
- (destructuring-bind (noun noun-root noun-gender noun-hint translation)
- (org-drill-get-noun-info)
- (with-replaced-entry-heading
- (format "Declensions of %s (%s) ==> %s\n\n"
- noun noun-gender translation)
- (org-cycle-hide-drawers 'all)
- (funcall reschedule-fn))))
- ;;; `translate_number' card type ==============================================
- ;;; See spanish.org for usage
- (defun spelln-integer-in-language (n lang)
- (let ((spelln-language lang))
- (spelln-integer-in-words n)))
- (defun org-drill-present-translate-number ()
- (let ((num-min (read (org-entry-get (point) "DRILL_NUMBER_MIN")))
- (num-max (read (org-entry-get (point) "DRILL_NUMBER_MAX")))
- (language (read (org-entry-get (point) "DRILL_LANGUAGE" t)))
- (drilled-number 0)
- (drilled-number-direction 'to-english)
- (highlight-face 'font-lock-warning-face))
- (cond
- ((not (fboundp 'spelln-integer-in-words))
- (message "`spell-number.el' not loaded, skipping 'translate_number' card...")
- (sit-for 0.5)
- 'skip)
- ((not (and (numberp num-min) (numberp num-max) language))
- (error "Missing language or minimum or maximum numbers for number card"))
- (t
- (if (> num-min num-max)
- (psetf num-min num-max
- num-max num-min))
- (setq drilled-number
- (+ num-min (random* (abs (1+ (- num-max num-min))))))
- (setq drilled-number-direction
- (if (zerop (random* 2)) 'from-english 'to-english))
- (cond
- ((eql 'to-english drilled-number-direction)
- (org-drill-present-card-using-text
- (format "\nTranslate into English:\n\n%s\n"
- (propertize
- (spelln-integer-in-language drilled-number language)
- 'face highlight-face))
- (spelln-integer-in-language drilled-number 'english-gb)))
- (t
- (org-drill-present-card-using-text
- (format "\nTranslate into %s:\n\n%s\n"
- (capitalize (format "%s" language))
- (propertize
- (spelln-integer-in-language drilled-number 'english-gb)
- 'face highlight-face))
- (spelln-integer-in-language drilled-number language))))))))
- ;; (defun org-drill-show-answer-translate-number (reschedule-fn)
- ;; (let* ((language (read (org-entry-get (point) "DRILL_LANGUAGE" t)))
- ;; (highlight-face 'font-lock-warning-face)
- ;; (non-english
- ;; (let ((spelln-language language))
- ;; (propertize (spelln-integer-in-words *drilled-number*)
- ;; 'face highlight-face)))
- ;; (english
- ;; (let ((spelln-language 'english-gb))
- ;; (propertize (spelln-integer-in-words *drilled-number*)
- ;; 'face 'highlight-face))))
- ;; (with-replaced-entry-text
- ;; (cond
- ;; ((eql 'to-english *drilled-number-direction*)
- ;; (format "\nThe English translation of %s is:\n\n%s\n"
- ;; non-english english))
- ;; (t
- ;; (format "\nThe %s translation of %s is:\n\n%s\n"
- ;; (capitalize (format "%s" language))
- ;; english non-english)))
- ;; (funcall reschedule-fn))))
- ;;; `spanish_verb' card type ==================================================
- ;;; Not very interesting, but included to demonstrate how a presentation
- ;;; function can manipulate which subheading are hidden versus shown.
- (defun org-drill-present-spanish-verb ()
- (let ((prompt nil)
- (reveal-headings nil))
- (with-hidden-comments
- (with-hidden-cloze-hints
- (with-hidden-cloze-text
- (case (random* 6)
- (0
- (org-drill-hide-all-subheadings-except '("Infinitive"))
- (setq prompt
- (concat "Translate this Spanish verb, and conjugate it "
- "for the *present* tense.")
- reveal-headings '("English" "Present Tense" "Notes")))
- (1
- (org-drill-hide-all-subheadings-except '("English"))
- (setq prompt (concat "For the *present* tense, conjugate the "
- "Spanish translation of this English verb.")
- reveal-headings '("Infinitive" "Present Tense" "Notes")))
- (2
- (org-drill-hide-all-subheadings-except '("Infinitive"))
- (setq prompt (concat "Translate this Spanish verb, and "
- "conjugate it for the *past* tense.")
- reveal-headings '("English" "Past Tense" "Notes")))
- (3
- (org-drill-hide-all-subheadings-except '("English"))
- (setq prompt (concat "For the *past* tense, conjugate the "
- "Spanish translation of this English verb.")
- reveal-headings '("Infinitive" "Past Tense" "Notes")))
- (4
- (org-drill-hide-all-subheadings-except '("Infinitive"))
- (setq prompt (concat "Translate this Spanish verb, and "
- "conjugate it for the *future perfect* tense.")
- reveal-headings '("English" "Future Perfect Tense" "Notes")))
- (5
- (org-drill-hide-all-subheadings-except '("English"))
- (setq prompt (concat "For the *future perfect* tense, conjugate the "
- "Spanish translation of this English verb.")
- reveal-headings '("Infinitive" "Future Perfect Tense" "Notes"))))
- (org-cycle-hide-drawers 'all)
- (prog1 (org-drill-presentation-prompt)
- (org-drill-hide-subheadings-if 'org-drill-entry-p)))))))
- (provide 'org-drill)
|