diff options
| author | Richard M. Stallman | 1992-09-13 06:01:19 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1992-09-13 06:01:19 +0000 |
| commit | bfe81e789a0838e336f71f182cf500e5068765fd (patch) | |
| tree | 04a3122fc833515fb83145bfd9ca3c5d876ba6ff | |
| parent | c3554e95658a0ea4b90cc4d6110664c12d463b5a (diff) | |
| download | emacs-bfe81e789a0838e336f71f182cf500e5068765fd.tar.gz emacs-bfe81e789a0838e336f71f182cf500e5068765fd.zip | |
*** empty log message ***
| -rw-r--r-- | lisp/diff.el | 57 | ||||
| -rw-r--r-- | lisp/dired-aux.el | 77 |
2 files changed, 71 insertions, 63 deletions
diff --git a/lisp/diff.el b/lisp/diff.el index 347bbb75d35..c317baf3281 100644 --- a/lisp/diff.el +++ b/lisp/diff.el | |||
| @@ -166,21 +166,48 @@ With prefix arg, prompt for diff switches." | |||
| 166 | (message "Comparing files %s %s..." new old) | 166 | (message "Comparing files %s %s..." new old) |
| 167 | (setq new (expand-file-name new) | 167 | (setq new (expand-file-name new) |
| 168 | old (expand-file-name old)) | 168 | old (expand-file-name old)) |
| 169 | (let ((buf (compile-internal (mapconcat 'identity | 169 | (let ((old-alt (diff-prepare old new)) |
| 170 | (append '("diff") | 170 | (new-alt (diff-prepare new old)) |
| 171 | (if (consp diff-switches) | 171 | buf) |
| 172 | diff-switches | 172 | (unwind-protect |
| 173 | (list diff-switches)) | 173 | (let ((command |
| 174 | (list old) | 174 | (mapconcat 'identity |
| 175 | (list new)) | 175 | (append '("diff") |
| 176 | " ") | 176 | (if (consp diff-switches) |
| 177 | "No more differences" "Diff" | 177 | diff-switches |
| 178 | 'diff-parse-differences))) | 178 | (list diff-switches)) |
| 179 | (save-excursion | 179 | (if (or old-alt new-alt) |
| 180 | (set-buffer buf) | 180 | (list "-L" old "-L" new)) |
| 181 | (set (make-local-variable 'diff-old-file) old) | 181 | (list (or old-alt old)) |
| 182 | (set (make-local-variable 'diff-new-file) new)) | 182 | (list (or new-alt new))) |
| 183 | buf)) | 183 | " "))) |
| 184 | (setq buf | ||
| 185 | (compile-internal command | ||
| 186 | "No more differences" "Diff" | ||
| 187 | 'diff-parse-differences))) | ||
| 188 | (save-excursion | ||
| 189 | (set-buffer buf) | ||
| 190 | (set (make-local-variable 'diff-old-file) old) | ||
| 191 | (set (make-local-variable 'diff-new-file) new)) | ||
| 192 | buf) | ||
| 193 | (if old-alt (delete-file old-alt)) | ||
| 194 | (if new-alt (delete-file new-alt))))) | ||
| 195 | |||
| 196 | ;; Copy the file FILE into a temporary file if that is necessary | ||
| 197 | ;; for comparison. (This is only necessary if the file name has a handler.) | ||
| 198 | ;; OTHER is the other file to be compared. | ||
| 199 | (defun diff-prepare (file other) | ||
| 200 | (let (handler handlers) | ||
| 201 | (setq handlers file-name-handler-alist) | ||
| 202 | (while (and (consp handlers) (null handler)) | ||
| 203 | (if (and (consp (car handlers)) | ||
| 204 | (stringp (car (car handlers))) | ||
| 205 | (string-match (car (car handlers)) file)) | ||
| 206 | (setq handler (cdr (car handlers)))) | ||
| 207 | (setq handlers (cdr handlers))) | ||
| 208 | (if handler | ||
| 209 | (funcall handler 'diff-prepare file other) | ||
| 210 | nil))) | ||
| 184 | 211 | ||
| 185 | ;;;###autoload | 212 | ;;;###autoload |
| 186 | (defun diff-backup (file &optional switches) | 213 | (defun diff-backup (file &optional switches) |
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index d94285f7544..3b66c68598f 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el | |||
| @@ -466,24 +466,36 @@ and use this command with a prefix argument (the value does not matter)." | |||
| 466 | ;; Compress or uncompress the current file. | 466 | ;; Compress or uncompress the current file. |
| 467 | ;; Return nil for success, offending filename else. | 467 | ;; Return nil for success, offending filename else. |
| 468 | (let* (buffer-read-only | 468 | (let* (buffer-read-only |
| 469 | (from-file (dired-get-filename))) | 469 | (from-file (dired-get-filename)) |
| 470 | (cond ((save-excursion (beginning-of-line) | 470 | (new-file (dired-compress-file from-file))) |
| 471 | (looking-at dired-re-sym)) | 471 | (if new-file |
| 472 | (dired-log (concat "Attempt to compress a symbolic link:\n" | 472 | (progn (dired-update-file-line new-file) nil) |
| 473 | from-file)) | 473 | (dired-log (concat "Failed to compress" from-file)) |
| 474 | (dired-make-relative from-file)) | 474 | from-file))) |
| 475 | ((string-match "\\.Z$" from-file) | 475 | |
| 476 | (defun dired-compress-file (file) | ||
| 477 | ;; Compress or uncompress FILE. | ||
| 478 | ;; Return the name of the compressed or uncompressed file. | ||
| 479 | ;; Rerurn nil if no change in files. | ||
| 480 | (let (handler (handlers file-name-handler-alist)) | ||
| 481 | (while (and (consp handlers) (null handler)) | ||
| 482 | (if (and (consp (car handlers)) | ||
| 483 | (stringp (car (car handlers))) | ||
| 484 | (string-match (car (car handlers)) file)) | ||
| 485 | (setq handler (cdr (car handlers)))) | ||
| 486 | (setq handlers (cdr handlers))) | ||
| 487 | (cond (handler | ||
| 488 | (funcall handler 'dired-compress-file file)) | ||
| 489 | ((file-symlink-p file) | ||
| 490 | nil) | ||
| 491 | ((string-match "\\.Z$" file) | ||
| 476 | (if (dired-check-process (concat "Uncompressing " from-file) | 492 | (if (dired-check-process (concat "Uncompressing " from-file) |
| 477 | "uncompress" from-file) | 493 | "uncompress" from-file) |
| 478 | (dired-make-relative from-file) | 494 | (substring file 0 -2))) |
| 479 | (dired-update-file-line (substring from-file 0 -2)))) | ||
| 480 | (t | 495 | (t |
| 481 | (if (dired-check-process (concat "Compressing " from-file) | 496 | (if (dired-check-process (concat "Compressing " from-file) |
| 482 | "compress" "-f" from-file) | 497 | "compress" "-f" from-file) |
| 483 | ;; Errors from the process are already logged. | 498 | (concat name ".Z")))))) |
| 484 | (dired-make-relative from-file) | ||
| 485 | (dired-update-file-line (concat from-file ".Z"))))) | ||
| 486 | nil)) | ||
| 487 | 499 | ||
| 488 | (defun dired-mark-confirm (op-symbol arg) | 500 | (defun dired-mark-confirm (op-symbol arg) |
| 489 | ;; Request confirmation from the user that the operation described | 501 | ;; Request confirmation from the user that the operation described |
| @@ -720,8 +732,9 @@ a prefix arg lets you edit the `ls' switches used for the new listing." | |||
| 720 | (let (buffer-read-only) | 732 | (let (buffer-read-only) |
| 721 | (beginning-of-line) | 733 | (beginning-of-line) |
| 722 | (dired-add-entry-do-indentation marker-char) | 734 | (dired-add-entry-do-indentation marker-char) |
| 723 | (dired-ls (dired-make-absolute filename directory);; don't expand `.' ! | 735 | ;; don't expand `.' ! |
| 724 | (concat dired-actual-switches "d")) | 736 | (insert-directory (dired-make-absolute filename directory) |
| 737 | (concat dired-actual-switches "d")) | ||
| 725 | (forward-line -1) | 738 | (forward-line -1) |
| 726 | ;; We want to have the non-directory part, only: | 739 | ;; We want to have the non-directory part, only: |
| 727 | (let* ((beg (dired-move-to-filename t)) ; error for strange output | 740 | (let* ((beg (dired-move-to-filename t)) ; error for strange output |
| @@ -1536,7 +1549,7 @@ This function takes some pains to conform to `ls -lR' output." | |||
| 1536 | (if (equal dirname (car (car (reverse dired-subdir-alist)))) | 1549 | (if (equal dirname (car (car (reverse dired-subdir-alist)))) |
| 1537 | ;; top level directory may contain wildcards: | 1550 | ;; top level directory may contain wildcards: |
| 1538 | (dired-readin-insert dired-directory) | 1551 | (dired-readin-insert dired-directory) |
| 1539 | (dired-ls dirname dired-actual-switches nil t))) | 1552 | (insert-directory dirname dired-actual-switches nil t))) |
| 1540 | (message "Reading directory %s...done" dirname) | 1553 | (message "Reading directory %s...done" dirname) |
| 1541 | (setq end (point-marker)) | 1554 | (setq end (point-marker)) |
| 1542 | (indent-rigidly begin end 2) | 1555 | (indent-rigidly begin end 2) |
| @@ -1635,38 +1648,6 @@ is always equal to STRING." | |||
| 1635 | 1648 | ||
| 1636 | ;;; moving by subdirectories | 1649 | ;;; moving by subdirectories |
| 1637 | 1650 | ||
| 1638 | (defun dired-subdir-index (dir) | ||
| 1639 | ;; Return an index into alist for use with nth | ||
| 1640 | ;; for the sake of subdir moving commands. | ||
| 1641 | (let (found (index 0) (alist dired-subdir-alist)) | ||
| 1642 | (while alist | ||
| 1643 | (if (string= dir (car (car alist))) | ||
| 1644 | (setq alist nil found t) | ||
| 1645 | (setq alist (cdr alist) index (1+ index)))) | ||
| 1646 | (if found index nil))) | ||
| 1647 | |||
| 1648 | ;;;###autoload | ||
| 1649 | (defun dired-next-subdir (arg &optional no-error-if-not-found no-skip) | ||
| 1650 | "Go to next subdirectory, regardless of level." | ||
| 1651 | ;; Use 0 arg to go to this directory's header line. | ||
| 1652 | ;; NO-SKIP prevents moving to end of header line, returning whatever | ||
| 1653 | ;; position was found in dired-subdir-alist. | ||
| 1654 | (interactive "p") | ||
| 1655 | (let ((this-dir (dired-current-directory)) | ||
| 1656 | pos index) | ||
| 1657 | ;; nth with negative arg does not return nil but the first element | ||
| 1658 | (setq index (- (dired-subdir-index this-dir) arg)) | ||
| 1659 | (setq pos (if (>= index 0) | ||
| 1660 | (dired-get-subdir-min (nth index dired-subdir-alist)))) | ||
| 1661 | (if pos | ||
| 1662 | (progn | ||
| 1663 | (goto-char pos) | ||
| 1664 | (or no-skip (skip-chars-forward "^\n\r")) | ||
| 1665 | (point)) | ||
| 1666 | (if no-error-if-not-found | ||
| 1667 | nil ; return nil if not found | ||
| 1668 | (error "%s directory" (if (> arg 0) "Last" "First")))))) | ||
| 1669 | |||
| 1670 | ;;;###autoload | 1651 | ;;;###autoload |
| 1671 | (defun dired-prev-subdir (arg &optional no-error-if-not-found no-skip) | 1652 | (defun dired-prev-subdir (arg &optional no-error-if-not-found no-skip) |
| 1672 | "Go to previous subdirectory, regardless of level. | 1653 | "Go to previous subdirectory, regardless of level. |