Mercurial > emacs

comparison lisp/arc-mode.el @ 12024:8e31a35ac027

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(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 ()