From: Alexey Veretennikov Date: Sat, 13 Jun 2015 20:36:24 +0000 (+0200) Subject: Merge remote-tracking branch 'ztree/master' X-Git-Url: https://code.delx.au/gnu-emacs-elpa/commitdiff_plain/7df8d42c144aa31a8337c62127c85bd86be563b1?hp=0ce6cfdfbe59a8b7955e3a2c9156e1bbdb2516fc Merge remote-tracking branch 'ztree/master' 1) All functions now starts with ztree- prefix 2) All files now have lexical-binding enabled --- diff --git a/packages/ztree/ztree-diff-model.el b/packages/ztree/ztree-diff-model.el index 54a961522..b68631e05 100644 --- a/packages/ztree/ztree-diff-model.el +++ b/packages/ztree/ztree-diff-model.el @@ -1,4 +1,4 @@ -;;; ztree-diff-model.el --- diff model for directory trees +;;; ztree-diff-model.el --- diff model for directory trees -*- lexical-binding: t; -*- ;; Copyright (C) 2013-2015 Free Software Foundation, Inc. ;; @@ -45,7 +45,7 @@ -;; Create a record ztree-diff-node with defined fielsd and getters/setters +;; Create a record ztree-diff-node with defined fields and getters/setters ;; here: ;; parent - parent node ;; left-path is the full path on the left side of the diff window, @@ -53,7 +53,7 @@ ;; 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 -(defrecord ztree-diff-node (parent left-path right-path short-name right-short-name children different)) +(ztree-defrecord ztree-diff-node (parent left-path right-path short-name right-short-name children different)) (defun ztree-diff-node-to-string (node) "Construct the string with contents of the NODE given." @@ -79,7 +79,7 @@ "\n" " * Children: " ch-str "\n"))) - + (defun ztree-diff-node-short-name-wrapper (node &optional right-side) "Return the short name of the NODE given. @@ -139,7 +139,7 @@ Returns t if equal." (defun ztree-directory-files (dir) "Return the list of full paths of files in a directory DIR. Filters out . and .." - (ztree-filter #'(lambda (file) (let ((simple-name (file-short-name file))) + (ztree-filter #'(lambda (file) (let ((simple-name (ztree-file-short-name file))) (not (or (string-equal simple-name ".") (string-equal simple-name ".."))))) (directory-files dir 'full))) @@ -157,12 +157,12 @@ 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))) + (ztree-diff-node-set-different node (car traverse)) + (ztree-diff-node-set-children node (cdr traverse))) ;; node is a file (ztree-diff-node-set-different node @@ -181,8 +181,8 @@ Argument SIDE either 'left or 'right side." parent (when (eq side 'left) file) (when (eq side 'right) file) - (file-short-name file) - (file-short-name file) + (ztree-file-short-name file) + (ztree-file-short-name file) nil 'new)) (children (ztree-diff-model-subtree node file side))) @@ -192,8 +192,8 @@ Argument SIDE either 'left or 'right side." parent (when (eq side 'left) file) (when (eq side 'right) file) - (file-short-name file) - (file-short-name file) + (ztree-file-short-name file) + (ztree-file-short-name file) nil 'new) result))) @@ -240,7 +240,7 @@ the rest is the combined list of nodes." (dolist (file1 list1) ;; for every entry in the first directory ;; we are creating the node - (let* ((simple-name (file-short-name file1)) + (let* ((simple-name (ztree-file-short-name file1)) (isdir (file-directory-p file1)) (children nil) (different nil) @@ -250,7 +250,7 @@ the rest is the combined list of nodes." ;; 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 - #'(lambda (x) (and (string-equal (file-short-name x) + #'(lambda (x) (and (string-equal (ztree-file-short-name x) simple-name) (eq isdir (file-directory-p x))))))) ;; 2. if it is not in the second directory, add it as a node @@ -287,7 +287,7 @@ the rest is the combined list of nodes." (dolist (file2 list2) ;; for every entry in the second directory ;; we are creating the node - (let* ((simple-name (file-short-name file2)) + (let* ((simple-name (ztree-file-short-name file2)) (isdir (file-directory-p file2)) (children nil) ;; create the node to be added to the results list @@ -295,7 +295,7 @@ the rest is the combined list of nodes." ;; 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 - #'(lambda (x) (and (string-equal (file-short-name x) + #'(lambda (x) (and (string-equal (ztree-file-short-name x) simple-name) (eq isdir (file-directory-p x))))))) ;; if it is not in the first directory, add it as a node @@ -321,8 +321,8 @@ the rest is the combined list of nodes." (setq ztree-diff-model-wait-message (concat "Comparing " dir1 " and " dir2 " ...")) (let* ((model (ztree-diff-node-create nil dir1 dir2 - (file-short-name dir1) - (file-short-name dir2) + (ztree-file-short-name dir1) + (ztree-file-short-name dir2) nil nil)) (traverse (ztree-diff-node-traverse model dir1 dir2))) @@ -341,7 +341,7 @@ the rest is the combined list of nodes." (ztree-diff-node-set-children node (cdr traverse)) (ztree-diff-node-set-different node (car traverse)) (message "Done."))) - + (provide 'ztree-diff-model) diff --git a/packages/ztree/ztree-diff.el b/packages/ztree/ztree-diff.el index 6caa73eae..cd7a353e2 100644 --- a/packages/ztree/ztree-diff.el +++ b/packages/ztree/ztree-diff.el @@ -1,4 +1,4 @@ -;;; ztree-diff.el --- Text mode diff for directory trees +;;; ztree-diff.el --- Text mode diff for directory trees -*- lexical-binding: t; -*- ;; Copyright (C) 2013-2015 Free Software Foundation, Inc. ;; @@ -110,28 +110,28 @@ By default paths starting with dot (like .git) are ignored") (defun ztree-diff-insert-buffer-header () "Insert the header to the ztree buffer." - (insert-with-face "Differences tree" ztreep-diff-header-face) - (newline-and-begin) + (ztree-insert-with-face "Differences tree" ztreep-diff-header-face) + (insert "\n") (when ztree-diff-dirs-pair - (insert-with-face (concat "Left: " (car ztree-diff-dirs-pair)) - ztreep-diff-header-small-face) - (newline-and-begin) - (insert-with-face (concat "Right: " (cdr ztree-diff-dirs-pair)) - ztreep-diff-header-small-face) - (newline-and-begin)) - (insert-with-face "Legend:" ztreep-diff-header-small-face) - (newline-and-begin) - (insert-with-face " Normal file " ztreep-diff-model-normal-face) - (insert-with-face "- same on both sides" ztreep-diff-header-small-face) - (newline-and-begin) - (insert-with-face " Orphan file " ztreep-diff-model-add-face) - (insert-with-face "- does not exist on other side" ztreep-diff-header-small-face) - (newline-and-begin) - (insert-with-face " Mismatch file " ztreep-diff-model-diff-face) - (insert-with-face "- different from other side" ztreep-diff-header-small-face) - (newline-and-begin) - (insert-with-face "==============" ztreep-diff-header-face) - (newline-and-begin)) + (ztree-insert-with-face (concat "Left: " (car ztree-diff-dirs-pair)) + ztreep-diff-header-small-face) + (insert "\n") + (ztree-insert-with-face (concat "Right: " (cdr ztree-diff-dirs-pair)) + ztreep-diff-header-small-face) + (insert "\n")) + (ztree-insert-with-face "Legend:" ztreep-diff-header-small-face) + (insert "\n") + (ztree-insert-with-face " Normal file " ztreep-diff-model-normal-face) + (ztree-insert-with-face "- same on both sides" ztreep-diff-header-small-face) + (insert "\n") + (ztree-insert-with-face " Orphan file " ztreep-diff-model-add-face) + (ztree-insert-with-face "- does not exist on other side" ztreep-diff-header-small-face) + (insert "\n") + (ztree-insert-with-face " Mismatch file " ztreep-diff-model-diff-face) + (ztree-insert-with-face "- different from other side" ztreep-diff-header-small-face) + (insert "\n") + (ztree-insert-with-face "==============" ztreep-diff-header-face) + (insert "\n")) (defun ztree-diff-full-rescan () "Force full rescan of the directory trees." @@ -151,7 +151,7 @@ By default paths starting with dot (like .git) are ignored") (file-exists-p right)) node nil))) - + (defun ztree-diff-existing-common-parent (node) "Return the first node in up in hierarchy of the NODE which has both sides." (let ((common (ztree-diff-existing-common node))) @@ -170,7 +170,7 @@ By default paths starting with dot (like .git) are ignored") (ztree-diff-model-partial-rescan common) (ztree-diff-node-update-all-parents-diff node) (ztree-refresh-buffer (line-number-at-pos)))))) - + (defun ztree-diff-partial-rescan () "Perform partial rescan on the current node." @@ -178,7 +178,7 @@ By default paths starting with dot (like .git) are ignored") (let ((found (ztree-find-node-at-point))) (when found (ztree-diff-do-partial-rescan (car found))))) - + (defun ztree-diff-simple-diff (node) "Create a simple diff buffer for files from left and right panels. @@ -213,7 +213,7 @@ 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)) - (open-f '(lambda (path) (if hard (find-file path) + (open-f #'(lambda (path) ((insert )f hard (find-file path) (let ((split-width-threshold nil)) (view-file-other-window path)))))) (cond ((and left right) @@ -225,7 +225,7 @@ Argument NODE node containing paths to files to call a diff on." (left (funcall open-f left)) (right (funcall open-f right)) (t nil)))) - + (defun ztree-diff-copy-file (node source-path destination-path copy-to-right) @@ -258,7 +258,7 @@ COPY-TO-RIGHT specifies which side of the NODE to update." (defun ztree-diff-copy-dir (node source-path destination-path copy-to-right) - "Update the NODE status and copy the directory. + "Update the NODE status and copy the directory. Directory copied from SOURCE-PATH to DESTINATION-PATH. COPY-TO-RIGHT specifies which side of the NODE to update." (let* ((src-path (file-name-as-directory source-path)) @@ -352,7 +352,7 @@ COPY-TO-RIGHT specifies which side of the NODE to update." ((and (eq side 'right) node-right) (view-file node-right)))))))) - + (defun ztree-diff-delete-file () "Delete the file under the cursor." @@ -447,7 +447,7 @@ Argument DIR2 right directory." (ztreediff-mode) (setq ztree-diff-dirs-pair (cons dir1 dir2)) (ztree-refresh-buffer))) - + diff --git a/packages/ztree/ztree-dir.el b/packages/ztree/ztree-dir.el index d52aef149..3dd87b7f7 100644 --- a/packages/ztree/ztree-dir.el +++ b/packages/ztree/ztree-dir.el @@ -1,4 +1,4 @@ -;;; ztree-dir.el --- Text mode directory tree +;;; ztree-dir.el --- Text mode directory tree -*- lexical-binding: t; -*- ;; Copyright (C) 2013-2015 Free Software Foundation, Inc. ;; @@ -84,15 +84,15 @@ user press RETURN on file ")t "Insert the header to the ztree buffer." (let ((start (point))) (insert "Directory tree") - (newline-and-begin) + (insert "\n") (insert "==============") (set-text-properties start (point) '(face ztreep-header-face))) - (newline-and-begin)) + (insert "\n")) (defun ztree-file-not-hidden (filename) "Determines if the file with FILENAME should be visible." (not (string-match ztree-hidden-files-regexp - (file-short-name filename)))) + (ztree-file-short-name filename)))) (defun ztree-find-file (node hard) "Find the file at NODE. @@ -117,7 +117,7 @@ Otherwise, the ztree window is used to find the file." (expand-file-name (substitute-in-file-name path)) 'ztree-file-not-hidden 'ztree-insert-buffer-header - 'file-short-name + 'ztree-file-short-name 'file-directory-p 'string-equal '(lambda (x) (directory-files x 'full)) diff --git a/packages/ztree/ztree-util.el b/packages/ztree/ztree-util.el index 45f297de1..85df4446d 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 +;;; ztree-util.el --- Auxulary utilities for the ztree package -*- lexical-binding: t; -*- ;; Copyright (C) 2013-2015 Free Software Foundation, Inc. ;; @@ -43,36 +43,30 @@ Taken from http://www.emacswiki.org/emacs/ElispCookbook#toc39" (mapcar (lambda (x) (and (funcall condp x) x)) lst))) -(defun printable-string (string) +(defun ztree-printable-string (string) "Strip newline character from file names, like 'Icon\n. Argument STRING string to process.'." (replace-regexp-in-string "\n" "" string)) -(defun file-short-name (file) +(defun ztree-file-short-name (file) "By given FILE name return base file/directory name. Taken from http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg01238.html" - (printable-string (file-name-nondirectory (directory-file-name file)))) + (ztree-printable-string (file-name-nondirectory (directory-file-name file)))) - -(defun newline-and-begin () - "Move a point to the beginning of the next line." - (insert "\n") - (beginning-of-line)) - -(defun car-atom (value) +(defun ztree-car-atom (value) "Return VALUE if value is an atom, otherwise (car value) or nil. Used since `car-safe' returns nil for atoms" (if (atom value) value (car value))) -(defun insert-with-face (text face) +(defun ztree-insert-with-face (text face) "Insert TEXT with the FACE provided." (let ((start (point))) (insert text) (put-text-property start (point) 'face face))) -(defmacro defrecord (record-name record-fields) +(defmacro ztree-defrecord (record-name record-fields) "Create a record (structure) and getters/setters. Record is the following set of functions: @@ -84,7 +78,7 @@ argument - the record; \"field\" is from \"record-fields\" symbols arguments - the record and the field value Example: -\(defrecord person (name age)) +\(ztree-defrecord person (name age)) will be expanded to the following functions: @@ -92,7 +86,12 @@ will be expanded to the following functions: \(defun person-name (record) (...) \(defun person-age (record) (...) \(defun person-set-name (record value) (...) -\(defun person-set-age (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 @@ -101,19 +100,19 @@ will be expanded to the following functions: (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))) + (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) + (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) diff --git a/packages/ztree/ztree-view.el b/packages/ztree/ztree-view.el index a251be8da..519097b8e 100644 --- a/packages/ztree/ztree-view.el +++ b/packages/ztree/ztree-view.el @@ -1,4 +1,4 @@ -;;; ztree-view.el --- Text mode tree view (buffer) +;;; ztree-view.el --- Text mode tree view (buffer) -*- lexical-binding: t; -*- ;; Copyright (C) 2013-2015 Free Software Foundation, Inc. ;; @@ -191,7 +191,7 @@ or nil if there is no node" (node (ztree-find-node-in-line (line-number-at-pos)))) (when node (cons node (if (> (current-column) center) 'right 'left))))) - + (defun ztree-is-expanded-node (node) "Find if the NODE is in the list of expanded nodes." @@ -225,7 +225,7 @@ Argument STATE node state." (dolist (child children) (ztree-do-toggle-expand-subtree-iter child state))))) - + (defun ztree-do-toggle-expand-subtree () "Implements the subtree expand." (let* ((line (line-number-at-pos)) @@ -241,7 +241,7 @@ Argument STATE node state." (ztree-refresh-buffer line) ;; restore window start position (set-window-start (selected-window) current-pos)))) - + (defun ztree-do-perform-action (hard) "Toggle expand/collapsed state for nodes or perform an action. @@ -262,7 +262,7 @@ should be performed on node." (ztree-refresh-buffer line) ;; restore window start position (set-window-start (selected-window) current-pos))))) - + (defun ztree-perform-action () "Toggle expand/collapsed state for nodes or perform the action. @@ -291,7 +291,7 @@ Performs the soft action, binded on Space, on node." ztree-expanded-nodes-list)) (push node ztree-expanded-nodes-list))) - + (defun ztree-toggle-expand-state (node) "Toggle expanded/collapsed state for NODE." (ztree-do-toggle-expand-state node (not (ztree-is-expanded-node node)))) @@ -322,15 +322,15 @@ then close the node." Argument NODE node which contents will be returned." (let ((nodes (funcall ztree-node-contents-fun node)) (comp #'(lambda (x y) - (string< (funcall ztree-node-short-name-fun x) - (funcall ztree-node-short-name-fun y))))) + (string< (funcall ztree-node-short-name-fun x) + (funcall ztree-node-short-name-fun y))))) (cons (sort (ztree-filter #'(lambda (f) (funcall ztree-node-is-expandable-fun f)) nodes) comp) (sort (ztree-filter #'(lambda (f) (not (funcall ztree-node-is-expandable-fun f))) nodes) comp)))) - + (defun ztree-draw-char (c x y &optional face) "Draw char C at the position (1-based) (X Y). @@ -412,20 +412,20 @@ Argument START-OFFSET column to start drawing from." ;; from the children list (let ((last-child (ztree-find children #'(lambda (x) - (funcall visible (car-atom x))))) + (funcall visible (ztree-car-atom x))))) (x-offset (+ 2 offset))) (when last-child (ztree-draw-vertical-rounded-line (1+ root) - (car-atom last-child) + (ztree-car-atom last-child) x-offset))) ;; draw recursively (dolist (child children) (ztree-draw-tree child (1+ depth) start-offset) (let ((end (if (listp child) line-end-node line-end-leaf))) - (when (funcall visible (car-atom child)) + (when (funcall visible (ztree-car-atom child)) (ztree-draw-horizontal-line line-start end - (car-atom child))))))))) + (ztree-car-atom child))))))))) (defun ztree-fill-parent-array (tree) "Set the root lines array. @@ -433,7 +433,7 @@ Argument TREE nodes tree to create an array of lines from." (let ((root (car tree)) (children (cdr tree))) (dolist (child children) - (ztree-set-parent-for-line (car-atom child) root) + (ztree-set-parent-for-line (ztree-car-atom child) root) (when (listp child) (ztree-fill-parent-array child))))) @@ -497,7 +497,7 @@ Argument PATH start node." (when (funcall ztree-node-showp-fun leaf) ;; insert the leaf and add it to children (push (ztree-insert-entry leaf (1+ depth) nil) - children))))) + children))))) ;; result value is the list - head is the root line, ;; rest are children (cons root-line children))) @@ -524,7 +524,7 @@ Argument PATH start node." (puthash line side ztree-line-tree-properties)) (ztree-insert-single-entry short-name depth expandable expanded 0)) (puthash line node ztree-line-to-node-table) - (newline-and-begin) + (insert "\n") line)) (defun ztree-insert-single-entry (short-name depth diff --git a/packages/ztree/ztree.el b/packages/ztree/ztree.el index 79e6fe6d2..2f739aa9b 100644 --- a/packages/ztree/ztree.el +++ b/packages/ztree/ztree.el @@ -1,4 +1,4 @@ -;;; ztree.el --- Text mode directory tree +;;; ztree.el --- Text mode directory tree -*- lexical-binding: t; -*- ;; Copyright (C) 2013-2015 Free Software Foundation, Inc. ;;