emacs-pretest-bug
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Replacement of spaces in wdired


From: martin rudalics
Subject: Re: Replacement of spaces in wdired
Date: Sun, 03 Dec 2006 19:56:37 +0100
User-agent: Mozilla Thunderbird 1.0 (Windows/20041206)

> The patch at
> http://lists.gnu.org/archive/html/emacs-devel/2006-02/msg01071.html no
> longer applies cleanly to the wdired.el in CVS, even after correcting
> the wrapping of long lines and ignoring white space.  The patch is
> also really quite large.

It is large because it also tries to handle permission bits correctly.
Attached find a revised patch of this which should apply against the
August version of wdired.el.  It also removes keymap text properties -
the current version still wants to remove local-map properties instead.
Please test my changes since I probably missed something during merging.
*** wdired.el   Tue Aug 15 11:00:52 2006
--- wdired.el   Sun Dec  3 19:38:16 2006
***************
*** 283,292 ****
          (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))))

--- 283,295 ----
          (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))))

***************
*** 312,331 ****
  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* ((end (line-end-position))
!          (beg (next-single-property-change
!                (line-beginning-position) 'old-name nil end)))
!     (unless (eq beg end)
!       (let ((file
!              (if old
!                  (get-text-property beg 'old-name)
!                (wdired-normalize-filename
!                 (buffer-substring-no-properties
!                  (+ 2 beg) (next-single-property-change (1+ beg) 
'end-name))))))
!         (if (or no-dir old)
!             file
!           (and file (> (length file) 0)
!                (concat (dired-current-directory) file)))))))


  (defun wdired-change-to-dired-mode ()
--- 315,335 ----
  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))
!         (setq end (next-single-property-change (1+ beg) 'end-name))
!         (setq file (buffer-substring-no-properties (1+ 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 ()
***************
*** 333,341 ****
    (or (eq major-mode 'wdired-mode)
        (error "Not a Wdired buffer"))
    (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)
--- 337,345 ----
    (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)
***************
*** 368,413 ****
        (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
--- 372,413 ----
        (errors 0)
        file-ori 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-ori (wdired-get-filename nil t))
!       (when file-ori
!         (setq file-new (wdired-get-filename)))
!       (when (and file-ori (not (equal file-new file-ori)))
!         (setq changes t)
!         (if (not file-new)            ;empty filename!
!             (setq files-deleted (cons file-ori files-deleted))
!           (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
***************
*** 417,426 ****
                                           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))

--- 417,426 ----
                                           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))

***************
*** 446,455 ****
                (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)
--- 446,454 ----
                (dired-do-create-files-regexp
                 (function dired-rename-file)
                 "Move" 1 ".*" filename-new nil t))
!         (forward-line -1)
!         (beginning-of-line)
!         (setq exit-while (bobp)))))))

  ;; marks a list of files for deletion
  (defun wdired-flag-for-deletion (filenames-ori)
***************
*** 527,541 ****
  (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 (previous-single-property-change (point) 'old-link nil)))
!     (when beg
!       (let ((target
!              (if old
!                  (get-text-property (1- beg) 'old-link)
!                (buffer-substring-no-properties
!                 (1+ beg) (next-single-property-change beg 'end-link)))))
!         (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 ()
--- 526,542 ----
  (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 ()
***************
*** 613,641 ****
      (define-key map [down-mouse-1] 'wdired-mouse-toggle-bit)
      map))

! ;; 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)
!                                  'keymap 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)))))

--- 614,647 ----
      (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)))))

***************
*** 661,684 ****
          (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 (cond
!                   ((not (eq (char-after (point)) ?-)) "-")
!                   ((= (% (- (current-column) wdired-col-perm) 3) 0) "r")
!                   ((= (% (- (current-column) wdired-col-perm) 3) 1) "w")
!                   (t "x")))
        (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 pos-prop (1- pos-prop) 'perm-changed t)))

  (defun wdired-mouse-toggle-bit (event)
    "Toggle the permission bit that was left clicked."
--- 667,693 ----
          (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."
***************
*** 690,717 ****
  ;; 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)
!   (+
!    (if (= (elt perms 1) ?-) 0 400)
!    (if (= (elt perms 2) ?-) 0 200)
!    (case (elt perms 3)
!      (?- 0)
!      (?S 4000)
!      (?s 4100)
!      (t 100))
!    (if (= (elt perms 4) ?-) 0 40)
!    (if (= (elt perms 5) ?-) 0 20)
!    (case (elt perms 6)
!      (?- 0)
!      (?S 2000)
!      (?s 2010)
!      (t 10))
!    (if (= (elt perms 7) ?-) 0 4)
!    (if (= (elt perms 8) ?-) 0 2)
!    (case (elt perms 9)
!      (?- 0)
!      (?T 1000)
!      (?t 1001)
!      (t 1))))

  ;; Perform the changes in the permissions of the files that have
  ;; changed.
--- 699,721 ----
  ;; 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.

reply via email to

[Prev in Thread] Current Thread [Next in Thread]