emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/cpio-mode 38a59a6 59/61: Renamed from cpio.el.


From: Stefan Monnier
Subject: [elpa] externals/cpio-mode 38a59a6 59/61: Renamed from cpio.el.
Date: Fri, 11 Jan 2019 15:25:39 -0500 (EST)

branch: externals/cpio-mode
commit 38a59a651db39679b72cc202cf6e227617e5fabd
Author: Douglas Lewan <address@hidden>
Commit: Douglas Lewan <address@hidden>

    Renamed from cpio.el.
---
 cpio-mode.el | 2036 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 2036 insertions(+)

diff --git a/cpio-mode.el b/cpio-mode.el
new file mode 100644
index 0000000..3c1fdf6
--- /dev/null
+++ b/cpio-mode.el
@@ -0,0 +1,2036 @@
+;;; cpio-mode.el --- Handle cpio archives in the style of dired. -*- coding: 
utf-8 -*-
+
+;; Author: Douglas Lewan <address@hidden>
+;; Maintainer: Douglas Lewan <address@hidden>
+;; Version: 0.16β
+;; Long description: cpio-mode provides a dired-like interface for working 
with cpio archives. You can view, edit and save entries. You can also change 
permissions, UID, etc.
+;; Dependencies: (bindat 24.5) (cl 24.5) (ert 24.5)
+;; Created: 2015 Jan 03
+;; Package-Type: multi
+;; Keywords: files
+
+;; Copyright © 2019 Free Software Foundation, Inc.
+;; All rights reserved.
+;; 
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+
+;;; Commentary:
+
+;; This package implements cpio-mode,
+;; a mode for working with cpio archives
+;; through a dired-like interface.
+
+
+;;; Documentation:
+
+;; 
+;; NAME: cpio-mode
+;; 
+;; USAGE:
+;;     (load-library 'cpio-mode) OR
+;;     (require 'cpio-mode)
+;;
+;;     Once loaded, there are several ways to invoke cpio-mode:
+;; 
+;;     • M-x cpio-mode
+;; 
+;;     • If you want to put a cpio-archive into cpio-mode autmatically,
+;;       then add the following to your .emacs:
+;;         (add-hook 'find-file-hook 'cpio-mode-find-file-hook)
+;;
+;;     • Another way to do this would be to modify magic-mode-alist
+;;         (setq magic-mode-alist
+;;              (add-to-list 'magic-mode-alist
+;;                           (cons 'cpio-discern-archive-type 'cpio-mode))).
+;;
+;;     • If you only care about archives that end .cpio,
+;;       then the following would also work:
+;;         (setq auto-mode-alist
+;;               (add-to-list 'auto-mode-alist (cons "\\.cpio\\'" 
'cpio-mode))).
+;; 
+;; DESCRIPTION:
+;;     cpio-mode presents a cpio archive as if it were a directory
+;;     in a manner like dired-mode.
+;;     tar-mode already does such a thing for tar archives,
+;;     and some ideas (and likely code) have been adapted from tar-mode.
+;; 
+;;     To automatically invoke cpio-mode when finding a file
+;;     add the following to your find-file-hook.
+;; 
+;;     You can use toggle-cpio-mode to switch between cpio-mode
+;;     and fundamental mode.
+;; 
+;; KEYMAP:
+;;     This should be conceptually as close to dired as I can make it.
+;; 
+;; OPTIONS:
+;; 
+;; ENVIRONMENT:
+;;     Early development was done under emacs 24.2
+;;     on the Fedora 18 distribution of 64 bit GNU/Linux.
+;; 
+;;     Later development happened under emacs 24.5
+;;     on GNU/Linux Mint, Linux kernel 4.4.0.
+;;
+;;     Current development is happening on emacs 24.5
+;;     on GNU/Linux Trisquel, Linux Kernel 4.4.0.
+;; 
+;; RETURN CODE:
+;; 
+;; NOTES:
+;;     Binary formats are not yet implemented.
+;; 
+;; CAVEATS:
+;;     Only regular files can be edited.
+;;     I'm not sure what to do with symbolic links yet.
+;; 
+;; SECURITY ISSUES:
+;;     There are no ownership/group-ship tests on anything.
+;;     You could create an archive with bad behavior
+;;     (for example, a set-uid executable)
+;;     when unpacked by root.
+;; 
+
+;; 
+;; cpio-mode.el is the entry point to all of cpio-mode code.
+;; It defines the archive management variables and functions
+;; that define cpio-mode.
+;; That said, there are other components.
+;; 1. There's some generically useful code
+;;    defined in
+;;    • cpio-generic.el, truly generic code,
+;;    • cpio-modes.el, file-mode related information,
+;; 2. Every archive format has its own file: 
+;;    cpio-bin for the cpio binary format,
+;;    cpio-crc for the cpio CRC format,
+;;    etc.
+;; 3. cpio-mode.el, this file, defining the cpio logic
+;;    reflected in the catalog,
+;;    a list of the information of all the headers
+;;    in the current archive.
+;; 4. The package cpio-dired, defining the user interface.
+;; 
+;; The following figure shows the relationships
+;; among those components.
+;; 
+;; +----------------------+   +-------------+   +-------------+
+;; | Format specific code |   |             |   |             |
+;; | +---------------+    |   |             |   |             |
+;; | | cpio-bin      |    |   |             |   |             |
+;; | | +--------------+   |   |    CPIO     |   | dired-like  |
+;; | +-|cpio-crc      |   |<->|    Logic    |<->|     UI      |
+;; |   | +-------------+  |   |             |   |             |
+;; |   +-| hpbin       |  |   |             |   |             |
+;; |     | +------------+ |   |             |   |             |
+;; |     +-| ···        | |   |             |   |             |
+;; |       +------------+ |   |             |   |             |
+;; +----------------------+   +-------------+   +-------------+
+;;             Λ                     Λ                 Λ
+;;             |                     |                 |
+;;             V                     V                 V
+;; +----------------------------------------------------------+
+;; | generic code                                             |
+;; |          +------------+ +--------------+ +-----+         |
+;; |          | cpio-modes | | cpio-generic | | ··· |         |
+;; |          +------------+ +--------------+ +-----+         |
+;; +----------------------------------------------------------+
+;; 
+;; The basic idea is that the format-spedific code parses and makes headers
+;; while all the cpio logic uses those parsed headers to edit
+;; and calls format-specific parsing and making functions.
+;; 
+;; The main data structures are the following.
+;; 
+;; 0. Parsed headers, an inode-like array structure.
+;; 
+;; 1. Entries, an array containing a parsed header,
+;;    the header start and the contents start.
+;; 
+;; 2. The catalog, a list of the entries in the cpio archive,
+;;    including the trailer.
+;; 
+;; 3. The buffer holding the archive.
+;;    This buffer is put into cpio-mode.
+;;    It holds all the "global" data,
+;;    like the catalog described above.
+;; 
+;; 4. The buffer holding the dired-like UI.
+;;    cpio-mode creates this buffer and
+;;    puts this buffer into cpio-dired-mode.
+;; 
+;; 5. Buffers visiting entries.
+;;    cpio-dired-mode uses the archive buffer
+;;    to get entry contents and them in the visiting buffer.
+;;    cpio-dired-mode puts that buffer in cpio-entry-contents-mode,
+;;    a minor mode that handles editing and saving
+;;    an entry's contents.
+
+;;; Naming conventions.
+
+;;
+;; All files that define cpio-mode begin with "cpio."
+;; 
+;; Global variables all begin '*cpio-...'.
+;; Functions are named 'cpio-...'.
+;; 
+;; The corresponding archive format specific names for format FMT
+;; begin '*cpio-FMT-...' and 'cpio-FMT-...'.
+;; The format-specific variables names are calculated
+;; in (cpio-set-local-vars).
+;; That function drops directly into corresponding format-specific functions
+;;     
+;; The format-specific function names are calculated
+;; in (cpio-set-local-funcs).
+;; Here is the process:
+;;     cpio-do-good-stuff-func
+;;     --> "cpio-do-good-stuff-func"
+;;     --> "cpio" "do" "good" "stuff"
+;;     --> "cpio-fmt-do-good-stuff"
+;;     --> cpio-fmt-do-good-stuff
+;; 
+;; The index of FIELD within a parsed header is named 'cpio-FIELD-parsed-idx'.
+;;
+;; Each archive format FMT has a regular expression
+;; that identifies that format unambiguously called '*cpio-FMT-header-re*'.
+;; 
+;; The functions (cpio-get-FIELD) operate directly on the header
+;; to extract FIELD.
+;; It's not clear that these need to be defined here.
+;;
+;; The functions (cpio-FIELD) operate on a parsed header
+;; to extract FIELD.
+;; 
+;; Depending on the context the expression "entry attributes",
+;; often abbreviated "attrs", and the phrase "parsed header"
+;; are used to reference the structure
+;; that stores inode-like information (mode, size, user, etc.).
+;; Truly, the expressions are semantically equivalent.
+;; However, "parsed header" is used where the topic at hand is
+;; the archive, and
+;; "entry attributes" is used where the topic at hand is
+;; the internal processing within cpio-mode.
+;;
+;; An "entry" is, somewhat ambiguously, either an entry in the archive
+;; or a member of the catalog.
+;; The context should make it clear which is intended.
+;; Yes, in principle they're isomorphic.
+;; (And, yes, I hate specifications that depend on context.)
+;; 
+
+;;; Code:
+
+;;
+;; Dependencies
+;; 
+
+
+(require 'dired)
+
+(require 'cpio-generic)
+(require 'cpio-modes)
+
+(require 'cpio-affiliated-buffers)
+
+(require 'cpio-bin)
+;; While I like things to be alphabetical, newc /must/ precede crc.
+(require 'cpio-newc)
+(require 'cpio-crc)
+(require 'cpio-hpbin)
+(require 'cpio-hpodc)
+(require 'cpio-odc)
+(require 'cpio-dired)
+(require 'cpio-entry-contents-mode)
+
+;; Formats not supported:
+;;   (require 'cpio-tar)
+;;   (require 'cpio-ustar)
+
+;;;;;;;;;;;;;;;;
+;; Things to make the byte compiler happy.
+(defvar *cpio-catalog-entry-attrs-idx*)
+(defvar *cpio-catalog-entry-contents-start-idx*)
+(defvar *cpio-catalog-entry-header-start-idx*)
+(defvar *cpio-catalog-entry-length*)
+(defvar *cpio-catalog-entry-modified-flag-idx*)
+(defvar *cpio-chksum-parsed-idx*)
+(defvar *cpio-crc-header-re*)
+(defvar *cpio-crc-padding-char*)
+(defvar *cpio-crc-padding-modulus*)
+(defvar *cpio-crc-padding-str*)
+(defvar *cpio-dev-maj-parsed-idx*)
+(defvar *cpio-dev-min-parsed-idx*)
+(defvar *cpio-entry-size-parsed-idx*)
+(defvar *cpio-gid-parsed-idx*)
+(defvar *cpio-ino-parsed-idx*)
+(defvar *cpio-mode-parsed-idx*)
+(defvar *cpio-mtime-parsed-idx*)
+(defvar *cpio-name-parsed-idx*)
+(defvar *cpio-namesize-parsed-idx*)
+(defvar *cpio-newc-header-re*)
+(defvar *cpio-newc-padding-char*)
+(defvar *cpio-newc-padding-modulus*)
+(defvar *cpio-newc-padding-str*)
+(defvar *cpio-nlink-parsed-idx*)
+(defvar *cpio-odc-header-re*)
+(defvar *cpio-odc-padding-char*)
+(defvar *cpio-odc-padding-modulus*)
+(defvar *cpio-odc-padding-str*)
+(defvar *cpio-parsed-header-length*)
+(defvar *cpio-rdev-maj-parsed-idx*)
+(defvar *cpio-rdev-min-parsed-idx*)
+(defvar *cpio-uid-parsed-idx*)
+(defvar cpio-entry-name)
+(defvar cpio-try-names)
+;;;; (declare-function cpio-contents-buffer-name "cpio-dired.el")
+(declare-function cpio-dired-buffer-name "cpio-dired.el")
+(declare-function cpio-dired-move-to-first-entry "cpio-dired.el")
+(declare-function cpio-dired-next-line "cpio-dired.el")
+(declare-function cpio-entry-contents-mode "cpio-entry-contents-mode.el")
+(declare-function cpio-present-ala-dired "cpio-dired.el")
+;; EO things for the byte compiler.
+;;;;;;;;;;;;;;;;
+
+
+;; 
+;; Vars
+;; 
+(defvar *cpio-format* ()
+  "The format of the cpio archive in the current-buffer.
+Takes the values 'bin, 'newc, 'odc etc.")
+(setq *cpio-format* ())
+
+(make-variable-buffer-local '*cpio-format*)
+
+;; N.B. The format REs go here since they are what we use
+;; to discern the type of the archive.
+
+(defvar *cpio-tar-header-re* "not yet set"
+  "RE to match tar format cpio archives.")
+(setq *cpio-tar-header-re* "not yet set")
+
+
+(defvar *cpio-ustar-header-re* "not yet set"
+  "RE to match ustar format cpio archives.")
+(setq *cpio-ustar-header-re* "not yet set")
+
+
+(defvar *cpio-hpbin-header-re* "not yet set"
+  "RE to match hpbin format cpio archives.")
+(setq *cpio-hpbin-header-re* "not yet set")
+
+
+(defvar *cpio-hpodc-header-re* "not yet set"
+  "RE to match hpodc format cpio archives.")
+(setq *cpio-hpodc-header-re* "not yet set")
+
+
+;; MAINTENTANCE Order matters; hpodc must precede odc.
+(defvar *cpio-re-type-alist* (list
+                             (cons *cpio-bin-header-re*   'bin)
+                             (cons *cpio-crc-header-re*   'crc)
+                             (cons *cpio-hpbin-header-re* 'hpbin)
+                             (cons *cpio-hpodc-header-re* 'hpodc)
+                             (cons *cpio-newc-header-re*  'newc)
+                             (cons *cpio-odc-header-re*   'odc)
+                             (cons *cpio-tar-header-re*   'tar)
+                             (cons *cpio-ustar-header-re* 'ustar))
+  "Association list matching REs defining cpio entry header types
+with their corresponding archive types.
+The archive types are symbols: 'bin, 'newc, 'odc, etc.
+See `cpio-discern-archive-type' for the full list.")
+(setq *cpio-re-type-alist* (list
+                           (cons *cpio-bin-header-re*   'bin)
+                           (cons *cpio-crc-header-re*   'crc)
+                           (cons *cpio-hpbin-header-re* 'hpbin)
+                           (cons *cpio-hpodc-header-re* 'hpodc)
+                           (cons *cpio-newc-header-re*  'newc)
+                           (cons *cpio-odc-header-re*   'odc)
+                           (cons *cpio-tar-header-re*   'tar)
+                           (cons *cpio-ustar-header-re* 'ustar)))
+
+(defvar cpio-build-catalog-func ()
+  "The function for building the catalog of a specific archive format.")
+(setq cpio-build-catalog-func ())
+
+
+(defvar cpio-parse-header-func ()
+  "")
+(setq cpio-parse-header-func ())
+
+(defvar cpio-header-at-point-func ()
+  "")
+(setq cpio-header-at-point-func ())
+
+(defvar OBS-cpio-get-magic-func ()
+  "")
+(setq OBS-cpio-get-magic-func ())
+
+(defvar OBS-cpio-get-ino-func ()
+  "")
+(setq OBS-cpio-get-ino-func ())
+
+(defvar OBS-cpio-get-mode-func ()
+  "")
+(setq OBS-cpio-get-mode-func ())
+
+(defvar OBS-cpio-get-uid-func ()
+  "")
+(setq OBS-cpio-get-uid-func ())
+
+(defvar OBS-cpio-get-gid-func ()
+  "")
+(setq OBS-cpio-get-gid-func ())
+
+(defvar OBS-cpio-get-nlink-func ()
+  "")
+(setq OBS-cpio-get-nlink-func ())
+
+(defvar OBS-cpio-get-mtime-min-func ()
+  "")
+(setq OBS-cpio-get-mtime-min-func ())
+
+(defvar OBS-cpio-get-filesize-func ()
+  "")
+(setq OBS-cpio-get-filesize-func ())
+
+(defvar OBS-cpio-get-dev-maj-func ()
+  "")
+(setq OBS-cpio-get-dev-maj-func ())
+
+(defvar OBS-cpio-get-dev-min-func ()
+  "")
+(setq OBS-cpio-get-dev-min-func ())
+
+(defvar OBS-cpio-get-rdev-maj-func ()
+  "")
+(setq OBS-cpio-get-rdev-maj-func ())
+
+(defvar OBS-cpio-get-rdev-min-func ()
+  "")
+(setq OBS-cpio-get-rdev-min-func ())
+
+(defvar OBS-cpio-get-namesize-func ()
+  "")
+(setq OBS-cpio-get-namesize-func ())
+
+(defvar OBS-cpio-get-chksum-func ()
+  "")
+(setq OBS-cpio-get-chksum-func ())
+
+(defvar OBS-cpio-get-name-func ()
+  "")
+(setq OBS-cpio-get-name-func ())
+
+(defvar OBS-cpio-get-contents-func ()
+  "")
+(setq OBS-cpio-get-contents-func ())
+
+(defvar cpio-make-header-string-func ()
+  "")
+(setq cpio-make-header-string-func ())
+
+(defvar cpio-adjust-trailer-func ()
+  "")
+
+(defvar cpio-insert-trailer-func ()
+  "")
+
+(defvar cpio-delete-trailer-func ()
+  "")
+
+(defvar cpio-make-chksum-for-file-func ()
+  "")
+
+(defvar *cpio-local-funcs* ()
+  "A list of variables peculiar to the different headers and their fields.
+The design here is that package-wide variables have the prefix `cpio-'
+and the corresponding functions for a specific format FMT have the form 
`cpio-FMT-'.
+All of this can then be calculated via (symbol-name), etc.")
+(setq *cpio-local-funcs* (list
+                         ;; Catalog management
+                         'cpio-build-catalog-func
+                         'cpio-make-chksum-for-file-func
+                         ;; Header parsing functions
+                         'cpio-end-of-archive-func
+                         'cpio-start-of-trailer-func
+                         ;; Header making functions
+                         'cpio-make-chksum-func
+                         'cpio-make-header-string-func
+                         ;; Archive manipulation functions
+                         'cpio-adjust-trailer-func
+                         'cpio-insert-trailer-func
+                         'cpio-delete-trailer-func))
+;; (make-variable-buffer-local '*cpio-local-funcs*)
+
+(defvar *cpio-catalog* ()
+  "The variable that holds the catalog of entries in cpio-mode.
+Each entry has the following form:
+    name
+    [parsed-header
+     header-start
+     content-start
+     modified-flag].
+• name is the name of the entry
+• parsed-header has the description below.
+• header-start and content-start are markers,
+  so they should be automatically updated
+  with modifications to the buffer.
+• Don't use (aref) to get at these; use an accessor function.
+The last entry should is always be the TRAILER entry.
+
+A parsed header is a vector of the following form:
+    [inode
+     mode
+     uid
+     gid
+
+     nlink
+     mtime
+     filesize
+     dev-maj
+
+     dev-min
+     rdev-maj
+     rdev-min
+     name-size
+
+     chksum
+     name].")
+(make-variable-buffer-local '*cpio-catalog*)
+(setq *cpio-catalog* ())
+
+(let ((i 0))
+  ;; (defvar *cpio-catalog-entry-name-idx* i)
+  ;; (setq i (1+ i))
+  (defvar *cpio-catalog-entry-attrs-idx* i)
+  (setq *cpio-catalog-entry-attrs-idx* i)
+  
+  (setq i (1+ i))
+  (defvar *cpio-catalog-entry-header-start-idx* i)
+  (setq *cpio-catalog-entry-header-start-idx* i)
+  
+  (setq i (1+ i))
+  (defvar *cpio-catalog-entry-contents-start-idx* i)
+  (setq *cpio-catalog-entry-contents-start-idx* i)
+
+  (setq i (1+ i))
+  (defvar *cpio-catalog-entry-modified-flag-idx* i)
+  (setq *cpio-catalog-entry-modified-flag-idx* i)
+
+  (setq i (1+ i))
+  (defvar *cpio-catalog-entry-length* i)
+  (setq *cpio-catalog-entry-length* i))
+
+(defvar *cpio-archive-name* ()
+  "The name of the cpio archive being processed.")
+(setq *cpio-archive-name* ())
+(make-variable-buffer-local '*cpio-archive-names*)
+
+;; Indexes for the fields in a parsed header.
+(let ((i 0))
+  (defvar *cpio-ino-parsed-idx* i)
+  (setq *cpio-ino-parsed-idx* i)
+
+  (setq i (1+ i))
+  (defvar *cpio-mode-parsed-idx* i)
+  (setq *cpio-mode-parsed-idx* i)
+
+  (setq i (1+ i))
+  (defvar *cpio-uid-parsed-idx* i)
+  (setq *cpio-uid-parsed-idx* i)
+
+  (setq i (1+ i))
+  (defvar *cpio-gid-parsed-idx* i)
+  (setq *cpio-gid-parsed-idx* i)
+
+  (setq i (1+ i))
+  (defvar *cpio-nlink-parsed-idx* i)
+  (setq *cpio-nlink-parsed-idx* i)
+
+  (setq i (1+ i))
+  (defvar *cpio-mtime-parsed-idx* i)
+  (setq *cpio-mtime-parsed-idx* i)
+
+  (setq i (1+ i))
+  (defvar *cpio-entry-size-parsed-idx* i)
+  (setq *cpio-entry-size-parsed-idx* i)
+
+  (setq i (1+ i))
+  (defvar *cpio-dev-maj-parsed-idx* i)
+  (setq *cpio-dev-maj-parsed-idx* i)
+
+  (setq i (1+ i))
+  (defvar *cpio-dev-min-parsed-idx* i)
+  (setq *cpio-dev-min-parsed-idx* i)
+
+  (setq i (1+ i))
+  (defvar *cpio-rdev-maj-parsed-idx* i)
+  (setq *cpio-rdev-maj-parsed-idx* i)
+
+  (setq i (1+ i))
+  (defvar *cpio-rdev-min-parsed-idx* i)
+  (setq *cpio-rdev-min-parsed-idx* i)
+
+  (setq i (1+ i))
+  (defvar *cpio-namesize-parsed-idx* i)
+  (setq *cpio-namesize-parsed-idx* i)
+
+  (setq i (1+ i))
+  (defvar *cpio-chksum-parsed-idx* i)
+  (setq *cpio-chksum-parsed-idx* i)
+
+  (setq i (1+ i))
+  (defvar *cpio-name-parsed-idx* i)
+  (setq *cpio-name-parsed-idx* i)
+
+  (setq i (1+ i))
+  (defvar *cpio-parsed-header-length* i
+    "The length of a parsed header (attribute vector).")
+  (setq *cpio-parsed-header-length* i))
+
+(defvar *cpio-padding-modulus* ()
+  "The modulus to be used for building padded strings.")
+(setq *cpio-padding-modulus* ())
+
+(defvar *cpio-padding-char* ()
+  "The character to be used for building padded strings.")
+(setq *cpio-padding-char* ())
+
+(defvar *cpio-padding-str* ()
+  "A single character string of the character to be used for building padded 
strings.")
+(setq *cpio-padding-str* ())
+
+
+(defvar *cpio-archive-syntax-table* ()
+  "Every character in a cpio archive has word syntax.")
+(setq *cpio-archive-syntax-table* ())
+
+
+(defvar *cpio-header-length* ()
+  "A buffer-local variable to hold the length of the header
+for a cpio archive of the current format.")
+(setq *cpio-header-length* ())
+
+
+
+;;
+;; Customizations
+;; 
+(defgroup cpio ()
+  "Customizations for cpio-mode."
+  :group 'data)
+
+(defcustom cpio-default-format "newc"
+  "The default cpio format to use for a new or empty archive."
+  :type 'string
+  :group 'cpio)
+
+
+;; 
+;; Library
+;; 
+
+(defun cpio-mode-find-file-hook ()
+  "find-file hook to detect if a file is likely a cpio archive.
+If it is, then put it under cpio-mode."
+  (let ((fname "cpio-mode-find-file-hook"))
+    (if (cpio-discern-archive-type)
+       (cpio-mode))))
+
+(defun cpio-discern-archive-type ()
+  "Return a symbol reflecting the type of the cpio archive in the current 
buffer.
+Values are 'bin, 'newc, 'odc, 'crc, 'tar, 'ustar, 'hpbin, 'hpodc
+and NIL if the current buffer does not begin with a cpio entry header."
+  ;; Using a RE may not be the right way to go.
+  ;; Maybe each format needs a function.
+  (let ((fname "cpio-discern-archive-type")
+       (this-archive-type ()))
+    (unless *cpio-archive-syntax-table*
+      (setq *cpio-archive-syntax-table* (make-syntax-table))
+      (let ((i 0))
+       (while (< i #x100)
+         (modify-syntax-entry i "w" *cpio-archive-syntax-table*)
+         (setq i (1+ i)))))
+    (with-syntax-table *cpio-archive-syntax-table*
+      (save-excursion
+       (widen)
+       (goto-char (point-min))
+       (catch 'found-it
+         (mapc (lambda (archive-spec)
+                 (cond ((looking-at-p (car archive-spec))
+                        (setq this-archive-type (cdr archive-spec))
+                        (throw 'found-it t))
+                       (t t)))
+               *cpio-re-type-alist*))))
+    this-archive-type))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Header handling
+
+;; HEREHERE I think all these (funcall)s need to be wrapped with *s.
+(defun cpio-parse-header (header-str)
+  "Return the internal entry header structure encoded in HEADER-STR."
+  (let ((fname "cpio-parse-header"))
+    (funcall cpio-parse-header-func header-str)))
+
+(defun OBS-cpio-header-at-point (&optional where)
+  "Return the header string at or following point WHERE.
+If WHERE is not given, then use point.
+CAVEAT: This searches for the magic number at the begining of the header;
+if WHERE is inside the magic number, then the search will fail."
+  (unless where (setq where (point)))
+  (let ((fname "cpio-header-at-point"))
+    (funcall cpio-header-at-point-func where)))
+
+(defun cpio-ino (parsed-header)
+  "Return the inode in PARSED-HEADER.
+CAVEAT: See `cpio-magic'."
+  (let ((fname "cpio-ino"))
+    (aref parsed-header *cpio-ino-parsed-idx*)))
+
+(defun cpio-mode-value (parsed-header)
+  "Return the mode (as an integer) in PARSED-HEADER.
+CAVEAT: See `cpio-magic'."
+  (let ((fname "cpio-mode"))
+    (aref parsed-header *cpio-mode-parsed-idx*)))
+
+(defun cpio-uid (parsed-header)
+  "Return the UID (as an integer) in PARSED-HEADER.
+CAVEAT: See `cpio-magic'."
+  (let ((fname "cpio-uid"))
+    (aref parsed-header *cpio-uid-parsed-idx*)))
+
+(defun cpio-gid (parsed-header)
+  "Return the GID (as an integer) in PARSED-HEADER.
+CAVEAT: See `cpio-magic'."
+  (let ((fname "cpio-gid"))
+    (aref parsed-header *cpio-gid-parsed-idx*)))
+
+(defun cpio-nlink (parsed-header)
+  "Return the number of links in PARSED-HEADER.
+CAVEAT: See `cpio-magic'."
+  (let ((fname "cpio-nlink"))
+    (aref parsed-header *cpio-nlink-parsed-idx*)))
+
+(defun cpio-mtime (parsed-header)
+  "Return the mod time (emacs time structure) in PARSED-HEADER.
+CAVEAT: See `cpio-magic'."
+  (let ((fname "cpio-mtime"))
+    (aref parsed-header *cpio-mtime-parsed-idx*)))
+
+(defun cpio-entry-size (parsed-header)
+  "Return the size of the contents in PARSED-HEADER.
+CAVEAT: See `cpio-magic'."
+  (let ((fname "cpio-entry-size"))
+    (aref parsed-header *cpio-entry-size-parsed-idx*)))
+
+(defun cpio-dev-maj (parsed-header)
+  "Return the dev maj in PARSED-HEADER.
+CAVEAT: See `cpio-magic'."
+  (let ((fname "cpio-dev"))
+    (aref parsed-header *cpio-dev-maj-parsed-idx*)))
+
+(defun cpio-dev-min (parsed-header)
+  "Return the dev in PARSED-HEADER.
+CAVEAT: See `cpio-magic'."
+  (let ((fname "cpio-dev-min"))
+    (aref parsed-header *cpio-dev-min-parsed-idx*)))
+
+(defun cpio-rdev-maj (parsed-header)
+  "Return the rdev maj in PARSED-HEADER.
+CAVEAT: See `cpio-magic'."
+  (let ((fname "cpio-rdev-maj"))
+    (aref parsed-header *cpio-rdev-maj-parsed-idx*)))
+
+(defun cpio-rdev-min (parsed-header)
+  "Return the rdev in PARSED-HEADER.
+CAVEAT: See `cpio-magic'."
+  (let ((fname "cpio-rdev-min"))
+    (aref parsed-header *cpio-rdev-min-parsed-idx*)))
+
+(defun cpio-namesize (parsed-header)
+  "Return the size of the name  in PARSED-HEADER.
+CAVEAT: See `cpio-magic'."
+  (let ((fname "cpio-namesize"))
+    (aref parsed-header *cpio-namesize-parsed-idx*)))
+
+(defun cpio-entry-name (parsed-header)
+  "Return the name in PARSED-HEADER.
+CAVEAT: See `cpio-magic'."
+  (let ((fname "cpio-name"))
+    (aref parsed-header *cpio-name-parsed-idx*)))
+
+(defun cpio-chksum (parsed-header)
+  "Return the checksum in PARSE-HEADER."
+  (let ((fname "cpio-chksum"))
+    (aref *cpio-chksum-parsed-idx* parsed-header)))
+
+(defun cpio-contents-start (entry-name)
+  "Return the contents start for ENTRY-NAME."
+  (let ((fname "cpio-contents-start")
+       (catalog-entry (cpio-entry entry-name)))
+    (aref catalog-entry *cpio-catalog-entry-contents-start-idx*)))
+
+(defun cpio-entry-attrs (entry-name)
+  "Retrieve the entry attributes for ENTRY-NAME."
+  (let ((fname "cpio-entry-attrs"))
+    (if *cab-parent*
+       (with-current-buffer *cab-parent*
+         (cpio-entry-attrs entry-name))
+      (aref (cpio-entry entry-name) *cpio-catalog-entry-attrs-idx*))))
+
+(defun cpio-entry-header-start (entry)
+  "Return the start of the entry specified in ENTRY."
+  (let ((fname "cpio-entry-header-start"))
+    (aref entry *cpio-catalog-entry-header-start-idx*)))
+
+;; HEREHERE This isn't right yet.
+;; It's being introduced to fix the acrobatics in (cpio-internal-do-deletion).
+(defun cpio-entry-header-end (entry)
+  "Return the end of the unpadded header specified in ENTRY."
+  (let ((fname "cpio-entry-header-end")
+       (attrs (aref entry *cpio-catalog-entry-attrs-idx*)))
+    (+ (cpio-entry-header-start entry) *cpio-header-length* (cpio-namesize 
attrs))
+    ))
+
+(defun cpio-entry-contents-start (entry)
+  "Return the start of the contents of the entry specified in ENTRY."
+  (let ((fname "cpio-entry-contents-start"))
+    (aref entry *cpio-catalog-entry-contents-start-idx*)))
+
+(defun cpio-entry-contents-end (entry)
+  "Return the end of the contents of the entry specified in ENTRY."
+  (let* ((fname "cpio-entry-contents-end")
+        (attrs (aref entry *cpio-catalog-entry-attrs-idx*))
+        (entry-name (cpio-entry-name attrs)))
+    (+ (cpio-entry-contents-start entry)
+       (cpio-entry-size attrs))))
+
+(defun cpio-set-header-start (entry where)
+  "Set the header start marker in ENTRY to the location WHERE."
+  (let ((fname "cpio-set-header-start")
+       (where-marker (cond ((integerp where)
+                            (set-marker (make-marker) where))
+                           ((markerp where)
+                            where)
+                           (t
+                            (signal 'wrong-type-error (list where))))))
+    (aset entry *cpio-catalog-entry-header-start-idx* where-marker)))
+
+(defun cpio-set-contents-start (entry where)
+  "Set the contents start marker in ENTRY to the location WHERE.
+WHERE can be an integer or marker."
+  (let ((fname "cpio-set-contents-start")
+       (where-marker (cond ((integerp where)
+                            (set-marker (make-marker) where))
+                           ((markerp where)
+                            where)
+                           (t
+                            (signal 'wrong-type-error (list where))))))
+    (aset entry *cpio-catalog-entry-contents-start-idx* where-marker)))
+
+(defun cpio-contents (entry-name &optional archive-buffer)
+  "Return a string that is the contents of the named entry."
+  (let ((fname "cpio-contents"))
+    (cond (archive-buffer
+          (with-current-buffer archive-buffer
+            (cpio-contents entry-name)))
+         (*cab-parent*
+          (with-current-buffer *cab-parent*
+            (cpio-contents entry-name)))
+         ((eq major-mode 'cpio-mode)
+          (let* ((entry-attrs    (cpio-entry-attrs    entry-name))
+                 (contents-start (cpio-contents-start entry-name))
+                 (contents-size  (cpio-entry-size entry-attrs))
+                 (contents-end (+ contents-start contents-size))
+                 (result))
+            (if (null entry-attrs)
+                (error "%s(): Could not get entry attributes for [[%s]]." 
fname entry-name))
+            (goto-char contents-start)
+            (forward-char contents-size)
+            (setq result (buffer-substring-no-properties contents-start 
contents-end))))
+         (t
+          (error "%s(): Could not find the archive buffer." fname)))))
+
+(defun cpio-catalog ()
+  "Return the catalog relevant to the current buffer."
+  (let ((fname "cpio-catalog"))
+    (unless (or (eq major-mode 'cpio-dired-mode)
+               (eq major-mode 'cpio-mode))
+      (error "%s(): only makes sense in a cpio buffer." fname))
+    (if *cab-parent*
+       (with-current-buffer *cab-parent*
+         *cpio-catalog*)
+      *cpio-catalog*)))
+
+(defun cpio-make-header-string (parsed-header &optional contents)
+  "Build a padded cpio header string based on the given PARSED-HEADER."
+  (let ((fname "cpio-make-header-string"))
+    (funcall cpio-make-header-string-func parsed-header contents)))
+
+(defun cpio-set-entry-size (parsed-header size)
+  "Set the entry-size element of PARSED-HEADER to SIZE."
+  (let ((fname "cpio-set-entry-size"))
+    (aset parsed-header *cpio-entry-size-parsed-idx* size)))
+
+(defun cpio-set-entry-name (parsed-header entry-name)
+  "Set the entry-name element of the PARSED-HEADER to ENTRY-NAME.
+To be consistent, this also sets the name's size element."
+  (let ((fname "cpio-set-entry-name"))
+    (aset parsed-header *cpio-name-parsed-idx* entry-name)
+    ;; The namesize in the header includes the terminating NULL at the end of 
the name.
+    ;; See, for example, (cpio-newc-header-size).
+    (aset parsed-header *cpio-namesize-parsed-idx* (1+ (length entry-name)))))
+
+(defun cpio-set-uid (parsed-header uid)
+  "Set the uid field in the PARSED-HEADER to UID.
+UID can be either a string (representing a number)
+or an integer."
+  (let ((fname "cpio-set-uid"))
+    (unless (integerp uid)
+      (setq uid (string-to-number uid)))
+    (aset parsed-header *cpio-uid-parsed-idx* uid)))
+
+(defun cpio-set-gid (parsed-header gid)
+  "Set the gid field in the PARSED-HEADER to GID.
+GID can be either a string (representing a number)
+or an integer."
+  (let ((fname "cpio-set-gid"))
+    (unless (integerp gid)
+      (setq gid (string-to-number gid)))
+    (aset parsed-header *cpio-gid-parsed-idx* gid)))
+
+(defun cpio-set-mode (parsed-header mode)
+  "Set the mode field in the PARSED-HEADER to MODE.
+MODE is either an integer or a string representing an integer."
+  (let ((fname "cpio-set-mode")
+       (integer-mode (cond ((integerp mode)
+                            mode)
+                           ((stringp mode)
+                            (string-to-number mode))
+                           (t
+                            (signal 'wrong-type-error (list mode))))))
+    (unless (cpio-valid-numeric-mode integer-mode)
+      (error "%s(): Invalid mode [[%s]]." fname mode))
+    (aset parsed-header *cpio-mode-parsed-idx* integer-mode)))
+
+(defun cpio-set-mtime (parsed-header mtime)
+  "Set the modification time in the PARSED-HEADER to MTIME.
+MTIME is an emacs time."
+  (let ((fname "cpio-set-mtime"))
+    (aset parsed-header *cpio-mtime-parsed-idx* mtime)))
+
+(defun cpio-extract-all ()
+  "Extract all entries from the cpio archive related to the current buffer."
+  (let ((fname "cpio-extract-all"))
+    (if *cab-parent*
+       (with-current-buffer *cab-parent*
+         (cpio-extract-all))
+      (mapc (lambda (e)
+             (let ((entry-name (car e)))
+               (cpio-extract-entry entry-name)))
+           *cpio-catalog*))))
+
+(defun cpio-ask-user-about-supersession-threat (entry-name)
+  "Ask a user who is trying to save ENTRY-NAME what to do
+if a file named ENTRY-NAME already exists
+or if there is a modified buffer containing that entry's contents."
+  (let* ((fname "cpio-ask-user-about-supersession-threat")
+        (intermediate-buffer-name (cpio-contents-buffer-name entry-name))
+        (intermediate-buffer (get-buffer intermediate-buffer-name))
+        (archive-mod-time (cpio-get-archive-mod-time)) ;HEREHERE Do I want 
this?
+        (entry-mod-time (cpio-mtime (cpio-entry-attrs entry-name))))
+    (cond ((and (buffer-live-p intermediate-buffer)
+               (buffer-modified-p intermediate-buffer)
+               (yes-or-no-p (format "A buffer for entry %s exists and is 
modified. Save? " entry-name)))
+          t)
+         ((and (file-exists-p entry-name)
+               (yes-or-no-p (format "File %s already exists. Overwrite? " 
entry-name)))
+          t)
+         (t t))))
+
+(defun cpio-get-archive-mod-time ()
+  "Return the modification time of the cpio archive affiliated with the 
current buffer."
+  (let ((fname "cpio-get-archive-mod-time")
+       (archive-buffer (if *cab-parent*
+                           *cab-parent*
+                         (current-buffer))))
+    (with-current-buffer archive-buffer
+      (message "%s(): is not implemented." fname))))
+
+(defun cpio-extract-entry (entry-name &optional force)
+  "Extract the archive entry ENTRY-NAME.
+If that file already exists (and this is called interactively),
+then prompt the user about overwriting it.
+If a buffer is already visiting that entry,
+then leave that buffer in place;
+otherwise kill the intermediate buffer.
+
+The optional argument FORCE indicates
+if this was called from a lisp program.
+If it is, then the extraction occurs no matter what.
+
+CAVEAT: Extracting the same ENTRY-NAME from different archives
+will create a conflict.
+
+CONTRACT: This can only be invoked in a cpio archive under cpio-mode
+or a buffer affiliated with such a buffer.
+
+NOTE: FORCE is not currently used anywhere in cpio-mode.
+It is present so that any applications that are built on cpio-mode
+can have predictable results."
+  (interactive "sName: \nP")
+  (let ((fname "cpio-extract-entry")
+       (attrs (cpio-entry-attrs entry-name))
+       ;; HEREHERE Would this be noticably more efficient
+       ;; with (cpio-numeric-entry-type)?
+       (entry-type (cpio-entry-type entry-name)))
+    (cond ((string-equal entry-type *cpio-modes-link*)
+          (warn "%s(): Symlink extraction is not yet implemented." fname))
+         ((string-equal entry-type *cpio-modes-reg*)
+          (cpio-extract-regular-file entry-name))
+         ((string-equal entry-type *cpio-modes-dir*)
+           (cpio-extract-directory entry-name))
+          ((string-equal entry-type *cpio-modes-char*)
+           (warn "%s(): Character special files cannot be extracted with 
cpio-mode." fname))
+          ((string-equal entry-type *cpio-modes-block*)
+           (warn "%s(): Block special files cannot be extracted with 
cpio-mode." fname))
+          ((string-equal entry-type *cpio-modes-fifo*)
+           (warn "%s(): FIFOs (pipes) cannot be extracted with cpio-mode." 
fname))
+          ((string-equal entry-type *cpio-modes-sock*)
+           (warn "%s(): Sockets cannot be extracted with cpio-mode." fname))
+          ((string-equal entry-type *cpio-modes-unknown*)
+           (warn "%s(): Unknown entry type -- not extracting." fname))
+          (t (error "%s(): Impossible condition." fname)))))
+
+(defun cpio-extract-regular-file (entry-name &optional from-lisp)
+  "Extract the regular file entry ENTRY-NAME.
+CONTRACT: ENTRY-NAME is in fact an entry of a regular file."
+  (let* ((fname "cpio-extract-regular-file")
+        (do-it (if from-lisp
+                   t
+                 (cpio-ask-user-about-supersession-threat entry-name)))
+        (buffer-name (cpio-contents-buffer-name entry-name))
+        (temp-buffer (get-buffer buffer-name))
+        (restore (buffer-live-p temp-buffer))
+        (contents)
+        (archive-buffer (if *cab-parent*
+                            *cab-parent*
+                          (current-buffer))))
+    (if do-it
+       (cond (temp-buffer
+              (setq contents (cpio-contents entry-name archive-buffer))
+              (cab-register temp-buffer archive-buffer)
+              (with-current-buffer temp-buffer
+                (insert contents)
+                (write-file entry-name))
+              (unless restore (kill-buffer temp-buffer)))
+             (t
+              (with-temp-buffer 
+                (insert (cpio-contents entry-name archive-buffer))
+                (write-file entry-name)
+                (unless restore (kill-buffer temp-buffer)))
+              (cpio-set-file-attrs entry-name))))))
+
+(defun cpio-extract-directory (entry-name)
+  "Extract the directory entry ENTRY-NAME.
+CONTRACT: ENTRY-NAME really is a directory entry."
+  (let ((fname "cpio-extract-directory")
+       (attrs (cpio-entry-attrs entry-name)))
+    (make-directory entry-name t)
+    (cpio-set-file-attrs entry-name)))
+
+(defun cpio-entry-type (entry-name)
+  "Return the type of the entry with the given ENTRY-NAME.
+The type is the single character that would be displayed
+in the initial mode slot of 'ls -l'.
+That is, 'l' is a link, '-' is a regular file, etc.
+See (cpio-int-mode-to-file-type) in cpio-modes.el for more detail.
+If ENTRY-NAME is not in the current archive, then return NIL."
+  (let ((fname "cpio-entry-type")
+       (entry-attrs)
+       (entry-mode))
+    (cond ((and entry-name
+               (setq entry-attrs (cpio-entry-attrs entry-name))
+               (setq entry-mode (cpio-mode-value entry-attrs)))
+          (cpio-int-mode-to-file-type entry-mode))
+         (t nil))))
+
+(defun cpio-numeric-entry-type (numeric-mode)
+  "Return the numeric entry type of the given NUMERIC MODE."
+  (let ((fname "cpio-numeric-entry-type"))
+    (cond ((= #o170000 (logand s-ifmt   numeric-mode))
+          s-ifmt)
+         ((= #o140000 (logand s-ifsock numeric-mode))
+          s-ifsock)
+         ((= #o120000 (logand s-iflnk  numeric-mode))
+          s-iflnk)
+         ((/= 0       (logand s-ifreg  numeric-mode))
+          s-ifreg)
+         ((/= 0       (logand s-ifdir  numeric-mode))
+          s-ifdir)
+         ((/= s-ifblk (logand s-ifblk  numeric-mode))
+          s-ifblk)
+         ((/= 0       (logand s-ifchr  numeric-mode))
+          s-ifchr)
+         ((/= 0       (logand s-ififo  numeric-mode))
+          s-ififo)
+         (t
+          s-ifunk))))
+
+(defun cpio-set-file-attrs (file-name)
+  "Set the attributes on FILE-NAME
+based on its attributes in the catalog."
+  (let* ((fname "cpio-set-file-attrs")
+        (attrs (cpio-entry-attrs file-name))
+        (mode-value (cpio-mode-value attrs))
+        (modtime (cpio-mtime attrs))
+        (uid (cpio-uid attrs))
+        (gid (cpio-gid-to-gid-string (cpio-gid attrs))))
+    (cpio-set-file-owner   file-name uid)
+    (cpio-set-file-group   file-name gid)
+    (cpio-set-file-mode    file-name mode-value)
+    (cpio-set-file-modtime file-name modtime)))
+
+(defun cpio-set-file-owner (file-name user) ;HEREHERE Generic?
+  "Change the owner of [the file] FILE-NAME to USER.
+USER is an either a numeric uid or a user's name.
+If USER is a string, but that user doesn't exist,
+then fail and return NIL.
+Otherwise return non-NIL."
+  (let ((fname "cpio-set-file-owner")
+       (uid (cond ((integerp user)
+                    user)
+                  ((stringp user)
+                   (cpio-uid-string-to-uid user))
+                  (t
+                   nil))))
+    (unless (file-exists-p file-name)
+      (error "%s(): requires the name of an existing file." fname))
+    (call-process "chown"
+                 nil
+                 nil
+                 nil
+                 uid
+                 file-name)))
+
+(defun cpio-set-file-group (file-name group) ;HEREHERE Generic?
+  "Change the group of [the file] FILE-NAME to group
+USER is an either a numeric gid or a group's name.
+If USER is a string, but that user doesn't exist,
+then fail and return NIL.
+Otherwise return non-NIL."
+  (let ((fname "cpio-set-file-group")
+       (gid (cond ((integerp group)
+                   group)
+                  ((stringp group)
+                   (cpio-gid-string-to-gid group))
+                  (t
+                   nil))))
+    (unless (file-exists-p file-name)
+      (error "%s(): requires the name of an existing file." fname))
+    (call-process "chgrp"
+                 nil
+                 nil
+                 nil
+                 gid
+                 file-name)))
+
+(defun cpio-set-file-mode (file-name mode) ;HEREHERE Generic?
+  "Set the mode of the [the file] FILE-NAME to MODE.
+MODE may be a complete symbolic mode or an appropriate integer.
+If FILE-NAME doesn't exist, then fail and return NIL.
+If MODE is not a valid mode value (either symbolic or numeric),
+then fail and return NIL."
+  (let ((fname "cpio-set-file-mode")
+       (mode-num (cond ((stringp mode)
+                        (cpio-mode-string-to-int-mode mode))
+                       ((integerp mode)
+                        mode)
+                       (t
+                        nil))))
+    (unless (cpio-valid-numeric-mode mode-num)
+      (if (integerp mode)
+         (error "%s(): [[%d]] is not a valid mode." fname mode-num)
+       (error "%s(): [[%s]] is not a valid mode." fname mode-num)))
+    (chmod file-name mode)))
+
+(defun cpio-set-file-modtime (file-name mod-time) ;HEREHERE Generic?
+  "Set the modtime of [the file] FILE-NAME to MOD-TIME.
+MOD-TIME is an emacs time."
+  (let ((fname "cpio-set-file-modtime")
+       (modtime-string (cpio-mtime-to-touch-string mod-time)))
+    (call-process "touch"
+                 nil
+                 nil
+                 nil
+                 "-t"
+                 modtime-string
+                 file-name)))
+
+(defun cpio-mtime-to-touch-string (mtime) ;HEREHERE Generic?
+  "Convert the given MTIME to a time that touch(1) understands.
+MTIME is an emacs time.
+Touch understands times of the form YYYYMMDDhhmm.ss."
+  (let ((fname "cpio-mtime-to-touch-string"))
+    (format-time-string "%Y%m%d%M%H.%S" mtime)))
+
+(defun cpio-adjust-trailer ()
+  "Replace the trailer in the current buffer
+with one with the correct size fot its contents."
+  (let ((fname "cpio-adjust-trailer"))
+    (if *cab-parent*
+       (with-current-buffer *cab-parent*
+         (funcall cpio-adjust-trailer-func))
+      (funcall cpio-adjust-trailer-func))))
+
+(defun cpio-insert-trailer ()
+  "Insert a trailer in a cpio archive."
+  (let ((fname "cpio-insert-trailer"))
+    (if *cab-parent*
+       (with-current-buffer *cab-parent*
+         (funcall cpio-insert-trailer-func))
+      (funcall cpio-insert-trailer-func))))
+
+(defun cpio-delete-trailer ()
+  "Delete the trailer in the cpio archive buffer affiliated with the current 
buffer."
+  (let ((fname "cpio-delete-trailer"))
+    (if *cab-parent*
+       (with-current-buffer *cab-parent*
+         (funcall cpio-delete-trailer-func))
+      (funcall cpio-delete-trailer-func))))
+
+(defun cpio-delete-archive-entry (entry)
+  "Delete the entry in the cpio archive specified by ENTRY.
+ENTRY is a catalog entry."
+  (let ((fname "cpio-delete-archive-entry"))
+    (if *cab-parent*
+       (with-current-buffer *cab-parent*
+         (cpio-delete-archive-entry entry))
+      (let* ((attrs (aref entry 0))
+            (size (cpio-entry-size attrs))
+            (entry-start (cpio-entry-header-start entry))
+            (contents-start (cpio-contents-start (cpio-entry-name attrs)))
+            (entry-end (1+ (cg-round-up (+ (1- contents-start)
+                                           (cpio-entry-size attrs))
+                                        *cpio-padding-modulus*))))
+       (with-writable-buffer
+        (delete-region entry-start entry-end))))))
+
+(defun cpio-insert-padded-header (header-string)
+  "Insert an appropriately padded version of HEADER-STRING.
+CONTRACT: You're at the point of insertion."
+  (let ((fname "cpio-insert-padded-header")
+       (padding))
+    (if *cab-parent*
+       (with-current-buffer *cab-parent*
+         (cpio-insert-padded-header header-string))
+      (with-writable-buffer
+       (insert (cpio-padded header-string *cpio-padding-modulus* 
*cpio-padding-char*))))))
+
+(defun cpio-insert-padded-contents (contents) ;HEREHERE Generic
+  "Insert an appropriately padded version of CONTENTS into the archive buffer.
+CONTRACT: Point is at the point of insertion."
+  (let ((fname "cpio-insert-padded-contents"))
+    (if *cab-parent*
+       (with-current-buffer *cab-parent*
+         (cpio-insert-padded-contents contents))
+      (with-writable-buffer
+       ;; (cpio-set-contents-start (point))
+       (insert (cpio-padded contents *cpio-padding-modulus* 
*cpio-padding-char*))))))
+
+(defun cpio-sort-catalog ()
+  "Return a copy of the catalog sorted by entry name (car cpio-catalog-entry)."
+  (let ((fname "cpio-sort-catalog"))
+    (sort *cpio-catalog* 'cpio-entry-less-p)))
+
+(defun cpio-entry-less-p (l r)
+  "Return non-nil if [the car of] entry L precedes [the car of] entry L.
+CONTRACT: L and R should be entries:
+        (entry-name [inode mode uid ...] entry-start entry-end)."
+  (let ((fname "cpio-entry-less-p"))
+    (string-lessp (car l) (car r))))
+
+(defun cpio-uid-to-uid-string (uid) ;; HEREHERE Generic?
+  "Convert the given UID, an integer, to a string,
+either a user name or a string representing UID."
+  (let ((fname "cpio-uid-to-uid-string"))
+    (if cpio-try-names
+       (or (user-login-name uid)
+           (number-to-string uid))
+      (number-to-string uid))))
+
+(defun cpio-uid-string-to-uid (user) ;; HEREHERE Generic?
+  "Return the system UID, an integer, for the string USER."
+  (let ((fname "cpio-uid-string-to-uid")
+       )
+    ;; (error "%s() is not yet implemented" fname)
+    (unless (stringp user)
+      (signal 'wrong-type-error (list user)))
+    (with-temp-buffer
+      ;; HEREHERE This clearly doesn't work on Windows.
+      ;; Also note that it won't work on very old versions of UNIX.
+      ;; What about MacOS?
+      ;; What would be the right thing on other operating systems?
+      (insert-file-contents "/etc/passwd")
+      (if (re-search-forward (concat "^" user ":[^:]*:\\([0-9]+\\):" 
(point-max) t))
+         (string-to-number (match-string 1))
+       nil))))
+
+(defun cpio-gid-to-gid-string (gid) ;; HEREHERE Generic?
+  "Convert the given GID, an integer, to a string."
+  (let ((fname "cpio-gid-to-gid-string"))
+    (if cpio-try-names
+       (or (user-login-name gid)
+           (number-to-string gid))
+      (number-to-string gid))))
+
+(defun cpio-gid-string-to-gid (group) ;; HEREHERE Generic?
+  "Return the system gid, an integer, for the given GROUP."
+  (let ((fname "cpio-gid-string-to-gid"))
+    (unless (stringp group)
+      (signal 'wrong-type-error (list group)))
+    (with-temp-buffer
+      ;; HEREHERE This clearly doesn't work on Windows.
+      ;; See (cpio-uid-string-to-uid).
+      (insert-file-contents "/etc/group")
+      (if (re-search-forward (concat "^" group ":[^:]*:\\([0-9]+\\):" 
(point-max) t))
+         (string-to-number (match-string 1))
+       nil))))
+
+(defun cpio-nlink-to-nlink-string (nlink)
+  "Convert the given NLINK, an integer, to a string."
+  (let ((fname "cpio-nlink-to-nlink-string"))
+    (number-to-string nlink)))
+
+(defun cpio-mtime-to-mtime-string (mtime &optional long)
+  "Convert the given MTIME, an emacs internal time, to a string.
+CAUTION: This depends on your emacs being able to handle
+a UNIX/GNU/Linux time as an integer."
+  (let ((fname "cpio-mtime-to-mtime-string")
+       (six-months (* 6 30 24 60 60))
+       (now (time-to-seconds (current-time)))
+       (tmp-time (time-to-seconds mtime)))
+    (cond (long
+          (format-time-string "%F %T" mtime))
+         ((< (- now tmp-time) six-months)
+          (format-time-string "%b %d %H:%M" mtime))
+         (t
+          (format-time-string "%b %d %Y " mtime)))))
+
+(defun cpio-filesize-to-filesize-string (filesize)
+  "Convert the given FILESIZE, an integer, to a string."
+  (let ((fname "cpio-filesize-to-filesize-string"))
+    (number-to-string filesize)))
+
+(defun cpio-dev-maj-to-dev-maj-string (dev-maj)
+  "Do Convert the given DEV-MAJ, an integer, to a string."
+  (let ((fname "cpio-dev-maj-to-dev-maj-string"))
+    (number-to-string dev-maj)))
+
+(defun cpio-dev-min-to-dev-min-string (dev-min)
+  "Do Convert the given DEV-MIN, an integer, to a string."
+  (let ((fname "cpio-dev-min-to-dev-min-string"))
+    (number-to-string dev-min)))
+
+(defun cpio-entry-name-to-entry-name-string (name)
+  "DConvert the given NAME, an integer, to a string."
+  (let ((fname "cpio-entry-name-to-entry-name-string"))
+    name))
+
+(defun cpio-find-entry (entry-name)
+  "Find the given ENTRY-NAME and return the buffer holding its contents."
+  (let ((fname "cpio-find-entry")
+       (target-buffer (get-file-buffer entry-name))
+       (just-created nil)
+       (local-parent *cab-parent*))
+    (unless target-buffer
+      (setq just-created t)
+      (with-current-buffer (setq target-buffer (get-buffer-create entry-name))
+       (cab-register target-buffer local-parent)
+       (setq buffer-file-name entry-name)
+       (setq buffer-file-truename (abbreviate-file-name
+                                   (concat (cpio-archive-name) "/"
+                                           buffer-file-name)))
+       (set (make-local-variable 'cpio-entry-name) entry-name)))
+    (with-current-buffer target-buffer
+      (cond ((and just-created
+                 (= 0 (buffer-size)))
+            ;; I can't seem to get coding right.
+            ;; (cpio-set-auto-coding (setq contents (cpio-contents 
entry-name)))
+            (with-writable-buffer 
+             (insert (cpio-contents entry-name)))
+            (goto-char (point-min)))
+           (t t))
+      (set-buffer-modified-p nil))
+    target-buffer))
+
+(defun cpio-archive-name ()
+  "Return [the full path to] the cpio archive associated with the current 
buffer."
+  (let ((fname "cpio-archive-name"))
+    (unless (or *cab-parent*
+               (eq major-mode 'cpio-mode))
+      (error "%s(): You're not in a cpio-archive affiliated buffer." fname))
+    (if *cab-parent*
+       (buffer-file-name *cab-parent*)
+      (buffer-file-name))))
+
+(defun cpio-contents-buffer-name (name)
+  "Return the name of the buffer that would/does hold the contents of entry 
NAME.
+CAVEAT: Yes, there's a possibility of a collision here.
+However, that would mean that you're editing 
+more than one archive, each containing entries of the same name
+more than one of whose contents you are currently editing.
+Run more than one instance of emacs to avoid such collisions."
+  (let ((fname "cpio-contents-buffer-name"))
+    ;; (format "%s (in cpio archive %s)" name (file-name-nondirectory 
(buffer-file-name *cab-parent*)))))
+    name))
+;;    (expand-file-name
+;;      (concat name "!"))))
+
+(defun cpio-create-entry-attrs (filename)
+  "Create an entry attribute structure based on the given FILENAME."
+  (let* ((fname "cpio-create-entry-attrs")
+        (attrs (file-attributes filename))
+
+        (ino (nth 10 attrs))
+        (mode (cpio-mode-string-to-int-mode (nth 8 attrs)))
+        (uid (nth 2 attrs))
+        (gid (nth 3 attrs))
+
+        (nlink 1)
+        (mtime (time-to-seconds (nth 5 attrs)))
+        (entry-size (nth 7 attrs))
+        (dev-maj (nth 11 attrs))
+
+        (dev-min 1)
+        (rdev-maj 0)
+        (rdev-min 0)
+        (namesize (length filename))
+
+        (chksum (cpio-make-chksum-for-file filename))
+
+        (result (make-vector 14 nil)))
+    (aset result *cpio-ino-parsed-idx*        ino)
+    (aset result *cpio-mode-parsed-idx*       mode)
+    (aset result *cpio-uid-parsed-idx*        uid)
+    (aset result *cpio-gid-parsed-idx*        gid)
+
+    (aset result *cpio-nlink-parsed-idx*      nlink)
+    (aset result *cpio-mtime-parsed-idx*      (seconds-to-time mtime))
+    (aset result *cpio-entry-size-parsed-idx* entry-size)
+    (aset result *cpio-dev-maj-parsed-idx*    dev-maj)
+
+    (aset result *cpio-dev-min-parsed-idx*    dev-min)
+    (aset result *cpio-rdev-maj-parsed-idx*   rdev-maj)
+    (aset result *cpio-rdev-min-parsed-idx*   rdev-min)
+    (aset result *cpio-namesize-parsed-idx*   namesize)
+    
+    (aset result *cpio-chksum-parsed-idx*     chksum)
+    (aset result *cpio-name-parsed-idx*       filename)
+
+    result))
+
+(defun cpio-make-chksum-for-file (filename)
+  "Return the checksum for FILENAME."
+  (let ((fname "cpio-make-chksum-for-file"))
+    (funcall cpio-make-chksum-for-file-func filename)))
+
+(defun cpio-create-faux-directory-attrs (name)
+  "Create attributes appropriate for adding a directory entry to a 
cpio-archive.
+CAVEAT: While many attributes are derived from a best guess of reality,
+many are simply invented."
+  (let* ((fname "cpio-create-faux-directory-attrs")
+        (local-attrs (file-attributes "."))
+        (ino 1)
+        ;; HEREHERE think about basing the mode on umask or local-attrs.
+        (mode (logior s-ifdir
+                      s-irwxu
+                      s-irusr
+                      s-ixusr))
+        (uid (user-uid))
+        (gid (group-gid))
+        
+        (nlink 1)
+        (now (current-time))
+        (mtime (list (nth 0 now) (nth 1 now)))
+
+        (entry-size 0)
+        (dev-maj 1)
+        (dev-min 1)
+        (rdev-maj 0)
+        (rdev-min 0)
+        (namesize (1+ (length name)))
+        (chksum 0)                     ;Checksum for a direcory is always 0.
+        (result (make-vector 14 nil)))
+    (aset result *cpio-ino-parsed-idx*        ino)
+    (aset result *cpio-mode-parsed-idx*       mode)
+    (aset result *cpio-uid-parsed-idx*        uid)
+    (aset result *cpio-gid-parsed-idx*        gid)
+    
+    (aset result *cpio-nlink-parsed-idx*      nlink)
+    (aset result *cpio-mtime-parsed-idx*      mtime)
+    (aset result *cpio-entry-size-parsed-idx* entry-size)
+    (aset result *cpio-dev-maj-parsed-idx*    dev-maj)
+    
+    (aset result *cpio-dev-min-parsed-idx*    dev-min)
+    (aset result *cpio-rdev-maj-parsed-idx*   rdev-maj)
+    (aset result *cpio-rdev-min-parsed-idx*   rdev-min)
+    (aset result *cpio-namesize-parsed-idx*   namesize)
+    
+    (aset result *cpio-chksum-parsed-idx*     chksum)
+    (aset result *cpio-name-parsed-idx*       name)
+    
+    result))
+
+(defun cpio-entry-exists-p (name)
+  "Return non-nil if there's already an entry called NAME
+in the current archive."
+  (let ((fname "cpio-entry-exists-p"))
+    (unless (or (eq major-mode 'cpio-mode)
+               (eq major-mode 'cpio-dired-mode))
+      (error "%s(): You're not in a cpio-dired buffer." fname))
+    (if *cab-parent*
+       (with-current-buffer *cab-parent*
+           (cpio-entry-exists-p name))
+      (assoc name (cpio-catalog)))))
+
+(defun cpio-move-to-entry (entry-name)
+  "Move the point to ENTRY-NAME."
+  (let ((fname "cpio-move-to-entry")
+       (where nil))
+    (unless (eq major-mode 'cpio-dired-mode)
+      (error "%s(): You're not in a cpio-dired buffer." fname))
+    (save-excursion
+      (cpio-dired-move-to-first-entry)
+      (while (not (looking-at-p (concat entry-name "$")))
+       (cpio-dired-next-line 1))
+      (if (looking-at-p (concat entry-name "$"))
+         (setq where (point))))
+    (if where
+       (goto-char where))))
+
+;;
+;; Functions about the modified state of a catalog entry.
+;; 
+(defun cpio-set-entry-unmodified (catalog-entry)
+  "Mark the given CATALOG-ENTRY as not modified."
+  (let ((fname "cpio-set-entry-unmodified"))
+    (cpio-validate-catalog-entry catalog-entry)
+    (aset catalog-entry *cpio-catalog-entry-modified-flag-idx* 
'cpio-mode-entry-unmodified)))
+
+(defun cpio-set-entry-modified (catalog-entry)
+  "Mark the given CATALOG-ENTRY as modified."
+  (let ((fname "cpio-set-entry-modified"))
+    (cpio-validate-catalog-entry catalog-entry)
+    (aset catalog-entry *cpio-catalog-entry-modified-flag-idx* 
'cpio-mode-entry-modified)))
+
+(defun cpio-entry-modified-p (catalog-entry)
+  "Return non-NIL if CATALOG-ENTRY is marked as modified."
+  (let ((fname "cpio-entry-modified-p")
+       (modified-flag))
+    (cpio-validate-catalog-entry catalog-entry)
+    (cond ((eq 'cpio-mode-modified 
+              (setq modified-flag (aref catalog-entry 
*cpio-catalog-entry-modified-flag-idx*)))
+          t)
+         ((eq 'cpio-mode-unmodified catalog-entry)
+          nil)
+         (t
+          (error "%s(): Invalid modified flag value [[%s]]." fname 
modified-flag)))))
+
+(defun cpio-validate-catalog-entry (catalog-entry)
+  "Verify that the given CATALOG-ENTRY is (could be) a valid catalog entry.
+Signal an error if it isn't."
+  (let ((fname "validate-catalog-entry")
+       (modified-flag))
+    (unless (vectorp catalog-entry)
+      (signal 'wrong-type-error (list catalog-entry)))
+    (unless (= *cpio-catalog-entry-length* (length catalog-entry))
+      (error "%(): The catalog entry [[%d]] is not the right length." fname 
*cpio-catalog-entry-length*))
+    (unless (vectorp (aref catalog-entry *cpio-catalog-entry-attrs-idx*))
+      (signal 'wrong-type-error (list catalog-entry)))
+    (unless (= *cpio-parsed-header-length* (length (aref catalog-entry 
*cpio-catalog-entry-attrs-idx*)))
+      (error "%s(): The parsed header in [[%s]] is not the right length." 
fname (aref catalog-entry *cpio-catalog-entry-attrs-idx*))
+      (sit-for 1)
+      (error "%s(): Found [[%d]], expected [[%d]]." fname (length (aref 
catalog-entry *cpio-catalog-entry-attrs-idx*)) *cpio-parsed-header-length*))
+    (unless (and (markerp (aref catalog-entry 
*cpio-catalog-entry-header-start-idx*))
+                (markerp (aref catalog-entry 
*cpio-catalog-entry-contents-start-idx*)))
+      (error "%s(): The marker fields in [[%s]] are not markers." fname 
catalog-entry))
+    ;; The modified flag may not be set yet, so ignore it.
+    ))
+
+;; A few functions for a failed attempt at supporting different encodings.
+
+;; Modified from (set-auto-coding) ∈ mule.el.
+(defun cpio-set-auto-coding (contents)
+  "Return coding system for the current buffer.
+See `cpio-find-auto-coding' for how the coding system is found.
+Return nil if an invalid coding system is found.
+
+The variable `set-auto-coding-function' (which see) is set to this
+function by default."
+  (let ((found (cpio-find-auto-coding cpio-entry-name contents)))
+    (if (and found (coding-system-p (car found)))
+       (car found))))
+
+;; Modified from (find-auto-coding) ∈ mule.el.
+(defun cpio-find-auto-coding (entry-name contents)
+  "Find a coding system for an archive entry ENTRY-NAME.
+
+The function checks ENTRY-NAME against the variable `auto-coding-alist'.
+If ENTRY-NAME doesn't match any entries in the variable, it checks the
+contents of the current buffer following point against
+`auto-coding-regexp-alist'.  If no match is found, it checks for a
+`coding:' tag in the first one or two lines following point.  If no
+`coding:' tag is found, it checks any local variables list in the last
+3K bytes out of the SIZE bytes.  Finally, if none of these methods
+succeed, it checks to see if any function in `auto-coding-functions'
+gives a match.
+
+If a coding system is specified, the return value is a cons
+\(CODING . SOURCE), where CODING is the specified coding system and
+SOURCE is a symbol `auto-coding-alist', `auto-coding-regexp-alist',
+`:coding', or `auto-coding-functions' indicating by what CODING is
+specified.  Note that the validity of CODING is not checked;
+it's the caller's responsibility to check it.
+
+If nothing is specified, the return value is nil."
+  (error "%s() is not yet implemented" "cpio-find-auto-coding")
+  (or (let ((coding-system (auto-coding-alist-lookup entry-name)))
+       (if coding-system
+           (cons coding-system 'auto-coding-alist)))
+      ;; Try using `auto-coding-regexp-alist'.
+      (let ((coding-system (cpio-auto-coding-regexp-alist-lookup contents)))
+       (if coding-system
+           (cons coding-system 'auto-coding-regexp-alist)))
+      (let* ((case-fold-search t)
+            (size (length contents))
+            (head-start 0)
+            (head-end (+ head-start (min size 1024)))
+            (head (substring contents head-start head-end))
+            coding-system head-found tail-found char-trans)
+       ;; Try a short cut by searching for the string "coding:"
+       ;; and for "unibyte:".
+       (setq head-found (or (string-match "coding:" contents)
+                            (string-match "unibyte:" contents)
+                            (string-match "enable-character-translation:" 
contents)))
+
+       ;; At first check the head.
+       (when head-found
+         ;; (goto-char head-start)
+         ;; (setq head-end (set-auto-mode-1))
+         ;; (setq head-start (point))
+         (when (and head-end (< head-found head-end))
+           (goto-char head-start)
+           (when (and set-auto-coding-for-load
+                      (string-match
+                       "\\(.*;\\)?[ \t]*unibyte:[ \t]*\\([^ ;]+\\)"
+                       contents))
+              (display-warning 'mule
+                               (format "\"unibyte: t\" (in %s) is obsolete; \
+use \"coding: 'raw-text\" instead."
+                                       (file-relative-name entry-name))
+                               :warning)
+             (setq coding-system 'raw-text))
+           (when (and (not coding-system)
+                      (string-match
+                       "\\(.*;\\)?[ \t]*coding:[ \t]*\\([^ ;]+\\)"
+                       contents)
+             (setq coding-system (intern (match-string 2 contents))))
+           (when (string-match
+                  "\\(.*;\\)?[ \t]*enable-character-translation:[ \t]*\\([^ 
;]+\\)"
+                  contents)
+             (setq char-trans (match-string 2 contents)))))
+
+       (if coding-system
+           ;; If the coding-system name ends with "!", remove it and
+           ;; set char-trans to "nil".
+           (let ((name (symbol-name coding-system)))
+             (if (= (aref name (1- (length name))) ?!)
+                 (setq coding-system (intern (substring name 0 -1))
+                       char-trans "nil"))))
+       (when (and char-trans
+                  (not (setq char-trans (intern char-trans))))
+         (make-local-variable 'enable-character-translation)
+         (setq enable-character-translation nil))
+       (if coding-system
+           (cons coding-system :coding)))
+       ;; Finally, try all the `auto-coding-functions'.
+       (let ((funcs auto-coding-functions)
+             (coding-system nil))
+         (while (and funcs (not coding-system))
+           (setq coding-system (ignore-errors
+                                 (save-excursion
+                                   (goto-char (point-min))
+                                   (funcall (pop funcs) size))))))
+       (if coding-system
+           (cons coding-system 'auto-coding-functions)))))
+
+(defun cpio-auto-coding-regexp-alist-lookup (contents)
+  "Lookup `auto-coding-regexp-alist' for CONTENTS.
+The value is a coding system is specified for the CONTENTS
+or nil."
+  (let ((fname "cpio-auto-coding-regexp-alist-lookup")
+       (alist auto-coding-regexp-alist)
+       (coding-system))
+    (error "%s() is not yet implemented" fname)
+    (while (and alist (not coding-system))
+      (let ((regexp (car (car alist))))
+       (if enable-multibyte-characters
+           (setq regexp (string-to-multibyte regexp)))
+       (if (string-match regexp contents)
+           (setq coding-system (cdr (car alist)))
+         (setq alist (cdr alist)))))
+    coding-system))
+
+(defun cpio-set-coding-system (entry-name)
+  "Set the coding system for the current buffer based on the contents of the 
entry-ENTRY-NAME."
+  (let ((fname "cpio-set-coding-system"))
+    (error "%s() is not yet implemented" fname)
+    (if *cab-parent*
+       (with-current-buffer *cab-parent*
+         (cpio-set-coding-system entry-name))
+      ;; (setq last-coding-system-used
+      ;;       (car (find-coding-systems-region (cpio-contents-start 
entry-name)
+      ;;                                       (cpio-contents-end   
entry-name))))
+      (set-buffer-file-coding-system last-coding-system-used 'force 
'nomodify))))
+
+(defun cpio-not-modified ()
+  "Mark the current cpio-dired-style and archive buffersfas unmodified."
+  (let ((fname "cpio-not-modified"))
+    (cond (*cab-parent*
+          (not-modified)
+          (with-current-buffer *cab-parent* (not-modified)))
+         (t
+          (not-modified)
+          (mapc (lambda (b)
+                  (if (buffer-live-p b)
+                      (with-current-buffer b
+                        (not-modified))))
+                *cab-subordinates*)))))
+
+;; 
+;; Commands
+;; 
+
+(defun cpio-view-dired-style-buffer ()
+  "Switch to the dired style buffer corresponding to this archive buffer."
+  ;; (cpio-dired-buffer-name) is in cpio-mode.el because
+  ;; it is invoked in the archive's directory.
+  (interactive)
+  (let ((fname "cpio-view-dired-style-buffer")
+       (archive-file-name (buffer-file-name)))
+    (unless (eq major-mode 'cpio-mode)
+      (error "%s(): You're not in a cpio archive buffer under cpio-mode." 
fname))
+    (bury-buffer)
+    (switch-to-buffer (cpio-dired-buffer-name archive-file-name))))
+
+
+;; 
+;; Mode definition
+;; 
+
+;; HEREHERE I'm hoping dired-mode gives me decent stuff for free.
+;; dired-mode -- Nope the hooks for dired-mode want a nicer environment.
+;; I'll have to see how tar-mode does it.
+
+(define-derived-mode cpio-mode fundamental-mode "cpio-mode"
+  "Treat cpio archives like file systems with a dired UI."
+  (if (null (setq *cpio-format* (cpio-discern-archive-type)))
+      (error "You're not in a supported CPIO buffer. It begins [[%s]]." 
(buffer-substring-no-properties 1 8)))
+
+  ;; 
+  ;; HEREHERE Get rid of this once things look clean.
+  ;; 
+  (cpio-backup-during-development)
+  ;; 
+  ;; EO temporary code for development
+  ;; 
+  
+  (let ((archive-buffer (current-buffer))
+       (cpio-dired-buffer))
+    ;; You really only need this for the binary archive formats,
+    ;; but, hey it's cheap to set it.
+    (set-syntax-table *cpio-archive-syntax-table*)
+    (setq buffer-read-only t)
+    (cpio-set-locals *cpio-format*)
+    (setq *cpio-archive-name* (buffer-file-name))
+    (cpio-build-catalog)
+    (with-current-buffer (setq cpio-dired-buffer
+                              (cpio-present-ala-dired (current-buffer)))
+      (make-local-variable '*cpio-archive-name*)
+      (cpio-dired-set-unmodified))
+    (cpio-create-keymap)
+    (bury-buffer)
+    ;; cpio-mode is the top level function here,
+    ;; so this should control what we see at this point.
+    (switch-to-buffer cpio-dired-buffer)))
+
+;; 
+;; HEREHERE Get rid of this once things look clean.
+;; 
+(defun cpio-backup-during-development ()
+  "Create a time-stamped backup of the file in the current-buffer.
+There's an implied CONTRACT there:
+The buffer must contain a file."
+  (let* ((fname "cpio-backup-during-development")
+        (filename (buffer-file-name))
+        (backup-file (format "%s-%s"
+                             filename
+                             (format-time-string "%Y%m%d%H%H%M%S.%3N"))))
+    (copy-file filename backup-file nil 'keep-time 'preserve-uid-gid 
'preserve-permissions)))
+
+;; 
+;; EO temporary code for development
+;; 
+
+
+(defvar *cpio-dired-modified* nil
+  "A flag to record if any archive-modifying events have occured
+since either the beginning or the last save.")
+(setq *cpio-dired-modified* nil)
+
+(make-variable-buffer-local '*cpio-dired-modified*)
+
+(defun cpio-dired-modified-p ()
+  "Return non-NIL if the catalog has been modified
+and, thus, the archive can be saved."
+  (let ((fname "cpio-dired-modified-p"))
+    (unless (or (eq major-mode 'cpio-dired-mode)
+               (eq major-mode 'cpio-mode))
+      (error "%s(): only makes sense in a cpio-dired buffer." fname))
+    (if *cab-parent*
+       (with-current-buffer *cab-parent*
+         (cpio-dired-modified-p))
+      *cpio-dired-modified*)))
+
+(defun cpio-dired-set-modified ()
+  "Flag the catalog as modified."
+  (let ((fname "cpio-dired-set-modified"))
+    (unless (or (eq major-mode 'cpio-dired-mode)
+               (eq major-mode 'cpio-mode))
+      (error "%s(): only makes sense in a cpio-dired buffer." fname))
+    (if *cab-parent*
+       (with-current-buffer *cab-parent*
+         (cpio-dired-set-modified))
+      (setq *cpio-dired-modified* t))))
+
+(defun cpio-dired-set-unmodified ()
+  "Flag the catalog as not modified."
+  (let ((fname "cpio-dired-set-unmodified"))
+    ;; HEREHERE There's probably more to this than just the following.
+    ;; For example, should it look for entry-contents buffers and
+    ;; offer to save them if they're modified?
+    ;; What about upon killing the archive buffer?
+    (unless (or (eq major-mode 'cpio-dired-mode)
+               (eq major-mode 'cpio-mode))
+      (error "%s(): only makes sense in a cpio-dired buffer." fname))
+    (cond (*cab-parent*
+          (with-current-buffer *cab-parent*
+            (cpio-dired-set-unmodified)))
+         (t
+          (setq *cpio-dired-modified* nil)
+          (set-buffer-modified-p nil)
+          (with-current-buffer (cpio-dired-buffer-name (buffer-name))
+            (set-buffer-modified-p nil))))))
+
+(defvar *cpio-have-made-keymap* nil
+  "Flag to indicate that the cpio-mode-map has already been built.")
+(setq *cpio-have-made-keymap* nil)
+
+(defun cpio-create-keymap ()
+  (let ((fname "cpio-create-keymap")
+       (keymap (make-keymap)))
+    (setq cpio-mode-map keymap)
+    (unless *cpio-have-made-keymap*
+      (define-key cpio-mode-map "\C-c\C-c" 'cpio-view-dired-style-buffer)
+      (define-key cpio-mode-map        "q" 'cpio-quit))))
+
+(defun cpio-quit ()
+  "Quit cpio mode and kill all the affiliated buffers."
+  (interactive)
+  (let ((fname "cpio-quit"))
+    (if *cab-parent*
+       (with-current-buffer *cab-parent*
+         (cpio-quit)
+         (unless (kill-buffer)
+           (warn "%s(): Could not kill [[%s]]." fname (current-buffer)))))))
+
+(defun cpio-entry (entry-name)
+  "Return the entry in the catalog for the entry with ENTRY-NAME."
+  (let ((fname "cpio-entry"))
+    (if *cab-parent*
+       (cdr (assoc entry-name (with-current-buffer *cab-parent*
+                                *cpio-catalog*)))
+      (cdr (assoc entry-name *cpio-catalog*)))))
+
+(defun cpio-entry-attrs-from-catalog-entry (catalog-entry)
+  "Do that."
+  (let ((fname "cpio-entry c-attrs-from-catalog"))
+    (aref catalog-entry *cpio-catalog-entry-attrs-idx*)))
+
+(defun cpio-build-catalog ()
+  "Build the catalog that tracks the entries in this cpio-mode buffer.
+cpio-mode maintains the catalog in the *cpio-catalog* variable."
+  (let ((fname "cpio-build-catalog"))
+    (goto-char (point-min))
+    (setq *cpio-catalog* (funcall cpio-build-catalog-func))))
+
+(defun cpio-set-locals (archive-type)
+  "Establish certain variables as local to the current buffer and give them 
good values.
+ARCHIVE-TYPE is a symbol."
+  (let ((fname "cpio-set-locals"))
+    (if *cab-parent*
+       (with-current-buffer *cab-parent*
+         (cpio-set-local-vars archive-type))
+      (cpio-set-local-vars archive-type)
+      (cpio-set-local-funcs archive-type))))
+
+(defun cpio-set-local-funcs (archive-type)
+  "Establish the functions for the given archive type.
+The functions are assigned to the elements of *cpio-local-funcs*,
+a string of symbols.
+Thus, to use them as functions
+you need to (funcall) them or to (apply) them.
+CAVEAT: No checking is done.
+This function doesn't care /why/ you are asking for functions
+that are appropriate for ARCHIVE-TYPE.
+That's the caller's business.
+
+See *cpio-local-funcs* for more information."
+  (let ((fname "cpio-set-local-funcs")
+       (archive-type-name (symbol-name archive-type)))
+    (mapc 'make-local-variable
+         *cpio-local-funcs*)
+    ;; Here is the process:
+    ;; cpio-do-good-stuff-func
+    ;; --> "cpio-do-good-stuff-func"
+    ;; --> "cpio" "do" "good" "stuff"
+    ;; --> "cpio-fmt-do-good-stuff"
+    ;; --> cpio-fmt-do-good-stuff
+    ;; (setq cpio-do-good-stuff-func cpio-hdr-do-good-stuff)
+    ;; Here's an example of the desired result for newc headers.
+    ;; (setq cpio-parse-header-func 'cpio-newc-parse-header)
+    (mapc (lambda (local-func-var)
+           (let* ((name-parts (split-string (symbol-name local-func-var) "-"))
+                  (target-name (concat (car name-parts) "-" ;HEREHERE Should 
this be (pop)?
+                                       (symbol-name archive-type))))
+             (setq name-parts (cdr (remove "func" name-parts)))
+             (mapc (lambda (part)
+                     (setq target-name (concat target-name "-" part)))
+                   name-parts)
+             ;; 1. (set) not (setq) because
+             ;; 2. local-func-var holds a symbol)
+             (set local-func-var (read target-name))
+             target-name))
+         *cpio-local-funcs*)))
+
+(defun cpio-set-local-vars (archive-type)
+  "Set all the necessary local variables for the CPIO archive type given."
+  (let ((fname "cpio-set-local-vars"))
+    ;; Some variables are not format-specific.
+    (make-local-variable '*cpio-catalog*)
+    (setq *cpio-catalog* ())
+    (setq *cpio-archive-name* (buffer-file-name))
+    ;; Now for the format-specific variables.
+    (cond ((eq archive-type 'bin)
+          (cpio-set-local-bin-vars))
+         ((eq archive-type 'newc)
+          (cpio-set-local-newc-vars))
+         ((eq archive-type 'odc)
+          (cpio-set-local-odc-vars))
+         ((eq archive-type 'crc)
+          (cpio-set-local-crc-vars))
+         ((eq archive-type 'tar)
+          (cpio-set-local-tar-vars))
+         ((eq archive-type 'ustar)
+          (cpio-set-local-ustar-vars))
+         ((eq archive-type 'hpbin)
+          (cpio-set-local-hpbin-vars))
+         ((eq archive-type 'hpodc)
+          (cpio-set-local-hpodc-vars))
+         (t (error "%s(): Unknown archive type [[%s]]" fname archive-type)))))
+
+(defun cpio-set-local-bin-vars ()
+  "Set buffer local variables appropriate for a BIN format CPIO archive."
+  (let ((fname "cpio-set-local-bin-vars"))
+    (make-local-variable '*cpio-padding-modulus*)
+    (setq *cpio-padding-modulus* *cpio-bin-padding-modulus*)
+    (make-local-variable '*cpio-padding-char*)
+    (setq *cpio-padding-char* *cpio-bin-padding-char*)
+    (make-local-variable '*cpio-padding-str*)
+    (setq *cpio-padding-str* *cpio-bin-padding-str*)
+    (make-local-variable '*cpio-header-length*)
+    (setq *cpio-header-length* *cpio-bin-header-length*)))
+
+(defun cpio-set-local-newc-vars ()
+  "Set buffer local variables appropriate for a NEWC format CPIO archive."
+  (let ((fname "cpio-set-local-newc-vars"))
+    (make-local-variable '*cpio-padding-modulus*)
+    (setq *cpio-padding-modulus* *cpio-newc-padding-modulus*)
+    (make-local-variable '*cpio-padding-char*)
+    (setq *cpio-padding-char* *cpio-newc-padding-char*)
+    (make-local-variable '*cpio-padding-str*)
+    (setq *cpio-padding-str* *cpio-newc-padding-str*)
+    (make-local-variable '*cpio-header-length*)
+    (setq *cpio-header-length* *cpio-newc-header-length*)))
+
+(defun cpio-set-local-odc-vars ()
+  "Set buffer local variables appropriate for a ODC format CPIO archive."
+  (let ((fname "cpio-set-local-odc-vars"))
+    (make-local-variable '*cpio-padding-modulus*)
+    (setq *cpio-padding-modulus* *cpio-odc-padding-modulus*)
+    (make-local-variable '*cpio-padding-char*)
+    (setq *cpio-padding-char* *cpio-odc-padding-char*)
+    (make-local-variable '*cpio-padding-str*)
+    (setq *cpio-padding-str* *cpio-odc-padding-str*)
+    (make-local-variable '*cpio-header-length*)
+    (setq *cpio-header-length* *cpio-odc-header-length*)))
+
+(defun cpio-set-local-crc-vars ()
+  "Set buffer local variables appropriate for a CRC format CPIO archive."
+  (let ((fname "cpio-set-local-crc-vars"))
+    (make-local-variable '*cpio-padding-modulus*)
+    (setq *cpio-padding-modulus* *cpio-crc-padding-modulus*)
+    (make-local-variable '*cpio-padding-char*)
+    (setq *cpio-padding-char* *cpio-crc-padding-char*)
+    (make-local-variable '*cpio-padding-str*)
+    (setq *cpio-padding-str* *cpio-crc-padding-str*)
+    (make-local-variable '*cpio-header-length*)
+    (setq *cpio-header-length* *cpio-crc-header-length*)))
+
+(defun cpio-set-local-tar-vars ()
+  "Set buffer local variables appropriate for a TAR format CPIO archive."
+  (let ((fname "cpio-set-local-tar-vars"))
+    (error "%s() is not yet implemented" fname)))
+
+(defun cpio-set-local-ustar-vars ()
+  "Set buffer local variables appropriate for a USTAR format CPIO archive."
+  (let ((fname "cpio-set-local-ustar-vars"))
+    (error "%s() is not yet implemented" fname)))
+
+(defun cpio-set-local-hpbin-vars ()
+  "Set buffer local variables appropriate for a HPBIN format CPIO archive."
+  (let ((fname "cpio-set-local-hpbin-vars"))
+    (error "%s() is not yet implemented" fname)))
+
+(defun cpio-set-local-hpodc-vars ()
+  "Set buffer local variables appropriate for a HPODC format CPIO archive."
+  (let ((fname "cpio-set-local-hpodc-vars"))
+    (error "%s() is not yet implemented" fname)))
+
+
+(provide 'cpio-mode)
+;;; cpio-mode.el ends here



reply via email to

[Prev in Thread] Current Thread [Next in Thread]