From: Andreas Gerler Date: Sun, 26 Nov 2023 15:43:18 +0000 (+0100) Subject: add wfnames X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=7a51a1c774ca7407c1ec989e791d7cbc0cfdb257;p=emacsconfig.git add wfnames Signed-off-by: Andreas Gerler --- diff --git a/elpa/wfnames-20230712.1154/wfnames-autoloads.el b/elpa/wfnames-20230712.1154/wfnames-autoloads.el new file mode 100644 index 00000000..050f8881 --- /dev/null +++ b/elpa/wfnames-20230712.1154/wfnames-autoloads.el @@ -0,0 +1,34 @@ +;;; wfnames-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "wfnames" "wfnames.el" (0 0 0 0)) +;;; Generated autoloads from wfnames.el + +(autoload 'wfnames-setup-buffer "wfnames" "\ +Initialize wfnames buffer with FILES and display it with DISPLAY-FN. + +Arg DISPLAY-FN default to `switch-to-buffer' if unspecified. +When APPEND is specified, append FILES to existing `wfnames-buffer'. + +\(fn FILES &optional (DISPLAY-FN #\\='switch-to-buffer) APPEND)" nil nil) + +(register-definition-prefixes "wfnames" '("wfnames-")) + +;;;*** + +;;;### (autoloads nil nil ("wfnames-pkg.el") (0 0 0 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; wfnames-autoloads.el ends here diff --git a/elpa/wfnames-20230712.1154/wfnames-pkg.el b/elpa/wfnames-20230712.1154/wfnames-pkg.el new file mode 100644 index 00000000..e3a7b054 --- /dev/null +++ b/elpa/wfnames-20230712.1154/wfnames-pkg.el @@ -0,0 +1,12 @@ +(define-package "wfnames" "20230712.1154" "Edit filenames" + '((emacs "24.3")) + :commit "4447417c58b063df1fca1ba4bec9cb650c7beb60" :authors + '(("Thierry Volpiatto" . "thievol@posteo.net")) + :maintainers + '(("Thierry Volpiatto" . "thievol@posteo.net")) + :maintainer + '("Thierry Volpiatto" . "thievol@posteo.net") + :url "https://github.com/thierryvolpiatto/wfnames") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/wfnames-20230712.1154/wfnames.el b/elpa/wfnames-20230712.1154/wfnames.el new file mode 100644 index 00000000..54e2d7a7 --- /dev/null +++ b/elpa/wfnames-20230712.1154/wfnames.el @@ -0,0 +1,321 @@ +;;; wfnames.el --- Edit filenames -*- lexical-binding:t -*- + +;; Author: Thierry Volpiatto +;; Copyright (C) 2022 Thierry Volpiatto, all rights reserved. +;; URL: https://github.com/thierryvolpiatto/wfnames + +;; Compatibility: GNU Emacs 24.3+" +;; Package-Requires: ((emacs "24.3")) +;; Version: 1.1 + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + + +;;; Commentary: + +;; A mode to edit filenames, similar to wdired. + +;; This package have no user interface, but you can easily use it with +;; Helm package by customizing `helm-ff-edit-marked-files-fn' +;; variable. If you are not using Helm you will have to define +;; yourself a function that call `wfnames-setup-buffer' with a list of +;; files as argument. + +;; Usage: +;; Once in the Wfnames buffer, edit your filenames and hit C-c C-c to +;; save your changes. You have completion on filenames and directories +;; with TAB but if you are using Iedit package and it is in action use =M-TAB=. + +;;; Code: + +(require 'cl-lib) + +;; Internal. +(defvar wfnames-buffer "*Wfnames*") +(defvar wfnames--modified nil) + +(defgroup wfnames nil + "A mode to edit filenames." + :group 'wfnames) + +(defcustom wfnames-create-parent-directories t + "Create parent directories when non nil." + :type 'boolean) + +(defcustom wfnames-interactive-rename t + "Ask confirmation when overwriting." + :type 'boolean) + +(defvar wfnames-after-commit-hook nil) + +(defcustom wfnames-after-commit-function #'kill-buffer + "A function to call on `wfnames-buffer' when done." + :type 'function) + +(defcustom wfnames-make-backup nil + "Backup files before overwriting when non nil." + :type 'boolean) + +(defface wfnames-modified + '((t :background "LightBlue" :foreground "black")) + "Face used when filename is modified.") + +(defface wfnames-modified-exists + '((t :background "DarkOrange" :foreground "black")) + "Face used when modified fname point to an existing file.") + +(defface wfnames-files '((t :foreground "DeepSkyBlue")) + "Face used to display filenames in wfnames buffer.") + +(defface wfnames-dir '((t :background "White" :foreground "red")) + "Face used to display directories in wfnames buffer.") + +(defface wfnames-symlink '((t :foreground "Orange")) + "Face used to display symlinks in wfnames buffer.") + +(defface wfnames-prefix '((t :foreground "Gold")) + "Face used to prefix filenames in wfnames buffer.") + +(defvar wfnames-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-c") #'wfnames-commit-buffer) + (define-key map (kbd "C-x C-s") #'wfnames-commit-buffer) + (define-key map (kbd "C-c C-r") #'wfnames-revert-current-line) + (define-key map (kbd "C-M-r") #'revert-buffer) + (define-key map (kbd "C-c C-k") #'wfnames-abort) + (define-key map (kbd "TAB") #'completion-at-point) + ;; This override ispell completion in iedit map which is useless + ;; here. + (define-key map (kbd "C-M-i") #'completion-at-point) + map)) + +(defun wfnames-capf () + "Provide filename completion in wfnames buffer." + (let ((beg (point-at-bol)) + (end (point))) + (list beg end #'completion-file-name-table + :exit-function (lambda (str _status) + (when (and (stringp str) + (eq (char-after) ?/)) + (delete-char -1)))))) + +(define-derived-mode wfnames-mode + text-mode "wfnames" + "Major mode to edit filenames. + +Special commands: +\\{wfnames-mode-map}" + (add-hook 'after-change-functions #'wfnames-after-change-hook nil t) + (make-local-variable 'wfnames--modified) + (set (make-local-variable 'completion-at-point-functions) #'wfnames-capf) + (set (make-local-variable 'revert-buffer-function) #'wfnames-revert-changes)) + +(defun wfnames-abort () + "Quit and kill wfnames buffer." + (interactive) + (quit-window t)) + +(defun wfnames-after-change-hook (beg end _len) + "Put overlay on current line when modified. +Args BEG and END delimit changes on line." + (with-current-buffer wfnames-buffer + (save-excursion + (save-match-data + (goto-char beg) + (let* ((bol (point-at-bol)) + (eol (point-at-eol)) + (old (get-text-property bol 'old-name)) + (new (buffer-substring-no-properties bol eol)) + ov face) + (setq face (if (file-exists-p new) + 'wfnames-modified-exists 'wfnames-modified)) + (setq-local wfnames--modified + (cons old (delete old wfnames--modified))) + (cl-loop for o in (overlays-in bol eol) + when (overlay-get o 'hff-changed) + return (setq ov o)) + (cond ((string= old new) + (cl-loop for o in (overlays-in bol eol) + when (overlay-get o 'hff-changed) + do (delete-overlay o))) + (ov + (move-overlay ov bol eol) + (overlay-put ov 'face face)) + (t (setq ov (make-overlay bol eol)) + (overlay-put ov 'face face) + (overlay-put ov 'hff-changed t) + (overlay-put ov 'priority -1) + (overlay-put ov 'evaporate t))) + ;; When text is modified with something else than + ;; self-insert-command e.g. yank or iedit-rect, it loose its + ;; properties, so restore props here. + (put-text-property beg end 'face 'wfnames-files) + (put-text-property beg end 'old-name old)))))) + +;;;###autoload +(cl-defun wfnames-setup-buffer (files + &optional (display-fn #'switch-to-buffer) append) + "Initialize wfnames buffer with FILES and display it with DISPLAY-FN. + +Arg DISPLAY-FN default to `switch-to-buffer' if unspecified. +When APPEND is specified, append FILES to existing `wfnames-buffer'." + (with-current-buffer (get-buffer-create wfnames-buffer) + (unless append (erase-buffer)) + (save-excursion + (when append (goto-char (point-max))) + (cl-loop for file in files + for face = (cond ((file-directory-p file) 'wfnames-dir) + ((file-symlink-p file) 'wfnames-symlink) + (t 'wfnames-files)) + do (insert (propertize + file 'old-name file 'face face + 'line-prefix (propertize + "* " + 'face 'wfnames-prefix)) + "\n")) + (when append (delete-duplicate-lines (point-min) (point-max)))) + (unless append + ;; Go to beginning of basename on first line. + (while (re-search-forward "/" (point-at-eol) t)) + (wfnames-mode) + (funcall display-fn wfnames-buffer)))) + +(defun wfnames-ask-for-overwrite (file) + "Ask before overwriting FILE." + (or (null wfnames-interactive-rename) + (y-or-n-p + (format "File `%s' exists, overwrite? " + file)))) + +(defun wfnames-maybe-backup (file) + "Backup FILE." + (when wfnames-make-backup + (with-current-buffer (find-file-noselect file) + (let ((backup-by-copying t)) + (backup-buffer)) + (kill-buffer)))) + +(defun wfnames-commit-buffer () + "Commit wfnames buffer when changes are done." + (interactive) + (let ((renamed 0) (skipped 0) delayed overwrites) + (cl-labels ((commit () + (with-current-buffer wfnames-buffer + (goto-char (point-min)) + (while (not (eobp)) + (let* ((beg (point-at-bol)) + (end (point-at-eol)) + (old (get-text-property (point) 'old-name)) + (new (buffer-substring-no-properties beg end)) + ow) + (unless (string= old new) ; not modified, skip. + (cond (;; New file exists, rename it to a + ;; temp file to put it out of the way + ;; and delay real rename to next + ;; turn. Make it accessible in + ;; overwrites alist for next usage as + ;; old [1]. + (and (file-exists-p new) + ;; new is one of the old + ;; files about to be modified. + (member new wfnames--modified) + (not (member new delayed))) + ;; Maybe ask. + (if (wfnames-ask-for-overwrite new) + (let ((tmpfile (make-temp-name new))) + (push (cons new tmpfile) overwrites) + (push new delayed) + (wfnames-maybe-backup new) + (rename-file new tmpfile)) + ;; Answer is no, skip. + (add-text-properties + beg end `(old-name ,new)) + (cl-incf skipped))) + ;; Now really rename files. + (t + (when (and (file-exists-p new) + (not (member new delayed))) + (setq ow t)) + (when wfnames-create-parent-directories + ;; Check if base directory of new exists. + (let ((basedir (file-name-directory + (directory-file-name new)))) + (unless (file-directory-p basedir) + (mkdir basedir 'parents)))) + (if (and ow (wfnames-ask-for-overwrite new)) + ;; Direct overwrite i.e. first loop. + (progn + (wfnames-maybe-backup new) + (rename-file old new 'overwrite)) + ;; 'No' answered. + (and ow (cl-incf skipped)) + ;; It is an overwrite when OLD is + ;; found in overwrites alist (2nd + ;; loop), otherwise do normal renaming. + (and (null ow) + (rename-file + (or (assoc-default old overwrites) old) + new))) + (add-text-properties beg end `(old-name ,new)) + (setq delayed (delete new delayed)) + (cl-incf renamed)))) + (forward-line 1))) + (when delayed (commit))))) + (commit) + (run-hooks 'wfnames-after-commit-hook) + (message "Renamed %s file(s), Skipped %s file(s)" renamed skipped) + (funcall wfnames-after-commit-function wfnames-buffer)))) + +(defun wfnames-revert-current-line-1 () + "Revert current line to its initial state in a wfnames buffer." + (let ((old (get-text-property (point) 'old-name)) + (new (buffer-substring-no-properties + (point-at-bol) (point-at-eol)))) + (unless (and old new (string= old new)) + (delete-region (point-at-bol) (point-at-eol)) + (insert (propertize + old 'old-name old 'face 'wfnames-file + 'line-prefix (propertize + "* " + 'face 'wfnames-prefix)))) + (forward-line 1))) + +(defun wfnames-revert-current-line (&optional arg) + "Revert current line to its initial state in a wfnames buffer. + +With a numeric prefix ARG, revert the ARG next lines." + (interactive "p") + (dotimes (_ arg) + (wfnames-revert-current-line-1) + (when (eobp) (forward-line -1)) + (goto-char (point-at-bol)) + (while (re-search-forward "/" (point-at-eol) t)))) + +(defun wfnames-revert-changes (_ignore-auto _no-confirm) + "Revert wfnames buffer to its initial state. + +This is used as `revert-buffer-function' for `wfnames-mode'." + (with-current-buffer wfnames-buffer + (cl-loop for o in (overlays-in (point-min) (point-max)) + when (overlay-get o 'hff-changed) + do (delete-overlay o)) + (goto-char (point-min)) + (save-excursion + (while (not (eobp)) + (wfnames-revert-current-line-1))) + (while (re-search-forward "/" (point-at-eol) t)))) + +(provide 'wfnames) + +;;; wfnames.el ends here