diff --git a/README.md b/README.md index 8634011..d572121 100644 --- a/README.md +++ b/README.md @@ -93,6 +93,18 @@ See all custom variables of speed-type pressing: M-x customize-group speed-type RET ``` +### Transform or filter content with regex +To replace certain regexs with a replacement there exists +`speed-type-replace-regexs`. It's a list of pairs which are replaced +in order. You can also define the empty-string as replacement to +"filter" certain annyoing patterns. + +For example, filter wikipedia references when using `speed-type-pandoc` +```emacs-lisp +;; replace wikipedia references +(add-to-list 'speed-type-replace-regexs '("\\^(\\(\\[[0-9]+\\]\\)+)" . "")) +``` + ### Customize cursor motion By default the cursor moves forward with each typed character and diff --git a/speed-type.el b/speed-type.el index 78bebb9..2cd27ff 100644 --- a/speed-type.el +++ b/speed-type.el @@ -427,7 +427,9 @@ Note: 'nil' values are excluded from the calculations. "C-c C-k" #'speed-type-complete "C-c C-f" #'speed-type-finish-animation "TAB" #'speed-type-code-tab - "RET" #'speed-type-code-ret) + "RET" #'speed-type-code-ret + "DEL" #'speed-type-delete-backward-char + "" #'speed-type-delete-forward-char) (define-derived-mode speed-type-mode fundamental-mode "SpeedType" "Major mode for practicing touch typing." @@ -990,7 +992,7 @@ Therefore `secure-hash-algorithms' should provide sha1 or md5 else (short-hash-str (substring hash-str 0 (min 7 (length hash-str))))) short-hash-str))))) -(defconst speed-type-pandoc-request-header "\"User-Agent:Emacs: speed-type/1.4 https://github.com/dakra/speed-type\"" +(defconst speed-type-pandoc-request-header "\"User-Agent:Emacs: speed-type/1.7 https://github.com/dakra/speed-type\"" "This const is used when pandoc is retrieving content from an url.") (defun speed-type--pandoc-top-filename (url) @@ -1236,7 +1238,35 @@ Whitespace is determined using `char-syntax'." (defun speed-type--handle-del (start end) "Keep track of the statistics when a deletion occurs between START and END." - (delete-region start end) + (when (speed-type-handle-overwrite-mode-p) + (if (and overwrite-mode (member this-original-command '(yank))) + (progn + (goto-char start) + (while (search-forward "\n" end t 1) + (delete-char -1) + (insert (speed-type-prepare-string " " speed-type-ignore-whitespace-for-complete + nil + speed-type-transform-hook + (make-speed-type-transform-context :major-mode (with-current-buffer speed-type--content-buffer major-mode) + :text-type speed-type--text-type + :start nil + :end nil + :entries speed-type--entries + :errors speed-type--errors + :non-consecutive-errors speed-type--non-consecutive-errors + :corrections speed-type--corrections + :best-correct-streak speed-type--best-correct-streak)))) + (setq speed-type--last-changed-text (buffer-substring end (min (+ end (- end start)) (point-max)))) + (delete-region end (min (+ end (- end start)) (point-max))) + (goto-char start) + (let ((mstart nil)) + (while (string-match "\n" speed-type--last-changed-text mstart) + (setq mstart (match-end 0)) + (goto-char (+ start (match-beginning 0))) + (unless (looking-at "\n") + (delete-char 1) + (insert (match-string 0 speed-type--last-changed-text)))))) + (delete-region start end))) (setq start (if (<= (point-max) start) (point-max) start)) (setq end (if (<= (point-max) end) (point-max) end)) (dotimes (i (- end start)) @@ -1473,6 +1503,7 @@ END is a point where the check stops to scan for diff." (cl-incf speed-type--current-correct-streak) (when (> speed-type--current-correct-streak speed-type--best-correct-streak) (setq speed-type--best-correct-streak speed-type--current-correct-streak)) + (remove-text-properties pos (1+ pos) '(speed-type-orig-char nil)) (let ((char-status (get-text-property i 'speed-type-char-status orig))) (when (eq char-status 'error) (cl-incf speed-type--corrections)) (add-text-properties pos (1+ pos) '(speed-type-char-status correct)))) @@ -1481,8 +1512,10 @@ END is a point where the check stops to scan for diff." (setq speed-type--current-correct-streak 0) (when non-consecutive-error-p (cl-incf speed-type--non-consecutive-errors)) (add-text-properties pos (1+ pos) '(speed-type-char-status error)) + (when (and overwrite-mode (null (get-text-property i 'speed-type-oirg-char orig))) + (add-text-properties pos (1+ pos) (list 'speed-type-orig-char (aref orig i)))) (speed-type-add-extra-words (+ (or speed-type-add-extra-words-on-error 0) - (or (and non-consecutive-error-p speed-type-add-extra-words-on-non-consecutive-errors) 0))))) + (or (and non-consecutive-error-p speed-type-add-extra-words-on-non-consecutive-errors) 0))))) (cl-incf speed-type--entries) (let ((f (if is-same 'speed-type-correct-face (if non-consecutive-error-p 'speed-type-error-face 'speed-type-consecutive-error-face)))) (let ((overlay (make-overlay pos (1+ pos)))) @@ -1492,8 +1525,8 @@ END is a point where the check stops to scan for diff." (if (or (eq speed-type-point-motion-on-error 'point-move) (string= new "") (not any-error)) - (goto-char (- end (if overwrite-mode 1 0))) - (goto-char (- end (if overwrite-mode 2 1))) + (goto-char (- end (if (speed-type-handle-overwrite-mode-p) 0 1))) + (goto-char (- end (if (speed-type-handle-overwrite-mode-p) 2 1))) (beep) (message "Wrong key")) (not any-error))) @@ -1543,6 +1576,21 @@ content-buffer manually if there is a add-extra-word-function." (not (save-excursion (text-property-search-backward 'speed-type-char-status 'error t))) (not (text-property-any (point-min) (point-max) 'speed-type-char-status 'error))))))) +(defun speed-type--swap-orig-char (str) + "Read any text-property: speed-type-oirg-char in STR and make a new string." + (with-temp-buffer + (insert str) + (goto-char (point-min)) + (while (not (eobp)) + (when (get-text-property (point) 'speed-type-orig-char) + (let* ((p-orig-char (apply 'propertize (char-to-string (get-text-property (point) 'speed-type-orig-char)) (text-properties-at (point)))) + (new-orig-char (char-after (point)))) + (delete-region (point) (1+ (point))) + (save-excursion (insert p-orig-char)) + (put-text-property (point) (1+ (point)) 'speed-type-orig-char new-orig-char))) + (forward-char)) + (buffer-string))) + (defun speed-type--change (start end _length) "Handle buffer change between START and END. LENGTH is ignored. Used for hook AFTER-CHANGE-FUNCTIONS. @@ -1554,20 +1602,23 @@ are color coded and stats are gathered about the typing performance." nil) (t (progn (speed-type--resume) - (let ((new-text (buffer-substring start end)) - (old-text speed-type--last-changed-text)) + (let ((new-text (buffer-substring start end))) (speed-type--handle-del start end) - (insert old-text) - (if (< start (point-max)) - (let* ((end (if (> end (point-max)) (point-max) end)) - (orig (buffer-substring start end))) - (when-let* ((overlay (and (equal new-text "") - (car (overlays-at end))))) - (move-overlay overlay (1- (overlay-end overlay)) (overlay-end overlay)) (current-buffer)) - (speed-type--diff orig new-text start end) - (when (speed-type-complete-p) (speed-type-complete))) - (beep) - (message "End of buffer"))))))) + (let ((old-text speed-type--last-changed-text)) + (when (and (speed-type-handle-overwrite-mode-p) (not (and overwrite-mode (member this-original-command '(yank))))) + (let ((before-insert (point))) + (insert (speed-type--swap-orig-char old-text)) + (remove-text-properties before-insert (point) '(speed-type-orig-char nil)))) + (if (< start (point-max)) + (let* ((end (if (> end (point-max)) (point-max) end)) + (orig (if (and (speed-type-handle-overwrite-mode-p) (not (and overwrite-mode (member this-original-command '(yank))))) + (buffer-substring start end) old-text))) + (when-let* ((overlay (and (equal new-text "") (car (overlays-at end))))) + (move-overlay overlay (1- (overlay-end overlay)) (overlay-end overlay)) (current-buffer)) + (speed-type--diff (speed-type--swap-orig-char orig) new-text start end) + (when (speed-type-complete-p) (speed-type-complete))) + (beep) + (message "End of buffer")))))))) (defun speed-type-forward-replace-map-adjust-properties (map property end) "Replace each FROM/TO pair in MAP while adjusting PROPERTY regions. @@ -2406,6 +2457,30 @@ LIMIT is supplied to the random-function." (goto-char (point)) ;; this is for undo making the "jump-back" part of this undo-group )) +(defun speed-type-handle-overwrite-mode-p () + "Check if special logic is needed because of `overwrite-mode'." + (or (not overwrite-mode) + (not (member this-command '(self-insert-command))) + (eolp))) + +(defun speed-type-delete-forward-char (n &optional killflag) + "Delete char forward while in a speed-type session. + +N and KILLFLAG are described in `delete-forward-char' from simple.el." + (declare (interactive-only delete-char)) + (interactive "p\nP") + (let ((overwrite-mode nil)) + (call-interactively 'delete-forward-char))) + +(defun speed-type-delete-backward-char (n &optional killflag) + "Delete char backward while in an speed-type session. + +N and KILLFLAG are described in `delete-backward-char' from simple.el." + (declare (interactive-only delete-char)) + (interactive "p\nP") + (let ((overwrite-mode nil)) + (call-interactively 'delete-backward-char))) + (defun speed-type-code-tab () "A command to be mapped to TAB when speed typing code." (interactive) @@ -2725,7 +2800,11 @@ If FILE-NAME is nil, will use file-name of CURRENT-BUFFER." (end-of-line 1) (forward-line 1) (point)) - (point-min))) + (when (string-match-p "wikipedia" fn) + (re-search-forward "^\\([^ |-]+ \\).*\\." nil t 2) + (beginning-of-line) + (point)) + (point-min))) (end (or (when (re-search-forward "***.END.OF.\\(THIS\\|THE\\).PROJECT.GUTENBERG.EBOOK" nil t) (beginning-of-line 1) (forward-line -1) @@ -2772,7 +2851,13 @@ The file-name of the content is a converted form of URL." (let ((stb (if speed-type-randomize (let* ((buf (speed-type-prepare-content-buffer-from-buffer buffer)) (title (format "Text section of url %s" url)) - (start (with-current-buffer buf (point-min))) + (start (with-current-buffer buf + (or + (when (string-match-p "wikipedia" fn) + (re-search-forward "^\\([^ |-]+ \\).*\\." nil t 2) + (beginning-of-line) + (point)) + (point-min)))) (end (with-current-buffer buf (point-max)))) (speed-type--setup buf start diff --git a/test/speed-type-test.el b/test/speed-type-test.el index c51546a..3f731c1 100644 --- a/test/speed-type-test.el +++ b/test/speed-type-test.el @@ -38,6 +38,25 @@ (require 'speed-type) (require 'cl-macs) +(defun speed-type-test-user-input (str) + "Helper function to simulate an insertion from user." + (cond + ((member str '("RET" "TAB")) + (let ((this-command (keymap-lookup nil str))) + (funcall this-command))) + ((string= "DEL" str) + (let ((this-command (keymap-lookup nil str))) + (funcall this-command 1))) + (t + (dotimes (pos (length str)) + (let ((this-command 'self-insert-command) + (post-self-insert-hook nil) + (expand-abbrev nil) + (internal-auto-fill nil) + (auto-fill-function nil) + (auto-fill-chars nil)) + (self-insert-command 1 (aref str pos))))))) + (ert-deftest speed-type-test/stop-words-p-supply-garbage () (should-error (speed-type--stop-word-p nil)) (should-error (speed-type--stop-word-p 1)) @@ -218,24 +237,27 @@ TEST-IN-BUF is a lambda which is executed within the speed-type-buffer." (setq speed-type-point-motion-on-error 'point-stay) (speed-type-test-region (lambda () + ;; TODO Enable overwrite-mode here, make point-movement work in test-env + ;; For some reason it resets the point due to some post-hook or post-advice. + ;; (when (= (% (random 2) 2) 0) (overwrite-mode)) (should (= (point) 1)) (should (= speed-type--errors 0)) (should (= speed-type--non-consecutive-errors 0)) - (insert "b") + (speed-type-test-user-input "b") (should (= speed-type--errors 1)) (should (= speed-type--non-consecutive-errors 1)) (should (= (point) 1)) - (insert "c") + (speed-type-test-user-input "c") (should (= speed-type--errors 2)) (should (= speed-type--non-consecutive-errors 1)) (should (= (point) 1)) - (insert "a") + (speed-type-test-user-input "a") (should (= speed-type--errors 2)) (should (= speed-type--non-consecutive-errors 1)) (should (= (point) 2)) - (funcall (keymap-lookup nil "DEL") 1) + (speed-type-test-user-input "DEL") (should (= (point) 1)) - (insert "a") + (speed-type-test-user-input "a") (should (= speed-type--errors 2)) (should (= speed-type--corrections 1)) (should (= speed-type--non-consecutive-errors 1)) @@ -250,20 +272,21 @@ TEST-IN-BUF is a lambda which is executed within the speed-type-buffer." (setq speed-type-point-motion-on-error 'point-move) (speed-type-test-region (lambda () + (when (= (% (random 2) 2) 0) (overwrite-mode)) (should (= (point) 1)) (should (= speed-type--errors 0)) (should (= speed-type--non-consecutive-errors 0)) - (insert "b") + (speed-type-test-user-input "b") (should (= speed-type--errors 1)) (should (= speed-type--non-consecutive-errors 1)) (should (= (point) 2)) - (insert "c") + (speed-type-test-user-input "c") (should (= speed-type--errors 2)) (should (= speed-type--non-consecutive-errors 1)) (should (= (point) 3)) - (funcall (keymap-lookup nil "DEL") 1) + (speed-type-test-user-input "DEL") (should (= (point) 2)) - (insert "b") + (speed-type-test-user-input "b") (should (= speed-type--errors 2)) (should (= speed-type--corrections 1)) (should (= speed-type--non-consecutive-errors 1)) @@ -295,7 +318,8 @@ Also assure when that added words are downcased too." ;; test top word file and source file is written (ert-deftest speed-type-test/general-region () "Do a general test with `speed-type-region' with fundamental mode and a prog-mode, checking content, overlays, point and point-motion, buffer-variables and statistic file." - (let ((content "abcde") + (let ((content "abcde\n\nab\tcde") + (override-active (= 0 (% (random 2) 2))) (mode (nth (random 2) '(fundamental-mode emacs-lisp-mode))) (speed-type-statistic-filename (concat (temporary-file-directory) "speed-type-statistic.el"))) (with-temp-buffer @@ -305,19 +329,25 @@ Also assure when that added words are downcased too." (content-buf speed-type--content-buffer)) (unwind-protect (with-current-buffer buf - (insert "a") - (insert "b") - (insert "a") - (insert "a") - (funcall (keymap-lookup nil "DEL") 1) - (funcall (keymap-lookup nil "DEL") 1) - (insert "c") - (insert "!") - (insert "!") + (when override-active (overwrite-mode)) + (speed-type-test-user-input "a") + (speed-type-test-user-input "b") + (speed-type-test-user-input "a") + (speed-type-test-user-input "a") + (speed-type-test-user-input "DEL") + (speed-type-test-user-input "DEL") + (speed-type-test-user-input "c") + (speed-type-test-user-input "!") + (speed-type-test-user-input "!") + (speed-type-test-user-input "RET") + (speed-type-test-user-input "RET") + (speed-type-test-user-input "a") + (speed-type-test-user-input "b") + (speed-type-test-user-input "TAB") ; (should (= speed-type--start-time 1753299414.2124302)) (should (eq speed-type--buffer (current-buffer))) ; (should (eq speed-type--content-buffer (get-buffer "*speed-type-content-buffer*"))) - (should (= speed-type--entries 5)) + (should (= speed-type--entries 10)) (should (= speed-type--errors 4)) (should (= speed-type--non-consecutive-errors 2)) (should (= speed-type--corrections 1)) @@ -335,6 +365,8 @@ Also assure when that added words are downcased too." (should (eq (overlay-get (car (overlays-at (1+ i))) 'face) 'speed-type-correct-face))) (should (eq (overlay-get (car (overlays-at 4)) 'face) 'speed-type-error-face)) (should (eq (overlay-get (car (overlays-at 5)) 'face) 'speed-type-consecutive-error-face)) + (dotimes (i 3) + (should (eq (overlay-get (car (overlays-at (+ 6 i))) 'face) 'speed-type-correct-face))) ) (kill-buffer buf) (should (eq (buffer-live-p content-buf) nil))))))) @@ -351,15 +383,15 @@ Also assure when that added words are downcased too." (let ((buf (speed-type-region (point-min) (point-max)))) (unwind-protect (with-current-buffer buf - (insert "0") - (insert "0") - (insert "a") - (insert "b") + (speed-type-test-user-input "0") + (speed-type-test-user-input "0") + (speed-type-test-user-input "a") + (speed-type-test-user-input "b") (funcall (keymap-lookup nil "DEL") 1) (funcall (keymap-lookup nil "DEL") 1) - (insert "0") - (insert "!") - (insert "!") + (speed-type-test-user-input "0") + (speed-type-test-user-input "!") + (speed-type-test-user-input "!") (should (eq speed-type--buffer (current-buffer))) (should (= speed-type--entries 5)) (should (= speed-type--errors 4))