diff --git a/wfnames.el b/wfnames.el index e5a83b5..a61a18d 100644 --- a/wfnames.el +++ b/wfnames.el @@ -34,20 +34,20 @@ ;; 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 +;; 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) +(eval-when-compile (require 'cl-lib)) ;you are only using macros, so this should be OK ;; Internal. -(defvar wfnames-buffer "*Wfnames*") -(defvar wfnames--modified nil) +(defvar wfnames-buffer "*Wfnames*") ;perhaps `defconst' +(defvar-local wfnames--modified nil) (defgroup wfnames nil "A mode to edit filenames." - :group 'wfnames) + :group 'wfnames) ;watch out, this is a recursive group (defcustom wfnames-create-parent-directories t "Create parent directories when non nil." @@ -57,16 +57,21 @@ "Ask confirmation when overwriting." :type 'boolean) -(defvar wfnames-after-commit-hook nil) +(defcustom wfnames-after-commit-hook nil + "Hook to run after `wfnames-commit-buffer'." ;rephrase this + :type 'hook) (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." + "Non-nil means files are backed up before overwriting." :type 'boolean) +;; instead of defining new faces and colours, do you think it would be +;; possible to inherit from existing faces? + (defface wfnames-modified '((t :background "LightBlue" :foreground "black")) "Face used when filename is modified.") @@ -104,27 +109,27 @@ "Provide filename completion in wfnames buffer." (let ((beg (line-beginning-position)) (end (point))) + ;; Does it make sense to extend beyond END to allow completing + ;; file names mid-string? (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" +(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)) + (setq-local completion-at-point-functions #'wfnames-capf) + (setq-local revert-buffer-function #'wfnames-revert-changes)) (defun wfnames-abort () "Quit and kill wfnames buffer." (interactive) - (quit-window t)) + (quit-window t)) ;isn't this `kill-buffer-and-window' (defun wfnames-after-change-hook (beg end _len) "Put overlay on current line when modified. @@ -137,9 +142,10 @@ Args BEG and END delimit changes on line." (eol (line-end-position)) (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)) + (face (if (file-exists-p new) + 'wfnames-modified-exists + 'wfnames-modified)) + ov) (setq-local wfnames--modified (cons old (delete old wfnames--modified))) (cl-loop for o in (overlays-in bol eol) @@ -184,10 +190,10 @@ When APPEND is specified, append FILES to existing `wfnames-buffer'." "* " 'face 'wfnames-prefix)) "\n")) - (when append (delete-duplicate-lines (point-min) (point-max)))) + (when append (delete-duplicate-lines (point-min) (point-max)))) ;this requires Emacs 24.4 (unless append ;; Go to beginning of basename on first line. - (while (re-search-forward "/" (line-end-position) t)) + (re-search-forward "\\(?:/[^/]*\\)*/" (line-end-position) t) (wfnames-mode) (funcall display-fn wfnames-buffer)))) @@ -202,7 +208,7 @@ When APPEND is specified, append FILES to existing `wfnames-buffer'." "Backup FILE." (when wfnames-make-backup (with-current-buffer (find-file-noselect file) - (let ((backup-by-copying t)) + (let ((backup-by-copying t)) ;why is this bound? isn't this a user preference? (backup-buffer)) (kill-buffer)))) @@ -252,7 +258,7 @@ When APPEND is specified, append FILES to existing `wfnames-buffer'." (let ((basedir (file-name-directory (directory-file-name new)))) (unless (file-directory-p basedir) - (mkdir basedir 'parents)))) + (make-directory basedir 'parents)))) (if (and ow (wfnames-ask-for-overwrite new)) ;; Direct overwrite i.e. first loop. (progn @@ -300,21 +306,22 @@ With a numeric prefix ARG, revert the ARG next lines." (wfnames-revert-current-line-1) (when (eobp) (forward-line -1)) (goto-char (line-beginning-position)) - (while (re-search-forward "/" (line-end-position) t)))) + (re-search-forward "\\(?:/[^/]*\\)*/" (line-end-position) 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)) + (dolist (o (overlays-in (point-min) (point-max))) + (when (overlay-get o 'hff-changed) + (delete-overlay o))) (goto-char (point-min)) (save-excursion (while (not (eobp)) (wfnames-revert-current-line-1))) - (while (re-search-forward "/" (line-end-position) t)))) + (re-search-forward "\\(?:/[^/]*\\)*/" (line-end-position) t))) + (provide 'wfnames)