[elpa] 196/352: Uusi macro: wcheck-with-language-data

[Stefan Monnier]

monnier pushed a commit to branch master
in repository elpa.

commit 6fc8fe138dc0abdc21de9dea7361501176c0c0bb
Author: Teemu Likonen <address@hidden>
Date:   Wed Dec 29 11:10:51 2010 +0000

    Uusi macro: wcheck-with-language-data
    
    Tämä vähentää ja selkeyttää toistuvia
    
        (let ((... (wcheck-query-language-data ...))
              (... (wcheck-query-language-data ...))
              (... (wcheck-query-language-data ...))
              ...)
           ...)
    
    -rakenteita.
---
 wcheck-mode.el |  328 +++++++++++++++++++++++++++++---------------------------
 1 files changed, 170 insertions(+), 158 deletions(-)

diff --git a/wcheck-mode.el b/wcheck-mode.el
index a51d263..7428e06 100644
--- a/wcheck-mode.el
+++ b/wcheck-mode.el
@@ -802,31 +802,48 @@ other text elements in buffers."
                        3))
 
 
+(defmacro wcheck-with-language-data (language bindings &rest body)
+  (let ((lang-var (make-symbol "--wck-language--")))
+    `(let* ((,lang-var ,(cadr language))
+            ,@(when (car language)
+                `((,(car language) ,lang-var)))
+            ,@(mapcar
+               (lambda (var)
+                 (cond ((symbolp var)
+                        (list var `(wcheck-query-language-data
+                                    ,lang-var ',var)))
+                       ((and var (listp var))
+                        (list (car var) `(wcheck-query-language-data
+                                          ,lang-var ',(cadr var))))))
+               bindings))
+       ,@body)))
+
+
 (defun wcheck-send-words (buffer strings)
   "Send STRINGS for the process that handles BUFFER.
 STRINGS is a list of strings to be sent as input for the external
 process which handles BUFFER. Each string in STRINGS is sent as
 separate line."
-  (let ((program (wcheck-query-language-data
-                  (wcheck-get-data :buffer buffer :language)
-                  'program)))
-
-    (cond ((or (wcheck-get-data :buffer buffer :process)
-               (stringp program))
-           (process-send-string
-            (wcheck-start-get-process buffer)
-            (concat (mapconcat #'identity strings "\n") "\n")))
-          ((functionp program)
-           (when (buffer-live-p buffer)
-             (with-current-buffer buffer
-               (let ((words (save-match-data (funcall program strings))))
-                 (when (wcheck-list-of-strings-p words)
-                   (setq wcheck-received-words words)
-                   (wcheck-timer-add-paint-request buffer))))))
-          (t
-           (when (buffer-live-p buffer)
-             (with-current-buffer buffer
-               (wcheck-mode -1)))))))
+  (wcheck-with-language-data
+   (language (wcheck-get-data :buffer buffer :language))
+   (program)
+
+   (cond ((or (wcheck-get-data :buffer buffer :process)
+              (stringp program))
+          (process-send-string
+           (wcheck-start-get-process buffer)
+           (concat (mapconcat #'identity strings "\n") "\n")))
+         ((functionp program)
+          (when (buffer-live-p buffer)
+            (with-current-buffer buffer
+              (let ((words (save-match-data (funcall program strings))))
+                (when (wcheck-list-of-strings-p words)
+                  (setq wcheck-received-words words)
+                  (wcheck-timer-add-paint-request buffer))))))
+         (t
+          (when (buffer-live-p buffer)
+            (with-current-buffer buffer
+              (wcheck-mode -1)))))))
 
 
 (defun wcheck-receive-words (process string)
@@ -1002,26 +1019,23 @@ operation was unsuccessful."
   ;; If process for this BUFFER exists return it.
   (or (wcheck-get-data :buffer buffer :process)
       ;; It doesn't exist so start a new one.
-      (let* ((language (wcheck-get-data :buffer buffer :language))
-             (program (wcheck-query-language-data language 'program))
-             (args (wcheck-query-language-data language 'args))
-             (process-connection-type
-              (wcheck-query-language-data language 'connection))
-             proc)
-
-        (when (wcheck-program-executable-p program)
-          ;; Start the process.
-          (setq proc (apply #'start-process wcheck-process-name nil
-                            program args))
-          ;; Add the process Lisp object to database.
-          (wcheck-set-buffer-data buffer :process proc)
-          ;; Set the output handler function.
-          (set-process-filter proc #'wcheck-receive-words)
-          ;; Prevent Emacs from querying user about running processes
-          ;; when killing Emacs.
-          (set-process-query-on-exit-flag proc nil)
-          ;; Return the process object.
-          proc))))
+      (wcheck-with-language-data
+       (language (wcheck-get-data :buffer buffer :language))
+       (program args (process-connection-type connection))
+
+       (when (wcheck-program-executable-p program)
+         ;; Start the process.
+         (let ((proc (apply #'start-process wcheck-process-name nil
+                            program args)))
+           ;; Add the process Lisp object to database.
+           (wcheck-set-buffer-data buffer :process proc)
+           ;; Set the output handler function.
+           (set-process-filter proc #'wcheck-receive-words)
+           ;; Prevent Emacs from querying user about running processes
+           ;; when killing Emacs.
+           (set-process-query-on-exit-flag proc nil)
+           ;; Return the process object.
+           proc)))))
 
 
 (defun wcheck-update-buffer-data (buffer language)
@@ -1086,50 +1100,45 @@ elements between BEG and END; all hidden parts are 
omitted."
     (with-current-buffer buffer
       (save-excursion
 
-        (let* ((language (wcheck-get-data :buffer buffer :language))
-               (regexp (concat
-                        (wcheck-query-language-data language 'regexp-start)
-                        "\\("
-                        (wcheck-query-language-data language 'regexp-body)
-                        "\\)"
-                        (wcheck-query-language-data language 'regexp-end)))
-
-               (syntax (eval (wcheck-query-language-data language 'syntax)))
-               (discard (wcheck-query-language-data language 'regexp-discard))
-               (case-fold-search
-                (wcheck-query-language-data language 'case-fold))
+        (wcheck-with-language-data
+         (language (wcheck-get-data :buffer buffer :language))
+         (regexp-start regexp-body regexp-end regexp-discard
+                       syntax (case-fold-search case-fold))
+
+         (let ((regexp
+                (concat regexp-start "\\(" regexp-body "\\)" regexp-end))
                (face-p (wcheck-generate-face-predicate language major-mode))
                (search-spaces-regexp nil)
                (old-point 0)
                words)
 
-          (with-syntax-table syntax
-            (goto-char beg)
-            (save-match-data
-              (catch 'infinite
-                (while (re-search-forward regexp end t)
-                  (cond ((= (point) old-point)
-                         ;; Make sure we don't end up in an infinite
-                         ;; loop when the regexp always matches with
-                         ;; zero width in the current point position.
-                         (throw 'infinite t))
-
-                        ((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
-                                     (match-beginning 1) 'invisible buffer
-                                     end)))
-
-                        ((and (eval face-p)
-                              (or (equal discard "")
-                                  (not (string-match
-                                        discard
-                                        (match-string-no-properties 1)))))
-                         ;; Add the match to the word list.
-                         (add-to-list 'words (match-string-no-properties 1))))
-                  (setq old-point (point))))))
-          words)))))
+           (with-syntax-table (eval syntax)
+             (goto-char beg)
+             (save-match-data
+               (catch 'infinite
+                 (while (re-search-forward regexp end t)
+                   (cond ((= (point) old-point)
+                          ;; Make sure we don't end up in an infinite
+                          ;; loop when the regexp always matches with
+                          ;; zero width in the current point position.
+                          (throw 'infinite t))
+
+                         ((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
+                                      (match-beginning 1) 'invisible buffer
+                                      end)))
+
+                         ((and (eval face-p)
+                               (or (equal regexp-discard "")
+                                   (not (string-match
+                                         regexp-discard
+                                         (match-string-no-properties 1)))))
+                          ;; Add the match to the word list.
+                          (add-to-list 'words (match-string-no-properties 1))))
+                   (setq old-point (point))))))
+           words))))))
 
 
 (defun wcheck-paint-words (buffer beg end wordlist)
@@ -1140,54 +1149,53 @@ visible in BUFFER within position range from BEG to 
END."
   (when (buffer-live-p buffer)
     (with-current-buffer buffer
       (save-excursion
-        (let* ((language (wcheck-get-data :buffer buffer :language))
-               (r-start (wcheck-query-language-data language 'regexp-start))
-               (r-end (wcheck-query-language-data language 'regexp-end))
-               (syntax (eval (wcheck-query-language-data language 'syntax)))
-               (case-fold-search
-                (wcheck-query-language-data language 'case-fold))
-               (face-p (wcheck-generate-face-predicate language major-mode))
+
+        (wcheck-with-language-data
+         (language (wcheck-get-data :buffer buffer :language))
+         (regexp-start regexp-end syntax (case-fold-search case-fold)
+                       (ol-face face) suggestion-program)
+
+         (let ((face-p (wcheck-generate-face-predicate language major-mode))
                (search-spaces-regexp nil)
-               (ol-face (wcheck-query-language-data language 'face))
                (ol-keymap (make-sparse-keymap))
                (ol-mouse-face nil)
                (ol-help-echo nil)
                regexp old-point)
 
-          (when (wcheck-query-language-data language 'suggestion-program)
-            (define-key ol-keymap [down-mouse-3] 'wcheck-mouse-click-overlay)
-            (define-key ol-keymap [mouse-3] 'undefined)
-            (setq ol-mouse-face 'highlight
-                  ol-help-echo "mouse-3: show suggestions"))
-
-          (with-syntax-table syntax
-            (save-match-data
-              (dolist (word wordlist)
-                (setq regexp (concat r-start "\\("
-                                     (regexp-quote word) "\\)"
-                                     r-end)
-                      old-point 0)
-                (goto-char beg)
-
-                (catch 'infinite
-                  (while (re-search-forward regexp end t)
-                    (cond ((= (point) old-point)
-                           ;; We didn't move forward so break the loop.
-                           ;; Otherwise we would loop endlessly.
-                           (throw 'infinite t))
-                          ((invisible-p (match-beginning 1))
-                           ;; The point is invisible so jump forward to
-                           ;; the next change of "invisible" text
-                           ;; property.
-                           (goto-char (next-single-char-property-change
-                                       (match-beginning 1) 'invisible buffer
-                                       end)))
-                          ((eval face-p)
-                           ;; Make an overlay.
-                           (wcheck-make-overlay
-                            buffer ol-face ol-mouse-face ol-help-echo ol-keymap
-                            (match-beginning 1) (match-end 1))))
-                    (setq old-point (point))))))))))))
+           (when suggestion-program
+             (define-key ol-keymap [down-mouse-3] 'wcheck-mouse-click-overlay)
+             (define-key ol-keymap [mouse-3] 'undefined)
+             (setq ol-mouse-face 'highlight
+                   ol-help-echo "mouse-3: show suggestions"))
+
+           (with-syntax-table (eval syntax)
+             (save-match-data
+               (dolist (word wordlist)
+                 (setq regexp (concat regexp-start "\\("
+                                      (regexp-quote word) "\\)"
+                                      regexp-end)
+                       old-point 0)
+                 (goto-char beg)
+
+                 (catch 'infinite
+                   (while (re-search-forward regexp end t)
+                     (cond ((= (point) old-point)
+                            ;; We didn't move forward so break the loop.
+                            ;; Otherwise we would loop endlessly.
+                            (throw 'infinite t))
+                           ((invisible-p (match-beginning 1))
+                            ;; The point is invisible so jump forward to
+                            ;; the next change of "invisible" text
+                            ;; property.
+                            (goto-char (next-single-char-property-change
+                                        (match-beginning 1) 'invisible buffer
+                                        end)))
+                           ((eval face-p)
+                            ;; Make an overlay.
+                            (wcheck-make-overlay
+                             buffer ol-face ol-mouse-face ol-help-echo 
ol-keymap
+                             (match-beginning 1) (match-end 1))))
+                     (setq old-point (point)))))))))))))
 
 
 ;;; Spelling suggestions
@@ -1277,42 +1285,46 @@ call the function with single argument TEXT. The 
function must
 return substitute suggestions as a list of strings (or nil if
 there aren't any)."
 
-  (let ((program (wcheck-query-language-data language 'suggestion-program))
-        (args (wcheck-query-language-data language 'suggestion-args))
-        (parser (wcheck-query-language-data language 'suggestion-parser)))
-
-    (cond ((not (wcheck-suggestion-program-configured-p language))
-           (message
-            "Language \"%s\": suggestion program or function is not configured"
-            language)
-           'error)
-
-          ((and (stringp program)
-                (not parser))
-           (message "Language \"%s\": parser function is not configured"
-                    language)
-           'error)
-
-          ((stringp program)
-           (with-temp-buffer
-             (insert text)
-             (apply #'call-process-region (point-min) (point-max)
-                    program t t nil args)
-             (goto-char (point-min))
-             (let ((suggestions (save-match-data (funcall parser))))
-               (if (wcheck-list-of-strings-p suggestions)
-                   suggestions
-                 (message
-                  "Parser function must return a list of strings or nil")
-                 'error))))
-
-          ((functionp program)
-           (let ((suggestions (save-match-data (funcall program text))))
-             (if (wcheck-list-of-strings-p suggestions)
-                 suggestions
-               (message
-                "Suggestion function must return a list of strings or nil")
-               'error))))))
+  (wcheck-with-language-data
+   (nil language)
+   ((program suggestion-program)
+    (args suggestion-args)
+    (parser suggestion-parser))
+
+   (cond ((not (wcheck-suggestion-program-configured-p language))
+          (message
+           "Language \"%s\": suggestion program or function is not configured"
+           language)
+          'error)
+
+         ((and (stringp program)
+               (not parser))
+          (message "Language \"%s\": parser function is not configured"
+                   language)
+          'error)
+
+         ((stringp program)
+          (with-temp-buffer
+            (insert text)
+            (apply #'call-process-region (point-min) (point-max)
+                   program t t nil args)
+            (goto-char (point-min))
+            (let ((suggestions (save-match-data (funcall parser))))
+              (if (wcheck-list-of-strings-p suggestions)
+                  suggestions
+                (progn
+                  (message
+                   "Parser function must return a list of strings or nil")
+                  'error)))))
+
+         ((functionp program)
+          (let ((suggestions (save-match-data (funcall program text))))
+            (if (wcheck-list-of-strings-p suggestions)
+                suggestions
+              (progn
+                (message
+                 "Suggestion function must return a list of strings or nil")
+                'error)))))))
 
 
 (defun wcheck-choose-suggestion-popup (suggestions event)
@@ -1471,7 +1483,7 @@ Return a predicate expression that is used to decide 
whether
 position with LANGUAGE and MAJOR-MODE. Evaluating the predicate
 expression will return a boolean."
   (let* ((face-settings (wcheck-major-mode-face-settings
-                        language major-mode))
+                         language major-mode))
          (mode (nth 1 face-settings))
          (faces (nthcdr 2 face-settings)))
     (cond ((not font-lock-mode)