Mercurial > emacs
comparison lisp/arc-mode.el @ 12024:8e31a35ac027
(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.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Tue, 30 May 1995 21:45:22 +0000 |
parents | cccb62a4bac6 |
children | 3cf4df625c3b |
comparison
equal
deleted
inserted
replaced
12023:1a3e7aef5f8a | 12024:8e31a35ac027 |
---|---|
256 (put 'archive-subfile-dos 'permanent-local t) | 256 (put 'archive-subfile-dos 'permanent-local t) |
257 | 257 |
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 |
264 (defsubst archive-name (suffix) | 268 (defsubst archive-name (suffix) |
265 (intern (concat "archive-" (symbol-name archive-subtype) "-" suffix))) | 269 (intern (concat "archive-" (symbol-name archive-subtype) "-" suffix))) |
476 (define-key archive-mode-map "d" 'archive-flag-deleted) | 480 (define-key archive-mode-map "d" 'archive-flag-deleted) |
477 (define-key archive-mode-map "\C-d" 'archive-flag-deleted) | 481 (define-key archive-mode-map "\C-d" 'archive-flag-deleted) |
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) |
485 (define-key archive-mode-map "n" 'archive-next-line) | 488 (define-key archive-mode-map "n" 'archive-next-line) |
486 (define-key archive-mode-map "\C-n" 'archive-next-line) | 489 (define-key archive-mode-map "\C-n" 'archive-next-line) |
497 (define-key archive-mode-map "\177" 'archive-unflag-backwards) | 500 (define-key archive-mode-map "\177" 'archive-unflag-backwards) |
498 (define-key archive-mode-map "E" 'archive-extract-other-window) | 501 (define-key archive-mode-map "E" 'archive-extract-other-window) |
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")) |
559 (items (if (memq system-type '(ms-dos windows-nt)) | 574 (items (if (memq system-type '(ms-dos windows-nt)) |
560 (list item1) ; msdog has its own indicator | 575 (list item1) ; msdog has its own indicator |
615 ;; long when the archive -- which has to be moved in memory -- is large. | 630 ;; long when the archive -- which has to be moved in memory -- is large. |
616 (insert | 631 (insert |
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 |
631 (defun archive-alternate-display () | 649 (defun archive-alternate-display () |
632 "Toggle alternative display. To avoid very long lines some archive mode | 650 "Toggle alternative display. To avoid very long lines some archive mode |
684 ;; Section: Member extraction | 702 ;; Section: Member extraction |
685 | 703 |
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." |
701 (interactive) | 715 (interactive) |
702 (let* ((view-p (eq other-window-p 'view)) | 716 (let* ((view-p (eq other-window-p 'view)) |
1302 (archive-lzh-ogm newgid files "a gid" 12)) | 1316 (archive-lzh-ogm newgid files "a gid" 12)) |
1303 | 1317 |
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 |
1311 | 1325 |
1312 (defun archive-zip-summarize () | 1326 (defun archive-zip-summarize () |