[elpa] master 900c8fa 38/92: Refactored using defrecord macro

[Alexey Veretennikov]

branch: master
commit 900c8fa9c5e5b1521e6d2fe52f20de299e8ecd89
Author: Alexey Veretennikov <address@hidden>
Commit: Alexey Veretennikov <address@hidden>

    Refactored using defrecord macro
---
 ztree-diff-model.el |   89 ++++++++++++++++----------------------------------
 ztree-diff.el       |   24 +++++++-------
 ztree-util.el       |   57 ++++++++++++++++++++++++++++++++
 3 files changed, 98 insertions(+), 72 deletions(-)

diff --git a/ztree-diff-model.el b/ztree-diff-model.el
index 67b11ba..75cd8a8 100644
--- a/ztree-diff-model.el
+++ b/ztree-diff-model.el
@@ -12,55 +12,28 @@
     (setq ztree-diff-model-wait-message (concat ztree-diff-model-wait-message 
"."))
     (message ztree-diff-model-wait-message)))
 
-;; different = {nil, 'new, 'diff}
-(defun ztree-diff-model-create-node (left-full-path right-full-path short-name 
children different)
-  (let (node)
-    (setq node (plist-put node 'left left-full-path))
-    (setq node (plist-put node 'right right-full-path))
-    (setq node (plist-put node 'short short-name))
-    (setq node (plist-put node 'children children))
-    (setq node (plist-put node 'different different))))
 
-;; Getters
 
-(defun ztree-diff-model-get-left-path (node)
-  (plist-get node 'left))
+;; Create a record ztree-diff-node with defined fielsd and getters/setters
+;; here left-path is the full path on the left side of the diff window,
+;; right-path is the full path of the right side,
+;; short-name - is the file or directory name
+;; children - list of nodes - files or directories if the node is a directory
+;; different = {nil, 'new, 'diff} - means comparison status
+(defrecord ztree-diff-node (left-path right-path short-name children 
different))
 
-(defun ztree-diff-model-get-right-path (node)
-  (plist-get node 'right))
 
-(defun ztree-diff-model-short-name (node)
-    (plist-get node 'short))
-
-(defun ztree-diff-model-children (node)
-    (plist-get node 'children))
-
-(defun ztree-diff-model-differet (node)
-    (plist-get node 'different))
-
-;; Setters
-
-(defun ztree-diff-model-set-parent (node)
-  (plist-put node 'parent parent))
-
-(defun ztree-diff-model-set-children (node children)
-  (plist-put node 'children children))
-
-(defun ztree-diff-model-set-different (node different)
-  (plist-put node 'different different))
-
-
-(defun ztree-diff-model-is-directory (node)
-  (let ((left  (plist-get node 'left))
-        (right (plist-get node 'right)))
+(defun ztree-diff-node-is-directory (node)
+  (let ((left (ztree-diff-node-left-path node))
+        (right (ztree-diff-node-right-path node)))
     (if left
         (file-directory-p left)
       (file-directory-p right))))
 
-(defun ztree-diff-model-side (node)
-  (let ((left  (plist-get node 'left))
-        (right (plist-get node 'right)))
-  (if (and left right) 'both
+(defun ztree-diff-node-side (node)
+ (let ((left (ztree-diff-node-left-path node))
+        (right (ztree-diff-node-right-path node)))
+   (if (and left right) 'both
     (if left 'left 'right))))
 
 (defun ztree-diff-model-files-equal (file1 file2)
@@ -82,14 +55,14 @@
         (result nil))
     (dolist (file files)
       (if (file-directory-p file)
-          (push (ztree-diff-model-create-node
+          (push (ztree-diff-node-create
                  (when (eq side 'left) file)
                  (when (eq side 'right) file)
                  (file-short-name file)
                  (ztree-diff-model-subtree file side)
                  'new)
                 result)
-        (push (ztree-diff-model-create-node
+        (push (ztree-diff-node-create
                (when (eq side 'left) file)
                (when (eq side 'right) file)
                (file-short-name file)
@@ -107,7 +80,7 @@
         old)
     old))
 
-(defun ztree-diff-model-traverse (parent path1 path2)
+(defun ztree-diff-node-traverse (parent path1 path2)
   "Function traversing 2 paths returning the list where the
 first element is the difference status (nil, 'diff, 'new') and
 the rest is the combined list of nodes"
@@ -145,7 +118,7 @@ the rest is the combined list of nodes"
               (setq different (if (ztree-diff-model-files-equal file1 file2) 
nil 'diff))
             ;; 3.2 if it is the directory
             ;; 3.2.1 get the result of the directories comparison together 
with status
-            (let ((traverse (ztree-diff-model-traverse parent file1 file2)))
+            (let ((traverse (ztree-diff-node-traverse parent file1 file2)))
               ;; 3.2.2 update the difference status for whole comparison from
               ;;       difference result from the 2 subdirectories comparison
               (setq different (car traverse))
@@ -153,7 +126,7 @@ the rest is the combined list of nodes"
               (setq children (cdr traverse)))))
         ;; 2.3 update difference status for the whole comparison
         (setq different-dir (ztree-diff-model-update-diff different-dir 
different))
-        (let ((node (ztree-diff-model-create-node file1 file2 simple-name 
children different)))
+        (let ((node (ztree-diff-node-create file1 file2 simple-name children 
different)))
           ;; push the created node to the result list
           (push node result))))
     ;; second - adding entries from the right directory which are not present
@@ -178,7 +151,7 @@ the rest is the combined list of nodes"
           ;; update the different status for the whole comparison
           (setq different-dir (ztree-diff-model-update-diff different-dir 
'new))
           ;; push the created node to the result list
-          (push (ztree-diff-model-create-node file1 file2 simple-name children 
'new)
+          (push (ztree-diff-node-create file1 file2 simple-name children 'new)
                 result))))
     (cons different-dir result)))
 
@@ -189,22 +162,18 @@ the rest is the combined list of nodes"
     (error "Path %s is not a directory" dir2))
   (setq ztree-diff-model-wait-message (concat "Comparing " dir1 " and " dir2 " 
..."))
   (let* ((model 
-          (ztree-diff-model-create-node dir1 dir2
-                                        (concat (file-short-name dir1)
-                                                " <--> "
-                                                (file-short-name dir2))
-                                        nil
-                                        nil))
-         (traverse (ztree-diff-model-traverse model dir1 dir2)))
-    (ztree-diff-model-set-children model (cdr traverse))
+          (ztree-diff-node-create dir1 dir2
+                                   (concat (file-short-name dir1)
+                                           " <--> "
+                                           (file-short-name dir2))
+                                   nil
+                                   nil))
+         (traverse (ztree-diff-node-traverse model dir1 dir2)))
+    (ztree-diff-node-set-children model (cdr traverse))
     (print model)
-    (ztree-diff-model-set-different model (car traverse))
+    (ztree-diff-node-set-different model (car traverse))
     (message "Done.")
     model))
 
   
 (provide 'ztree-diff-model)
-
-                              
-        
-
diff --git a/ztree-diff.el b/ztree-diff.el
index 0c44ad9..b839714 100644
--- a/ztree-diff.el
+++ b/ztree-diff.el
@@ -68,8 +68,8 @@ including . and ..")
 (defvar ztreep-diff-model-normal-face 'ztreep-diff-model-normal-face)
 
 
-(defun ztree-diff-model-face (node)
-  (let ((diff (ztree-diff-model-differet node)))
+(defun ztree-diff-node-face (node)
+  (let ((diff (ztree-diff-node-different node)))
     (cond ((eq diff 'diff) ztreep-diff-model-diff-face)
           ((eq diff 'new)  ztreep-diff-model-add-face)
           (t ztreep-diff-model-normal-face))))  
@@ -91,9 +91,9 @@ including . and ..")
   (insert-with-face "==============" ztreep-diff-header-face)
   (newline))
 
-(defun ztree-diff-model-action (node)
-  (let ((left (ztree-diff-model-get-left-path node))
-        (right (ztree-diff-model-get-right-path node)))
+(defun ztree-diff-node-action (node)
+  (let ((left (ztree-diff-node-left-path node))
+        (right (ztree-diff-node-right-path node)))
     (when (and left right)
       (ediff left right))))
 
@@ -101,18 +101,18 @@ including . and ..")
   "Creates an interactive buffer with the directory tree of the path given"
   (interactive "DLeft directory \nDRight directory ")
   (let* ((difference (ztree-diff-model-create dir1 dir2))
-         (buf-name (concat "*" (ztree-diff-model-short-name difference) "*")))
+         (buf-name (concat "*" (ztree-diff-node-short-name difference) "*")))
     (ztree-view buf-name
                 difference
                 (list ztree-diff-hidden-files-regexp)
                 'ztree-diff-insert-buffer-header
-                'ztree-diff-model-short-name
-                'ztree-diff-model-is-directory
+                'ztree-diff-node-short-name
+                'ztree-diff-node-is-directory
                 'equal
-                'ztree-diff-model-children
-                'ztree-diff-model-face
-                'ztree-diff-model-action
-                'ztree-diff-model-side)))
+                'ztree-diff-node-children
+                'ztree-diff-node-face
+                'ztree-diff-node-action
+                'ztree-diff-node-side)))
 
 
 (provide 'ztree-diff)
diff --git a/ztree-util.el b/ztree-util.el
index 1e90a80..6368c13 100644
--- a/ztree-util.el
+++ b/ztree-util.el
@@ -63,4 +63,61 @@ Used since car-safe returns nil for atoms"
     (put-text-property start (point) 'face face)))
 
 
+(defmacro defrecord (record-name record-fields)
+  "Create a record (structure) and getters/setters.
+
+Record is the following set of functions:
+ - Record constructor with name \"record-name\"-create and list of
+arguments which will be assigned to record-fields
+ - Record getters with names \"record-name\"-\"field\" accepting one
+argument - the record; \"field\" is from \"record-fields\" symbols
+ - Record setters with names \"record-name\"-set-\"field\" accepting two
+arguments - the record and the field value
+
+Example:
+`(defrecord person (name age))`
+
+will be expanded to the following functions:
+
+`(defun person-create (name age) (...)`
+`(defun person-name (record) (...)`
+`(defun person-age (record) (...)`
+`(defun person-set-name (record value) (...)`
+`(defun person-set-age (record value) (...)`"
+  (let ((ctor-name (intern (concat (symbol-name record-name) "-create")))
+        (rec-var (make-symbol "record")))
+    `(progn
+       ;; constructor with the name "record-name-create"
+       ;; with arguments list "record-fields" expanded
+       (defun ,ctor-name (,@record-fields)
+         (let ((,rec-var))
+           ,@(mapcar #'(lambda (x) 
+                      (list 'setq rec-var (list 'plist-put rec-var (list 
'quote x) x)))
+                    record-fields)))
+       ;; getters with names "record-name-field" where the "field"
+       ;; is from record-fields
+       ,@(mapcar #'(lambda (x)
+                    (let ((getter-name (intern (concat (symbol-name 
record-name)
+                                                       "-"
+                                                       (symbol-name x)))))
+                      `(progn
+                         (defun ,getter-name (,rec-var)
+                           (plist-get ,rec-var ',x)
+                           ))))
+                record-fields)
+       ;; setters wit names "record-name-set-field where the "field"
+       ;; is from record-fields
+       ;; arguments for setters: (record value)
+       ,@(mapcar #'(lambda (x)
+                     (let ((setter-name (intern (concat (symbol-name 
record-name)
+                                                        "-set-"
+                                                        (symbol-name x)))))
+                       `(progn
+                          (defun ,setter-name (,rec-var value)
+                            (plist-put ,rec-var ',x value)
+                            ))))
+                 record-fields))))
+
+
+
 (provide 'ztree-util)