emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] master 3790777: * ztree/ztree-diff-model.el (ztree-diff-node): Us


From: Stefan Monnier
Subject: [elpa] master 3790777: * ztree/ztree-diff-model.el (ztree-diff-node): Use cl-defstruct
Date: Mon, 25 Jan 2016 03:46:56 +0000

branch: master
commit 37907778d2266ea80e079d015c26281195f6b30b
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    * ztree/ztree-diff-model.el (ztree-diff-node): Use cl-defstruct
    
    (ztree-diff-model-partial-rescan, ztree-diff-model-subtree)
    (ztree-diff-node-update-diff-from-children, )
    (ztree-diff-node-traverse):
    * ztree/ztree-diff.el (ztree-diff-copy-file, ztree-diff-copy-dir)
    (ztree-diff-delete-file): Adjust accordingly.
    * ztree/ztree-dir.el (ztree-dir): Don't quote lambda.
    * ztree/ztree.el: Fix up maintainer address.  Add cl-lib dependency.
    * ztree/ztree-util.el (ztree-defrecord): Delete.
---
 packages/ztree/ztree-diff-model.el |   72 ++++++++++++++++++-----------------
 packages/ztree/ztree-diff.el       |   22 ++++++-----
 packages/ztree/ztree-dir.el        |   14 +++---
 packages/ztree/ztree-util.el       |   64 +-------------------------------
 packages/ztree/ztree-view.el       |    8 ++-
 packages/ztree/ztree.el            |    5 +-
 6 files changed, 65 insertions(+), 120 deletions(-)

diff --git a/packages/ztree/ztree-diff-model.el 
b/packages/ztree/ztree-diff-model.el
index e8fa4d9..f0b4e4a 100644
--- a/packages/ztree/ztree-diff-model.el
+++ b/packages/ztree/ztree-diff-model.el
@@ -31,6 +31,7 @@
 
 ;;; Code:
 (require 'ztree-util)
+(eval-when-compile (require 'cl-lib))
 
 (defvar ztree-diff-model-wait-message nil
   "Message showing while constructing the diff tree.")
@@ -54,7 +55,16 @@
 ;; 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
-(ztree-defrecord ztree-diff-node (parent left-path right-path short-name 
right-short-name children different))
+(cl-defstruct (ztree-diff-node
+               (:constructor)
+               (:constructor ztree-diff-node-create
+                (parent left-path right-path
+                        different
+                        &aux (short-name (ztree-file-short-name
+                                          (or left-path right-path)))
+                        (right-short-name (ztree-file-short-name
+                                           (or right-path left-path))))))
+  parent left-path right-path short-name right-short-name children different)
 
 (defun ztree-diff-model-ignore-p (node)
   "Determine if the NODE should be excluded from comparison results."
@@ -126,6 +136,9 @@ RIGHT if only on the right side."
   "Return FILE as the local file name."
   ;; FIXME: We shouldn't use internal Tramp functions.
   (require 'tramp)
+  (declare-function tramp-tramp-file-p "tramp" (name))
+  (declare-function tramp-file-name-localname "tramp" (vec))
+  (declare-function tramp-dissect-file-name "tramp" (name &optional nodefault))
   (if (not (tramp-tramp-file-p file))
       file
     (tramp-file-name-localname (tramp-dissect-file-name file))))
@@ -167,18 +180,17 @@ Filters out . and .."
                (file-exists-p left)
                (file-exists-p right))
       (if isdir
-          (let ((traverse (ztree-diff-node-traverse
-                           node
-                           left
-                           right)))
-            (ztree-diff-node-set-different node (car traverse))
-            (ztree-diff-node-set-children node (cdr traverse)))
+        (let ((traverse (ztree-diff-node-traverse
+                         node
+                         left
+                         right)))
+          (setf (ztree-diff-node-different node) (car traverse))
+          (setf (ztree-diff-node-children node) (cdr traverse)))
         ;; node is a file
-        (ztree-diff-node-set-different
-         node
-         (if (ztree-diff-model-files-equal left right)
-             nil
-           'diff))))))
+        (setf (ztree-diff-node-different node)
+              (if (ztree-diff-model-files-equal left right)
+                  nil
+                'diff))))))
 
 (defun ztree-diff-model-subtree (parent path side)
   "Create a subtree with given PARENT for the given PATH.
@@ -191,20 +203,14 @@ Argument SIDE either 'left or 'right side."
                         parent
                         (when (eq side 'left) file)
                         (when (eq side 'right) file)
-                        (ztree-file-short-name file)
-                        (ztree-file-short-name file)
-                        nil
                         'new))
                  (children (ztree-diff-model-subtree node file side)))
-            (ztree-diff-node-set-children node children)
+            (setf (ztree-diff-node-children node) children)
             (push node result))
         (push (ztree-diff-node-create
                parent
                (when (eq side 'left) file)
                (when (eq side 'right) file)
-               (ztree-file-short-name file)
-               (ztree-file-short-name file)
-               nil
                'new)
               result)))
     result))
@@ -219,7 +225,7 @@ Argument SIDE either 'left or 'right side."
               (ztree-diff-model-update-diff
                diff
                (ztree-diff-node-different child)))))
-    (ztree-diff-node-set-different node diff)))
+    (setf (ztree-diff-node-different node) diff)))
 
 (defun ztree-diff-node-update-all-parents-diff (node)
   "Recursively update all parents diff status for the NODE."
@@ -257,7 +263,7 @@ the rest is the combined list of nodes."
              (different nil)
              ;; create the current node to be set as parent to
              ;; subdirectories
-             (node (ztree-diff-node-create parent file1 nil simple-name 
simple-name nil nil))
+             (node (ztree-diff-node-create parent file1 nil nil))
              ;; 1. find if the file is in the second directory and the type
              ;;    is the same - i.e. both are directories or both are files
              (file2 (ztree-find list2
@@ -286,9 +292,9 @@ the rest is the combined list of nodes."
               ;; 3.2.3 set the children list from the 2 subdirectories 
comparison
               (setq children (cdr traverse)))))
         ;; update calculated parameters of the node
-        (ztree-diff-node-set-right-path node file2)
-        (ztree-diff-node-set-children node children)
-        (ztree-diff-node-set-different node different)
+        (setf (ztree-diff-node-right-path node) file2)
+        (setf (ztree-diff-node-children node) children)
+        (setf (ztree-diff-node-different node) different)
         ;; 2.3 update difference status for the whole comparison
         ;; depending if the node should participate in overall result
         (unless (ztree-diff-model-ignore-p node)
@@ -304,7 +310,7 @@ the rest is the combined list of nodes."
              (isdir (file-directory-p file2))
              (children nil)
              ;; create the node to be added to the results list
-             (node (ztree-diff-node-create parent nil file2 simple-name 
simple-name nil 'new))
+             (node (ztree-diff-node-create parent nil file2 'new))
              ;; 1. find if the file is in the first directory and the type
              ;;    is the same - i.e. both are directories or both are files
              (file1 (ztree-find list1
@@ -317,7 +323,7 @@ the rest is the combined list of nodes."
           (when (file-directory-p file2)
             (setq children (ztree-diff-model-subtree node file2 'right)))
           ;; set calculated children to the node
-          (ztree-diff-node-set-children node children)
+          (setf (ztree-diff-node-children node) children)
           ;; update the different status for the whole comparison
           ;; depending if the node should participate in overall result
           (unless (ztree-diff-model-ignore-p node)
@@ -339,14 +345,10 @@ from comparison."
   (setf ztree-diff-model-ignore-fun ignore-p)
   (setq ztree-diff-model-wait-message (concat "Comparing " dir1 " and " dir2 " 
..."))
   (let* ((model
-          (ztree-diff-node-create nil dir1 dir2
-                                  (ztree-file-short-name dir1)
-                                  (ztree-file-short-name dir2)
-                                  nil
-                                  nil))
+          (ztree-diff-node-create nil dir1 dir2 nil))
          (traverse (ztree-diff-node-traverse model dir1 dir2)))
-    (ztree-diff-node-set-children model (cdr traverse))
-    (ztree-diff-node-set-different model (car traverse))
+    (setf (ztree-diff-node-children model) (cdr traverse))
+    (setf (ztree-diff-node-different model) (car traverse))
     (message "Done.")
     model))
 
@@ -357,8 +359,8 @@ from comparison."
   (let ((traverse (ztree-diff-node-traverse node
                                             (ztree-diff-node-left-path node)
                                             (ztree-diff-node-right-path 
node))))
-    (ztree-diff-node-set-children node (cdr traverse))
-    (ztree-diff-node-set-different node (car traverse))
+    (setf (ztree-diff-node-children node) (cdr traverse))
+    (setf (ztree-diff-node-different node) (car traverse))
     (message "Done.")))
 
 
diff --git a/packages/ztree/ztree-diff.el b/packages/ztree/ztree-diff.el
index ff9b323..ea66a6e 100644
--- a/packages/ztree/ztree-diff.el
+++ b/packages/ztree/ztree-diff.el
@@ -217,9 +217,11 @@ Argument NODE node containing paths to files to call a 
diff on."
 2 if left or right present - view left or rigth"
   (let ((left (ztree-diff-node-left-path node))
         (right (ztree-diff-node-right-path node))
+        ;; FIXME: The GNU convention is to only use "path" for lists of
+        ;; directories as in load-path.
         (open-f #'(lambda (path) (if hard (find-file path)
-                                  (let ((split-width-threshold nil))
-                                    (view-file-other-window path))))))
+                              (let ((split-width-threshold nil))
+                                (view-file-other-window path))))))
     (cond ((and left right)
            (if (not (ztree-diff-node-different node))
                (funcall open-f left)
@@ -252,11 +254,11 @@ COPY-TO-RIGHT specifies which side of the NODE to update."
         (progn              ; otherwise:
           ;; assuming all went ok when left and right nodes are the same
           ;; set both as not different
-          (ztree-diff-node-set-different node nil)
+          (setf (ztree-diff-node-different node) nil)
           ;; update left/right paths
           (if copy-to-right
-              (ztree-diff-node-set-right-path node target-path)
-            (ztree-diff-node-set-left-path node target-path))
+              (setf (ztree-diff-node-right-path node) target-path)
+            (setf (ztree-diff-node-left-path node) target-path))
           (ztree-diff-node-update-all-parents-diff node)
           (ztree-refresh-buffer (line-number-at-pos)))))))
 
@@ -283,10 +285,10 @@ COPY-TO-RIGHT specifies which side of the NODE to update."
         (progn
           (message target-full-path)
           (if copy-to-right
-              (ztree-diff-node-set-right-path node
-                                              target-full-path)
-            (ztree-diff-node-set-left-path node
-                                           target-full-path))
+              (setf (ztree-diff-node-right-path node)
+                    target-full-path)
+            (setf (ztree-diff-node-left-path node)
+                  target-full-path))
           (ztree-diff-model-update-node node)
           (ztree-diff-node-update-all-parents-diff node)
           (ztree-refresh-buffer (line-number-at-pos)))))))
@@ -411,7 +413,7 @@ COPY-TO-RIGHT specifies which side of the NODE to update."
                   (setq children (ztree-filter
                                   #'(lambda (x) (not (ztree-diff-node-equal x 
node)))
                                   children))
-                  (ztree-diff-node-set-children parent children))
+                  (setf (ztree-diff-node-children parent) children))
                 (ztree-diff-node-update-all-parents-diff node)
                 ;;(ztree-diff-model-partial-rescan node)
                 (ztree-refresh-buffer (line-number-at-pos))))))))))
diff --git a/packages/ztree/ztree-dir.el b/packages/ztree/ztree-dir.el
index 3dd87b7..08f4041 100644
--- a/packages/ztree/ztree-dir.el
+++ b/packages/ztree/ztree-dir.el
@@ -115,14 +115,14 @@ Otherwise, the ztree window is used to find the file."
     (let ((buf-name (concat "*Directory " path " tree*")))
       (ztree-view buf-name
                   (expand-file-name (substitute-in-file-name path))
-                  'ztree-file-not-hidden
-                  'ztree-insert-buffer-header
-                  'ztree-file-short-name
-                  'file-directory-p
-                  'string-equal
-                  '(lambda (x) (directory-files x 'full))
+                  #'ztree-file-not-hidden
+                  #'ztree-insert-buffer-header
+                  #'ztree-file-short-name
+                  #'file-directory-p
+                  #'string-equal
+                  (lambda (x) (directory-files x 'full))
                   nil                   ; face
-                  'ztree-find-file)))) ; action
+                  #'ztree-find-file)))) ; action
 
 
 (provide 'ztree-dir)
diff --git a/packages/ztree/ztree-util.el b/packages/ztree/ztree-util.el
index 85df444..40fe12e 100644
--- a/packages/ztree/ztree-util.el
+++ b/packages/ztree/ztree-util.el
@@ -1,4 +1,4 @@
-;;; ztree-util.el --- Auxulary utilities for the ztree package -*- 
lexical-binding: t; -*-
+;;; ztree-util.el --- Auxiliary utilities for the ztree package -*- 
lexical-binding: t; -*-
 
 ;; Copyright (C) 2013-2015  Free Software Foundation, Inc.
 ;;
@@ -65,68 +65,6 @@ Used since `car-safe' returns nil for atoms"
     (insert text)
     (put-text-property start (point) 'face face)))
 
-
-(defmacro ztree-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:
-\(ztree-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) (...)
-
-To test expansion one can use GNU Emacs's pp library:
-\(require 'pp)
-\(pp-macroexpand-expression
- '(ztree-defrecord person (name age)))"
-  (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)
-                            (setq ,rec-var (plist-put ,rec-var ',x value))
-                            ))))
-                 record-fields))))
-
-
 (provide 'ztree-util)
 
 ;;; ztree-util.el ends here
diff --git a/packages/ztree/ztree-view.el b/packages/ztree/ztree-view.el
index e7f20fd..4a5a766 100644
--- a/packages/ztree/ztree-view.el
+++ b/packages/ztree/ztree-view.el
@@ -326,11 +326,13 @@ Argument NODE node which contents will be returned."
                             (funcall ztree-node-short-name-fun y)))))
     (cons (sort (ztree-filter
                  #'(lambda (f) (funcall ztree-node-is-expandable-fun f))
-                 nodes) comp)
+                 nodes)
+                comp)
           (sort (ztree-filter
                  #'(lambda (f) (not (funcall ztree-node-is-expandable-fun f)))
-                 nodes) comp))))
-
+                 nodes)
+                comp))))
+                
 
 (defun ztree-draw-char (c x y &optional face)
   "Draw char C at the position (1-based) (X Y).
diff --git a/packages/ztree/ztree.el b/packages/ztree/ztree.el
index 7dc67f4..b591756 100644
--- a/packages/ztree/ztree.el
+++ b/packages/ztree/ztree.el
@@ -1,10 +1,11 @@
 ;;; ztree.el --- Text mode directory tree -*- lexical-binding: t; -*-
 
-;; Copyright (C) 2013-2015  Free Software Foundation, Inc.
+;; Copyright (C) 2013-2016  Free Software Foundation, Inc.
 ;;
-;; Author: Alexey Veretennikov <alexey dot veretennikov at gmail dot com>
+;; Author: Alexey Veretennikov <address@hidden>
 ;; Created: 2013-11-1l
 ;; Version: 1.0.2
+;; Package-Requires: ((cl-lib "0"))
 ;; Keywords: files tools
 ;; URL: https://github.com/fourier/ztree
 ;; Compatibility: GNU Emacs 24.x



reply via email to

[Prev in Thread] Current Thread [Next in Thread]