[elpa] externals/ampc 6b96b2215e 093/111: * ampc.el: Optimise parsing of MPD's output.

[Stefan Monnier]

branch: externals/ampc
commit 6b96b2215e8c4bedd6d0f00422b6a03831da4795
Author: Christopher Schmidt <christopher@ch.ristopher.com>
Commit: Christopher Schmidt <christopher@ch.ristopher.com>

    * ampc.el: Optimise parsing of MPD's output.
    (ampc-iterate-source): Cache delimiter if it should be bound.  Compute 
delimiter
    regexp at compile time.
    (ampc-iterate-source-output): Cache tags and tag regexps.
    (ampc-extract-regexp): New macro.
    (ampc-extract): Inline function.  Pass regexp rather than tag.  Refactor tag
    cleaning to ampc-clean-tag.
    All callers changed.
    (ampc-clean-tag): New function.
    (ampc-narrow-entry): Inline function.  Do not modify point.  Return start of
    delimiter match.
---
 ampc.el | 129 +++++++++++++++++++++++++++++++++++-----------------------------
 1 file changed, 70 insertions(+), 59 deletions(-)

diff --git a/ampc.el b/ampc.el
index fb2a72fb0d..a866254f36 100644
--- a/ampc.el
+++ b/ampc.el
@@ -922,34 +922,47 @@ modified."
 
 (defmacro ampc-iterate-source (data-buffer delimiter bindings &rest body)
   (declare (indent 3) (debug t))
-  `(when (,@(if data-buffer `(with-current-buffer ,data-buffer) '(progn))
-          (search-forward-regexp
+  (when (memq (intern delimiter) bindings)
+    (callf2 delq (intern delimiter) bindings)
+    (push (list (intern delimiter)
+                '(buffer-substring (point) (line-end-position)))
+          bindings))
+  `(,@(if data-buffer `(with-current-buffer ,data-buffer) '(progn))
+    (when (search-forward-regexp
            ,(concat "^" (regexp-quote delimiter) ": ")
-           nil t))
-     (loop with next
-           do (,@(if data-buffer `(with-current-buffer ,data-buffer) '(progn))
-               (save-restriction
-                 (setf next (ampc-narrow-entry ,delimiter))
+           nil t)
+      (loop with next
+            do (save-restriction
+                 (setf next (ampc-narrow-entry
+                             ,(concat "^" (regexp-quote delimiter) ": ")))
                  (let ,(loop for binding in bindings
                              if (consp binding)
                              collect binding
                              else
                              collect `(,binding (ampc-extract
-                                                 ,(symbol-name binding)))
+                                                 (ampc-extract-regexp
+                                                  ,(symbol-name binding))))
                              end)
-                   ,@body)))
-           while next
-           do (,@(if data-buffer `(with-current-buffer ,data-buffer) '(progn))
-               (goto-char next)))))
+                   ,@body))
+            while next
+            do (goto-char next)))))
 
 (defmacro ampc-iterate-source-output (delimiter bindings pad-data &rest body)
   (declare (indent 2) (debug t))
   `(let ((output-buffer (current-buffer))
-         (properties (plist-get (cdr ampc-type) :properties)))
+         (tags (loop for (tag . props) in
+                     (plist-get (cdr ampc-type) :properties)
+                     collect (cons tag (ampc-extract-regexp tag)))))
      (ampc-iterate-source
          data-buffer ,delimiter ,bindings
-       (with-current-buffer output-buffer
-         (ampc-insert (ampc-pad ,pad-data) ,@body)))))
+       (let ((pad-data ,pad-data))
+         (with-current-buffer output-buffer
+           (ampc-insert (ampc-pad pad-data) ,@body))))))
+
+(defmacro ampc-extract-regexp (tag)
+  (if (stringp tag)
+      (concat "^" (regexp-quote tag) ": \\(.*\\)$")
+    `(concat "^" (regexp-quote ,tag) ": \\(.*\\)$")))
 
 (defmacro ampc-tagger-log (&rest what)
   (declare (indent 0) (debug t))
@@ -1573,21 +1586,19 @@ modified."
 (defun ampc-create-tree ()
   (avl-tree-create 'ampc-tree<))
 
-(defun ampc-extract (tag)
-  (save-excursion
-    (goto-char (point-min))
-    (when (search-forward-regexp
-           (concat "^" (regexp-quote tag) ": \\(.*\\)$")
-           nil
-           t)
-      (let ((result (match-string 1)))
-        (let ((func (cdr (assoc tag ampc-tag-transform-funcs))))
-          (when func
-            (setf result (funcall func result))))
-        result))))
-
-(defun ampc-clean-tag (tag value)
-  (or value (unless (member tag '("Track" 'Track)) "[Not Specified]")))
+(defsubst ampc-extract (regexp)
+  (goto-char (point-min))
+  (when (search-forward-regexp regexp nil t)
+    (match-string 1)))
+
+(defsubst ampc-clean-tag (tag value)
+  (if value
+      (let ((func (cdr (assoc tag ampc-tag-transform-funcs))))
+        (if func
+            (funcall func value)
+          value))
+    (unless (equal tag "Track")
+      "[Not Specified]")))
 
 (defun ampc-insert (element data &optional cmp cmp-data)
   (goto-char (point-min))
@@ -1685,28 +1696,24 @@ modified."
                        collect (cdr (assoc p song))))
                 `((,song))))))
 
-(defun* ampc-narrow-entry (&optional (delimiter "file") &aux result)
-  (narrow-to-region
-   (move-beginning-of-line nil)
-   (or (progn (goto-char (line-end-position))
-              (when (search-forward-regexp
-                     (concat "^" (regexp-quote delimiter) ": ")
-                     nil
-                     t)
-                (move-beginning-of-line nil)
-                (setf result (point))
-                (1- (point))))
-       (point-max)))
-  result)
+(defsubst ampc-narrow-entry (delimiter-regexp)
+  (let ((result))
+    (narrow-to-region
+     (line-beginning-position)
+     (or (save-excursion
+           (goto-char (line-end-position))
+           (when (search-forward-regexp delimiter-regexp nil t)
+             (setf result (point))
+             (1- (line-beginning-position))))
+         (point-max)))
+    result))
 
 (defun ampc-fill-playlist ()
   (ampc-fill-skeleton 'playlist
     (let ((index 0))
       (ampc-iterate-source-output "file" (file)
-        (loop for (tag . tag-properties) in properties
-              collect (ampc-clean-tag tag (with-current-buffer
-                                              data-buffer
-                                            (ampc-extract tag))))
+        (loop for (tag . tag-regexp) in tags
+              collect (ampc-clean-tag tag (ampc-extract tag-regexp)))
         `(("file" . ,file)
           (index . ,(1- (incf index))))
         'ampc-int-insert-cmp
@@ -1715,9 +1722,8 @@ modified."
 (defun ampc-fill-outputs ()
   (ampc-fill-skeleton 'outputs
     (ampc-iterate-source-output "outputid" (outputid outputenabled)
-      (loop for (tag . tag-properties) in properties
-            collect (ampc-clean-tag tag (with-current-buffer data-buffer
-                                          (ampc-extract tag))))
+      (loop for (tag . tag-regexp) in tags
+            collect (ampc-clean-tag tag (ampc-extract tag-regexp)))
       `(("outputid" . ,outputid)
         ("outputenabled" . ,outputenabled)))))
 
@@ -1725,7 +1731,9 @@ modified."
   (ampc-iterate-source
       nil
       "file"
-      (Title Artist (Pos (string-to-number (ampc-extract "Pos"))))
+      (Title
+       Artist
+       (Pos (string-to-number (ampc-extract (ampc-extract-regexp "Pos")))))
     (let ((entry (cons (concat Title
                                (when Artist
                                  (concat " - " Artist)))
@@ -1752,10 +1760,10 @@ modified."
   (ampc-fill-skeleton 'current-playlist
     (ampc-iterate-source-output
         "file"
-        (file (pos (string-to-number (ampc-extract "Pos"))))
-      (loop for (tag . tag-properties) in properties
-            collect (ampc-clean-tag tag (with-current-buffer data-buffer
-                                          (ampc-extract tag))))
+        (file (pos (string-to-number (ampc-extract
+                                      (ampc-extract-regexp "Pos")))))
+      (loop for (tag . tag-regexp) in tags
+            collect (ampc-clean-tag tag (ampc-extract tag-regexp)))
       `(("file" . ,file)
         ("Pos" . ,pos))
       'ampc-int-insert-cmp
@@ -1901,16 +1909,18 @@ modified."
 
 (defun ampc-fill-internal-db-entry (tree tags song-props)
   (loop for tag in tags
-        for data = (ampc-clean-tag tag (ampc-extract tag))
+        for data = (ampc-clean-tag tag (ampc-extract (ampc-extract-regexp 
tag)))
         do (unless (cdr tree)
              (setf (cdr tree) (ampc-create-tree)))
         (setf tree (avl-tree-enter (cdr tree)
                                    (cons data nil)
                                    (lambda (_ match)
                                      match))))
-  (push (cons (cons "file" (ampc-extract "file"))
+  (push (cons (cons "file" (ampc-extract (ampc-extract-regexp "file")))
               (loop for p in song-props
-                    for data = (ampc-clean-tag (car p) (ampc-extract (car p)))
+                    for data = (ampc-clean-tag (car p)
+                                               (ampc-extract
+                                                (ampc-extract-regexp (car p))))
                     when data
                     collect (cons (car p) data)
                     end))
@@ -2779,7 +2789,8 @@ FILES should be a list of absolute file names, the files 
to tag."
                          file
                          (loop for tag in ampc-tagger-tags
                                collect
-                               (cons tag (or (ampc-extract (symbol-name tag))
+                               (cons tag (or (ampc-extract (ampc-extract-regexp
+                                                            (symbol-name tag)))
                                              ""))))))
           (run-hook-with-args 'ampc-tagger-grabbed-hook file)
           (progress-reporter-update reporter i))