;;; Code:
(require 'ztree-util)
+(eval-when-compile (require 'cl-lib))
(defvar ztree-diff-model-wait-message nil
"Message showing while constructing the diff tree.")
;; 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."
"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))))
(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.
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))
(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."
(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
;; 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)
(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
(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)
(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))
(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.")))
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)
(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)))))))
(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)))))))
(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))))))))))
(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)
-;;; 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.
;;
(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
(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).
;;; 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 <alexey.veretennikov@gmail.com>
;; 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