unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
blob f059ab774a54e921eb1d8f5a5a10b7b35b4fa8cf 34047 bytes (raw)
name: lisp/wdired.el 	 # note: path name is non-authoritative(*)

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
 
;;; wdired.el --- Rename files editing their names in dired buffers -*- coding: utf-8; -*-

;; Copyright (C) 2004-2016 Free Software Foundation, Inc.

;; Filename: wdired.el
;; Author: Juan León Lahoz García <juanleon1@gmail.com>
;; Version: 2.0
;; Keywords: dired, environment, files, renaming

;; This file is part of GNU Emacs.

;; GNU Emacs 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.

;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; wdired.el (the "w" is for writable) provides an alternative way of
;; renaming files.
;;
;; Have you ever wished to use C-x r t (string-rectangle), M-%
;; (query-replace), M-c (capitalize-word), etc... to change the name of
;; the files in a "dired" buffer? Now you can do this.  All the power
;; of Emacs commands are available to renaming files!
;;
;; This package provides a function that makes the filenames of a
;; dired buffer editable, by changing the buffer mode (which inhibits
;; all of the commands of dired mode). Here you can edit the names of
;; one or more files and directories, and when you press C-c C-c, the
;; renaming takes effect and you are back to dired mode.
;;
;; Another things you can do with WDired:
;;
;; - To move files to another directory (by typing their path,
;;   absolute or relative, as a part of the new filename).
;;
;; - To change the target of symbolic links.
;;
;; - To change the permission bits of the filenames (in systems with a
;;   working unix-alike `dired-chmod-program'). See and customize the
;;   variable `wdired-allow-to-change-permissions'.  To change a single
;;   char (toggling between its two more usual values) you can press
;;   the space bar over it or left-click the mouse.  To set any char to
;;   an specific value (this includes the SUID, SGID and STI bits) you
;;   can use the key labeled as the letter you want.  Please note that
;;   permissions of the links cannot be changed in that way, because
;;   the change would affect to their targets, and this would not be
;;   WYSIWYG :-).
;;
;; - To mark files for deletion, by deleting their whole filename.

;;; Usage:

;; You can edit the names of the files by typing C-x C-q or by
;; executing M-x wdired-change-to-wdired-mode.  Use C-c C-c when
;; finished or C-c C-k to abort.  While editing filenames, a new
;; submenu "WDired" is available at top level.  You can customize the
;; behavior of this package from this menu.

;;; Change Log:

;; Google is your friend (previous versions with complete changelogs
;; were posted to gnu.emacs.sources)

;;; Code:

(require 'dired)
(autoload 'dired-do-create-files-regexp "dired-aux")

(defgroup wdired nil
  "Mode to rename files by editing their names in dired buffers."
  :group 'dired)

(defcustom wdired-use-interactive-rename nil
  "If non-nil, WDired requires confirmation before actually renaming files.
If nil, WDired doesn't require confirmation to change the file names,
and the variable `wdired-confirm-overwrite' controls whether it is ok
to overwrite files without asking."
  :type 'boolean
  :group 'wdired)

(defcustom wdired-confirm-overwrite t
  "If nil the renames can overwrite files without asking.
This variable has no effect at all if `wdired-use-interactive-rename'
is not nil."
  :type 'boolean
  :group 'wdired)

(defcustom wdired-use-dired-vertical-movement nil
  "If t, the \"up\" and \"down\" movement works as in Dired mode.
That is, always move the point to the beginning of the filename at line.

If `sometimes', only move to the beginning of filename if the point is
before it, and `track-eol' is non-nil.  This behavior is very handy
when editing several filenames.

If nil, \"up\" and \"down\" movement is done as in any other buffer."
  :type '(choice (const :tag "As in any other mode" nil)
		 (const :tag "Smart cursor placement" sometimes)
		 (other :tag "As in dired mode" t))
  :group 'wdired)

(defcustom wdired-allow-to-redirect-links t
  "If non-nil, the target of the symbolic links are editable.
In systems without symbolic links support, this variable has no effect
at all."
  :type 'boolean
  :group 'wdired)

(defcustom wdired-allow-to-change-permissions nil
  "If non-nil, the permissions bits of the files are editable.

If t, to change a single bit, put the cursor over it and press the
space bar, or left click over it.  You can also hit the letter you want
to set: if this value is allowed, the character in the buffer will be
changed.  Anyway, the point is advanced one position, so, for example,
you can keep the <x> key pressed to give execution permissions to
everybody to that file.

If `advanced', the bits are freely editable.  You can use
`string-rectangle', `query-replace', etc.  You can put any value (even
newlines), but if you want your changes to be useful, you better put a
intelligible value.

Anyway, the real change of the permissions is done by the external
program `dired-chmod-program', which must exist."
  :type '(choice (const :tag "Not allowed" nil)
                 (const :tag "Toggle/set bits" t)
		 (other :tag "Bits freely editable" advanced))
  :group 'wdired)

(defcustom wdired-keep-marker-rename t
  ;; Use t as default so that renamed files "take their markers with them".
  "Controls marking of files renamed in WDired.
If t, files keep their previous marks when they are renamed.
If a character, renamed files (whether previously marked or not)
are afterward marked with that character.
This option affects only files renamed by `wdired-finish-edit'.
See `dired-keep-marker-rename' if you want to do the same for files
renamed by `dired-do-rename' and `dired-do-rename-regexp'."
  :type '(choice (const :tag "Keep" t)
		 (character :tag "Mark" :value ?R))
  :version "24.3"
  :group 'wdired)

(defcustom wdired-create-parent-directories t
  "If non-nil, create parent directories of destination files.
If non-nil, when you rename a file to a destination path within a
nonexistent directory, wdired will create any parent directories
necessary.  When nil, attempts to rename a file into a
nonexistent directory will fail."
  :version "26.1"
  :type 'boolean
  :group 'wdired)

(defvar wdired-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\C-x\C-s" 'wdired-finish-edit)
    (define-key map "\C-c\C-c" 'wdired-finish-edit)
    (define-key map "\C-c\C-k" 'wdired-abort-changes)
    (define-key map "\C-c\C-[" 'wdired-abort-changes)
    (define-key map "\C-x\C-q" 'wdired-exit)
    (define-key map "\C-m"     'ignore)
    (define-key map "\C-j"     'ignore)
    (define-key map "\C-o"     'ignore)
    (define-key map [up]       'wdired-previous-line)
    (define-key map "\C-p"     'wdired-previous-line)
    (define-key map [down]     'wdired-next-line)
    (define-key map "\C-n"     'wdired-next-line)

    (define-key map [menu-bar wdired]
      (cons "WDired" (make-sparse-keymap "WDired")))
    (define-key map [menu-bar wdired wdired-customize]
      '("Options" . wdired-customize))
    (define-key map [menu-bar wdired dashes]
      '("--"))
    (define-key map [menu-bar wdired wdired-abort-changes]
      '(menu-item "Abort Changes" wdired-abort-changes
		  :help "Abort changes and return to dired mode"))
    (define-key map [menu-bar wdired wdired-finish-edit]
      '("Commit Changes" . wdired-finish-edit))

    (define-key map [remap upcase-word] 'wdired-upcase-word)
    (define-key map [remap capitalize-word] 'wdired-capitalize-word)
    (define-key map [remap downcase-word] 'wdired-downcase-word)

    map)
  "Keymap used in `wdired-mode'.")

(defvar wdired-mode-hook nil
  "Hooks run when changing to WDired mode.")

;; Local variables (put here to avoid compilation gripes)
(defvar wdired-col-perm) ;; Column where the permission bits start
(defvar wdired-old-content)
(defvar wdired-old-point)
(defvar wdired-old-marks)

(defun wdired-mode ()
  "Writable Dired (WDired) mode.
\\<wdired-mode-map>
In WDired mode, you can edit the names of the files in the
buffer, the target of the links, and the permission bits of the
files.

Type \\[wdired-finish-edit] to exit WDired mode, returning to
Dired mode, and make your edits \"take effect\" by modifying the
file and directory names, link targets, and/or file permissions
on disk.  If you delete the filename of a file, it is flagged for
deletion in the Dired buffer.

Type \\[wdired-abort-changes] to abort your edits and exit WDired mode.

Type \\[customize-group] RET wdired to customize WDired behavior.

The only editable texts in a WDired buffer are filenames,
symbolic link targets, and filenames permission."
  (interactive)
  (error "This mode can be enabled only by `wdired-change-to-wdired-mode'"))
(put 'wdired-mode 'mode-class 'special)


;;;###autoload
(defun wdired-change-to-wdired-mode ()
  "Put a Dired buffer in Writable Dired (WDired) mode.
\\<wdired-mode-map>
In WDired mode, you can edit the names of the files in the
buffer, the target of the links, and the permission bits of the
files.  After typing \\[wdired-finish-edit], Emacs modifies the files and
directories to reflect your edits.

See `wdired-mode'."
  (interactive)
  (unless (eq major-mode 'dired-mode)
    (error "Not a Dired buffer"))
  (set (make-local-variable 'wdired-old-content)
       (buffer-substring (point-min) (point-max)))
  (set (make-local-variable 'wdired-old-marks)
       (dired-remember-marks (point-min) (point-max)))
  (set (make-local-variable 'wdired-old-point) (point))
  (set (make-local-variable 'query-replace-skip-read-only) t)
  (add-function :after-while (local 'isearch-filter-predicate)
                #'wdired-isearch-filter-read-only)
  (use-local-map wdired-mode-map)
  (force-mode-line-update)
  (setq buffer-read-only nil)
  (dired-unadvertise default-directory)
  (add-hook 'kill-buffer-hook 'wdired-check-kill-buffer nil t)
  (setq major-mode 'wdired-mode)
  (setq mode-name "Editable Dired")
  (setq revert-buffer-function 'wdired-revert)
  ;; I temp disable undo for performance: since I'm going to clear the
  ;; undo list, it can save more than a 9% of time with big
  ;; directories because setting properties modify the undo-list.
  (buffer-disable-undo)
  (wdired-preprocess-files)
  (if wdired-allow-to-change-permissions
      (wdired-preprocess-perms))
  (if (and wdired-allow-to-redirect-links (fboundp 'make-symbolic-link))
      (wdired-preprocess-symlinks))
  (buffer-enable-undo) ; Performance hack. See above.
  (set-buffer-modified-p nil)
  (setq buffer-undo-list nil)
  (run-mode-hooks 'wdired-mode-hook)
  (message "%s" (substitute-command-keys
		 "Press \\[wdired-finish-edit] when finished \
or \\[wdired-abort-changes] to abort changes")))

(defun wdired-isearch-filter-read-only (beg end)
  "Skip matches that have a read-only property."
  (not (text-property-not-all (min beg end) (max beg end)
			      'read-only nil)))

;; Protect the buffer so only the filenames can be changed, and put
;; properties so filenames (old and new) can be easily found.
(defun wdired-preprocess-files ()
  (put-text-property (point-min) (1+ (point-min))'front-sticky t)
  (save-excursion
    (goto-char (point-min))
    (let ((b-protection (point))
	  filename)
      (while (not (eobp))
	(setq filename (dired-get-filename nil t))
        (when (and filename
		   (not (member (file-name-nondirectory filename) '("." ".."))))
	  (dired-move-to-filename)
	  ;; The rear-nonsticky property below shall ensure that text preceding
	  ;; the filename can't be modified.
	  (add-text-properties
	   (1- (point)) (point) `(old-name ,filename rear-nonsticky (read-only)))
	  (put-text-property b-protection (point) 'read-only t)
	  (setq b-protection (dired-move-to-end-of-filename t))
	  (put-text-property (point) (1+ (point)) 'end-name t))
        (forward-line))
      (put-text-property b-protection (point-max) 'read-only t))))

;; This code is a copy of some dired-get-filename lines.
(defsubst wdired-normalize-filename (file unquotep)
  (when unquotep
    (setq file
          ;; FIXME: shouldn't we check for a `b' argument or somesuch before
          ;; doing such unquoting?  --Stef
          (read (concat
                 "\"" (replace-regexp-in-string
                       "\\([^\\]\\|\\`\\)\"" "\\1\\\\\"" file)
                 "\""))))
  (and file buffer-file-coding-system
       (not file-name-coding-system)
       (not default-file-name-coding-system)
       (setq file (encode-coding-string file buffer-file-coding-system)))
  file)

(defun wdired-get-filename (&optional no-dir old)
  "Return the filename at line.
Similar to `dired-get-filename' but it doesn't rely on regexps.  It
relies on WDired buffer's properties.  Optional arg NO-DIR with value
non-nil means don't include directory.  Optional arg OLD with value
non-nil means return old filename."
  ;; FIXME: Use dired-get-filename's new properties.
  (let (beg end file)
    (save-excursion
      (setq end (line-end-position))
      (beginning-of-line)
      (setq beg (next-single-property-change (point) 'old-name nil end))
      (unless (eq beg end)
	(if old
	    (setq file (get-text-property beg 'old-name))
	  ;; In the following form changed `(1+ beg)' to `beg' so that
	  ;; the filename end is found even when the filename is empty.
	  ;; Fixes error and spurious newlines when marking files for
	  ;; deletion.
	  (setq end (next-single-property-change beg 'end-name))
	  (setq file (buffer-substring-no-properties (1+ beg) end)))
	;; Don't unquote the old name, it wasn't quoted in the first place
        (and file (setq file (wdired-normalize-filename file (not old)))))
      (if (or no-dir old)
	  file
	(and file (> (length file) 0)
             (concat (dired-current-directory) file))))))


(defun wdired-change-to-dired-mode ()
  "Change the mode back to dired."
  (or (eq major-mode 'wdired-mode)
      (error "Not a Wdired buffer"))
  (let ((inhibit-read-only t))
    (remove-text-properties
     (point-min) (point-max)
     '(front-sticky nil rear-nonsticky nil read-only nil keymap nil)))
  (use-local-map dired-mode-map)
  (force-mode-line-update)
  (setq buffer-read-only t)
  (setq major-mode 'dired-mode)
  (setq mode-name "Dired")
  (dired-advertise)
  (remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t)
  (set (make-local-variable 'revert-buffer-function) 'dired-revert))


(defun wdired-abort-changes ()
  "Abort changes and return to dired mode."
  (interactive)
  (let ((inhibit-read-only t))
    (erase-buffer)
    (insert wdired-old-content)
    (goto-char wdired-old-point))
  (wdired-change-to-dired-mode)
  (set-buffer-modified-p nil)
  (setq buffer-undo-list nil)
  (message "Changes aborted"))

(defun wdired-finish-edit ()
  "Actually rename files based on your editing in the Dired buffer."
  (interactive)
  (wdired-change-to-dired-mode)
  (let ((changes nil)
	(errors 0)
	files-deleted
	files-renamed
	some-file-names-unchanged
	file-old file-new tmp-value)
    (save-excursion
      (when (and wdired-allow-to-redirect-links
		 (fboundp 'make-symbolic-link))
	(setq tmp-value (wdired-do-symlink-changes))
	(setq errors (cdr tmp-value))
	(setq changes (car tmp-value)))
      (when (and wdired-allow-to-change-permissions
		 (boundp 'wdired-col-perm)) ; could have been changed
	(setq tmp-value (wdired-do-perm-changes))
	(setq errors (+ errors (cdr tmp-value)))
	(setq changes (or changes (car tmp-value))))
      (goto-char (point-max))
      (while (not (bobp))
	(setq file-old (wdired-get-filename nil t))
	(when file-old
	  (setq file-new (wdired-get-filename))
          (if (equal file-new file-old)
	      (setq some-file-names-unchanged t)
            (setq changes t)
            (if (not file-new)		;empty filename!
                (push file-old files-deleted)
	      (when wdired-keep-marker-rename
		(let ((mark (cond ((integerp wdired-keep-marker-rename)
				   wdired-keep-marker-rename)
				  (wdired-keep-marker-rename
				   (cdr (assoc file-old wdired-old-marks)))
				  (t nil))))
		  (when mark
		    (push (cons (substitute-in-file-name file-new) mark)
			  wdired-old-marks))))
              (push (cons file-old (substitute-in-file-name file-new))
                    files-renamed))))
	(forward-line -1)))
    (when files-renamed
      (setq errors (+ errors (wdired-do-renames files-renamed))))
    (if changes
	(progn
	  ;; If we are displaying a single file (rather than the
	  ;; contents of a directory), change dired-directory if that
	  ;; file was renamed.  (This ought to be generalized to
	  ;; handle the multiple files case, but that's less trivial).
	  (when (and (stringp dired-directory)
		     (not (file-directory-p dired-directory))
		     (null some-file-names-unchanged)
		     (= (length files-renamed) 1))
	    (setq dired-directory (cdr (car files-renamed))))
	  ;; Re-sort the buffer.
	  (revert-buffer)
	  (let ((inhibit-read-only t))
	    (dired-mark-remembered wdired-old-marks)))
      (let ((inhibit-read-only t))
	(remove-text-properties (point-min) (point-max)
				'(old-name nil end-name nil old-link nil
					   end-link nil end-perm nil
					   old-perm nil perm-changed nil))
	(message "(No changes to be performed)")))
    (when files-deleted
      (wdired-flag-for-deletion files-deleted))
    (when (> errors 0)
      (dired-log-summary (format "%d rename actions failed" errors) nil)))
  (set-buffer-modified-p nil)
  (setq buffer-undo-list nil))

(defun wdired-do-renames (renames)
  "Perform RENAMES in parallel."
  (let ((residue ())
        (progress nil)
        (errors 0)
        (overwrite (or (not wdired-confirm-overwrite) 1)))
    (while (or renames
               ;; We've done one round through the renames, we have found
               ;; some residue, but we also made some progress, so maybe
               ;; some of the residue were resolved: try again.
               (prog1 (setq renames residue)
                 (setq progress nil)
                 (setq residue nil)))
      (let* ((rename (pop renames))
             (file-new (cdr rename)))
        (cond
         ((rassoc file-new renames)
          (error "Trying to rename 2 files to the same name"))
         ((assoc file-new renames)
          ;; Renaming to a file name that already exists but will itself be
          ;; renamed as well.  Let's wait until that one gets renamed.
          (push rename residue))
         ((and (assoc file-new residue)
               ;; Make sure the file really exists: if it doesn't it's
               ;; not really a conflict.  It might be a temp-file generated
               ;; specifically to break a circular renaming.
               (file-exists-p file-new))
          ;; Renaming to a file name that already exists, needed to be renamed,
          ;; but whose renaming could not be performed right away.
          (if (or progress renames)
              ;; There's still a chance the conflict will be resolved.
              (push rename residue)
            ;; We have not made any progress and we've reached the end of
            ;; the renames, so we really have a circular conflict, and we
            ;; have to forcefully break the cycle.
            (message "Circular renaming: using temporary file name")
            (let ((tmp (make-temp-name file-new)))
              (push (cons (car rename) tmp) renames)
              (push (cons tmp file-new) residue))))
         (t
          (setq progress t)
          (let ((file-ori (car rename)))
            (if wdired-use-interactive-rename
                (wdired-search-and-rename file-ori file-new)
              ;; If dired-rename-file autoloads dired-aux while
              ;; dired-backup-overwrite is locally bound,
              ;; dired-backup-overwrite won't be initialized.
              ;; So we must ensure dired-aux is loaded.
              (require 'dired-aux)
              (condition-case err
                  (let ((dired-backup-overwrite nil))
                    (and wdired-create-parent-directories
                         (wdired-create-parentdirs file-new))
                    (dired-rename-file file-ori file-new
                                       overwrite))
                (error
                 (setq errors (1+ errors))
                 (dired-log "Rename `%s' to `%s' failed:\n%s\n"
                            file-ori file-new
                            err)))))))))
    errors))

(defun wdired-create-parentdirs (file-new)
  "Create parent directories for FILE-NEW if they don't exist."
  (and (not (file-exists-p (file-name-directory file-new)))
       (message "Creating directory for file %s" file-new)
       (make-directory (file-name-directory file-new) t)))

(defun wdired-exit ()
  "Exit wdired and return to dired mode.
Just return to dired mode if there are no changes.  Otherwise,
ask a yes-or-no question whether to save or cancel changes,
and proceed depending on the answer."
  (interactive)
  (if (buffer-modified-p)
      (if (y-or-n-p (format "Buffer %s modified; save changes? "
			    (current-buffer)))
	  (wdired-finish-edit)
	(wdired-abort-changes))
    (wdired-change-to-dired-mode)
    (set-buffer-modified-p nil)
    (setq buffer-undo-list nil)
    (message "(No changes need to be saved)")))

;; Rename a file, searching it in a modified dired buffer, in order
;; to be able to use `dired-do-create-files-regexp' and get its
;; "benefits".
(defun wdired-search-and-rename (filename-ori filename-new)
  (save-excursion
    (goto-char (point-max))
    (forward-line -1)
    (let ((done nil)
	  curr-filename)
      (while (and (not done) (not (bobp)))
        (setq curr-filename (wdired-get-filename nil t))
        (if (equal curr-filename filename-ori)
            (progn
              (setq done t)
              (let ((inhibit-read-only t))
                (dired-move-to-filename)
                (search-forward (wdired-get-filename t) nil t)
                (replace-match (file-name-nondirectory filename-ori) t t))
              (dired-do-create-files-regexp
               (function dired-rename-file)
               "Move" 1 ".*" filename-new nil t))
	  (forward-line -1))))))

;; marks a list of files for deletion
(defun wdired-flag-for-deletion (filenames-ori)
  (save-excursion
    (goto-char (point-min))
    (while (not (eobp))
      (if (member (dired-get-filename nil t) filenames-ori)
          (dired-flag-file-deletion 1)
	(forward-line)))))

(defun wdired-customize ()
  "Customize WDired options."
  (interactive)
  (customize-apropos "wdired" 'groups))

(defun wdired-revert (&optional _arg _noconfirm)
  "Discard changes in the buffer and update it based on changes on disk.
Optional arguments are ignored."
  (wdired-change-to-dired-mode)
  (revert-buffer)
  (wdired-change-to-wdired-mode))

(defun wdired-check-kill-buffer ()
  ;; FIXME: Can't we use the normal mechanism for that?  --Stef
  (if (and
       (buffer-modified-p)
       (not (y-or-n-p "Buffer changed. Discard changes and kill buffer? ")))
      (error "Error")))

(defun wdired-next-line (arg)
  "Move down lines then position at filename or the current column.
See `wdired-use-dired-vertical-movement'.  Optional prefix ARG
says how many lines to move; default is one line."
  (interactive "^p")
  (with-no-warnings (next-line arg))
  (if (or (eq wdired-use-dired-vertical-movement t)
	  (and wdired-use-dired-vertical-movement
	       (< (current-column)
		  (save-excursion (dired-move-to-filename)
				  (current-column)))))
      (dired-move-to-filename)))

(defun wdired-previous-line (arg)
  "Move up lines then position at filename or the current column.
See `wdired-use-dired-vertical-movement'.  Optional prefix ARG
says how many lines to move; default is one line."
  (interactive "^p")
  (with-no-warnings (previous-line arg))
  (if (or (eq wdired-use-dired-vertical-movement t)
	  (and wdired-use-dired-vertical-movement
	       (< (current-column)
		  (save-excursion (dired-move-to-filename)
				  (current-column)))))
      (dired-move-to-filename)))

;; Put the needed properties to allow the user to change links' targets
(defun wdired-preprocess-symlinks ()
  (let ((inhibit-read-only t))
    (save-excursion
      (goto-char (point-min))
      (while (not (eobp))
        (if (looking-at dired-re-sym)
            (progn
              (re-search-forward " -> \\(.*\\)$")
	      (put-text-property (- (match-beginning 1) 2)
				 (1- (match-beginning 1)) 'old-link
				 (match-string-no-properties 1))
              (put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t)
              (put-text-property (1- (match-beginning 1))
				 (match-beginning 1)
				 'rear-nonsticky '(read-only))
	      (put-text-property (match-beginning 1)
				 (match-end 1) 'read-only nil)))
        (forward-line)
	(beginning-of-line)))))


(defun wdired-get-previous-link (&optional old move)
  "Return the next symlink target.
If OLD, return the old target.  If MOVE, move point before it."
  (let (beg end target)
    (setq beg (previous-single-property-change (point) 'old-link nil))
    (if beg
	(progn
	  (if old
	      (setq target (get-text-property (1- beg) 'old-link))
	    (setq end (next-single-property-change beg 'end-link))
	    (setq target (buffer-substring-no-properties (1+ beg) end)))
	  (if move (goto-char (1- beg)))))
    (and target (wdired-normalize-filename target t))))

(declare-function make-symbolic-link "fileio.c")

;; Perform the changes in the target of the changed links.
(defun wdired-do-symlink-changes ()
  (let ((changes nil)
	(errors 0)
	link-to-ori link-to-new link-from)
    (goto-char (point-max))
    (while (setq link-to-new (wdired-get-previous-link))
      (setq link-to-ori (wdired-get-previous-link t t))
      (setq link-from (wdired-get-filename nil t))
      (unless (equal link-to-new link-to-ori)
        (setq changes t)
        (if (equal link-to-new "") ;empty filename!
            (setq link-to-new "/dev/null"))
        (condition-case err
            (progn
              (delete-file link-from)
              (make-symbolic-link
               (substitute-in-file-name link-to-new) link-from))
          (error
           (setq errors (1+ errors))
           (dired-log "Link `%s' to `%s' failed:\n%s\n"
                      link-from link-to-new
                      err)))))
    (cons changes errors)))

;; Perform a "case command" skipping read-only words.
(defun wdired-xcase-word (command arg)
  (if (< arg 0)
      (funcall command arg)
    (while (> arg 0)
      (condition-case nil
          (progn
            (funcall command 1)
            (setq arg (1- arg)))
        (error
         (if (forward-word-strictly)
	     ;; Skip any non-word characters to avoid triggering a read-only
	     ;; error which would cause skipping the next word characters too.
	     (skip-syntax-forward "^w")
	   (setq arg 0)))))))

(defun wdired-downcase-word (arg)
  "WDired version of `downcase-word'.
Like original function but it skips read-only words."
  (interactive "p")
  (wdired-xcase-word 'downcase-word arg))

(defun wdired-upcase-word (arg)
  "WDired version of `upcase-word'.
Like original function but it skips read-only words."
  (interactive "p")
  (wdired-xcase-word 'upcase-word arg))

(defun wdired-capitalize-word (arg)
  "WDired version of `capitalize-word'.
Like original function but it skips read-only words."
  (interactive "p")
  (wdired-xcase-word 'capitalize-word arg))


;; The following code deals with changing the access bits (or
;; permissions) of the files.

(defvar wdired-perm-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map " " 'wdired-toggle-bit)
    (define-key map "r" 'wdired-set-bit)
    (define-key map "w" 'wdired-set-bit)
    (define-key map "x" 'wdired-set-bit)
    (define-key map "-" 'wdired-set-bit)
    (define-key map "S" 'wdired-set-bit)
    (define-key map "s" 'wdired-set-bit)
    (define-key map "T" 'wdired-set-bit)
    (define-key map "t" 'wdired-set-bit)
    (define-key map "s" 'wdired-set-bit)
    (define-key map "l" 'wdired-set-bit)
    (define-key map [down-mouse-1] 'wdired-mouse-toggle-bit)
    map))

;; Put a keymap property to the permission bits of the files, and store the
;; original name and permissions as a property
(defun wdired-preprocess-perms ()
  (let ((inhibit-read-only t))
    (set (make-local-variable 'wdired-col-perm) nil)
    (save-excursion
      (goto-char (point-min))
      (while (not (eobp))
	(when (and (not (looking-at dired-re-sym))
		   (wdired-get-filename)
		   (re-search-forward dired-re-perms (line-end-position) 'eol))
	  (let ((begin (match-beginning 0))
		(end (match-end 0)))
	    (unless wdired-col-perm
	      (setq wdired-col-perm (- (current-column) 9)))
	    (if (eq wdired-allow-to-change-permissions 'advanced)
		(progn
		  (put-text-property begin end 'read-only nil)
		  ;; make first permission bit writable
		  (put-text-property
		   (1- begin) begin 'rear-nonsticky '(read-only)))
	      ;; avoid that keymap applies to text following permissions
	      (add-text-properties
	       (1+ begin) end
	       `(keymap ,wdired-perm-mode-map rear-nonsticky (keymap))))
	    (put-text-property end (1+ end) 'end-perm t)
	    (put-text-property
	     begin (1+ begin) 'old-perm (match-string-no-properties 0))))
        (forward-line)
	(beginning-of-line)))))

(defun wdired-perm-allowed-in-pos (char pos)
  (cond
   ((= char ?-)          t)
   ((= char ?r)          (= (% pos 3) 0))
   ((= char ?w)          (= (% pos 3) 1))
   ((= char ?x)          (= (% pos 3) 2))
   ((memq char '(?s ?S)) (memq pos '(2 5)))
   ((memq char '(?t ?T)) (= pos 8))
   ((= char ?l)          (= pos 5))))

(defun wdired-set-bit ()
  "Set a permission bit character."
  (interactive)
  (if (wdired-perm-allowed-in-pos last-command-event
                                  (- (current-column) wdired-col-perm))
      (let ((new-bit (char-to-string last-command-event))
            (inhibit-read-only t)
	    (pos-prop (- (point) (- (current-column) wdired-col-perm))))
        (put-text-property 0 1 'keymap wdired-perm-mode-map new-bit)
        (put-text-property 0 1 'read-only t new-bit)
        (insert new-bit)
        (delete-char 1)
	(put-text-property (1- pos-prop) pos-prop 'perm-changed t)
	(put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap)))
    (forward-char 1)))

(defun wdired-toggle-bit ()
  "Toggle the permission bit at point."
  (interactive)
  (let ((inhibit-read-only t)
	(new-bit "-")
	(pos-prop (- (point) (- (current-column) wdired-col-perm))))
    (if (eq (char-after (point)) ?-)
	(setq new-bit
	      (if (= (% (- (current-column) wdired-col-perm) 3) 0) "r"
		(if (= (% (- (current-column) wdired-col-perm) 3) 1) "w"
		  "x"))))
    (put-text-property 0 1 'keymap wdired-perm-mode-map new-bit)
    (put-text-property 0 1 'read-only t new-bit)
    (insert new-bit)
    (delete-char 1)
    (put-text-property (1- pos-prop) pos-prop 'perm-changed t)
    (put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap))))

(defun wdired-mouse-toggle-bit (event)
  "Toggle the permission bit that was left clicked."
  (interactive "e")
  (mouse-set-point event)
  (wdired-toggle-bit))

;; Allowed chars for 4000 bit are Ss  in position 3
;; Allowed chars for 2000 bit are Ssl in position 6
;; Allowed chars for 1000 bit are Tt  in position 9
(defun wdired-perms-to-number (perms)
  (let ((nperm 0777))
    (if (= (elt perms 1) ?-) (setq nperm (- nperm 400)))
    (if (= (elt perms 2) ?-) (setq nperm (- nperm 200)))
    (let ((p-bit (elt perms 3)))
      (if (memq p-bit '(?- ?S)) (setq nperm (- nperm 100)))
      (if (memq p-bit '(?s ?S)) (setq nperm (+ nperm 4000))))
    (if (= (elt perms 4) ?-) (setq nperm (- nperm 40)))
    (if (= (elt perms 5) ?-) (setq nperm (- nperm 20)))
    (let ((p-bit (elt perms 6)))
      (if (memq p-bit '(?- ?S ?l)) (setq nperm (- nperm 10)))
      (if (memq p-bit '(?s ?S ?l)) (setq nperm (+ nperm 2000))))
    (if (= (elt perms 7) ?-) (setq nperm (- nperm 4)))
    (if (= (elt perms 8) ?-) (setq nperm (- nperm 2)))
    (let ((p-bit (elt perms 9)))
      (if (memq p-bit '(?- ?T)) (setq nperm (- nperm 1)))
      (if (memq p-bit '(?t ?T)) (setq nperm (+ nperm 1000))))
    nperm))

;; Perform the changes in the permissions of the files that have
;; changed.
(defun wdired-do-perm-changes ()
  (let ((changes nil)
	(errors 0)
	(prop-wanted (if (eq wdired-allow-to-change-permissions 'advanced)
			 'old-perm 'perm-changed))
	filename perms-ori perms-new perm-tmp)
    (goto-char (next-single-property-change (point-min) prop-wanted
					    nil (point-max)))
    (while (not (eobp))
      (setq perms-ori (get-text-property (point) 'old-perm))
      (setq perms-new (buffer-substring-no-properties
		       (point) (next-single-property-change (point) 'end-perm)))
      (unless (equal perms-ori perms-new)
        (setq changes t)
        (setq filename (wdired-get-filename nil t))
        (if (= (length perms-new) 10)
            (progn
              (setq perm-tmp
                    (int-to-string (wdired-perms-to-number perms-new)))
              (unless (equal 0 (process-file dired-chmod-program
					     nil nil nil perm-tmp filename))
                (setq errors (1+ errors))
                (dired-log "%s %s `%s' failed\n\n"
                           dired-chmod-program perm-tmp filename)))
          (setq errors (1+ errors))
          (dired-log "Cannot parse permission `%s' for file `%s'\n\n"
                     perms-new filename)))
      (goto-char (next-single-property-change (1+ (point)) prop-wanted
					      nil (point-max))))
    (cons changes errors)))

(provide 'wdired)

;; Local Variables:
;; byte-compile-dynamic: t
;; End:

;;; wdired.el ends here

debug log:

solving f059ab7 ...
found f059ab7 in https://git.savannah.gnu.org/cgit/emacs.git

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).