Mercurial > emacs

comparison lisp/arc-mode.el @ 61414:9918f801db35

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(archive-mode-map): Move initialization into the declaration. Override *all* bindings of `undo'. (archive-lemacs): Remove, use (featurep 'xemacs) instead.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Sat, 09 Apr 2005 19:18:17 +0000
parents 9e01303c94ac
children ec0621e2b94f 146c086df160
comparison
equal deleted inserted replaced
61413:3e3591a70d6f 61414:9918f801db35
1 ;;; arc-mode.el --- simple editing of archives 1 ;;; arc-mode.el --- simple editing of archives
2 2
3 ;; Copyright (C) 1995, 1997, 1998, 2003 Free Software Foundation, Inc. 3 ;; Copyright (C) 1995, 1997, 1998, 2003, 2005 Free Software Foundation, Inc.
4 4
5 ;; Author: Morten Welinder <terra@gnu.org> 5 ;; Author: Morten Welinder <terra@gnu.org>
6 ;; Keywords: archives msdog editing major-mode 6 ;; Keywords: archives msdog editing major-mode
7 ;; Favourite-brand-of-beer: None, I hate beer. 7 ;; Favourite-brand-of-beer: None, I hate beer.
8 8
328 (defvar archive-file-list-start nil "Position of first contents line.") 328 (defvar archive-file-list-start nil "Position of first contents line.")
329 (defvar archive-file-list-end nil "Position just after last contents line.") 329 (defvar archive-file-list-end nil "Position just after last contents line.")
330 (defvar archive-proper-file-start nil "Position of real archive's start.") 330 (defvar archive-proper-file-start nil "Position of real archive's start.")
331 (defvar archive-read-only nil "Non-nil if the archive is read-only on disk.") 331 (defvar archive-read-only nil "Non-nil if the archive is read-only on disk.")
332 (defvar archive-local-name nil "Name of local copy of remote archive.") 332 (defvar archive-local-name nil "Name of local copy of remote archive.")
333 (defvar archive-mode-map nil "Local keymap for archive mode listings.") 333 (defvar archive-mode-map
334 (let ((map (make-keymap)))
335 (suppress-keymap map)
336 (define-key map " " 'archive-next-line)
337 (define-key map "a" 'archive-alternate-display)
338 ;;(define-key map "c" 'archive-copy)
339 (define-key map "d" 'archive-flag-deleted)
340 (define-key map "\C-d" 'archive-flag-deleted)
341 (define-key map "e" 'archive-extract)
342 (define-key map "f" 'archive-extract)
343 (define-key map "\C-m" 'archive-extract)
344 (define-key map "g" 'revert-buffer)
345 (define-key map "h" 'describe-mode)
346 (define-key map "m" 'archive-mark)
347 (define-key map "n" 'archive-next-line)
348 (define-key map "\C-n" 'archive-next-line)
349 (define-key map [down] 'archive-next-line)
350 (define-key map "o" 'archive-extract-other-window)
351 (define-key map "p" 'archive-previous-line)
352 (define-key map "q" 'quit-window)
353 (define-key map "\C-p" 'archive-previous-line)
354 (define-key map [up] 'archive-previous-line)
355 (define-key map "r" 'archive-rename-entry)
356 (define-key map "u" 'archive-unflag)
357 (define-key map "\M-\C-?" 'archive-unmark-all-files)
358 (define-key map "v" 'archive-view)
359 (define-key map "x" 'archive-expunge)
360 (define-key map "\177" 'archive-unflag-backwards)
361 (define-key map "E" 'archive-extract-other-window)
362 (define-key map "M" 'archive-chmod-entry)
363 (define-key map "G" 'archive-chgrp-entry)
364 (define-key map "O" 'archive-chown-entry)
365
366 (if (fboundp 'command-remapping)
367 (progn
368 (define-key map [remap advertised-undo] 'archive-undo)
369 (define-key map [remap undo] 'archive-undo))
370 (substitute-key-definition 'advertised-undo 'archive-undo map global-map)
371 (substitute-key-definition 'undo 'archive-undo map global-map))
372
373 (define-key map
374 (if (featurep 'xemacs) 'button2 [mouse-2]) 'archive-mouse-extract)
375
376 (if (featurep 'xemacs)
377 () ; out of luck
378
379 (define-key map [menu-bar immediate]
380 (cons "Immediate" (make-sparse-keymap "Immediate")))
381 (define-key map [menu-bar immediate alternate]
382 '(menu-item "Alternate Display" archive-alternate-display
383 :enable (boundp (archive-name "alternate-display"))
384 :help "Toggle alternate file info display"))
385 (define-key map [menu-bar immediate view]
386 '(menu-item "View This File" archive-view
387 :help "Display file at cursor in View Mode"))
388 (define-key map [menu-bar immediate display]
389 '(menu-item "Display in Other Window" archive-display-other-window
390 :help "Display file at cursor in another window"))
391 (define-key map [menu-bar immediate find-file-other-window]
392 '(menu-item "Find in Other Window" archive-extract-other-window
393 :help "Edit file at cursor in another window"))
394 (define-key map [menu-bar immediate find-file]
395 '(menu-item "Find This File" archive-extract
396 :help "Extract file at cursor and edit it"))
397
398 (define-key map [menu-bar mark]
399 (cons "Mark" (make-sparse-keymap "Mark")))
400 (define-key map [menu-bar mark unmark-all]
401 '(menu-item "Unmark All" archive-unmark-all-files
402 :help "Unmark all marked files"))
403 (define-key map [menu-bar mark deletion]
404 '(menu-item "Flag" archive-flag-deleted
405 :help "Flag file at cursor for deletion"))
406 (define-key map [menu-bar mark unmark]
407 '(menu-item "Unflag" archive-unflag
408 :help "Unmark file at cursor"))
409 (define-key map [menu-bar mark mark]
410 '(menu-item "Mark" archive-mark
411 :help "Mark file at cursor"))
412
413 (define-key map [menu-bar operate]
414 (cons "Operate" (make-sparse-keymap "Operate")))
415 (define-key map [menu-bar operate chown]
416 '(menu-item "Change Owner..." archive-chown-entry
417 :enable (fboundp (archive-name "chown-entry"))
418 :help "Change owner of marked files"))
419 (define-key map [menu-bar operate chgrp]
420 '(menu-item "Change Group..." archive-chgrp-entry
421 :enable (fboundp (archive-name "chgrp-entry"))
422 :help "Change group ownership of marked files"))
423 (define-key map [menu-bar operate chmod]
424 '(menu-item "Change Mode..." archive-chmod-entry
425 :enable (fboundp (archive-name "chmod-entry"))
426 :help "Change mode (permissions) of marked files"))
427 (define-key map [menu-bar operate rename]
428 '(menu-item "Rename to..." archive-rename-entry
429 :enable (fboundp (archive-name "rename-entry"))
430 :help "Rename marked files"))
431 ;;(define-key map [menu-bar operate copy]
432 ;; '(menu-item "Copy to..." archive-copy))
433 (define-key map [menu-bar operate expunge]
434 '(menu-item "Expunge Marked Files" archive-expunge
435 :help "Delete all flagged files from archive"))
436 map))
437 "Local keymap for archive mode listings.")
334 (defvar archive-file-name-indent nil "Column where file names start.") 438 (defvar archive-file-name-indent nil "Column where file names start.")
335 439
336 (defvar archive-remote nil "Non-nil if the archive is outside file system.") 440 (defvar archive-remote nil "Non-nil if the archive is outside file system.")
337 (make-variable-buffer-local 'archive-remote) 441 (make-variable-buffer-local 'archive-remote)
338 (put 'archive-remote 'permanent-local t) 442 (put 'archive-remote 'permanent-local t)
356 "Vector of file descriptors. 460 "Vector of file descriptors.
357 Each descriptor is a vector of the form 461 Each descriptor is a vector of the form
358 [EXT-FILE-NAME INT-FILE-NAME CASE-FIDDLED MODE ...]") 462 [EXT-FILE-NAME INT-FILE-NAME CASE-FIDDLED MODE ...]")
359 (make-variable-buffer-local 'archive-files) 463 (make-variable-buffer-local 'archive-files)
360 464
361 (defvar archive-lemacs
362 (string-match "\\(Lucid\\|Xemacs\\)" emacs-version)
363 "*Non-nil when running under under Lucid Emacs or Xemacs.")
364 ;; ------------------------------------------------------------------------- 465 ;; -------------------------------------------------------------------------
365 ;; Section: Support functions. 466 ;; Section: Support functions.
366 467
367 (defsubst archive-name (suffix) 468 (defsubst archive-name (suffix)
368 (intern (concat "archive-" (symbol-name archive-subtype) "-" suffix))) 469 (intern (concat "archive-" (symbol-name archive-subtype) "-" suffix)))
584 ;; Archive mode is suitable only for specially formatted data. 685 ;; Archive mode is suitable only for specially formatted data.
585 (put 'archive-mode 'mode-class 'special) 686 (put 'archive-mode 'mode-class 'special)
586 ;; ------------------------------------------------------------------------- 687 ;; -------------------------------------------------------------------------
587 ;; Section: Key maps 688 ;; Section: Key maps
588 689
589 (if archive-mode-map nil 690 (let ((item1 '(archive-subfile-mode " Archive")))
590 (setq archive-mode-map (make-keymap))
591 (suppress-keymap archive-mode-map)
592 (define-key archive-mode-map " " 'archive-next-line)
593 (define-key archive-mode-map "a" 'archive-alternate-display)
594 ;;(define-key archive-mode-map "c" 'archive-copy)
595 (define-key archive-mode-map "d" 'archive-flag-deleted)
596 (define-key archive-mode-map "\C-d" 'archive-flag-deleted)
597 (define-key archive-mode-map "e" 'archive-extract)
598 (define-key archive-mode-map "f" 'archive-extract)
599 (define-key archive-mode-map "\C-m" 'archive-extract)
600 (define-key archive-mode-map "g" 'revert-buffer)
601 (define-key archive-mode-map "h" 'describe-mode)
602 (define-key archive-mode-map "m" 'archive-mark)
603 (define-key archive-mode-map "n" 'archive-next-line)
604 (define-key archive-mode-map "\C-n" 'archive-next-line)
605 (define-key archive-mode-map [down] 'archive-next-line)
606 (define-key archive-mode-map "o" 'archive-extract-other-window)
607 (define-key archive-mode-map "p" 'archive-previous-line)
608 (define-key archive-mode-map "q" 'quit-window)
609 (define-key archive-mode-map "\C-p" 'archive-previous-line)
610 (define-key archive-mode-map [up] 'archive-previous-line)
611 (define-key archive-mode-map "r" 'archive-rename-entry)
612 (define-key archive-mode-map "u" 'archive-unflag)
613 (define-key archive-mode-map "\M-\C-?" 'archive-unmark-all-files)
614 (define-key archive-mode-map "v" 'archive-view)
615 (define-key archive-mode-map "x" 'archive-expunge)
616 (define-key archive-mode-map "\177" 'archive-unflag-backwards)
617 (define-key archive-mode-map "E" 'archive-extract-other-window)
618 (define-key archive-mode-map "M" 'archive-chmod-entry)
619 (define-key archive-mode-map "G" 'archive-chgrp-entry)
620 (define-key archive-mode-map "O" 'archive-chown-entry)
621
622 (if archive-lemacs
623 (progn
624 ;; Not a nice "solution" but it'll have to do
625 (define-key archive-mode-map "\C-xu" 'archive-undo)
626 (define-key archive-mode-map "\C-_" 'archive-undo))
627 (define-key archive-mode-map [remap advertised-undo] 'archive-undo)
628 (define-key archive-mode-map [remap undo] 'archive-undo))
629
630 (define-key archive-mode-map
631 (if archive-lemacs 'button2 [mouse-2]) 'archive-mouse-extract)
632
633 (if archive-lemacs
634 () ; out of luck
635
636 (define-key archive-mode-map [menu-bar immediate]
637 (cons "Immediate" (make-sparse-keymap "Immediate")))
638 (define-key archive-mode-map [menu-bar immediate alternate]
639 '(menu-item "Alternate Display" archive-alternate-display
640 :enable (boundp (archive-name "alternate-display"))
641 :help "Toggle alternate file info display"))
642 (define-key archive-mode-map [menu-bar immediate view]
643 '(menu-item "View This File" archive-view
644 :help "Display file at cursor in View Mode"))
645 (define-key archive-mode-map [menu-bar immediate display]
646 '(menu-item "Display in Other Window" archive-display-other-window
647 :help "Display file at cursor in another window"))
648 (define-key archive-mode-map [menu-bar immediate find-file-other-window]
649 '(menu-item "Find in Other Window" archive-extract-other-window
650 :help "Edit file at cursor in another window"))
651 (define-key archive-mode-map [menu-bar immediate find-file]
652 '(menu-item "Find This File" archive-extract
653 :help "Extract file at cursor and edit it"))
654
655 (define-key archive-mode-map [menu-bar mark]
656 (cons "Mark" (make-sparse-keymap "Mark")))
657 (define-key archive-mode-map [menu-bar mark unmark-all]
658 '(menu-item "Unmark All" archive-unmark-all-files
659 :help "Unmark all marked files"))
660 (define-key archive-mode-map [menu-bar mark deletion]
661 '(menu-item "Flag" archive-flag-deleted
662 :help "Flag file at cursor for deletion"))
663 (define-key archive-mode-map [menu-bar mark unmark]
664 '(menu-item "Unflag" archive-unflag
665 :help "Unmark file at cursor"))
666 (define-key archive-mode-map [menu-bar mark mark]
667 '(menu-item "Mark" archive-mark
668 :help "Mark file at cursor"))
669
670 (define-key archive-mode-map [menu-bar operate]
671 (cons "Operate" (make-sparse-keymap "Operate")))
672 (define-key archive-mode-map [menu-bar operate chown]
673 '(menu-item "Change Owner..." archive-chown-entry
674 :enable (fboundp (archive-name "chown-entry"))
675 :help "Change owner of marked files"))
676 (define-key archive-mode-map [menu-bar operate chgrp]
677 '(menu-item "Change Group..." archive-chgrp-entry
678 :enable (fboundp (archive-name "chgrp-entry"))
679 :help "Change group ownership of marked files"))
680 (define-key archive-mode-map [menu-bar operate chmod]
681 '(menu-item "Change Mode..." archive-chmod-entry
682 :enable (fboundp (archive-name "chmod-entry"))
683 :help "Change mode (permissions) of marked files"))
684 (define-key archive-mode-map [menu-bar operate rename]
685 '(menu-item "Rename to..." archive-rename-entry
686 :enable (fboundp (archive-name "rename-entry"))
687 :help "Rename marked files"))
688 ;;(define-key archive-mode-map [menu-bar operate copy]
689 ;; '(menu-item "Copy to..." archive-copy))
690 (define-key archive-mode-map [menu-bar operate expunge]
691 '(menu-item "Expunge Marked Files" archive-expunge
692 :help "Delete all flagged files from archive"))
693 ))
694
695 (let* ((item1 '(archive-subfile-mode " Archive"))
696 (items (list item1)))
697 (or (member item1 minor-mode-alist) 691 (or (member item1 minor-mode-alist)
698 (setq minor-mode-alist (append items minor-mode-alist)))) 692 (setq minor-mode-alist (cons item1 minor-mode-alist))))
699 ;; ------------------------------------------------------------------------- 693 ;; -------------------------------------------------------------------------
700 (defun archive-find-type () 694 (defun archive-find-type ()
701 (widen) 695 (widen)
702 (goto-char (point-min)) 696 (goto-char (point-min))
703 ;; The funny [] here make it unlikely that the .elc file will be treated 697 ;; The funny [] here make it unlikely that the .elc file will be treated
760 (function 754 (function
761 (lambda (fil) 755 (lambda (fil)
762 ;; Using `concat' here copies the text also, so we can add 756 ;; Using `concat' here copies the text also, so we can add
763 ;; properties without problems. 757 ;; properties without problems.
764 (let ((text (concat (aref fil 0) "\n"))) 758 (let ((text (concat (aref fil 0) "\n")))
765 (if archive-lemacs 759 (if (featurep 'xemacs)
766 () ; out of luck 760 () ; out of luck
767 (add-text-properties 761 (add-text-properties
768 (aref fil 1) (aref fil 2) 762 (aref fil 1) (aref fil 2)
769 '(mouse-face highlight 763 '(mouse-face highlight
770 help-echo "mouse-2: extract this file into a buffer") 764 help-echo "mouse-2: extract this file into a buffer")
1807 ;; rms 15 Oct 98 1801 ;; rms 15 Oct 98
1808 (provide 'archive-mode) 1802 (provide 'archive-mode)
1809 1803
1810 (provide 'arc-mode) 1804 (provide 'arc-mode)
1811 1805
1812 ;;; arch-tag: e5966a01-35ec-4f27-8095-a043a79b457b 1806 ;; arch-tag: e5966a01-35ec-4f27-8095-a043a79b457b
1813 ;;; arc-mode.el ends here 1807 ;;; arc-mode.el ends here