;;;;;;;;;;;;;;;; lojban-flashcard.el ;;;;;;;;;;;;;;;; ;; This file consists of Lars Huttar's flashcard.el modified to work ;; with a specially formatted Lojban gismu list. The included ;; functions and delimiters could be modifed to work with cmavo as well ;; as gismu, but I have not done this. ;;; Modified for Lojban by Robert J. Chassell ;;; Last update: 8 October 1997 ;; -------------------------- ;; This file has two parts: ;; ;; 1. An unmodified copy of Lars Huttar's `flashcard.el', version: 0.95 (beta) ;; 2. Some Emacs Lisp code from a file originally called `fc-fix.el'; ;; this code is appended to Huttar's original. ;; -------------------------- ;; This program should work as-is with the Lojban/English files provided. ;; You must used specially formatted files containing the gismu list. ;; If you do not have the files provided, use the tools in the ;; accompanying `format-gismu-list.el' file to format the gismu list ;; and break it into suitably sized files. ;; I suggest you start with the provided `basic-words' which is a ;; fairly short list. Then work through the sections of the gismu ;; list, files `g1', `g2', etc. ;; Each file must begin with a line saying: ;; !% Fields: english/=/lojban ;; (or similar); otherwise the program fails. See the commentary by ;; Lars Huttar at about line 125 of this file. (Although this program ;; worked when I set it up for this distribution, something may go ;; wrong; it is a good idea to read all the commentary in this file ;; until the actual start of code, and then read the descriptions for ;; each function.) ;; -------------------------- ;;;;;;;;;;;;;;;; How to use this program ;;;;;;;;;;;;;;;; ;; Load this file; type: M-x eval-current-buffer ;; To start, type: M-x flashcard ;; The program will ask you for the name of a file; I suggest you ;; start with `basic-words'. Be sure to write the full, correct path. ;; On a slow machine, startup is slow. ;; To quit, type: q ;;;;;;;; Short list of default key bindings ;;;;;;;; ;; See Mode help for complete list: `C-h m' ;; If name of file is `foo', then score is kept in `foo.fs' by default. ;; f Load a flashcard file ;; d Start drilling on flashcards in memory ;; s Save accumulated score data ;; o Set flashcard options ;; o h Options help ;; h Mode help ;; q Quit ;; u Undo last card ;; To see Flashcard Options, type `o h' (no space) ;; To toggle language of question-answer, type `o a' (no space) ;; To toggle whether multiple choice, type `o m' ;; To set number of choices, if multiple choice, type `o c' and the number ;;;;;;;; Variables ;;;;;;;; ;; You may want to set `fc-flashcard-dir' and `fc-score-dir' ;; differently than their default value of: "~/flashcard". ;; For example: ;; (setq fc-flashcard-dir "/u/flashcard") ;; (setq fc-score-dir "/u/flashcard") ;;;;;;;; Delimiters for multiline gimsu list records ;;;;;;;; ;; These should be the only variables you are at all likely to change. (setq fc-field-delimiter "/=/") (setq fc-record-delimiter "^\*\\|^%") ;; Alternative delimiters: ;(setq fc-field-delimiter "/=/") ;(setq fc-record-delimiter "^\*") ; flashcard.el: flexible drilling on flashcards, 0.95 beta ; ======================================================== ; ; 8 Jun 1994 ; From: huttar@hp750.itg.ti.com (Lars Huttar) ; Organization: IEF Development, Texas Instruments Inc., Plano Texas ; ; Hi folks, ; ; It's about time I posted this flashcard drilling package. It's been ; through some limited beta testing, and some people have found it ; useful. I use it for drilling on Japanese vocabulary. It's a lot ; more streamlined than using cardboard flashcards. The best ; explanation of what flashcard.el does is probably in the comments at ; the beginning of the file. Its salient features are: ; - drilling on files of flashcards, from one "field" to another ; - recording the user's performance, and using past performance ; to focus current drill on what user needs most ; - mixing and drilling on multiple files simultaneously ; - optional multiple-choice mode ; ; I will be leaving my place of computer access in about a week, and I ; don't know if or when I'll have access after that. So if you have ; feedback for me, please don't hesitate. ; ; I hope you find this package useful. ; ; Lars Huttar ; huttar@cs.oberlin.edu ; Dallas, TX USA ; ; ;;; flashcard.el -- a package for drilling on questions and answers. ;;; Copyright (c) 1994 by Lars Huttar ;;; Freely distributable under the GNU GPL. ;;; Version: 0.95 (beta) ;;; Release date: Wed Jun 8 09:50:13 1994 ;;; The author welcomes suggestions and bug reports. ;;; However, the author offers NO WARRANTY, express or implied. ;;; The purpose of `flashcard' is to drill the user over a ;;; user-created database of questions and answers. It records ;;; scores, and can tailor the drill according to the user's past ;;; performance. To quickly summarize its features, I'll describe an ;;; example. ;;; I create a vocabulary file; the top line indicates that there are ;;; two fields in this file, called `dutch' and `english'. (But I ;;; could have three or more fields if desired.) I then enter a bunch ;;; of pairs of Dutch and English words, one pair on a line. E.g.: ;;; !% Fields: dutch english ;;; ;;; wie who ;;; huis house ;;; straat street ;;; etc. Then I can use `flashcard' to drill me on this file, either ;;; presenting me with the `dutch' field and letting me think of the ;;; `english' field, or vice versa. `flashcard' will not check my ;;; answers (unless I'm in multiple-choice mode); I must judge if I ;;; got the answer right or wrong, and hit `r' or `w' accordingly. ;;; `flashcard' keeps score for each field and each record: how many ;;; times I've gotten it right, how many times I've gotten it wrong, ;;; and when was the last time I got it right. This information is ;;; stored in a separate score file. ;;; At some later date I can come back to the same vocabulary ;;; file, and have `flashcard' drill me on selected cards, based ;;; on criteria such as "all cards which I haven't gotten right ;;; in a month" or "all cards which I've gotten right less than ;;; 75% of the time." ;;; Multiple vocabulary files can be loaded, mixed together, and ;;; drilled on simultaneously. When the drilling is done, scores will ;;; be saved to the appropriate separate score files. ;;; Someday perhaps there will be info documentation with all the ;;; information organized, and a nice tutorial. ;;; Some sample Japanese vocabulary files can be obtained by anonymous ;;; ftp from: ;;; crl.nmsu.edu:CLR/multiling/japanese/vocabulary ;;; kuso.shef.ac.uk:pub/japanese/larstango ;;; ftp.cc.monash.edu.au:pub/nihongo/mangajin-vocab ;;; However, you need Mule (Multilingual Emacs) or Nemacs (Japanese ;;; Emacs) to display the characters. ;;; Installation: ;;; Copy flashcard.el into a directory in your load-path. Byte-compile ;;; it if desired. Put the following in your .emacs file: ;;; (autoload 'flashcard "flashcard" ;;; "Use Flashcard package to drill on flashcards." t) ;;; LCD Archive Entry: ;;; flashcard.el|Lars Huttar|huttar@cs.oberlin.edu ;;; |Selective drilling on flashcards, tailored to your past performance ;;; |1994/06/08 09:50:13|0.95| ;;; Note: There is only occurrence of Flashcard going on per emacs process. ;;; To do: ;;; (x means done or fixed) ;;; x put in a proper LCD Entry. ;;; - document what "Overall" and "This card" fields mean. ;;; I.e. "This card" is persistent, and is specific not only to the ;;; card but also to the question/answer field combination. ;;; x speed up response time (especially to `r' and `w' commands) and/or ;;; display "Working..."-type message. ;;; x There seems to be a bug: fc-modified-scores is not being set ;;; to nil after saving. ;;; x oops, the first card is not being filtered for elegibility ;;; criteria. I guess we need to set fc-current-card = -1 and ;;; call fc-next-card. ;;; x probably remove redisplay-question/answer; just erase the buffer ;;; and start over? (what about case of redisplay answer and ... uh...) ;;; x finish multi-choice support by modifying fc-display-answer, (done) ;;; fc-redisplay-{question,answer}, and the mechanism for changing ;;; the options fc-num-choices and fc-multiple-choice (to update ;;; immediately). ;;; - maybe put something in the modeline indicating the filename (or ;;; title) of the (first?) file being drilled on. ;;; x move defun-subst's before the defun's? ;;; x enhance options help by letting user get help for one option ;;; at the bottom of the help buffer by hitting that key. ;;; - maybe a command to go backward without undo. ;;; x add "faces" for a snazzier look; highlight the question and ;;; the answer with a different weight/color/etc. ;;; - maybe I should re-instate separate keys for load-file (chucking ;;; previously loaded vocab) and add-file (adding to previously ;;; loaded vocab). ;;; x new variable fc-num-choices, which controls how many choices ;;; to present in multiple-choice mode. ;;; x Maybe a new variable, fc-filter-equals or some such. ;;; This would mean, filter out cards on which the question field ;;; and the answer field are equal. ;;; x In options, if new value == old value, don't update anything. (done) ;;; x Selection based on score criteria is already in place, and, ;;; I believe, tested. Now set up an interface for setting the ;;; criteria. Use letters l,p,r for options. (done) ;;; x Enhance options help to show current values of options. Use ;;; columns "Key", "Option name", "Current Value". (done) ;;; - This is probably not something I'll do before the first release, ;;; but it's something to think about: auto-saving of scores. ;;; Save the current score data to an auto-save file(s) periodically. ;;; Emacs would take care of this for us, if we kept the score data ;;; in buffers that were visiting those score files. However, that ;;; would be a pretty radical change to the current data structures. ;;; Is there some way to have an arbitrary hook called at auto-save ;;; time, to save some kind of state to a file? Hmm, there is an ;;; auto-save-hook variable, but it's not available in Mule. ;;; Certainly, we want to be able to save score data when Emacs ;;; gets a fatal error. ;;; How does save-some-buffers EXITING work? (it saves some ;;; non-file buffers) ;;; Until this is solved, say in the docs that the user should ;;; save frequently to avoid losing data. ;;; x update the Question/Answer ("foo"): "bar" stuff when changing ;;; the fc-question/answer-field, even when question-field and ;;; answer-field are the same. To do this, abstract out the ;;; functions to redraw question and answer (and other) lines. ;;; (done, I believe) ;;; x Make sure field names are consistent, what with defaults and ;;; all. (done, I think) ;;; x put the loaded records in right order, not reverse order. ;;; Do this by keeping an fc-records-tail variable and using it ;;; to extend the list. (done, I think) ;;; x keep track of the user's scores. Can currently load multiple files, ;;; drill on them together, and save the data into their respective ;;; score files. Tested with multiple files but not in multiple ;;; directions (e.g. eng->dutch, dutch->eng). ;;; / when sure about score file i/o, change %d's to %x's in format. ;;; Actually, why bother? It probably wouldn't make things clearer, ;;; and the space savings would only be about 10%. ;;; x perhaps add a multiple choice option. Then the program could ;;; easily check the user's answer. If so, we should reserve ;;; the keys `a' thru `e' or so. Or maybe use digits? Digits. ;;; - maybe let some fields be declared non-unique; e.g. ;;; a gender field for nouns. Flashcard would not attempt ;;; to drill from that field to other fields, nor store data ;;; about such drills. ;;; - a command, available in either of the two states, that marks the ;;; current flashcard (record) as being well-known, i.e. tells ;;; Flashcard not to drill on it anymore. The flashcard is not ;;; erased from the vocab file, but its score data contains a flag ;;; so it will no longer be drilled on. Thus different students ;;; using the same vocab file can have different words marked as ;;; too easy in their own score files. ;;; - Provide a way to clear the scores for the current card; perhaps ;;; to edit all three values arbitrarily. ;;; x add the ability to back up (just one question or all the way ;;; through a quiz?), undoing whatever score modifications were ;;; done. (done, just one question) ;;; x set up synchronized variables fc-current-card-num and fc-current-card, ;;; to cut down on repeated arefs. (fc-current-card-num would be what ;;; fc-current-card used to be.) (done) ;;; x structure / abstract out the line-positions of the question, ;;; answer, and help areas. Adjust help according to the number ;;; of fields and whether the display-extra-fields variable is set. ;;; Compute each field's position based on the previous, not as ;;; an absolute position. (done) ;;; x Possibly add a variable to turn off help, for slow terminals. ;;; User variables: (defvar fc-flashcard-dir "~/flashcard" "*The default directory for finding flashcard files. Should not end with a slash unless it is just \"/\".") (defvar fc-score-dir "~/flashcard" "*The default directory for saving flashcard score files. Should not end with a slash unless it is just \"/\".") (defvar fc-score-ext "fs" "*The extension used on flashcard score files (not including period).") (defvar fc-field-delimiter "\t" "*The default field delimiter string in flashcard files; a regexp.") (defvar fc-record-delimiter "\n" "*The default record delimiter string in flashcard files; a regexp.") (defvar fc-default-fields '("kanji" "hiragana" "english") "*Default list of field names (strings) for flashcard files. Usually not used, as the field names should be supplied in the files.") (defvar fc-show-other-fields 'answer-only "*When to show fields other than the question and answer fields. If nil, never; if t, always; otherwise, only when displaying an answer.") (defvar fc-auto-shuffle t "*If non-nil, shuffle cards at the start of each drill.") (defvar fc-multiple-choice nil "*If non-nil, drill in multiple-choice mode.") (defvar fc-num-choices 4 "*How many choices to present when fc-multiple-choice is non-nil.") (defvar fc-limit-percent nil "*Maximum percentage-right for cards to be drilled. Limit drill to cards whose percentage guessed right is lower than or equal to this value. If nil, no limit.") (defvar fc-limit-num-right nil "*Maximum number of times guessed right for cards to be drilled. Limit drill to cards that have been guessed right this many times or fewer. If nil, no limit.") (defvar fc-limit-last-right nil "*Minimum no. of days since last time gotten right, for cards to be drilled. Limit drill to cards that not have been guessed right as recently as this many days ago. If nil, no limit.") (defvar fc-filter-equals t "*If non-nil, don't drill on cards whose question and answer are the same.") (defvar fc-display-help t "*If non-nil, display help below question/answer.") (defvar fc-question-face 'bold "*Typeface for question text, if possible. Nil for none. Here's an example of an easy way to create a custom face (in emacs 19): (require 'hilit19) (setq fc-question-face (hilit-lookup-face-create 'firebrick-italic)) ") ;;or ;; (setq fc-question-face 'question) ;; (hilit-translate question 'hex-007039-bold) ;; no, I guess that doesn't work. (defvar fc-answer-face 'bold "*Typeface for answer text, if possible. Nil for none. See documentation for fc-question-face.") (defvar flashcard-mode-hooks nil "*Hooks run after initializing flashcard-mode, before loading any files. A good place to set key bindings in flashcard-mode-map.") (defvar flashcard-mode-map nil "*Keymap for flashcard-mode.") (if flashcard-mode-map nil ;; if flashcard-mode-map not set by user (setq flashcard-mode-map (make-keymap)) (suppress-keymap flashcard-mode-map) (define-key flashcard-mode-map "q" 'fc-quit) (define-key flashcard-mode-map "?" 'describe-mode) (define-key flashcard-mode-map "h" 'describe-mode) (define-key flashcard-mode-map "o" 'fc-options) (define-key flashcard-mode-map "f" 'fc-load-flashcard-file) (define-key flashcard-mode-map "d" 'fc-start-drill) (define-key flashcard-mode-map "s" 'fc-save-scores) (define-key flashcard-mode-map "c" 'fc-clear-data) (define-key flashcard-mode-map " " 'fc-question-ready) (define-key flashcard-mode-map "g" 'fc-give-up) (define-key flashcard-mode-map "r" 'fc-answer-right) ;(define-key flashcard-mode-map "y" 'fc-answer-right) (define-key flashcard-mode-map "w" 'fc-answer-wrong) ;(define-key flashcard-mode-map "n" 'fc-answer-wrong) (define-key flashcard-mode-map "\C-m" 'fc-multi-proceed) (define-key flashcard-mode-map "k" 'fc-skip) (define-key flashcard-mode-map "u" 'fc-undo) (define-key flashcard-mode-map "0" 'fc-choose) (define-key flashcard-mode-map "1" 'fc-choose) (define-key flashcard-mode-map "2" 'fc-choose) (define-key flashcard-mode-map "3" 'fc-choose) (define-key flashcard-mode-map "4" 'fc-choose) (define-key flashcard-mode-map "5" 'fc-choose) (define-key flashcard-mode-map "6" 'fc-choose) (define-key flashcard-mode-map "7" 'fc-choose) (define-key flashcard-mode-map "8" 'fc-choose) (define-key flashcard-mode-map "9" 'fc-choose) (define-key flashcard-mode-map "-" 'fc-undefined) (if (and (boundp 'fc-debug) fc-debug) (define-key flashcard-mode-map "I" ;; debugging '(lambda () (interactive) (fc-init) (message "fc initialized")))) (substitute-key-definition 'undefined 'fc-undefined flashcard-mode-map) ) ;; Internal variables: (defvar fc-state nil "Current state of flashcard program.") ;; such as: ;; nil - uninitialized ;; init - initialized but not drilling yet (options screen) ;; question - have asked a question, waiting for user to hit ;; fc-question-ready, fc-give-up, or fc-skip ;; answer-check - have displayed answer, waiting for user to hit ;; fc-answer-right, fc-answer-wrong, or fc-skip. ;; answer-gave-up - have displayed answer, waiting for user to hit ;; fc-give-up, or fc-skip. (defvar fc-fields nil "List of field names (strings) for flashcards in use.") (defvar fc-num-fields nil "Number of fields per flashcard (nil means uninitialized).") (defvar fc-question-field nil "Numeric index (into fc-fields) of field currently serving as question. Changing this variable directly (using setq or set-variable), in mid-drill, is NOT advisable. Use the `\\[fc-options]' command instead. But using setq or set-variable before starting a drill is fine.") (defvar fc-answer-field nil "Numeric index (into fc-fields) of field currently serving as answer. Changing this variable directly (using setq or set-variable), in mid-drill, is NOT advisable. Use the `\\[fc-options]' command instead. But using setq or set-variable before starting a drill is fine.") (defvar fc-current-score-field nil "Index of score field corresponding to current q-a combo.") (defvar fc-records nil "Flashcard record data structure.") (defvar fc-records-tail nil "Points to end of record data structure.") (defvar fc-num-records 0 "Number of flashcard records in memory.") (defvar fc-files nil "List of files currently loaded. For each, there is a vector containing the file name, its title, and the number of the last card loaded from the file.") (defvar fc-files-tail nil "Points to end of fc-files list.") (defvar fc-modified-scores nil "Non-nil if scores have been modified, i.e. user has been drilling and hasn't saved score data.") (defvar fc-debug nil "If non-nil, display debugging messages.") (defvar fc-current-card-num nil "Numeric index of current flashcard in permutation.") (defvar fc-current-record nil "Record of current flashcard being drilled on.") (defvar fc-num-right nil "Number of cards gotten right so far.") (defvar fc-num-wrong nil "Number of cards gotten wrong so far.") (defvar fc-permutation nil "A permutation representing a shuffling of the cards.") (defvar fc-question-help "Press\t\\[fc-question-ready]\tif you know the answer, \t\\[fc-give-up]\tto give up, or \t\\[fc-skip]\tto skip this question." "Help string displayed after asking a question. Command keys are substituted.") (defvar fc-question-multi-help "Press\tthe number of the correct answer, \t\\[fc-give-up]\tto give up, or \t\\[fc-skip]\tto skip this question." "Help string displayed after asking a multiple-choice question. Command keys are substituted.") (defvar fc-answer-help "Press\t\\[fc-answer-right]\tif you got it right, \t\\[fc-answer-wrong]\tif you got it wrong, or \t\\[fc-skip]\tto skip this question." "Help string displayed after displaying an answer when user has not given up. Command keys are substituted.") (defvar fc-answer-multi-help "Press\t\\[fc-multi-proceed]\tto proceed as indicated, \t\\[fc-answer-right]\tto count this one right, \t\\[fc-answer-wrong]\tto count this one wrong, \t\\[fc-skip]\tto skip this question." "Help string displayed after a multiple-choice answer. Command keys are substituted.") (defvar fc-gave-up-help "Press\t\\[fc-give-up] again to proceed, or \t\\[fc-skip] to skip this question." "Help string displayed after displaying an answer when user has given up. Command keys are substituted.") (defvar fc-done-help "Press\t\\[fc-save-scores] to save score data, \t\\[fc-start-drill] to drill again, \t\\[fc-quit] to leave Flashcard." "Help string displayed when a quiz is finished. Command keys are substituted.") (defvar fc-fields-error "The question and answer fields are the same. Use `o q' or `o a'." "Error string displayed with question and answer fields are the same.") (defvar fc-options-alist '((?a fc-answer-field fc-field-name) (?q fc-question-field fc-field-name) (?s fc-auto-shuffle) (?f fc-show-other-fields) (?p fc-limit-percent) (?n fc-limit-num-right) (?l fc-limit-last-right) (?e fc-filter-equals) (?m fc-multiple-choice) (?c fc-num-choices)) "Alist of flashcard options ((CHAR SYM . DISPLAY-FUNC) ...) where CHAR is the character for option variable SYM, and optional DISPLAY-FUNC is a function to display the value of the option variable.") (defvar fc-scores-backup nil "Backup of most recently changed scores.") (defvar fc-num-right-backup nil "Backup of fc-num-right.") (defvar fc-num-wrong-backup nil "Backup of fc-num-wrong.") (defvar fc-current-card-num-backup nil "Numeric index of card whose scores are backed up in fc-scores-backup.") (defvar fc-current-score-field-backup "Backup of fc-current-score-field.") (defvar fc-choices nil "Sequence of random choices for multiple-choice.") (defvar fc-current-choice nil "Choice chosen for current question.") (defvar fc-correct-choice nil "Correct choice for current question.") (defvar fc-timestamp-file "timestmp" "Temporary file used in a hack for getting the current time.") ;; Functions ;; First, use defsubst sometimes if available. (if (fboundp 'defsubst) (fset 'defun-subst 'defsubst) (fset 'defun-subst 'defun)) (defun-subst fc-drilling-p () "Return non-nil if drilling has started but not finished." (memq fc-state '(question answer-check answer-gave-up))) (defun-subst fc-num-score-fields () (* fc-num-fields (1- fc-num-fields))) ; = number of ways to drill: e.g. english->kanji, kanji->english, ; kanji->kana, etc. (defun-subst match-string (&optional which) (if (not which) (setq which 1)) (buffer-substring (match-beginning which) (match-end which))) ;; Data abstraction functions. Make these defsubst if possible. (defun-subst fc-get-filename (file-structure) (aref file-structure 0)) (defun-subst fc-get-last-card (file-structure) (aref file-structure 2)) ;; Data abstraction functions. Make these defsubst if possible. (defun-subst fc-get-field (record field-num) (or (elt (car record) field-num) "")) (defun-subst fc-make-record (field-values) ;; field-values is a list. (cons field-values (make-vector (fc-num-score-fields) nil))) ;; The list of field-values goes in the car. Scores (nil until used) ;; go in the cdr. Each nil will become a sub-vector of 3 zeroes ;; when used. (defun-subst fc-get-num-right (record) (fc-get-score record 0)) (defun-subst fc-get-num-wrong (record) (fc-get-score record 1)) (defun-subst fc-get-last-right (record) (fc-get-score record 2)) (defun-subst fc-set-num-right (record r) (fc-set-score record 0 r)) (defun-subst fc-set-num-wrong (record w) (fc-set-score record 1 w)) (defun-subst fc-set-last-right (record tm) (fc-set-score record 2 tm)) (defun-subst fc-check-score-field () (if (>= fc-current-score-field 0) t (error fc-fields-error))) (defun-subst delete-line () "Delete line point is on. Does not put deleted text into kill ring. Does not delete newline." (delete-region (progn (beginning-of-line) (point)) (progn (end-of-line) (point)))) (defun-subst fc-insert-help (str) "Insert help string STR if fc-display-help is non-nil. Command keys are substituted." (if fc-display-help (insert (substitute-command-keys str)))) ;;;###autoload (defun flashcard (&optional file) "Use flashcard package to drill on flashcards." (interactive) ; (list ; (expand-file-name ; (read-file-name "Flashcard file: " fc-flashcard-dir nil nil)) (let ((buf (get-buffer "*Flashcard*"))) (if buf (switch-to-buffer buf) (switch-to-buffer (get-buffer-create "*Flashcard*")) (flashcard-mode) (insert (substitute-command-keys "Welcome to Flashcard. Type \\[describe-mode] for help.")) (if file (fc-load-flashcard-file file) (call-interactively 'fc-load-flashcard-file))))) (defun flashcard-mode () ;; Need more documentation here. "Major mode for drilling on flashcards. Short list of default key bindings: f Load a flashcard file d Start drilling on flashcards in memory s Save accumulated score data o Set flashcard options o h Options help h Mode help q Quit u Undo last card Key bindings: \\{flashcard-mode-map} " (if (eq major-mode 'flashcard-mode) (error "You are already in flashcard-mode.") (setq mode-name "Flashcard") (setq major-mode 'flashcard-mode) (put 'flashcard-mode 'mode-class 'special) ; Now isn't that special... (use-local-map flashcard-mode-map) (setq tab-width 8) ;; becomes local (fc-init) (run-hooks 'flashcard-mode-hooks) )) (defun fc-undefined () "Function called when an undefined key sequence is it. Displays help." (interactive) (ding) (message (substitute-command-keys "Type \\[describe-mode] for help."))) (defun fc-init () "Initialize flashcard package." (setq fc-state 'init fc-fields nil fc-records nil fc-records-tail nil fc-num-records 0 fc-num-right 0 fc-num-wrong 0 fc-question-field 0 fc-answer-field 1 fc-files nil fc-files-tail nil )) (defun fc-score-file-name (flashcard-file-name) "Make a score file name from a flashcard file name." (let ((fname (expand-file-name (concat fc-score-dir "/" (file-name-nondirectory flashcard-file-name))))) (if (string-match (concat "\\." fc-score-ext "$") fname) fname (concat fname "." fc-score-ext)))) (defun fc-load-flashcard-file (file-name) (interactive ;; I would use (interactive "fLoad flashcard file:"), but I want the ;; default directory to be right. (list (expand-file-name (read-file-name "Load flashcard file: " fc-flashcard-dir nil t)))) "Load a flashcard file so it can be drilled on." (if (file-directory-p file-name) (signal 'file-error (list "Can't load a directory as a flashcard file" file-name))) (save-window-excursion (set-buffer (get-buffer-create " *flashcard-file*")) (erase-buffer) (message "Loading...") (insert-file-contents file-name) (let ((old-tail fc-records-tail) (old-num-records fc-num-records) (title (fc-parse-region (point-min) (point-max)))) ;; Turn lists into vectors, for random access speed. (if (listp fc-fields) (setq fc-fields (apply 'vector fc-fields))) (setq fc-fields-alist (let ((i -1)) (mapcar '(lambda (e) (setq i (1+ i)) (cons e i)) fc-fields))) (setq fc-num-fields (length fc-fields)) ; (if (listp fc-records) (setq fc-records (apply 'vector fc-records))) ;; Let fc-records remain a list. The shuffle, fc-permutation, ;; will contain pointers to the various parts of fc-records. (fc-add-file file-name title fc-num-records) (fc-load-scores-file file-name (if old-tail (cdr old-tail) fc-records) (- fc-num-records old-num-records)) )) (message (substitute-command-keys "Loading...done. Type `\\[fc-start-drill]' to begin drill."))) ;; Maybe that should be in the buffer, not a minibuffer message. (defun fc-save-scores () "Save score data from all loaded files into respective score files." (interactive) (if (or fc-modified-scores (and (interactive-p) (y-or-n-p "Scores have not been modified; save anyway? "))) (let ((flist fc-files) (rlist fc-records) (start-from 0)) (while flist (setq rlist (fc-save-scores-file (fc-get-filename (car flist)) rlist (- (fc-get-last-card (car flist)) start-from))) (setq start-from (fc-get-last-card (car flist))) (setq flist (cdr flist))) (setq fc-modified-scores nil)))) (defun fc-save-scores-file (fname records nrec) "Save score data for a given file into its proper score file." (save-window-excursion (set-buffer (get-buffer-create " *flashcard-scores*")) (erase-buffer) (while (> nrec 0) (fc-insert-score-data (car records)) (setq nrec (1- nrec)) (setq records (cdr records))) (if (not (file-directory-p fc-score-dir)) (fc-make-directory fc-score-dir)) (write-region (point-min) (point-max) (fc-score-file-name fname)) records)) (defun fc-insert-score-data (record) "Insert numerical score data for RECORD at point in current buffer." (let ((fc-current-score-field 0)) (while (< fc-current-score-field (fc-num-score-fields)) (let ((nr (fc-get-num-right record)) (nw (fc-get-num-wrong record)) (nl (fc-get-last-right record))) (if (or (> nr 0) (> nw 0) (> nl 0)) (insert (format "%d %d %d," nr nw nl)) ;; make these %x (insert ",")) ) (setq fc-current-score-field (1+ fc-current-score-field)))) (delete-backward-char 1) ;; change last comma to a newline (newline)) (defun fc-load-scores-file (fname records nrec) "Load score data for a given file from its score file." (let ((sfname (fc-score-file-name fname))) (if (not (file-readable-p sfname)) nil (save-window-excursion (set-buffer (get-buffer-create " *flashcard-scores*")) (erase-buffer) (insert-file-contents sfname) (while (and (> nrec 0) (not (eobp))) (fc-read-score-data (car records)) (setq nrec (1- nrec)) (setq records (cdr records))))))) (defun fc-read-score-data (record) "Read score data at point into RECORD." (let ((fc-current-score-field 0)) (while (and (< fc-current-score-field (fc-num-score-fields)) (not (eobp))) (if (looking-at "\\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)") (let ((nr (string-to-int (match-string 1))) (nw (string-to-int (match-string 2))) (nl (string-to-int (match-string 3)))) (fc-set-num-right record nr) (fc-set-num-wrong record nw) (fc-set-last-right record nl) (goto-char (1+ (match-end 0)))) (forward-char)) ;; skip comma or newline (setq fc-current-score-field (1+ fc-current-score-field))))) (defun fc-parse-region (min max) "Parse flashcard records in region MIN to MAX in current buffer. Return title of file if found." (let ((title "")) (goto-char min) (while (< (point) max) (cond ((looking-at "^!% *Title: *\\([^\n]+\\)$") (setq title (match-string 1))) ((looking-at "^!% *Fields: *\\([^\n]+\\) *$") (let ((fields-string (match-string 1)) (new-fields (fc-parse-record fc-field-delimiter (match-beginning 1) (match-end 1) t))) (if fc-fields (if (not (equal-sequence new-fields fc-fields)) (error "New fields %s differ from old fields %s" new-fields fc-fields)) (setq fc-fields new-fields) (setq fc-num-fields (length fc-fields)) ))) ((looking-at "^!% *\\([^:\n]*\\)") ;; error (error "Unknown !%% line: %s" (match-string 1))) ((looking-at "^!")) ; Ignore comments. ((looking-at "^[ \t]*$")) ; Ignore blank lines. (t ;Anything else is a flashcard record. (if fc-fields t (setq fc-fields fc-default-fields) (setq fc-num-fields (length fc-fields))) (fc-add-record (save-excursion (fc-parse-record fc-field-delimiter (point) max)))) ) ;; end cond (if (re-search-forward fc-record-delimiter max 1) (goto-char (match-end 0))) ;;... ;; kill buffer? ) title)) (defun fc-parse-record (delim min max &optional not-record) "Parse and record beginning at MIN, using arg DELIM as a field delimiter. Arg MAX limits end of record. Return as a list if optional third arg NOT-RECORD is non-nil; otherwise, return as a record." (goto-char min) (let* ((pt (point)) (eor ; find end of record (if (re-search-forward fc-record-delimiter max t) (match-beginning 0) max)) (fields nil) (next nil)) ;; Don't check for a correct number of fields. (goto-char pt) (while (< pt eor) (if (re-search-forward delim eor 1) (setq next (match-end 0) field-end (match-beginning 0)) (setq next eor field-end eor)) (if (> (point) pt) (let ((string (buffer-substring pt field-end))) (setq fields (nconc fields (cons ;; (if not-record (intern string) string) string nil)) pt next)))) (if not-record fields ; Just return the list. (fc-make-record fields)))) ; Make a full record. (defun fc-add-record (record) "Add RECORD to fc-records data structure." (if fc-records (progn (setcdr fc-records-tail (cons record nil)) (setq fc-records-tail (cdr fc-records-tail))) (setq fc-records (cons record nil)) (setq fc-records-tail fc-records)) (setq fc-num-records (1+ fc-num-records))) (defun fc-add-file (file title numlastcard) "Add [FILE TITLE NUMLASTCARD] to fc-files data structure." (let ((newcell (cons (vector file title numlastcard) nil))) (if fc-files (progn (setcdr fc-files-tail newcell) (setq fc-files-tail (cdr fc-files-tail))) (setq fc-files newcell) (setq fc-files-tail fc-files))) ;; (setq fc-num-files (1+ fc-num-files)) ) (defun fc-get-score (record n) (let ((scores (aref (cdr record) fc-current-score-field))) (if scores (aref scores n) 0))) (defun fc-set-score (record n v) (let ((scores (aref (cdr record) fc-current-score-field))) (if scores (aset scores n v) (let ((scores (make-vector 3 0))) (aset scores n v) (aset (cdr record) fc-current-score-field scores))))) (defun fc-backup-scores () "Backup enough data about current card/scores for undoing score changes." (setq fc-current-card-num-backup fc-current-card-num fc-num-right-backup fc-num-right fc-num-wrong-backup fc-num-wrong fc-current-score-field-backup fc-current-score-field fc-scores-backup (copy-sequence (aref (cdr fc-current-record) fc-current-score-field)) )) (defun goto-line-create (n) (goto-line n) (let ((d (- n (count-lines (point-min) (point))))) (if (not (bolp)) (setq d (1+ d))) (if (> d 1) (newline (1- d))))) (defun fc-set-buffer-lines () "Determine where to display things in the buffer." (setq fc-question-line 3 ; constant. fc-answer-line (+ fc-question-line 2 (if fc-multiple-choice fc-num-choices 0)) fc-help-line (+ fc-answer-line 2 (if fc-show-other-fields (- fc-num-fields 2) 0)))) (defun fc-start-drill (&optional arg) ;; finally, the meat. "Begin drilling on flashcards currently loaded." (interactive "P") (if (< fc-num-records 1) (error "You must load a flashcard file before drilling.")) (fc-set-buffer-lines) ;; Reset overall scores. (setq fc-num-right 0 fc-num-wrong 0) (setq fc-current-score-field (fc-compute-score-field fc-question-field fc-answer-field)) (fc-shuffle) ;; We set the current card to -1 so the fc-next-card starts searching ;; for the next valid card at index 0. (setq fc-current-card-num -1) (fc-next-card)) (defun fc-shuffle () "Create a permutation that represents a shuffling of the cards." (if (or (not fc-permutation) (< (length fc-permutation) fc-num-records)) (setq fc-permutation (make-vector fc-num-records nil))) (let ((i 0) j tmp (records-left fc-records)) (while (< i fc-num-records) (aset fc-permutation i (car records-left)) (setq i (1+ i) records-left (cdr records-left))) (if (not fc-auto-shuffle) nil (random t) ;; Seed random number generator. (setq i 0) (while (< i fc-num-records) (setq j (mod (abs (random)) fc-num-records)) ;; I'm not sure if abs is always defined in emacs 18. If not, ;; (defun abs (a) (if (< a 0) (- a) a)) ;; in emacs-19, (setq j (random fc-num-records)) ;; j could = i; doesn't matter. (setq tmp (aref fc-permutation i)) (aset fc-permutation i (aref fc-permutation j)) (aset fc-permutation j tmp) (setq i (1+ i)))))) (defun fc-do-current-card () "Start processing on current card." (erase-buffer) (setq fc-current-choice nil) (if fc-multiple-choice (fc-make-choices)) (fc-display-question) (setq fc-state 'question)) (defun fc-make-choices () "Prepare a sequence of random choices for multiple choice." ; (if (or (not fc-choices) (< (length fc-choices) fc-num-choices)) ; (setq fc-choices (make-vector fc-num-choices -1))) (setq fc-choices nil fc-current-choice nil fc-correct-choice (mod (abs (random)) fc-num-choices)) ;; avoid infinite loop (if (< fc-num-records fc-num-choices) (error "Can't pick %d choices out of only %d records." fc-num-choices fc-num-records)) (let ((i 0) n (inv-cc (- fc-num-choices fc-correct-choice 1))) ;; inv-cc is a mirror image of fc-correct-choice, for building the ;; list backwards. (while (< i fc-num-choices) (if (= i inv-cc) (setq n fc-current-card-num) (setq n (mod (abs (random)) fc-num-records)) (while (or (= n fc-current-card-num) (memq n fc-choices)) (setq n (mod (abs (random)) fc-num-records)))) (setq fc-choices (cons n fc-choices)) (setq i (1+ i))))) (defun fc-display-question () "Display current question and question help." (let* ((question (fc-get-field fc-current-record fc-question-field)) (cok (/= fc-question-field fc-answer-field)) (cr (if cok (fc-get-num-right fc-current-record) nil)) (cw (if cok (fc-get-num-wrong fc-current-record) nil)) (nc (if fc-multiple-choice fc-num-choices 0))) (goto-line-create 1) (insert (format "Card #%d of %d Overall: %d r %d w (%d%%)" (1+ fc-current-card-num) fc-num-records fc-num-right fc-num-wrong (fc-percent fc-num-right fc-num-wrong))) (if cok (insert (format " This card: %d r %d w (%d%%)" cr cw (fc-percent cr cw)))) (goto-line-create fc-help-line) ;; The above kludge is to assure that there are already newlines ;; after where the question will be. If we allowed the newlines ;; to be added later, they could inherit text properties from the ;; question. Is there a less kludgy way to avoid this? (goto-line-create fc-question-line) (insert (format "Question (%s): " (elt fc-fields fc-question-field))) (fc-insert-with-face question fc-question-face) (if fc-multiple-choice (fc-display-choices)) (goto-line-create fc-answer-line) (insert (format "Answer (%s): " (elt fc-fields fc-answer-field))) (if (and cok (eq fc-show-other-fields t)) (progn (goto-line-create (1+ fc-answer-line)) (fc-insert-other-fields fc-current-record))) (goto-line-create fc-help-line);; skip answer space (fc-insert-help (if fc-multiple-choice fc-question-multi-help fc-question-help)) ;; Make sure the question line is still visible. (goto-line fc-question-line) (beginning-of-line) (if (> (window-start) (point)) ;; question line has scrolled off (set-window-start (selected-window) (point))) )) ;; (defun fc-redisplay-question-line () ;; "Update question line in Flashcard buffer." ;; (let ((question (fc-get-field fc-current-record fc-question-field))) ;; (goto-line-create fc-question-line) ;; (delete-line) ;; (insert (format "Question (%s): " (elt fc-fields fc-question-field))) ;; (fc-insert-with-face question fc-question-face))) (defun fc-display-choices () "Display choices for multiple-choice question. Uses fc-choices." (goto-line-create (1+ fc-question-line)) (let ((ch fc-choices) (i 0)) (while ch (let* ((ir (car ch)) (answer (fc-get-field (aref fc-permutation ir) fc-answer-field))) (insert (format "\t%d. %s\n" (1+ i) answer))) (setq ch (cdr ch) i (1+ i))))) (defun fc-question-ready () "User command called when user knows answer to question." (interactive) (if (or (not (eq fc-state 'question)) fc-multiple-choice) (ding) (fc-check-score-field) (setq fc-state 'answer-check) (fc-display-answer))) (defun fc-choose () "User command to answer multiple choice question. This function should be called with a key sequence ending in a digit." (interactive) (if (not (eq fc-state 'question)) (ding) (let* ((choice (string-to-int (char-to-string last-command-char)))) (if (or (zerop choice) (> choice fc-num-choices)) (ding) (setq fc-current-choice (1- choice)) (fc-check-score-field) (setq fc-state 'answer-check) (fc-display-answer))))) (defun fc-give-up () "User command to give up on current card." (interactive) (cond ((eq fc-state 'question) (fc-check-score-field) (setq fc-state 'answer-gave-up) (fc-display-answer)) ((eq fc-state 'answer-gave-up) ;; (fc-check-score-field) ; not necess. since fc-answer-wrong will check. (fc-answer-wrong)) (t (ding)))) (defun fc-display-answer () "Display current answer and answer help. Assumes that fc-display-question has already been called." (interactive) (let ((answer (fc-get-field fc-current-record fc-answer-field))) (if fc-multiple-choice (progn ;; Urg. fc-current-choice might not be set because we might ;; have just switched to multi-choice mode in mid-question. ;; So do we assume they got it right or wrong?? ;; Actually, we can hack it to "skip" this question (unless ;; the user forces 'r' or 'w') by leaving fc-current-choice at nil. (if (not fc-current-choice) nil (goto-line-create (+ fc-question-line fc-current-choice 1)) (beginning-of-line) (insert (if (= fc-current-choice fc-correct-choice) "Right!" "Wrong.")) (goto-line-create (+ fc-question-line fc-correct-choice 1)) (re-search-forward "[0-9]\. ") (fc-apply-face-region fc-answer-face (match-beginning 0) (progn (end-of-line) (point)))))) (goto-line-create fc-answer-line) (end-of-line) (fc-insert-with-face answer fc-answer-face) (if (and fc-show-other-fields (not (eq fc-show-other-fields t))) ;; if fc-show-other-fields is nil, we don't show them, but ;; if it's t, we already displayed them during fc-display-question. (progn (goto-line-create (1+ fc-answer-line)) (fc-insert-other-fields fc-current-record))) (goto-line-create fc-help-line) (delete-region (point) (point-max)) ;; clear out old help (cond ((eq fc-state 'answer-check) (fc-insert-help (if fc-multiple-choice fc-answer-multi-help fc-answer-help))) ((eq fc-state 'answer-gave-up) (fc-insert-help fc-gave-up-help)) (t (error "Unexpected state %s in fc-display-answer" fc-state))) (goto-line fc-question-line) (beginning-of-line) (if (> (window-start) (point)) ;; question line has scrolled off (set-window-start (selected-window) (point))) )) (defun fc-redisplay-answer-line () "Update answer line in Flashcard buffer, as well as other fields." (let ((answer (fc-get-field fc-current-record fc-answer-field)) (answer-state (memq fc-state '(answer-check answer-gave-up)))) (goto-line-create fc-answer-line) (delete-line) (insert (format "Answer (%s): " (elt fc-fields fc-answer-field))) (if answer-state (fc-insert-with-face answer fc-answer-face)) (goto-line-create (1+ fc-answer-line)) (delete-line) (if (and fc-show-other-fields (or answer-state (eq fc-show-other-fields t))) (fc-insert-other-fields fc-current-record)))) (defun fc-skip () "User command to skip current card and proceed to next one." (interactive) (fc-next-card)) ;; Don't modify score. (defun fc-undo () "Go back to the last card drilled on, undoing its effects on scoring." (interactive) (if (not fc-current-card-num-backup) (error "Sorry, no backup data available.")) (fc-check-score-field) (if (/= fc-current-score-field fc-current-score-field-backup) (error "Can't undo past changed question/answer fields.")) (setq fc-current-card-num fc-current-card-num-backup fc-current-card-num-backup nil ;; no more backup data left fc-num-right fc-num-right-backup fc-num-wrong fc-num-wrong-backup fc-current-record (aref fc-permutation fc-current-card-num) ) (aset (cdr fc-current-record) fc-current-score-field fc-scores-backup) ;; go back and display the undone card. (fc-do-current-card)) (defun fc-next-card () "Proceed to next card." (fc-check-score-field) (let ((found nil)) (while (and (< fc-current-card-num (1- fc-num-records)) (not found)) (setq fc-current-card-num (1+ fc-current-card-num)) (setq fc-current-record (aref fc-permutation fc-current-card-num)) (if (fc-meets-criteria fc-current-record) (setq found t))) (if (not found) (fc-drill-done) (fc-do-current-card)))) (defun fc-meets-criteria (record) "Return t if RECORD falls within drill limits." (let ((cr (fc-get-num-right record)) (cw (fc-get-num-wrong record)) (cl (fc-get-last-right record))) (not ;; t if does not fail any criterion (or ;; t if fails any criterion (and fc-limit-num-right (> cr fc-limit-num-right)) (and fc-limit-percent (> (fc-percent cr cw) fc-limit-percent)) (and fc-limit-last-right (> cl 0) (< (fc-num-days-ago cl) fc-limit-last-right)) (and fc-filter-equals (equal (fc-get-field record fc-question-field) (fc-get-field record fc-answer-field))) )))) (defun fc-answer-wrong () "User command when user failed to get answer right." (interactive) (if (not (memq fc-state '(answer-check answer-gave-up))) (ding) (fc-check-score-field) (fc-backup-scores) (setq fc-num-wrong (1+ fc-num-wrong)) ;; Also keep data on this particular card. (fc-set-num-wrong fc-current-record (1+ (fc-get-num-wrong fc-current-record))) (or fc-modified-scores (setq fc-modified-scores t)) (fc-next-card))) (defun fc-answer-right () "User command when user got answer right." (interactive) (if (not (eq fc-state 'answer-check)) (ding) ;; (message "Working...") ;; because fc-timestamp can take time, ;; ;; especially if it is running Perl. :-( ;; (fc-sit-for 0) ;; Redisplay. ;;; Since we're no longer calling perl, let's try leaving out the message. (unwind-protect (progn (fc-check-score-field) (fc-backup-scores) (setq fc-num-right (1+ fc-num-right)) ;; Also keep data on this particular card. (fc-set-num-right fc-current-record (1+ (fc-get-num-right fc-current-record))) (fc-set-last-right fc-current-record (fc-timestamp)) (or fc-modified-scores (setq fc-modified-scores t)) (fc-next-card)) ;; (message "") ))) (defun fc-multi-proceed () "User command to score the current card according to the selected choice." (interactive) (if (not (and fc-multiple-choice (eq fc-state 'answer-check))) (ding) (cond ((null fc-current-choice) ;; If no choice was made, do nothing. (fc-next-card)) ((= fc-current-choice fc-correct-choice) (fc-answer-right)) (t (fc-answer-wrong))))) (defun fc-insert-other-fields (card) "Insert labels and contents of other fields on current line." (let ((field-num 0)) (while (< field-num fc-num-fields) (if (and (/= field-num fc-question-field) (/= field-num fc-answer-field)) (insert (format " (%s): %s" (elt fc-fields field-num) (fc-get-field card field-num)))) (setq field-num (1+ field-num))))) (defun fc-insert-with-face (string face) "Insert STRING at point, setting its text property in the buffer to FACE. See also fc-apply-face-region." (let ((oldpoint (point))) (insert string) (fc-apply-face-region face oldpoint (point)))) (defun fc-apply-face-region (face from to) "Apply FACE to region FROM TO. If FACE is nil or typefaces are not available, do nothing. Use put-text-property if available; otherwise, if attribute-on-region is available, FACE must be one of the symbols bold, inverse, or underline." (cond ((null face) nil) ;; Do nothing if face is nil. ((fboundp 'put-text-property) ;; Apply text property if possible (put-text-property from to 'face face)) ;; (in Emacs 19) ((fboundp 'attribute-on-region) ;; Use attributes (in Mule) (attribute-on-region face from to)))) (defun fc-drill-done () "Function called when drill is finished." (fc-display-options) (goto-line-create fc-question-line) (insert (substitute-command-keys "Drill done. Press `\\[fc-save-scores]' to save score data.")) (setq fc-state 'init)) (defun fc-display-options () "Displays flashcard option screen." (erase-buffer) (goto-line-create 1) (insert (format "Stats so far: %d right, %d wrong (%d%%)" fc-num-right fc-num-wrong (fc-percent fc-num-right fc-num-wrong))) ; ... etc. ; options: ; uestion field, nswer field (change with completing read) ; limits on drill:

ercentage right, umber right, ast time ; gotten right ; [fc-show-other-fields (probably not on options screen)] ; ultiple-choice (boolean) (goto-line-create fc-help-line) (fc-insert-help fc-done-help)) (defun equal-sequence (a b) "Determine whether sequences A and B contain equal objects." ;; like equal, except that any type of sequence can be equal-sequence ;; to any other type. (catch 'is-equal (or (equal a b) (let ((lena (length a)) (lenb (length b)) (i 0)) (if (/= lena lenb) nil (while (< i lena) (if (not (equal (elt a i) (elt b i))) (throw 'is-equal nil)) (setq i (1+ i))) t))))) ; Must supply a hacked current-time for pre-emacs-19. Here's a better ; alternative than the call to perl that used to be used here: modify ; a file using write-region, then use file-attributes to get the last ; modification time, as two 16-bit integers. It's still bad in that ; it messes with the file system unnecessarily; but it's a lot better ; than calling perl. (if (not (fboundp 'current-time)) (defun current-time () "Return the current time, as the number of seconds since 12:00 AM January 1970. The time is returned as a list of two integers. The first has the most significant 16 bits of the seconds, while the second has the least significant 16 bits." (let* ((time-file (concat fc-score-dir "/" fc-timestamp-file)) (file-attr (progn (if (not (file-directory-p fc-score-dir)) (fc-make-directory fc-score-dir)) ;; cause file to be modified. (write-region 1 1 time-file nil 1) (file-attributes time-file))) (mod-time (if file-attr (elt file-attr 5) nil))) (if mod-time mod-time '(0 0))))) (if (not (fboundp 'abs)) (defun abs (a) (if (< a 0) (- a) a))) ;; We only take the 20 most significant bits. This gets us down ;; almost to within an hour. (defun fc-timestamp () (let ((ct (current-time))) (logior (lsh (car ct) 4) (lsh (car (cdr ct)) -12)))) (defun fc-num-days-ago (timestamp) (let ((now (fc-timestamp))) ;; Timestamp is number of seconds since 1/1/70, with the last ;; 12 bits chopped off. That's seconds/4096. A day is 24*3600 seconds. ;; 4096 / (24*3600) = 32 / 675 (/ (* (- now timestamp) 32) 675))) ;; Calculate percentage... a is what percent of a + b? ;; Don't die on division by zero. Round to nearest integer. (defun fc-percent (a b) (if (zerop (+ a b)) 0 ;; So that questions that have never been answered ;; are counted as having a "right" percentage of zero. (/ (+ (* 100 a) (/ (+ a b) 2)) (+ a b)))) (defun fc-compute-score-field (qfield afield) "Find the score field used to record scores drilling from QFIELD to AFIELD." (if (= qfield afield) (error fc-fields-error)) (+ (* qfield (1- fc-num-fields)) afield (if (< qfield afield) -1 0))) ;; Example: fields are: kanji, hiragana, english ;; Order of score fields is: kanji->hiragana, kanji->english, ;; hiragana->kanji, hiragana->english, english->kanji, english->hiragana. ;; (fc-compute-score-field (hiragana=1 english=2)) ;; => (+ (* 1 (1- 3)) 2 -1) == 3 (defun fc-options () "Set Flashcard options." ;; This is a shortcut; we really want an options display screen. (interactive) (if (fc-sit-for 1 t) (message "Flashcard option: (aqsfprlemc or ? for help) - ")) (let ((done nil)) (while (not done) (let ((ch (read-char))) (setq done t) (cond ;; abort options ((eq ch ?\C-g) t) ((eq ch ?\C-m) t) ; RET also aborts. ;; options help ((eq ch ??) (fc-display-option-help) (setq done nil)) ;; set answer field ((eq ch ?a) (fc-set-answer-field)) ;; set question field ((eq ch ?q) (fc-set-question-field)) ;; toggle fc-auto-shuffle ((eq ch ?s) (setq fc-auto-shuffle (not fc-auto-shuffle)) (message "fc-auto-shuffle is now %s" fc-auto-shuffle)) ;; set fc-show-other-fields ((eq ch ?f) (setq fc-show-other-fields (cond ((null fc-show-other-fields) 'answer-only) ((eq fc-show-other-fields t) nil) (t t))) (message "fc-show-other-fields is now %s" fc-show-other-fields) (if (fc-drilling-p) (fc-redisplay-answer-line))) ;; set fc-limit-percent ((eq ch ?p) (let ((newval (read-minibuffer (format "Max percent right (nil for no limit): (%s) " fc-limit-percent)))) (if (and (or (not newval) (and (numberp newval) (<= newval 100) (>= newval 0))) (not (eq newval fc-limit-percent))) ; note, (eq 1 1) => t (progn (setq fc-limit-percent newval) (message "fc-limit-percent is now %s" newval))))) ;; set fc-limit-num-right ((eq ch ?n) (let ((newval (read-minibuffer (format "Max number of times right (nil for no limit): (%s) " fc-limit-num-right)))) (if (and (or (not newval) (and (numberp newval) (>= newval 0))) (not (eq newval fc-limit-num-right))) (progn (setq fc-limit-num-right newval) (message "fc-limit-num-right is now %s" newval))))) ;; set fc-limit-last-right ((eq ch ?l) (let ((newval (read-minibuffer (format "Min days since last time right (nil for no limit): (%s) " fc-limit-last-right)))) (if (and (or (not newval) (and (numberp newval) (>= newval 0))) (not (eq newval fc-limit-last-right))) (progn (setq fc-limit-last-right newval) (message "fc-limit-last-right is now %s" newval))))) ;; toggle fc-filter-equals ((eq ch ?e) (setq fc-filter-equals (not fc-filter-equals)) (message "fc-filter-equals is now %s" fc-filter-equals)) ;; toggle fc-multiple-choice ((eq ch ?m) (setq fc-multiple-choice (not fc-multiple-choice)) (message "fc-multiple-choice is now %s" fc-multiple-choice) (fc-set-buffer-lines) (if (fc-drilling-p) (progn (if fc-multiple-choice (fc-make-choices)) (fc-check-qa-fields)))) ;; really for redisplay. ;; set fc-num-choices ((eq ch ?c) (let ((newval (read-minibuffer (format "Number of choices in multiple-choice: (%s) " fc-num-choices)))) (if (and (numberp newval) (> newval 0) (/= newval fc-num-choices)) (progn (setq fc-num-choices newval) (message "fc-num-choices is now %s" newval) (fc-set-buffer-lines) (if (and (eq fc-state 'question) fc-multiple-choice) (progn (fc-make-choices) (fc-check-qa-fields))) ;; redisplay )))) ;; display doc string for an option ((eq ch ?h) (fc-display-option-help (read-char))) (t (ding)) ))))) (defun fc-display-option-help (&optional char) "Display help for flashcard options. If optional argument CHAR is non-nil (a character), display the documentation string for the corresponding option in the *Help* buffer. Otherwise, display general option help." (interactive) ; why not. (if char (let ((option (assq char fc-options-alist))) (if option (describe-variable (car (cdr option))) (ding))) (with-output-to-temp-buffer "*Help*" (princ "\ Flashcard Options: (for specific help, type `h' and the option letter) Key\tOption\t\t\tCurrent value ===\t======\t\t\t=============\n") (let ((vars fc-options-alist)) (while vars (let* ((next-var (car vars)) (key-char (car next-var)) (sym (car (cdr next-var))) (val (symbol-value sym)) (first-part (format "%c\t%s" key-char sym))) (princ first-part) (princ (make-string (- 26 (length first-part)) ?\ )) ; space to column 40 (princ (if (cdr (cdr next-var)) (apply (car (cdr (cdr next-var))) val nil) val)) (princ "\n")) (setq vars (cdr vars))))))) (defun fc-set-question-field () "Prompt for a field name and set the question field to it." (if (> fc-num-fields 2) (let* ((str (completing-read (format "Set question field to: (%s) " (elt fc-fields fc-question-field)) fc-fields-alist nil t)) (qnum (cdr (assoc str fc-fields-alist)))) (if (or (null qnum) (= qnum fc-question-field)) nil (setq fc-question-field qnum) (fc-check-qa-fields) (message "Question field is now %s" str))) (fc-swap-qa-fields))) (defun fc-set-answer-field () "Prompt for a field name and set the answer field to it." (if (> fc-num-fields 2) (let* ((str (completing-read (format "Set answer field to: (%s) " (elt fc-fields fc-answer-field)) fc-fields-alist nil t)) (anum (cdr (assoc str fc-fields-alist)))) (if (or (null anum) (= anum fc-answer-field)) nil (setq fc-answer-field anum) (fc-check-qa-fields) (message "Answer field is now %s" str))) (fc-swap-qa-fields))) (defun fc-swap-qa-fields () "Swap question and answer fields." (let ((old-qfield fc-question-field)) (setq fc-question-field fc-answer-field) (setq fc-answer-field old-qfield)) (fc-check-qa-fields) (message "Swapped question and answer fields (now %s -> %s)" (elt fc-fields fc-question-field) (elt fc-fields fc-answer-field))) (defun fc-check-qa-fields () "Update the situation based on new fc-question/answer-field." (if (not (fc-drilling-p)) nil ; do nothing; it'll be done when we start. (if (= fc-question-field fc-answer-field) (progn (setq fc-current-score-field -1) (erase-buffer) (fc-display-question) ;; (fc-redisplay-question-line) (fc-redisplay-answer-line)) (setq fc-current-score-field (fc-compute-score-field fc-question-field fc-answer-field)) (erase-buffer) (fc-display-question) (if (memq fc-state '(answer-check answer-gave-up)) (fc-display-answer))))) (if (string< emacs-version "19") (fset 'fc-sit-for 'sit-for) (defun fc-sit-for (secs &optional no-redisplay) "Same as sit-for under emacs-18.59: No millisecond argument." (sit-for secs nil no-redisplay))) ;; Has to be a function(?) because it gets passed around as a value. (defun fc-field-name (f) (or (elt fc-fields f) f)) (defun fc-clear-data (&optional quitting-p) "Clear flashcards and score data from memory. Confirmation is required if score data has been modified and not saved. Optional arg QUITTING-P, if non-nil, means use `quit' instead of `clear' in confirmation message. Returns t if data was cleared, nil otherwise." (interactive "P") (if (and fc-modified-scores (y-or-n-p "Score data is modified. Save it? ")) (fc-save-scores)) (if (or (not fc-modified-scores) (yes-or-no-p (format "Score data will be lost. Really %s? " (if quitting-p "quit" "clear")))) (progn (fc-init) (erase-buffer) (insert (substitute-command-keys "All data cleared. Press `\\[fc-load-flashcard-file]'") " to load a new flashcard file.") t) nil)) (defun fc-quit () "Quit Flashcard. Clear all data and kill *Flashcard* buffer. If there is unsaved score data, user will be queried to save it." (interactive) (if (fc-clear-data t) ;; save score data and/or confirm. (kill-buffer "*Flashcard*"))) (defun fc-make-directory (dir) "Create directory DIR." (if (fboundp 'make-directory) (make-directory dir t) (call-process "mkdir" nil (get-buffer-create " *mkdir-lossage*") nil (expand-file-name dir)))) (provide 'flashcard) ;;; --------------------- Here endeth flashcard.el ----------------------- ;;; fc-fix.el for flashcard.el v0.95 -*-emacs-lisp-*- ;;; fc-fix-version 0.01 ;;; Three replacement and one new defun ;;; for flashcard.el, version 0.95 (beta). ;;; These enable multiline fields. ;;; Written by Robert J. Chassell ;;; 17 February 1995 ;;; All of Bob's changes are commented and marked by three semi-colons ;;; at left most column. ;;; Note for documentation: ;;; ;;; If name of file is `foo', then score is kept in `foo.fs' by default ;;; ;;; To see Flashcard Options, type `o h' (no space) ;;; To toggle language of question-answer, type `o a' (no space) ;;; To toggle whether multiple choice, type `o m' ;;; To set number of choices, if multiple choice, type `o c' and the number ;;; New defun is: looking-at-backward ;;; Changed defuns are: ;;; goto-line-create ;;; fc-display-question ;;; fc-display-answer (defun looking-at-backward (regexp) "Return t if text before point matches regular expression REGEXP. Like looking-at, but in reverse." (let* ((begin (point)) (found (re-search-backward regexp nil t))) (goto-char begin) (and found (= begin (match-end 0))))) (defun goto-line-create (n) (goto-line n) (let ((d (- n (count-lines (point-min) (point))))) (if (not (bolp)) (setq d (1+ d))) (if (> d 1) (newline (1- d)))) ;;; Skip over existing lines. (while (not (looking-at "^$")) (forward-line 1)) ;;; end Bob's insert ) (defun fc-display-question () "Display current question and question help." (let* ((question (fc-get-field fc-current-record fc-question-field)) (cok (/= fc-question-field fc-answer-field)) (cr (if cok (fc-get-num-right fc-current-record) nil)) (cw (if cok (fc-get-num-wrong fc-current-record) nil)) (nc (if fc-multiple-choice fc-num-choices 0))) (goto-line-create 1) (insert (format "Card #%d of %d Overall: %d r %d w (%d%%)" (1+ fc-current-card-num) fc-num-records fc-num-right fc-num-wrong (fc-percent fc-num-right fc-num-wrong))) (if cok (insert (format " This card: %d r %d w (%d%%)" cr cw (fc-percent cr cw)))) (goto-line-create fc-help-line) ;; The above kludge is to assure that there are already newlines ;; after where the question will be. If we allowed the newlines ;; to be added later, they could inherit text properties from the ;; question. Is there a less kludgy way to avoid this? (goto-line-create fc-question-line) (insert (format "Question (%s): " (elt fc-fields fc-question-field))) (fc-insert-with-face question fc-question-face) (if fc-multiple-choice (fc-display-choices)) ;;; Next line removed by Bob ;; (goto-line-create fc-answer-line) ;;; Since answer goes at end of buffer, go to end, then move back over ;;; returns that were just the kluge. (goto-line (point-max)) (while (looking-at-backward "^$") (forward-line -1)) (forward-line 2) ;;; end Bob's insert (insert (format "Answer (%s): " (elt fc-fields fc-answer-field))) (if (and cok (eq fc-show-other-fields t)) (progn (goto-line-create (1+ fc-answer-line)) (fc-insert-other-fields fc-current-record))) ;;; Next line removed by Bob ;; (goto-line-create fc-help-line);; skip answer space ;;; Again, go to end of buffer and move back over returns to last text (goto-line (point-max)) (while (looking-at-backward "^$") (forward-line -1)) (forward-line 2) ;;; end Bob's insert (fc-insert-help (if fc-multiple-choice fc-question-multi-help fc-question-help)) ;; Make sure the question line is still visible. ;;; This goto-line should work, since answer line is not moved by ;;; other insertions. (goto-line fc-question-line) (beginning-of-line) (if (> (window-start) (point)) ;; question line has scrolled off (set-window-start (selected-window) (point))) )) (defun fc-display-answer () "Display current answer and answer help. Assumes that fc-display-question has already been called." (interactive) (let ((answer (fc-get-field fc-current-record fc-answer-field))) (if fc-multiple-choice (progn ;; Urg. fc-current-choice might not be set because we might ;; have just switched to multi-choice mode in mid-question. ;; So do we assume they got it right or wrong?? ;; Actually, we can hack it to "skip" this question (unless ;; the user forces 'r' or 'w') by leaving fc-current-choice at nil. (if (not fc-current-choice) nil ;;; Next line removed by Bob ;;; (goto-line-create (+ fc-question-line fc-current-choice 1)) ;;; If a multiple-choice, then will have multiple options. ;;; Search for that option. Note that fc-current-choice starts with ;;; zero, however the numbered list starts with "1. ", so the search ;;; must be for one plus the value of fc-current-choice. (search-forward (concat (1+ fc-current-choice) ". ")) ;;; end Bob's insert (beginning-of-line) (insert (if (= fc-current-choice fc-correct-choice) "Right!" "Wrong.")) ;;; Next line removed by Bob ;; (goto-line-create (+ fc-question-line fc-correct-choice 1)) ;;; This merely adds bold face to *this* line, so go to its beginning (beginning-of-line) ;;; end Bob's insert (re-search-forward "[0-9]\. ") (fc-apply-face-region fc-answer-face (match-beginning 0) (progn (end-of-line) (point)))))) ;;; Next line removed by Bob ;; (goto-line-create fc-answer-line) ;;; The fc-answer-line is indicated by "Answer ", so search for it. ;;; (Note: the fc-display-question function should provide a var for ;;; what is inserted, and not hardwire it as here.) (search-forward "Answer ") ;;; end Bob's insert (end-of-line) (fc-insert-with-face answer fc-answer-face) (if (and fc-show-other-fields (not (eq fc-show-other-fields t))) ;; if fc-show-other-fields is nil, we don't show them, but ;; if it's t, we already displayed them during fc-display-question. (progn ;;; Next line removed by Bob ;; (goto-line-create (1+ fc-answer-line)) ;;; The line into which other fileds are inserted is the next line (forward-line 1) ;;; end Bob's insert (fc-insert-other-fields fc-current-record))) ;;; Next line removed by Bob ;; (goto-line-create fc-help-line) ;;; The fc-help-line is indicated by "Press", so search for it. (search-forward "Press") (beginning-of-line) ;;; end Bob's insert (delete-region (point) (point-max)) ;; clear out old help (cond ((eq fc-state 'answer-check) (fc-insert-help (if fc-multiple-choice fc-answer-multi-help fc-answer-help))) ((eq fc-state 'answer-gave-up) (fc-insert-help fc-gave-up-help)) (t (error "Unexpected state %s in fc-display-answer" fc-state))) (goto-line fc-question-line) (beginning-of-line) (if (> (window-start) (point)) ;; question line has scrolled off (set-window-start (selected-window) (point))) )) ;;;;;;;;;;;;;;;; end fc-fix.el ;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;; end of composite: lojban-flashcard.el ;;;;;;;;;;;;;;;;