monnier pushed a commit to branch master in repository elpa. commit 170cc23e97baf049084654034ddbf7572af87420 Author: Teemu Likonen <tliko...@iki.fi> Date: Tue Jan 4 08:18:16 2011 +0000
Uusi ominaisuus: etsi seuraava/edellinen merkitty kohta Komennot ovat wcheck-jump-forward ja wcheck-jump-backward. --- wcheck-mode.el | 314 ++++++++++++++++++++++++++++++++++++++++++++++---------- 1 files changed, 261 insertions(+), 53 deletions(-) diff --git a/wcheck-mode.el b/wcheck-mode.el index 58cad2e..e3dd3b8 100644 --- a/wcheck-mode.el +++ b/wcheck-mode.el @@ -34,6 +34,10 @@ ;; "Switch wcheck-mode languages." t) ;; (autoload 'wcheck-spelling-suggestions "wcheck-mode" ;; "Spelling suggestions." t) +;; (autoload 'wcheck-jump-forward "wcheck-mode" +;; "Move point forward to next marked text area." t) +;; (autoload 'wcheck-jump-backward "wcheck-mode" +;; "Move point backward to previous marked text area." t) ;; ;; See customize group "wcheck" for information on how to configure ;; Wcheck mode. (M-x customize-group RET wcheck RET) @@ -550,9 +554,10 @@ This is used when language does not define a face." "Keymap for `wcheck-mode'.") (defvar wcheck-timer nil) -(defconst wcheck-timer-idle .4 +(defconst wcheck-timer-idle .3 "`wcheck-mode' idle timer delay (in seconds).") (defvar wcheck-timer-paint-event-count 0) +(defvar wcheck-timer-paint-event-count-std 3) (defvar wcheck-change-language-history nil "Language history for command `wcheck-change-language'.") @@ -562,6 +567,8 @@ This is used when language does not define a face." (defconst wcheck-process-name "wcheck" "Process name for `wcheck-mode'.") +(defvar wcheck-jump-step 5000) + ;;; Macros @@ -584,10 +591,13 @@ This is used when language does not define a face." (with-current-buffer ,var ,@body)))) + (defmacro wcheck-loop-over-read-reqs (var &rest body) `(wcheck-loop-over-reqs-engine :read-req ,var ,@body)) (defmacro wcheck-loop-over-paint-reqs (var &rest body) `(wcheck-loop-over-reqs-engine :paint-req ,var ,@body)) +(defmacro wcheck-loop-over-jump-reqs (var &rest body) + `(wcheck-loop-over-reqs-engine :jump-req ,var ,@body)) (defmacro wcheck-with-language-data (language bindings &rest body) @@ -619,6 +629,8 @@ This is used when language does not define a face." wcheck-suggestion-error) (wcheck-define-condition wcheck-parser-function-not-configured-error wcheck-suggestion-error) +(wcheck-define-condition wcheck-overlay-not-found-error wcheck-error) + ;;; Interactive commands @@ -757,7 +769,9 @@ Wcheck mode. You can access the variables through customize group Interactive command `wcheck-change-language' is used to switch languages. Command `wcheck-spelling-suggestions' gives spelling suggestions for marked text at point (also accessible through the -right-click mouse menu)." +right-click mouse menu). Commands `wcheck-jump-forward' and +`wcheck-jump-backward' move point to next/previous marked text +area." :init-value nil :lighter " wck" @@ -804,10 +818,17 @@ right-click mouse menu)." (setq wcheck-timer-paint-event-count at-least) (setq wcheck-timer-paint-event-count at-least) (wcheck-funcall-after-idle #'wcheck-timer-paint-event))) - (when (> (setq wcheck-timer-paint-event-count - (1- wcheck-timer-paint-event-count)) - 0) - (wcheck-funcall-after-idle #'wcheck-timer-paint-event)))) + (if (> (setq wcheck-timer-paint-event-count + (1- wcheck-timer-paint-event-count)) + 0) + (wcheck-funcall-after-idle #'wcheck-timer-paint-event) + (wcheck-timer-jump-event)))) + + +(defun wcheck-force-read (buffer) + (redisplay t) + (wcheck-buffer-data-set buffer :read-req t) + (wcheck-timer-read-event)) (defun wcheck-timer-read-event () @@ -823,37 +844,37 @@ marking strings in buffers." (wcheck-loop-over-read-reqs buffer - ;; We are about to fulfill buffer's window-reading request so - ;; remove the request. Reset also the list of received strings - ;; and visible window areas. - (wcheck-buffer-data-set buffer :read-req nil) - (wcheck-buffer-data-set buffer :strings nil) - (wcheck-buffer-data-set buffer :areas nil) - - ;; Walk through all windows which belong to this buffer. - (let (area-alist strings) - (walk-windows #'(lambda (window) - (when (eq buffer (window-buffer window)) - ;; Store the visible buffer area. - (push (cons (window-start window) - (window-end window t)) - area-alist))) - 'nomb t) - - ;; Combine overlapping buffer areas and read strings from all - ;; areas. - (let ((combined (wcheck-combine-overlapping-areas area-alist))) - (wcheck-buffer-data-set buffer :areas combined) - (dolist (area combined) - (setq strings (append (wcheck-read-strings - buffer (car area) (cdr area)) - strings)))) - ;; Send strings to checker engine. - (wcheck-send-strings buffer strings))) - - ;; Start a timer which will mark text in buffers/windows. Repeat the - ;; timer 3 times after the initial call. - (wcheck-timer-paint-event-run 3)) + (unless (wcheck-buffer-data-get :buffer buffer :jump-req) + ;; We are about to fulfill buffer's window-reading request so + ;; remove the request. Reset also the list of received strings and + ;; visible window areas. + (wcheck-buffer-data-set buffer :read-req nil) + (wcheck-buffer-data-set buffer :strings nil) + (wcheck-buffer-data-set buffer :areas nil) + + ;; Walk through all windows which belong to this buffer. + (let (area-alist strings) + (walk-windows #'(lambda (window) + (when (eq buffer (window-buffer window)) + ;; Store the visible buffer area. + (push (cons (window-start window) + (window-end window t)) + area-alist))) + 'nomb t) + + ;; Combine overlapping buffer areas and read strings from all + ;; areas. + (let ((combined (wcheck-combine-overlapping-areas area-alist))) + (wcheck-buffer-data-set buffer :areas combined) + (dolist (area combined) + (setq strings (append (wcheck-read-strings + buffer (car area) (cdr area)) + strings)))) + ;; Send strings to checker engine. + (wcheck-send-strings buffer strings)))) + + ;; Start a timer which will mark text in buffers/windows. + (wcheck-timer-paint-event-run wcheck-timer-paint-event-count-std)) (defun wcheck-send-strings (buffer strings) @@ -915,17 +936,13 @@ separate line." This is normally called by the `wcheck-mode' idle timer. This function marks (with overlays) strings in the buffers that have -requested it. - -If the optional argument REPEAT exists and is an integer then -also call the function repeatedly that many times after the first -call. The delay between consecutive calls is defined in variable -`wcheck-timer-idle'." +requested it." (wcheck-loop-over-paint-reqs buffer - (wcheck-remove-overlays) + (unless (wcheck-buffer-data-get :buffer buffer :jump-req) + (wcheck-remove-overlays)) ;; We are about to mark text in this buffer so remove this buffer's ;; request. (wcheck-buffer-data-set buffer :paint-req nil) @@ -935,11 +952,61 @@ call. The delay between consecutive calls is defined in variable (dolist (area (wcheck-buffer-data-get :buffer buffer :areas)) (wcheck-paint-strings buffer (car area) (cdr area) (wcheck-buffer-data-get :buffer buffer - :strings))))) + :strings) + ;; If jump-req is active then paint + ;; invisible text too. + (wcheck-buffer-data-get :buffer buffer + :jump-req))))) (wcheck-timer-paint-event-run)) +(defun wcheck-timer-jump-event () + (wcheck-loop-over-jump-reqs + buffer + + (let* ((jump-req (wcheck-buffer-data-get :buffer buffer :jump-req)) + (direction (wcheck-jump-req-direction jump-req)) + (start (wcheck-jump-req-start jump-req)) + (bound (wcheck-jump-req-bound jump-req))) + + (wcheck-buffer-data-set buffer :jump-req nil) + + (condition-case nil + (cond ((eq direction 'forward) + (let ((ol (wcheck-overlay-next start bound))) + (cond (ol + (goto-char (overlay-end ol)) + (when (invisible-p (point)) + (show-entry)) + (message "Found from line %s" + (line-number-at-pos (point))) + (wcheck-force-read buffer)) + ((< bound (point-max)) + (wcheck-jump-req-forward + buffer (1+ bound) (+ bound wcheck-jump-step))) + (t + (signal 'wcheck-overlay-not-found-error nil))))) + ((eq direction 'backward) + (let ((ol (wcheck-overlay-previous start bound))) + (cond (ol + (goto-char (overlay-start ol)) + (when (invisible-p (point)) + (show-entry)) + (message "Found from line %s" + (line-number-at-pos (point))) + (wcheck-force-read buffer)) + ((> bound (point-min)) + (wcheck-jump-req-backward + buffer (1- bound) (- bound wcheck-jump-step))) + (t + (signal 'wcheck-overlay-not-found-error nil)))))) + + (wcheck-overlay-not-found-error + (message "Found nothing") + (wcheck-force-read buffer)))))) + + ;;; Hooks @@ -1121,16 +1188,21 @@ BUFFER from the list." ;;; Read and paint strings -(defun wcheck-read-strings (buffer beg end) +(defun wcheck-read-strings (buffer beg end &optional invisible) "Return a list of text elements in BUFFER. Scan BUFFER between positions BEG and END and search for text elements according to buffer's language settings (see -`wcheck-language-data'). Return a list containing visible text -elements between BEG and END; all hidden parts are omitted." +`wcheck-language-data'). If INVISIBLE is non-nil read all buffer +areas, including invisible ones. Otherwise skip invisible text." + (when (buffer-live-p buffer) (with-current-buffer buffer (save-excursion + (when font-lock-mode + (save-excursion + (font-lock-fontify-region (min beg end) (max beg end)))) + (wcheck-with-language-data (language (wcheck-buffer-data-get :buffer buffer :language)) (regexp-start regexp-body regexp-end regexp-discard @@ -1154,7 +1226,8 @@ elements between BEG and END; all hidden parts are omitted." ;; zero width in the current point position. (throw 'infinite t)) - ((invisible-p (match-beginning 1)) + ((and (not invisible) + (invisible-p (match-beginning 1))) ;; This point is invisible. Let's jump forward ;; to next change of "invisible" property. (goto-char (next-single-char-property-change @@ -1173,10 +1246,13 @@ elements between BEG and END; all hidden parts are omitted." strings)))))) -(defun wcheck-paint-strings (buffer beg end strings) +(defun wcheck-paint-strings (buffer beg end strings &optional invisible) "Mark strings in buffer. + Mark all strings in STRINGS which are visible in BUFFER within -position range from BEG to END." +position range from BEG to END. If INVISIBLE is non-nil paint all +buffer areas, including invisible ones. Otherwise skip invisible +text." (when (buffer-live-p buffer) (with-current-buffer buffer @@ -1215,7 +1291,8 @@ position range from BEG to END." ;; We didn't move forward so break the loop. ;; Otherwise we would loop endlessly. (throw 'infinite t)) - ((invisible-p (match-beginning 1)) + ((and (not invisible) + (invisible-p (match-beginning 1))) ;; The point is invisible so jump forward to ;; the next change of "invisible" text ;; property. @@ -1230,6 +1307,121 @@ position range from BEG to END." (setq old-point (point))))))))))))) +;;; Jump forward or backward + + +(defun wcheck-overlay-next (start bound) + (catch 'overlay + (dolist (ol (overlays-at start)) + (when (overlay-get ol 'wcheck-mode) + (throw 'overlay ol))) + (let ((pos start)) + (while (and (setq pos (next-overlay-change pos)) + (< pos (min bound (point-max)))) + (dolist (ol (overlays-at pos)) + (when (overlay-get ol 'wcheck-mode) + (throw 'overlay ol))))))) + + +(defun wcheck-overlay-previous (start bound) + (catch 'overlay + (let ((pos start)) + (while (and (setq pos (previous-overlay-change pos)) + (> pos (max bound (point-min)))) + (dolist (ol (overlays-at pos)) + (when (overlay-get ol 'wcheck-mode) + (throw 'overlay ol))))))) + + +(defun wcheck-line-start-at (pos) + (save-excursion + (goto-char pos) + (line-beginning-position))) + + +(defun wcheck-line-end-at (pos) + (save-excursion + (goto-char pos) + (line-end-position))) + + +(defun wcheck-jump-req-forward (buffer start bound) + (with-current-buffer buffer + (let ((start (min start bound)) ;LET, ei LET* + (bound (wcheck-line-end-at (min (max start bound) (point-max))))) + (message "Searching forward in lines %d-%d..." + (line-number-at-pos start) + (line-number-at-pos bound)) + (wcheck-buffer-data-set buffer :jump-req + (wcheck-jump-req-create 'forward start bound)) + (wcheck-buffer-data-set buffer :areas (list (cons start bound))) + (wcheck-send-strings buffer (wcheck-read-strings buffer start bound t)) + (wcheck-timer-paint-event-run wcheck-timer-paint-event-count-std)))) + + +(defun wcheck-jump-req-backward (buffer start bound) + (with-current-buffer buffer + (let ((start (max start bound)) ;LET, ei LET* + (bound (wcheck-line-start-at (max (min start bound) (point-min))))) + (message "Searching backward in lines %d-%d..." + (line-number-at-pos start) + (line-number-at-pos bound)) + (wcheck-buffer-data-set buffer :jump-req + (wcheck-jump-req-create 'backward start bound)) + (wcheck-buffer-data-set buffer :areas (list (cons bound start))) + (wcheck-send-strings buffer (wcheck-read-strings buffer bound start t)) + (wcheck-timer-paint-event-run wcheck-timer-paint-event-count-std)))) + + +(defun wcheck-invisible-text-in-area-p (buffer beg end) + (catch 'invisible + (let ((pos (min beg end)) ;LET, ei LET* + (end (max beg end))) + (when (invisible-p pos) + (throw 'invisible t)) + (while (and (setq pos (next-single-char-property-change + pos 'invisible buffer)) + (< pos end)) + (when (invisible-p pos) + (throw 'invisible t)))))) + + +;;;###autoload +(defun wcheck-jump-forward () + "Move point forward to next marked text area." + (interactive) + (let ((buffer (current-buffer))) + (unless wcheck-mode + (wcheck-mode 1)) + (when wcheck-mode + (wcheck-buffer-data-set buffer :jump-req nil) + (let ((ol (wcheck-overlay-next + (point) (window-end (selected-window) t)))) + (if (and ol (not (wcheck-invisible-text-in-area-p + buffer (point) (overlay-end ol)))) + (goto-char (overlay-end ol)) + (wcheck-jump-req-forward + buffer (point) (+ (point) wcheck-jump-step))))))) + + +;;;###autoload +(defun wcheck-jump-backward () + "Move point backward to previous marked text area." + (interactive) + (let ((buffer (current-buffer))) + (unless wcheck-mode + (wcheck-mode 1)) + (when wcheck-mode + (wcheck-buffer-data-set buffer :jump-req nil) + (let ((ol (wcheck-overlay-previous + (point) (window-start (selected-window))))) + (if (and ol (not (wcheck-invisible-text-in-area-p + buffer (point) (overlay-start ol)))) + (goto-char (overlay-start ol)) + (wcheck-jump-req-backward + buffer (point) (- (point) wcheck-jump-step))))))) + + ;;; Spelling suggestions @@ -1734,7 +1926,7 @@ suggestion function." (defconst wcheck-buffer-data-keys - '(:buffer :process :language :read-req :paint-req :areas :strings)) + '(:buffer :process :language :read-req :paint-req :jump-req :areas :strings)) (defun wcheck-buffer-data-key-index (key) @@ -1797,6 +1989,22 @@ If KEY is nil return all buffer's all data." (aset item (wcheck-buffer-data-key-index key) value)))) +(defun wcheck-jump-req-create (direction start bound) + (when (and (or (eq direction 'forward) + (eq direction 'backward)) + (number-or-marker-p start) + (number-or-marker-p bound)) + (vector direction start bound))) + + +(defun wcheck-jump-req-direction (jump-req) + (aref jump-req 0)) +(defun wcheck-jump-req-start (jump-req) + (aref jump-req 1)) +(defun wcheck-jump-req-bound (jump-req) + (aref jump-req 2)) + + (provide 'wcheck-mode) ;;; wcheck-mode.el ends here