From 37907778d2266ea80e079d015c26281195f6b30b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 24 Jan 2016 22:46:51 -0500 Subject: [PATCH] * 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 e8fa4d9a2..f0b4e4aa3 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 ff9b3235f..ea66a6e99 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 3dd87b7f7..08f404117 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 85df4446d..40fe12ef0 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 e7f20fde0..4a5a766ea 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 7dc67f4e9..b591756c8 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 +;; Author: Alexey Veretennikov ;; 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 -- 2.39.2