branch: master
commit 900c8fa9c5e5b1521e6d2fe52f20de299e8ecd89
Author: Alexey Veretennikov <alexey.veretenni...@gmail.com>
Commit: Alexey Veretennikov <alexey.veretenni...@gmail.com>
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)
