From 597b0059f81ae8f39a063981cebdab0ca2dc540b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 26 Jan 2016 11:12:51 -0500 Subject: [PATCH] 2016-01-26 Stefan Monnier * ztree/ztree-diff-model.el (ztree-diff-node): Define with cl-defstruct. Remove `children', `short-name', and `right-short-name' args from ztree-diff-node-create, and compute them instead. (ztree-diff-model-partial-rescan, ztree-diff-model-subtree) (ztree-diff-node-update-diff-from-children) (ztree-diff-node-update-diff-from-parent) (ztree-diff-node-recreate): Use setf rather than `ztree-diff-node-set-'. Adjust call to ztree-diff-node-create. (ztree-diff-untrampify-filename): Silence byte-compiler. * ztree/ztree-diff.el (ztree-diff): Adjust call ztree-diff-node-create. (ztree-diff-delete-file, ztree-diff-copy-dir, ztree-diff-copy-file): Use setf rather than `ztree-diff-node-set-'. * ztree/ztree-dir.el (ztree-dir): Don't quote lambdas and prefer #' when quoting function symbols. * ztree/ztree-util.el (ztree-defrecord): Remove macro. * ztree/ztree-view.el (ztree-refresh-buffer): Prefer inhibit-read-only and limit its scope. * ztree/ztree.el: Declare dependency on cl-lib. Signed-off-by: Alexey Veretennikov --- ztree-diff-model.el | 106 ++++++++++++++++++++++++-------------------- ztree-diff.el | 40 +++++++---------- ztree-dir.el | 14 +++--- ztree-pkg.el | 2 - ztree-util.el | 64 +------------------------- ztree-view.el | 14 +++--- ztree.el | 4 +- 7 files changed, 93 insertions(+), 151 deletions(-) delete mode 100644 ztree-pkg.el diff --git a/ztree-diff-model.el b/ztree-diff-model.el index 203ebadfb..b4ad75fde 100644 --- a/ztree-diff-model.el +++ b/ztree-diff-model.el @@ -53,7 +53,19 @@ ;; short-name - is the file or directory name ;; children - list of nodes - files or directories if the node is a directory ;; different = {nil, 'same, 'new, 'diff, 'ignore} - 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 + (if (and left-path right-path) + (ztree-file-short-name right-path) + short-name))))) + 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." @@ -128,7 +140,11 @@ RIGHT if only on the right side." (defun ztree-diff-untrampify-filename (file) "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)))) @@ -140,6 +156,10 @@ RIGHT if only on the right side." (defun ztree-diff-model-files-equal (file1 file2) "Compare files FILE1 and FILE2 using external diff. Returns t if equal." + ;; FIXME: This "untrampification" only works if both file1 and file2 are on + ;; the same host. + ;; FIXME: We assume that default-directory is also on the same host as + ;; file(1|2). (let* ((file1-untrampified (ztree-diff-untrampify-filename (ztree-diff-modef-quotify-string file1))) (file2-untrampified (ztree-diff-untrampify-filename (ztree-diff-modef-quotify-string file2))) (diff-command (concat diff-command " -q" " " file1-untrampified " " file2-untrampified)) @@ -162,15 +182,15 @@ left and right parts existing." (if (ztree-diff-node-is-directory node) (ztree-diff-node-recreate node) ;; if a file, change a status - (ztree-diff-node-set-different - node - (if (or (ztree-diff-model-ignore-p node) ; if should be ignored - (eql (ztree-diff-node-different node) 'ignore) ; was ignored - (eql (ztree-diff-node-different ; or parent was ignored - (ztree-diff-node-parent node)) 'ignore)) - 'ignore - (ztree-diff-model-files-equal (ztree-diff-node-left-path node) - (ztree-diff-node-right-path node))))) + (setf (ztree-diff-node-different node) + (if (or (ztree-diff-model-ignore-p node) ; if should be ignored + (eql (ztree-diff-node-different node) 'ignore) ; was ignored + (eql (ztree-diff-node-different ; or parent was ignored + (ztree-diff-node-parent node)) + 'ignore)) + 'ignore + (ztree-diff-model-files-equal (ztree-diff-node-left-path node) + (ztree-diff-node-right-path node))))) ;; update all parents statuses (ztree-diff-node-update-all-parents-diff node)) @@ -186,20 +206,14 @@ Argument DIFF different status to be assigned to all created nodes." parent (when (eq side 'left) file) (when (eq side 'right) file) - (ztree-file-short-name file) - (ztree-file-short-name file) - nil diff)) (children (ztree-diff-model-subtree node file side diff))) - (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 diff) result))) result)) @@ -207,11 +221,11 @@ Argument DIFF different status to be assigned to all created nodes." (defun ztree-diff-node-update-diff-from-children (node) "Set the diff status for the NODE based on its children." (unless (eql (ztree-diff-node-different node) 'ignore) - (let ((diff (cl-reduce 'ztree-diff-model-update-diff + (let ((diff (cl-reduce #'ztree-diff-model-update-diff (ztree-diff-node-children node) :initial-value 'same :key 'ztree-diff-node-different))) - (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." @@ -248,7 +262,7 @@ setting status from the NODE, unless they have an ignore status" (not (or (eql status 'ignore) (eql (ztree-diff-node-different child) 'ignore)))) - (ztree-diff-node-set-different child status) + (setf (ztree-diff-node-different child) status) (ztree-diff-node-update-diff-from-parent child))) children))) @@ -272,7 +286,6 @@ if parent has ignored status - ignore" (and parent (or (eql (ztree-diff-node-different parent) 'ignore) (ztree-diff-model-ignore-p node))))) - (defun ztree-diff-node-recreate (node) @@ -288,7 +301,7 @@ if parent has ignored status - ignore" ;; update node status ignore status either inhereted from the ;; parent or the own (when should-ignore - (ztree-diff-node-set-different node 'ignore)) + (setf (ztree-diff-node-different node) 'ignore)) ;; first - adding all entries from left directory (dolist (file1 list1) ;; for every entry in the first directory @@ -301,27 +314,27 @@ if parent has ignored status - ignore" ;; create a child. The current node is a parent ;; new by default - will be overriden below if necessary (child - (ztree-diff-node-create node file1 file2 simple-name simple-name nil children-status))) + (ztree-diff-node-create node file1 file2 children-status))) ;; update child own ignore status (when (ztree-diff-model-should-ignore child) - (ztree-diff-node-set-different child 'ignore)) + (setf (ztree-diff-node-different child) 'ignore)) ;; if exists on a right side with the same type, ;; remove from the list of files on the right side (when file2 - (setf list2 (cl-delete file2 list2 :test 'string-equal))) + (setf list2 (cl-delete file2 list2 :test #'string-equal))) (cond ;; when exist just on a left side and is a directory, add all ((and isdir (not file2)) - (ztree-diff-node-set-children child - (ztree-diff-model-subtree child - file1 - 'left - (ztree-diff-node-different child)))) + (setf (ztree-diff-node-children child) + (ztree-diff-model-subtree child + file1 + 'left + (ztree-diff-node-different child)))) ;; if 1) exists on both sides and 2) it is a file ;; and 3) not ignored file ((and file2 (not isdir) (not (eql (ztree-diff-node-different child) 'ignore))) - (ztree-diff-node-set-different child - (ztree-diff-model-files-equal file1 file2))) + (setf (ztree-diff-node-different child) + (ztree-diff-model-files-equal file1 file2))) ;; if exists on both sides and it is a directory, traverse further ((and file2 isdir) (ztree-diff-node-recreate child))) @@ -332,33 +345,32 @@ if parent has ignored status - ignore" (dolist (file2 list2) ;; for every entry in the second directory ;; we are creating the node - (let* ((simple-name (ztree-file-short-name file2)) - (isdir (file-directory-p file2)) + (let* ((isdir (file-directory-p file2)) ;; create the child to be added to the results list (child - (ztree-diff-node-create node nil file2 simple-name simple-name nil children-status))) + (ztree-diff-node-create node nil file2 children-status))) ;; update ignore status of the child (when (ztree-diff-model-should-ignore child) - (ztree-diff-node-set-different child 'ignore)) + (setf (ztree-diff-node-different child) 'ignore)) ;; if it is a directory, set the whole subtree to children (when isdir - (ztree-diff-node-set-children child - (ztree-diff-model-subtree child - file2 - 'right - (ztree-diff-node-different child)))) + (setf (ztree-diff-node-children child) + (ztree-diff-model-subtree child + file2 + 'right + (ztree-diff-node-different child)))) ;; push the created node to the result list (push child children))) ;; finally set different status based on all children ;; depending if the node should participate in overall result (unless should-ignore - (ztree-diff-node-set-different node - (cl-reduce 'ztree-diff-model-update-diff - children - :initial-value 'same - :key 'ztree-diff-node-different))) + (setf (ztree-diff-node-different node) + (cl-reduce #'ztree-diff-model-update-diff + children + :initial-value 'same + :key 'ztree-diff-node-different))) ;; and set children - (ztree-diff-node-set-children node children))) + (setf (ztree-diff-node-children node) children))) (defun ztree-diff-model-update-node (node) diff --git a/ztree-diff.el b/ztree-diff.el index 3793cbb69..ed3d5f936 100644 --- a/ztree-diff.el +++ b/ztree-diff.el @@ -234,6 +234,8 @@ 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)))))) @@ -270,11 +272,11 @@ COPY-TO-RIGHT specifies which side of the NODE to update." ;; assuming all went ok when left and right nodes are the same ;; set both as not different if they were not ignored (unless (eq (ztree-diff-node-different node) 'ignore) - (ztree-diff-node-set-different node 'same)) + (setf (ztree-diff-node-different node) 'same)) ;; 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)))))) @@ -305,10 +307,8 @@ COPY-TO-RIGHT specifies which side of the NODE to update." ;; if everything is ok, update statuses (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-update-wait-message (concat "Updating " (ztree-diff-node-short-name node) " ...")) ;; TODO: do not rescan the node. Use some logic like in delete @@ -436,21 +436,19 @@ COPY-TO-RIGHT specifies which side of the NODE to update." delete-from-left) (and (eql node-side 'right) (not delete-from-left))) - (ztree-diff-node-set-children parent - (ztree-filter - (lambda (x) (not (ztree-diff-node-equal x node))) - children)) + (setf (ztree-diff-node-children parent) + (ztree-filter + (lambda (x) (not (ztree-diff-node-equal x node))) + children)) ;; otherwise update only one side - (let ((update-fun - (if delete-from-left - #'ztree-diff-node-set-left-path - #'ztree-diff-node-set-right-path))) - (mapc (lambda (x) (funcall update-fun x nil)) - (cons node (ztree-diff-node-children node)))) + (mapc (if delete-from-left + (lambda (x) (setf (ztree-diff-node-left-path x) nil)) + (lambda (x) (setf (ztree-diff-node-right-path x) nil))) + (cons node (ztree-diff-node-children node))) ;; and update diff status ;; if was ignored keep the old status (unless (eql (ztree-diff-node-different node) 'ignore) - (ztree-diff-node-set-different node 'new)) + (setf (ztree-diff-node-different node) 'new)) ;; finally update all children statuses (ztree-diff-node-update-diff-from-parent node))) (ztree-diff-node-update-all-parents-diff node) @@ -523,11 +521,7 @@ Argument DIR2 right directory." (unless (file-exists-p dir2) (error "Path %s does not exist" 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)) (buf-name (concat "*" (ztree-diff-node-short-name model) " <--> " diff --git a/ztree-dir.el b/ztree-dir.el index 89ce47bb8..d3d3b25f0 100644 --- a/ztree-dir.el +++ b/ztree-dir.el @@ -155,14 +155,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 (ztreedir-mode)))) diff --git a/ztree-pkg.el b/ztree-pkg.el deleted file mode 100644 index 2ee40ca10..000000000 --- a/ztree-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;; Generated package description from ztree.el -(define-package "ztree" "1.0.1" "Text mode directory tree" 'nil :url "https://github.com/fourier/ztree" :keywords '("files" "tools")) diff --git a/ztree-util.el b/ztree-util.el index c847c3be1..ec4945781 100644 --- a/ztree-util.el +++ b/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-2016 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/ztree-view.el b/ztree-view.el index 9e8920d98..3244ccc09 100644 --- a/ztree-view.el +++ b/ztree-view.el @@ -315,11 +315,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). @@ -607,12 +609,12 @@ Optional argument LINE scroll to the line given." ;; used in 2-side tree mode (when ztree-node-side-fun (setq ztree-line-tree-properties (make-hash-table))) - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (erase-buffer) (funcall ztree-tree-header-fun) (setq ztree-start-line (line-number-at-pos (point))) - (ztree-insert-node-contents ztree-start-node) - (scroll-to-line (if line line ztree-start-line))))) + (ztree-insert-node-contents ztree-start-node)) + (scroll-to-line (if line line ztree-start-line)))) (defun ztree-view ( diff --git a/ztree.el b/ztree.el index 05d0811df..08ac2892a 100644 --- a/ztree.el +++ b/ztree.el @@ -3,11 +3,9 @@ ;; Copyright (C) 2013-2016 Free Software Foundation, Inc. ;; ;; Author: Alexey Veretennikov -;; ;; Created: 2013-11-11 -;; ;; 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