summaryrefslogtreecommitdiff
path: root/lisp/wdired.el
blob: 928ecd653395c10ef32176ab6226a0c3fa140dff (plain)
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
875
876
877
878
;;; wdired.el --- Rename files editing their names in dired buffers

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

;; Filename: wdired.el
;; Author: Juan León Lahoz García <juan-leon.lahoz@tecsidel.es>
;; Version: 1.91
;; 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 2, 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 GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; 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 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.
;;
;; I do not have a URL to hang wdired, but you can use the one below
;; to find the latest version:
;;
;; http://groups.google.com/groups?as_ugroup=gnu.emacs.sources&as_q=wdired

;;; Installation:

;; Add this file (byte-compiling it is recommended) to your load-path.
;; Then add one of these set of lines (or similar ones) to your config:
;;
;; This is the easy way:
;;
;; (require 'wdired)
;; (define-key dired-mode-map "r" 'wdired-change-to-wdired-mode)
;;
;; This is recommended way for faster emacs startup time and lower
;; memory consumption, but remind to add these lines before dired.el
;; gets loaded (i.e., near the beginning of your .emacs file):
;;
;; (autoload 'wdired-change-to-wdired-mode "wdired")
;; (add-hook 'dired-load-hook
;;           '(lambda ()
;;              (define-key dired-mode-map "r" 'wdired-change-to-wdired-mode)
;;              (define-key dired-mode-map
;;                [menu-bar immediate wdired-change-to-wdired-mode]
;;                '("Edit File Names" . wdired-change-to-wdired-mode))))
;;
;;
;; Type "M-x customize-group RET wdired" if you want make changes to
;; the default behavior.

;;; Usage:

;; Then, you can start editing the names of the files by typing "r"
;; (or whatever key you choose, or M-x wdired-change-to-wdired-mode).
;; Use C-c C-c when finished or C-c C-k to abort. You can use also the
;; menu options: in dired mode, "Edit File Names" under "Immediate".
;; While editing the names, a new submenu "WDired" is available at top
;; level. You can customize the behavior of this package from this
;; menu.

;;; Change Log:

;; From 1.9 to 1.91
;;
;; - Fixed a bug (introduced in 1.9) so now files can be marked for
;;   deletion again, by deleting their whole filename.

;; From 1.8 to 1.9
;;
;; - Another alternative way of editing permissions allowed, see
;;   `wdired-allow-to-change-permissions' for details.
;;
;; - Now wdired doesn't rely on regexp so much. As a consequence of
;;   this, you can add newlines to filenames and symlinks targets
;;   (although this is not very usual, IMHO). Please note that dired
;;   (at least in Emacs 21.1 and previous) does not work very well
;;   with filenames with newlines in them, so RET is deactivated in
;;   wdired mode. But you can activate it if you want.
;;
;; - Now `upcase-word' `capitalize-word' and `downcase-word' are not
;;   advised to work better with wdired mode, but the keys bound to
;;   them use wdired versions of those commands.
;;
;; - Now "undo" actions are not inherited from wdired mode when
;;   changing to dired mode.
;;
;; - Code and documentation cleanups.
;;
;; - Fixed a bug that was making wdired to fail on users with
;;   `dired-backup-overwrite' set to t.
;;
;; - C-c C-[ now abort changes.

;; From 1.7 to 1.8
;;
;; - Now permission (access-control) bits of the files can be changed.
;;   Please see the commentary section and the custom variable
;;   `wdired-allow-to-change-permissions' for details.
;;
;; - Added another possible value for the variable
;;   `wdired-always-move-to-filename-beginning', useful to change
;;   permission bits of several files without the cursor jumping to
;;   filenames when changing lines.

;; From 0.1 to 1.7

;; - I've moved the list of changes to another file, because it was
;;   huge. Ask me for it or search older versions in google.

;;; TODO:

;; - Make it to work in XEmacs. Any volunteer?

;;; Code:

(eval-when-compile
  (require 'advice)
  (defvar dired-backup-overwrite) ; Only in emacs 20.x this is a custom var
  (set (make-local-variable 'byte-compile-dynamic) t))

(eval-and-compile
  (require 'dired)
  (autoload 'dired-do-create-files-regexp "dired-aux")
  (autoload 'dired-call-process "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 t, confirmation is required before actually rename the files.
Confirmation is required also for overwriting files.  If nil, no
confirmation is required for change the file names, and the variable
`wdired-is-ok-overwrite' is used to see if it is ok to overwrite files
without asking."
  :type 'boolean
  :group 'wdired)

(defcustom wdired-is-ok-overwrite nil
  "*If non-nil the renames can overwrite files without asking. 
This variable is used only if `wdired-use-interactive-rename' is nil."
  :type 'boolean
  :group 'wdired)

(defcustom wdired-always-move-to-filename-beginning nil
  "*If t the \"up\" and \"down\" movement is done 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 honored.  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-advise-functions t
  "*If t some editing commands are advised when wdired is loaded.
The advice only has effect in wdired mode.  These commands are
`query-replace' `query-replace-regexp' `replace-string', and the
advice makes them to ignore read-only regions, so no attempts to
modify these regions are done by them, and so they don't end
prematurely.

Setting this to nil does not unadvise the functions, if they are
already advised, but new Emacs will not advise them."
  :type 'boolean
  :group 'wdired)

(defcustom wdired-allow-to-redirect-links t
  "*If non-nil, the target of the symbolic links can be changed also.
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 can be changed also.

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 with 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)

(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-m"     'wdired-newline)
    (define-key map "\C-j"     'wdired-newline)
    (define-key map "\C-o"     'wdired-newline)
    (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]
      '("Abort Changes" . wdired-abort-changes))
    (define-key map [menu-bar wdired wdired-finish-edit]
      '("Commit Changes" . wdired-finish-edit))
    ;; FIXME: Use the new remap trick.
    (substitute-key-definition 'upcase-word 'wdired-upcase-word
			       map global-map)
    (substitute-key-definition 'capitalize-word 'wdired-capitalize-word
			       map global-map)
    (substitute-key-definition 'downcase-word 'wdired-downcase-word
			       map global-map)
    map))

(defvar wdired-mode-hook nil
  "Hook 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)


(defun wdired-mode ()
  "\\<wdired-mode-map>File Names Editing mode.

Press \\[wdired-finish-edit] to make the changes to take effect and
exit.  To abort the edit, use \\[wdired-abort-changes].

In this mode you can edit the names of the files, the target of the
links and the permission bits of the files.  You can `customize-group'
wdired.

Editing things out of the filenames, or adding or deleting lines is
not allowed, because the rest of the buffer is read-only."
  (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 a mode in which filenames are editable.
In this mode the names of the files can be changed, and after
typing C-c C-c the files and directories in disk are renamed.

See `wdired-mode'."
  (interactive)
  (set (make-local-variable 'wdired-old-content)
       (buffer-substring (point-min) (point-max)))
  (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 "Edit filenames")
  (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-hooks 'wdired-mode-hook)
  (message (substitute-command-keys "Press \\[wdired-finish-edit] when finished")))


;; 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 1 2 '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)
	  (put-text-property (- (point) 2) (1- (point)) 'old-name filename)
	  (put-text-property b-protection (1- (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)
  (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 (progn (end-of-line) (point)))
      (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))
	  (setq end (next-single-property-change (1+ beg) 'end-name))
	  (setq file (buffer-substring-no-properties (+ 2 beg) end)))
	(and file (setq file (wdired-normalize-filename file))))
      (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."
  (let ((inhibit-read-only t))
    (remove-text-properties (point-min) (point-max)
			    '(read-only nil local-map nil)))
  (put-text-property 1 2 'front-sticky 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)
  (setq 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))
  (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 ((overwrite (or wdired-is-ok-overwrite 1))
	(changes nil)
	(files-deleted nil)
	(errors 0)
	file-ori file-new tmp-value)
    (save-excursion
      (if (and wdired-allow-to-redirect-links
	       (fboundp 'make-symbolic-link))
	  (progn
	    (setq tmp-value (wdired-do-symlink-changes))
	    (setq errors (cdr tmp-value))
	    (setq changes (car tmp-value))))
      (if (and wdired-allow-to-change-permissions
	       (boundp 'wdired-col-perm)) ; could have been changed
	  (progn
	    (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-ori (wdired-get-filename nil t))
	(if file-ori
	    (setq file-new (wdired-get-filename)))
	(if (and file-ori (not (equal file-new file-ori)))
	    (progn
	      (setq changes t)
	      (if (not file-new) ;empty filename!
		  (setq files-deleted (cons file-ori files-deleted))
		(progn
		  (setq file-new (substitute-in-file-name file-new))
		  (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))
			  (dired-rename-file file-ori file-new
					     overwrite))
		      (error
		       (setq errors (1+ errors))
		       (dired-log (concat "Rename `" file-ori "' to `"
					  file-new "' failed:\n%s\n")
				  err))))))))
	(forward-line -1)))
    (if changes
        (revert-buffer) ;The "revert" is necessary to re-sort the buffer
      (let ((buffer-read-only nil))
	(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)")))
    (if files-deleted
        (wdired-flag-for-deletion files-deleted))
    (if (> errors 0)
        (dired-log-summary (format "%d rename actions failed" errors) nil)))
  (set-buffer-modified-p nil)
  (setq buffer-undo-list nil))

;; Renames 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 ((exit-while nil)
	  curr-filename)
      (while (not exit-while)
        (setq curr-filename (wdired-get-filename))
        (if (and curr-filename
                 (equal (substitute-in-file-name curr-filename) filename-new))
            (progn
              (setq exit-while 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))
          (progn
            (forward-line -1)
            (beginning-of-line)
            (setq exit-while (= 1 (point)))))))))

;; 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 the changes in the disk."
  (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 nil)))

(defun wdired-next-line (arg)
  "Move down lines then position at filename or the current column.
See `wdired-always-move-to-filename-beginning'.  Optional prefix ARG
says how many lines to move; default is one line."
  (interactive "p")
  (next-line arg)
  (if (or (eq wdired-always-move-to-filename-beginning t)
	  (and wdired-always-move-to-filename-beginning
	       (< (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-always-move-to-filename-beginning'.  Optional prefix ARG
says how many lines to move; default is one line."
  (interactive "p")
  (previous-line arg)
  (if (or (eq wdired-always-move-to-filename-beginning t)
	  (and wdired-always-move-to-filename-beginning
	       (< (current-column)
		  (save-excursion (dired-move-to-filename)
				  (current-column)))))
      (dired-move-to-filename)))

;; dired doesn't works well with newlines, so ...
(defun wdired-newline ()
  "Do nothing."
  (interactive))

;; 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-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))))



;; 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))
      (if (not (equal link-to-new link-to-ori))
          (progn
            (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 (concat "Link `" link-from "' to `"
				      link-to-new "' failed:\n%s\n")
			      err))))))
    (cons changes errors)))

;; Perform a "case command" skipping read-only words.
(defun wdired-xcase-word (command arg)
  (if (< arg 0)
      (funcall command arg)
    (progn
      (while (> arg 0)
	(condition-case err
	    (progn
	      (funcall command 1)
	      (setq arg (1- arg)))
	  (error
	   (if (not (forward-word 1))
	       (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 is related to advice some interactive functions
;; to make some editing commands in wdired mode not to fail trying to
;; change read-only text. Notice that some advises advice and unadvise
;; them-self to another functions: search-forward and
;; re-search-forward. This is to keep these functions advised only
;; when is necessary. Since they are built-in commands used heavily in
;; lots of places, to have it permanently advised would cause some
;; performance loss.


(defun wdired-add-skip-in-replace (command)
  "Advice COMMAND to skip matches while they have read-only properties.
This is useful to avoid \"read-only\" errors in search and replace
commands.  This advice only has effect in wdired mode."
  (eval
    `(defadvice ,command (around wdired-discard-read-only activate)
       ,(format "Make %s to work better with wdired,\n%s."  command
		"skipping read-only matches when invoked without argument")
       ad-do-it
       (if (eq major-mode 'wdired-mode)
	   (while (and ad-return-value
		       (text-property-any
			(max 1 (1- (match-beginning 0))) (match-end 0)
			'read-only t))
	     ad-do-it))
       ad-return-value)))


(defun wdired-add-replace-advice (command)
  "Advice COMMAND to skip matches while they have read-only properties.
This is useful to avoid \"read-only\" errors in search and replace
commands.  This advice only has effect in wdired mode."
  (eval
   `(defadvice ,command (around wdired-grok-read-only activate)
       ,(format "Make %s to work better with wdired,\n%s."  command
		"skipping read-only matches when invoked without argument")
       (if (eq major-mode 'wdired-mode)
           (progn
             (wdired-add-skip-in-replace 'search-forward)
             (wdired-add-skip-in-replace 're-search-forward)
             (unwind-protect 
                 ad-do-it
               (progn
                 (ad-remove-advice 'search-forward
                                   'around 'wdired-discard-read-only)
                 (ad-remove-advice 're-search-forward
                                   'around 'wdired-discard-read-only)
                 (ad-update 'search-forward)
                 (ad-update 're-search-forward))))
         ad-do-it)
       ad-return-value)))


(if wdired-advise-functions
    (progn
      (mapcar 'wdired-add-replace-advice
              '(query-replace query-replace-regexp replace-string))))


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

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

;; Put a local-map 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)
	filename)
    (set (make-local-variable 'wdired-col-perm) nil)
    (save-excursion
      (goto-char (point-min))
      (while (not (eobp))
	(if (and (not (looking-at dired-re-sym))
		 (setq filename (wdired-get-filename)))
	    (progn
	      (re-search-forward dired-re-perms)
	      (or wdired-col-perm
		  (setq wdired-col-perm (- (current-column) 9)))
	      (if (eq wdired-allow-to-change-permissions 'advanced)
		  (put-text-property (match-beginning 0) (match-end 0)
				     'read-only nil)
		(put-text-property (1+ (match-beginning 0)) (match-end 0)
				   'local-map wdired-perm-mode-map))
	      (put-text-property (match-end 0) (1+ (match-end 0)) 'end-perm t)
	      (put-text-property (match-beginning 0) (1+ (match-beginning 0))
				 '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-char
                                  (- (current-column) wdired-col-perm))
      (let ((new-bit (char-to-string last-command-char))
            (inhibit-read-only t)
	    (pos-prop (- (point) (- (current-column) wdired-col-perm))))
        (put-text-property 0 1 'local-map 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 pos-prop (1- pos-prop) 'perm-changed t))
    (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 'local-map 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 pos-prop (1- pos-prop) 'perm-changed t)))

(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)))
      (if (not (equal perms-ori perms-new))
	  (progn
	    (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)))
		  (if (not (equal 0 (dired-call-process dired-chmod-program
				     t perm-tmp filename)))
		      (progn
			(setq errors (1+ errors))
			(dired-log (concat dired-chmod-program " " perm-tmp
					   " `" filename "' failed\n\n")))))
	    (setq errors (1+ errors))
	    (dired-log (concat "Cannot parse permission `" perms-new
			       "' for file `" filename "'\n\n")))))
      (goto-char (next-single-property-change (1+ (point)) prop-wanted
					      nil (point-max))))
    (cons changes errors)))

(provide 'wdired)

;; arch-tag: bc00902e-526f-4305-bc7f-8862a559184f
;;; wdired.el ends here