[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 597b005 34/36: 2016-01-26 Stefan Monnier <address@hidden>
|
From: |
Alexey Veretennikov |
|
Subject: |
[elpa] master 597b005 34/36: 2016-01-26 Stefan Monnier <address@hidden> |
|
Date: |
Wed, 27 Jan 2016 23:51:00 +0000 |
branch: master
commit 597b0059f81ae8f39a063981cebdab0ca2dc540b
Author: Stefan Monnier <address@hidden>
Commit: Alexey Veretennikov <address@hidden>
2016-01-26 Stefan Monnier <address@hidden>
* 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 <address@hidden>
---
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(-)
diff --git a/ztree-diff-model.el b/ztree-diff-model.el
index 203ebad..b4ad75f 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 3793cbb..ed3d5f9 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 89ce47b..d3d3b25 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 2ee40ca..0000000
--- 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 c847c3b..ec49457 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 9e8920d..3244ccc 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 05d0811..08ac289 100644
--- a/ztree.el
+++ b/ztree.el
@@ -3,11 +3,9 @@
;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
;;
;; Author: Alexey Veretennikov <address@hidden>
-;;
;; 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
- [elpa] master be4e000 24/36: Fix typo in value of Created header keyword, (continued)
- [elpa] master be4e000 24/36: Fix typo in value of Created header keyword, Alexey Veretennikov, 2016/01/27
- [elpa] master b5b2d02 32/36: removed test files, Alexey Veretennikov, 2016/01/27
- [elpa] master 74899aa 30/36: Merge branch 'master' of github.com:fourier/ztree, Alexey Veretennikov, 2016/01/27
- [elpa] master 6d7ce1f 28/36: Fixed Delete method, Alexey Veretennikov, 2016/01/27
- [elpa] master 3d70aef 25/36: Merge pull request #30 from tarsius/fix-typo, Alexey Veretennikov, 2016/01/27
- [elpa] master 159ddbd 26/36: Fixed partial update, Alexey Veretennikov, 2016/01/27
- [elpa] master a7c5489 35/36: Upgraded version number, Alexey Veretennikov, 2016/01/27
- [elpa] master 7b5dfce 23/36: Use defvar-local instead of combo defvar && make-variable-buffer-local, Alexey Veretennikov, 2016/01/27
- [elpa] master e143f66 27/36: Fixed copy of the files; added 'R' for full rescan, Alexey Veretennikov, 2016/01/27
- [elpa] master dbf9539 31/36: Fixed issue #27, Alexey Veretennikov, 2016/01/27
- [elpa] master 597b005 34/36: 2016-01-26 Stefan Monnier <address@hidden>,
Alexey Veretennikov <=
- [elpa] master a136ff8 36/36: Merged from upstream with StefanM's changes, Alexey Veretennikov, 2016/01/27