diff options
| author | Karl Heuer | 1995-05-30 21:45:22 +0000 |
|---|---|---|
| committer | Karl Heuer | 1995-05-30 21:45:22 +0000 |
| commit | 43f657eaa2a5c36c073984417255b9baef78bbfa (patch) | |
| tree | 0e4d1f847f27401324330bddc2f660d18907ee54 | |
| parent | fe8287c6fa15c482d965d4acdd1d3adeb16dc2b1 (diff) | |
| download | emacs-43f657eaa2a5c36c073984417255b9baef78bbfa.tar.gz emacs-43f657eaa2a5c36c073984417255b9baef78bbfa.zip | |
(archive-lemacs): New variable.
(archive-mode-map, archive-summarize-files): Make it sort-of
work with Lucid Emacs.
(archive-mouse-extract): Use Lucid compatible code.
(archive-summarize-files, archive-lzh-chmod-entry): Guard
lambda with function.
| -rw-r--r-- | lisp/arc-mode.el | 160 |
1 files changed, 87 insertions, 73 deletions
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 328cc21a242..4f416995d59 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el | |||
| @@ -258,6 +258,10 @@ Archive and member name will be added.") | |||
| 258 | (defvar archive-files nil "Vector of file descriptors. Each descriptor is | 258 | (defvar archive-files nil "Vector of file descriptors. Each descriptor is |
| 259 | a vector of [ext-file-name int-file-name case-fiddled mode ...]") | 259 | a vector of [ext-file-name int-file-name case-fiddled mode ...]") |
| 260 | (make-variable-buffer-local 'archive-files) | 260 | (make-variable-buffer-local 'archive-files) |
| 261 | |||
| 262 | (defvar archive-lemacs | ||
| 263 | (string-match "\\(Lucid\\|Xemacs\\)" emacs-version) | ||
| 264 | "*Non-nil when running under under Lucid Emacs or Xemacs.") | ||
| 261 | ;; ------------------------------------------------------------------------- | 265 | ;; ------------------------------------------------------------------------- |
| 262 | ;; Section: Support functions. | 266 | ;; Section: Support functions. |
| 263 | 267 | ||
| @@ -478,7 +482,6 @@ archive. | |||
| 478 | (define-key archive-mode-map "e" 'archive-extract) | 482 | (define-key archive-mode-map "e" 'archive-extract) |
| 479 | (define-key archive-mode-map "f" 'archive-extract) | 483 | (define-key archive-mode-map "f" 'archive-extract) |
| 480 | (define-key archive-mode-map "\C-m" 'archive-extract) | 484 | (define-key archive-mode-map "\C-m" 'archive-extract) |
| 481 | (define-key archive-mode-map [mouse-2] 'archive-mouse-extract) | ||
| 482 | (define-key archive-mode-map "g" 'revert-buffer) | 485 | (define-key archive-mode-map "g" 'revert-buffer) |
| 483 | (define-key archive-mode-map "h" 'describe-mode) | 486 | (define-key archive-mode-map "h" 'describe-mode) |
| 484 | (define-key archive-mode-map "m" 'archive-mark) | 487 | (define-key archive-mode-map "m" 'archive-mark) |
| @@ -499,60 +502,72 @@ archive. | |||
| 499 | (define-key archive-mode-map "M" 'archive-chmod-entry) | 502 | (define-key archive-mode-map "M" 'archive-chmod-entry) |
| 500 | (define-key archive-mode-map "G" 'archive-chgrp-entry) | 503 | (define-key archive-mode-map "G" 'archive-chgrp-entry) |
| 501 | (define-key archive-mode-map "O" 'archive-chown-entry) | 504 | (define-key archive-mode-map "O" 'archive-chown-entry) |
| 502 | (substitute-key-definition 'undo 'archive-undo archive-mode-map global-map) | 505 | |
| 503 | 506 | (if archive-lemacs | |
| 504 | ;; Get rid of the Edit menu bar item to save space. | 507 | (progn |
| 505 | (define-key archive-mode-map [menu-bar edit] 'undefined) | 508 | ;; Not a nice "solution" but it'll have to do |
| 506 | 509 | (define-key archive-mode-map "\C-xu" 'archive-undo) | |
| 507 | (define-key archive-mode-map [menu-bar immediate] | 510 | (define-key archive-mode-map "\C-_" 'archive-undo)) |
| 508 | (cons "Immediate" (make-sparse-keymap "Immediate"))) | 511 | (substitute-key-definition 'undo 'archive-undo |
| 509 | (define-key archive-mode-map [menu-bar immediate alternate] | 512 | archive-mode-map global-map)) |
| 510 | '("Alternate Display" . archive-alternate-display)) | 513 | |
| 511 | (put 'archive-alternate-display 'menu-enable | 514 | (define-key archive-mode-map |
| 512 | '(boundp (archive-name "alternate-display"))) | 515 | (if archive-lemacs 'button2 [mouse-2]) 'archive-mouse-extract) |
| 513 | (define-key archive-mode-map [menu-bar immediate view] | 516 | |
| 514 | '("View This File" . archive-view)) | 517 | (if archive-lemacs |
| 515 | (define-key archive-mode-map [menu-bar immediate display] | 518 | () ; out of luck |
| 516 | '("Display in Other Window" . archive-display-other-window)) | 519 | ;; Get rid of the Edit menu bar item to save space. |
| 517 | (define-key archive-mode-map [menu-bar immediate find-file-other-window] | 520 | (define-key archive-mode-map [menu-bar edit] 'undefined) |
| 518 | '("Find in Other Window" . archive-extract-other-window)) | 521 | |
| 519 | (define-key archive-mode-map [menu-bar immediate find-file] | 522 | (define-key archive-mode-map [menu-bar immediate] |
| 520 | '("Find This File" . archive-extract)) | 523 | (cons "Immediate" (make-sparse-keymap "Immediate"))) |
| 521 | 524 | (define-key archive-mode-map [menu-bar immediate alternate] | |
| 522 | (define-key archive-mode-map [menu-bar mark] | 525 | '("Alternate Display" . archive-alternate-display)) |
| 523 | (cons "Mark" (make-sparse-keymap "Mark"))) | 526 | (put 'archive-alternate-display 'menu-enable |
| 524 | (define-key archive-mode-map [menu-bar mark unmark-all] | 527 | '(boundp (archive-name "alternate-display"))) |
| 525 | '("Unmark All" . archive-unmark-all-files)) | 528 | (define-key archive-mode-map [menu-bar immediate view] |
| 526 | (define-key archive-mode-map [menu-bar mark deletion] | 529 | '("View This File" . archive-view)) |
| 527 | '("Flag" . archive-flag-deleted)) | 530 | (define-key archive-mode-map [menu-bar immediate display] |
| 528 | (define-key archive-mode-map [menu-bar mark unmark] | 531 | '("Display in Other Window" . archive-display-other-window)) |
| 529 | '("Unflag" . archive-unflag)) | 532 | (define-key archive-mode-map [menu-bar immediate find-file-other-window] |
| 530 | (define-key archive-mode-map [menu-bar mark mark] | 533 | '("Find in Other Window" . archive-extract-other-window)) |
| 531 | '("Mark" . archive-mark)) | 534 | (define-key archive-mode-map [menu-bar immediate find-file] |
| 532 | 535 | '("Find This File" . archive-extract)) | |
| 533 | (define-key archive-mode-map [menu-bar operate] | 536 | |
| 534 | (cons "Operate" (make-sparse-keymap "Operate"))) | 537 | (define-key archive-mode-map [menu-bar mark] |
| 535 | (define-key archive-mode-map [menu-bar operate chown] | 538 | (cons "Mark" (make-sparse-keymap "Mark"))) |
| 536 | '("Change Owner..." . archive-chown-entry)) | 539 | (define-key archive-mode-map [menu-bar mark unmark-all] |
| 537 | (put 'archive-chown-entry 'menu-enable | 540 | '("Unmark All" . archive-unmark-all-files)) |
| 538 | '(fboundp (archive-name "chown-entry"))) | 541 | (define-key archive-mode-map [menu-bar mark deletion] |
| 539 | (define-key archive-mode-map [menu-bar operate chgrp] | 542 | '("Flag" . archive-flag-deleted)) |
| 540 | '("Change Group..." . archive-chgrp-entry)) | 543 | (define-key archive-mode-map [menu-bar mark unmark] |
| 541 | (put 'archive-chgrp-entry 'menu-enable | 544 | '("Unflag" . archive-unflag)) |
| 542 | '(fboundp (archive-name "chgrp-entry"))) | 545 | (define-key archive-mode-map [menu-bar mark mark] |
| 543 | (define-key archive-mode-map [menu-bar operate chmod] | 546 | '("Mark" . archive-mark)) |
| 544 | '("Change Mode..." . archive-chmod-entry)) | 547 | |
| 545 | (put 'archive-chmod-entry 'menu-enable | 548 | (define-key archive-mode-map [menu-bar operate] |
| 546 | '(fboundp (archive-name "chmod-entry"))) | 549 | (cons "Operate" (make-sparse-keymap "Operate"))) |
| 547 | (define-key archive-mode-map [menu-bar operate rename] | 550 | (define-key archive-mode-map [menu-bar operate chown] |
| 548 | '("Rename to..." . archive-rename-entry)) | 551 | '("Change Owner..." . archive-chown-entry)) |
| 549 | (put 'archive-rename-entry 'menu-enable | 552 | (put 'archive-chown-entry 'menu-enable |
| 550 | '(fboundp (archive-name "rename-entry"))) | 553 | '(fboundp (archive-name "chown-entry"))) |
| 551 | ;;(define-key archive-mode-map [menu-bar operate copy] | 554 | (define-key archive-mode-map [menu-bar operate chgrp] |
| 552 | ;; '("Copy to..." . archive-copy)) | 555 | '("Change Group..." . archive-chgrp-entry)) |
| 553 | (define-key archive-mode-map [menu-bar operate expunge] | 556 | (put 'archive-chgrp-entry 'menu-enable |
| 554 | '("Expunge Marked Files" . archive-expunge)) | 557 | '(fboundp (archive-name "chgrp-entry"))) |
| 555 | ) | 558 | (define-key archive-mode-map [menu-bar operate chmod] |
| 559 | '("Change Mode..." . archive-chmod-entry)) | ||
| 560 | (put 'archive-chmod-entry 'menu-enable | ||
| 561 | '(fboundp (archive-name "chmod-entry"))) | ||
| 562 | (define-key archive-mode-map [menu-bar operate rename] | ||
| 563 | '("Rename to..." . archive-rename-entry)) | ||
| 564 | (put 'archive-rename-entry 'menu-enable | ||
| 565 | '(fboundp (archive-name "rename-entry"))) | ||
| 566 | ;;(define-key archive-mode-map [menu-bar operate copy] | ||
| 567 | ;; '("Copy to..." . archive-copy)) | ||
| 568 | (define-key archive-mode-map [menu-bar operate expunge] | ||
| 569 | '("Expunge Marked Files" . archive-expunge)) | ||
| 570 | )) | ||
| 556 | 571 | ||
| 557 | (let* ((item1 '(archive-subfile-mode " Archive")) | 572 | (let* ((item1 '(archive-subfile-mode " Archive")) |
| 558 | (item2 '(archive-subfile-dos " Dos")) | 573 | (item2 '(archive-subfile-dos " Dos")) |
| @@ -617,14 +632,17 @@ is visible (and the real data of the buffer is hidden)." | |||
| 617 | (apply | 632 | (apply |
| 618 | (function concat) | 633 | (function concat) |
| 619 | (mapcar | 634 | (mapcar |
| 620 | (lambda (fil) | 635 | (function |
| 621 | ;; Using `concat' here copies the text also, so we can add | 636 | (lambda (fil) |
| 622 | ;; properties without problems. | 637 | ;; Using `concat' here copies the text also, so we can add |
| 623 | (let ((text (concat (aref fil 0) "\n"))) | 638 | ;; properties without problems. |
| 624 | (put-text-property (aref fil 1) (aref fil 2) | 639 | (let ((text (concat (aref fil 0) "\n"))) |
| 625 | 'mouse-face 'highlight | 640 | (if archive-lemacs |
| 626 | text) | 641 | () ; out of luck |
| 627 | text)) | 642 | (put-text-property (aref fil 1) (aref fil 2) |
| 643 | 'mouse-face 'highlight | ||
| 644 | text)) | ||
| 645 | text))) | ||
| 628 | files))) | 646 | files))) |
| 629 | (setq archive-file-list-end (point-marker))) | 647 | (setq archive-file-list-end (point-marker))) |
| 630 | 648 | ||
| @@ -686,15 +704,11 @@ value of `archive-tmpdir'." | |||
| 686 | (defun archive-mouse-extract (event) | 704 | (defun archive-mouse-extract (event) |
| 687 | "Extract a file whose name you click on." | 705 | "Extract a file whose name you click on." |
| 688 | (interactive "e") | 706 | (interactive "e") |
| 689 | (save-excursion | 707 | (mouse-set-point event) |
| 690 | (set-buffer (window-buffer (posn-window (event-end event)))) | 708 | (switch-to-buffer |
| 691 | (save-excursion | 709 | (save-excursion |
| 692 | (goto-char (posn-point (event-end event))) | 710 | (archive-extract) |
| 693 | ;; Just make sure this doesn't get an error. | 711 | (current-buffer)))) |
| 694 | (archive-get-descr))) | ||
| 695 | (select-window (posn-window (event-end event))) | ||
| 696 | (goto-char (posn-point (event-end event))) | ||
| 697 | (archive-extract)) | ||
| 698 | 712 | ||
| 699 | (defun archive-extract (&optional other-window-p) | 713 | (defun archive-extract (&optional other-window-p) |
| 700 | "In archive mode, extract this entry of the archive into its own buffer." | 714 | "In archive mode, extract this entry of the archive into its own buffer." |
| @@ -1304,7 +1318,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." | |||
| 1304 | (defun archive-lzh-chmod-entry (newmode files) | 1318 | (defun archive-lzh-chmod-entry (newmode files) |
| 1305 | (archive-lzh-ogm | 1319 | (archive-lzh-ogm |
| 1306 | ;; This should work even though newmode will be dynamically accessed. | 1320 | ;; This should work even though newmode will be dynamically accessed. |
| 1307 | (lambda (old) (archive-calc-mode old newmode t)) | 1321 | (function (lambda (old) (archive-calc-mode old newmode t))) |
| 1308 | files "a unix-style mode" 8)) | 1322 | files "a unix-style mode" 8)) |
| 1309 | ;; ------------------------------------------------------------------------- | 1323 | ;; ------------------------------------------------------------------------- |
| 1310 | ;; Section: Zip Archives | 1324 | ;; Section: Zip Archives |