[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/cpio-mode ec9c085 08/61: Create cpio.el
From: |
Stefan Monnier |
Subject: |
[elpa] externals/cpio-mode ec9c085 08/61: Create cpio.el |
Date: |
Fri, 11 Jan 2019 15:25:21 -0500 (EST) |
branch: externals/cpio-mode
commit ec9c0856e7bac873cd6dd6762a84dacc446d0e8b
Author: dlewan <address@hidden>
Commit: GitHub <address@hidden>
Create cpio.el
Initial code from local CVS.
---
cpio.el | 1408 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 1408 insertions(+)
diff --git a/cpio.el b/cpio.el
new file mode 100644
index 0000000..eeb6948
--- /dev/null
+++ b/cpio.el
@@ -0,0 +1,1408 @@
+;; -*- coding: utf-8 -*-
+;;; cpio.el --- cpio-mode for emacs
+; $Id: cpio.el,v 1.2.4.7.2.1 2018/03/08 06:22:10 doug Exp $
+
+;; COPYRIGHT 2015, 2017, 2018 Douglas Lewan, address@hidden
+
+;; Author: Douglas Lewan (address@hidden)
+;; Maintainer: -- " --
+;; Created: 2015 Jan 03
+;; Version: 0.02
+;; Keywords: cpio, archive
+
+;;; Commentary:
+
+;;; Documentation:
+
+;;
+;; NAME: cpio-mode
+;;
+;; USAGE:
+;; (load-library 'cpio-mode)
+;; (require '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:
+;; This was originally developed under emacs 24.2
+;; on the Fedora 18 distribution of 64 bit GNU/Linux.
+;;
+;; Current development is happening under emacs 24.5
+;; on Linux Mint, 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.
+;;
+
+;;
+;; cpio.el is the entry point to all of cpio-mode.
+;; 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.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.
+;;
+;; CAUTION: This (5) is not working correctly yet.
+;; Apparently, I don't understand
+;; how to make a minor mode be buffer local yet.
+;; It seems to apply buffer local,
+;; but merely loading it seems to turn it on in all buffers.
+;;
+;; The following code can at least clean up its mess.
+;; (mapc (lambda (b)
+;; (with-current-buffer b
+;; (cpio-entry-contents-mode 0)))
+;; (buffer-list))
+
+;;; 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.)
+;;
+
+;; Implemented commands (so far):
+;; M-x cpio-mode
+;; M-x cpio-dired-find-entry (e..f
+;; M-x cpio-extract-entry
+;; M-x cpio-extract-all
+;; M-x cpio-entry-contents-save (Don't trust this yet.)
+;;
+
+;;; Code:
+
+;;
+;; Dependencies
+;;
+
+;; During development I need access to local files.
+(setq load-path (add-to-list 'load-path (substring default-directory -1)))
+
+(require 'dired)
+
+;; (require 'cpio-generic)
+(load (concat default-directory "cpio-generic.el"))
+(message "Loaded cpio-generic.el.")
+;; (require 'cpio-modes)
+(load (concat default-directory "cpio-modes.el"))
+(message "Loaded cpio-modes.el.")
+;; (require 'cpio-affiliated-buffers)
+(load (concat default-directory "cpio-affiliated-buffers"))
+(message "Loaded cpio-affiliated-buffers.el.")
+;; (require 'cpio-hpbin)
+(load (concat default-directory "cpio-hpbin"))
+(message "Loaded cpio-hpbin.el")
+;; (require 'cpio-hpodc)
+(load (concat default-directory "cpio-hpodc"))
+(message "Loaded cpio-hpodc.el")
+;; (require 'cpio-newc)
+(load (concat default-directory "cpio-newc"))
+(message "Loaded cpio-newc.el.")
+;; (require 'cpio-odc)
+(load (concat default-directory "cpio-odc"))
+(message "Loaded cpio-odc.el")
+;; (require 'cpio-tar)
+;; (require 'cpio-ustar)
+;; (require 'cpio-wanted)
+(load (concat default-directory "cpio-wanted"))
+(message "Loaded cpio-wanted.el.")
+;; (require 'cpio-dired)
+(load (concat default-directory "cpio-dired"))
+(message "Loaded cpio-dired.el.")
+(load (concat default-directory "cpio-entry-contents-mode"))
+(message "Loaded cpio-entry-contents-mode.")
+
+
+;;
+;; Vars
+;;
+(defvar *cpio-format* ()
+ "The format of the cpio archive in the current-buffer.
+Takes the values 'bin, 'newc, 'odc etc.")
+(make-variable-buffer-local '*cpio-format*)
+
+(let ((i 0))
+ ;; HEREHERE Are these even used?
+ ;; It doesn't look like it.
+ (defvar *cpio-magic-idx* 0 ; (setq i (1+ i))
+ "Index of magic in a parsed cpio header.")
+ (setq *cpio-magic-idx* i)
+ (setq i (1+ i))
+
+ (defvar *cpio-ino-idx* 0 ; (setq i (1+ i))
+ "Index of ino in a parsed cpio header.")
+ (setq *cpio-ino-idx* i)
+ (setq i (1+ i))
+
+ (defvar *cpio-mode-idx* 0 ; (setq i (1+ i))
+ "Index of mode in a parsed cpio header.")
+ (setq *cpio-mode-idx* i)
+ (setq i (1+ i))
+
+ (defvar *cpio-uid-idx* 0 ; (setq i (1+ i))
+ "Index of uid in a parsed cpio header.")
+ (setq *cpio-uid-idx* i)
+ (setq i (1+ i))
+
+ (defvar *cpio-gid-idx* 0 ; (setq i (1+ i))
+ "Index of gid in a parsed cpio header.")
+ (setq *cpio-gid-idx* i)
+ (setq i (1+ i))
+
+ (defvar *cpio-nlink-idx* 0 ; (setq i (1+ i))
+ "Index of nlink in a parsed cpio header.")
+ (setq *cpio-nlink-idx* i)
+ (setq i (1+ i))
+
+ (defvar *cpio-mtime-idx* 0 ; (setq i (1+ i))
+ "Index of mtime in a parsed cpio header.")
+ (setq *cpio-mtime-idx* i)
+ (setq i (1+ i))
+
+ (defvar *cpio-entry-size-idx* 0 ; (setq i (1+ i))
+ "Index of filesize in a parsed cpio header.")
+ (setq *cpio-entry-size-idx* i)
+ (setq i (1+ i))
+
+ (defvar *cpio-dev-maj-idx* 0 ; (setq i (1+ i))
+ "Index of dev major in a parsed cpio header.")
+ (setq *cpio-dev-idx* i)
+ (setq i (1+ i))
+
+ (defvar *cpio-dev-min-idx* 0 ; (setq i (1+ i))
+ "Index of dev minor in a parsed cpio header.")
+ (setq *cpio-dev-idx* i)
+ (setq i (1+ i))
+
+ (defvar *cpio-rdev-maj-idx* 0 ; (setq i (1+ i))
+ "Index of rdev major in a parsed cpio header.")
+ (setq *cpio-rdev-maj-idx* i)
+ (setq i (1+ i))
+
+ (defvar *cpio-rdev-min-idx* 0 ; (setq i (1+ i))
+ "Index of rdev minor in a parsed cpio header.")
+ (setq *cpio-rdev-min-idx* i)
+ (setq i (1+ i))
+
+ (defvar *cpio-namesize-idx* 0 ; (setq i (1+ i))
+ "Index of namesize in a parsed cpio header.")
+ (setq *cpio-namesize-idx* i)
+ (setq i (1+ i))
+
+ (defvar *cpio-checksum-idx* 0 ; (setq i (1+ i))
+ "Index of checksum in a parsed cpio header.")
+ (setq *cpio-checksum-idx* i)
+ (setq i (1+ i))
+
+ (defvar *cpio-filename-idx 0 ; (setq i (1+ i))
+ "Index of filename in a parsed cpio header.")
+ (setq *cpio-filename-idx* i)
+ (setq i (1+ i))
+
+ (defvar *cpio-checksum-idx* 0 ; (setq i (1+ i))
+ "Index of the checksum in a parsed cpio-header.")
+ (setq *cpio-filename-idx* i)
+ (setq i (1+ i))
+ )
+
+;; N.B. The format REs go here since they are what we use
+;; to discern the type of the archive.
+(defvar *cpio-bin-header-re* "nOt yEt iMpLeMeNtEd"
+ "RE to match BIN format cpio archives.")
+(setq *cpio-bin-header-re* "nOt yEt iMpLeMeNtEd")
+
+(defvar *cpio-odc-header-re* "nOt yEt iMpLeMeNtEd"
+ "RE to match odc format cpio archives.")
+(setq *cpio-odc-header-re* "nOt yEt iMpLeMeNtEd")
+
+(defvar *cpio-crc-header-re* "nOt yEt iMpLeMeNtEd"
+ "RE to match crc format cpio archives.")
+(setq *cpio-crc-header-re* "nOt yEt iMpLeMeNtEd")
+
+(defvar *cpio-tar-header-re* "nOt yEt iMpLeMeNtEd"
+ "RE to match tar format cpio archives.")
+(setq *cpio-tar-header-re* "nOt yEt iMpLeMeNtEd")
+
+(defvar *cpio-ustar-header-re* "nOt yEt iMpLeMeNtEd"
+ "RE to match ustar format cpio archives.")
+(setq *cpio-ustar-header-re* "nOt yEt iMpLeMeNtEd")
+
+(defvar *cpio-hpbin-header-re* "nOt yEt iMpLeMeNtEd"
+ "RE to match hpbin format cpio archives.")
+(setq *cpio-hpbin-header-re* "nOt yEt iMpLeMeNtEd")
+
+(defvar *cpio-hpodc-header-re* "nOt yEt iMpLeMeNtEd"
+ "RE to match hpodc format cpio archives.")
+(setq *cpio-hpodc-header-re* "nOt yEt iMpLeMeNtEd")
+
+(defvar *cpio-re-type-alist* (list (cons *cpio-bin-header-re* 'bin)
+ (cons *cpio-newc-header-re* 'newc)
+ (cons *cpio-odc-header-re* 'odc)
+ (cons *cpio-crc-header-re* 'crc)
+ (cons *cpio-tar-header-re* 'tar)
+ (cons *cpio-ustar-header-re* 'ustar)
+ (cons *cpio-hpbin-header-re* 'hpbin)
+ (cons *cpio-hpodc-header-re* 'hpodc))
+ "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-newc-header-re* 'newc)
+ (cons *cpio-odc-header-re* 'odc)
+ (cons *cpio-crc-header-re* 'crc)
+ (cons *cpio-tar-header-re* 'tar)
+ (cons *cpio-ustar-header-re* 'ustar)
+ (cons *cpio-hpbin-header-re* 'hpbin)
+ (cons *cpio-hpodc-header-re* 'hpodc)))
+
+(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 cpio-get-magic-func ()
+ "")
+(setq cpio-get-magic-func ())
+
+(defvar cpio-get-ino-func ()
+ "")
+(setq cpio-get-ino-func ())
+
+(defvar cpio-get-mode-func ()
+ "")
+(setq cpio-get-mode-func ())
+
+(defvar cpio-get-uid-func ()
+ "")
+(setq cpio-get-uid-func ())
+
+(defvar cpio-get-gid-func ()
+ "")
+(setq cpio-get-gid-func ())
+
+(defvar cpio-get-nlink-func ()
+ "")
+(setq cpio-get-nlink-func ())
+
+(defvar cpio-get-mtime-min-func ()
+ "")
+(setq cpio-get-mtime-min-func ())
+
+(defvar cpio-get-filesize-func ()
+ "")
+(setq cpio-get-filesize-func ())
+
+(defvar cpio-get-dev-maj-func ()
+ "")
+(setq cpio-get-dev-maj-func ())
+
+(defvar cpio-get-dev-min-func ()
+ "")
+(setq cpio-get-dev-min-func ())
+
+(defvar cpio-get-rdev-maj-func ()
+ "")
+(setq cpio-get-rdev-maj-func ())
+
+(defvar cpio-get-rdev-min-func ()
+ "")
+(setq cpio-get-rdev-min-func ())
+
+(defvar cpio-get-namesize-func ()
+ "")
+(setq cpio-get-namesize-func ())
+
+(defvar cpio-get-chksum-func ()
+ "")
+(setq cpio-get-chksum-func ())
+
+(defvar cpio-get-name-func ()
+ "")
+(setq cpio-get-name-func ())
+
+(defvar cpio-get-contents-func ()
+ "")
+(setq cpio-get-contents-func ())
+
+(defvar cpio-make-header-string-func ()
+ "")
+(setq cpio-make-header-string-func ())
+
+(defvar *cpio-local-funcs* (list
+ ;; Catalog management
+ 'cpio-build-catalog-func
+ ;; Header parsing functions
+ 'cpio-parse-header-func
+ 'cpio-header-at-point-func
+ 'cpio-get-magic-func
+ 'cpio-get-dev-func
+ 'cpio-get-ino-func
+ 'cpio-get-mode-func
+ 'cpio-get-uid-func
+ 'cpio-get-gid-func
+ 'cpio-get-nlink-func
+ 'cpio-get-rdev-func
+ 'cpio-get-mtime-func
+ 'cpio-get-namesize-func
+ 'cpio-get-filesize-func
+ 'cpio-get-name-func
+ 'cpio-get-contents-func
+ 'cpio-end-of-archive
+ 'cpio-make-header-string-func
+ 'cpio-adjust-trailer-func)
+ "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
+ ;; Header parsing functions
+ 'cpio-end-of-archive-func
+ 'cpio-start-of-trailer-func
+ 'cpio-make-header-string-func
+ 'cpio-adjust-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].
+• 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.
+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
+ contents-size
+ checksum].")
+(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-content-start-idx* i)
+ (setq *cpio-catalog-entry-content-start-idx* i))
+
+(defvar *cpio-dired-buffer* ()
+ "The [subordinate] buffer used to present the curent catalog
+à la dired.")
+(setq *cpio-dired-buffer* ())
+(make-variable-buffer-local '*cpio-dired-buffer*)
+
+(defvar *cpio-archive-name* ()
+ "The name of the cpio archive being processed.")
+(setq *cpio-archive-name* ())
+(make-variable-buffer-local '*cpio-archive-names*)
+
+(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-checksum-idx* i)
+ (setq *cpio-checksum-idx* i)
+
+ (setq i (1+ i))
+ (defvar *cpio-name-parsed-idx* i)
+ (setq *cpio-name-parsed-idx* i))
+
+
+;;
+;; Customizations
+;;
+(defgroup cpio ()
+ "Customizations for cpio-mode.")
+
+(defcustom cpio-default-format "newc"
+ "The default cpio format to use for a new or empty archive."
+ :type 'string
+ :group 'cpio)
+
+
+;;
+;; Library
+;;
+(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))
+ (save-excursion
+ (widen)
+ (goto-char (point-min))
+ (catch 'found-it
+ (mapcar (lambda (archive-spec)
+ (cond ((looking-at (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 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 (cdr (assoc entry-name (cpio-catalog)))))
+ (aref catalog-entry *cpio-catalog-entry-content-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*
+ (aref (cdr (assoc entry-name (cpio-catalog))) 0))
+ (aref (cdr (assoc entry-name (cpio-catalog))) 0))))
+
+(defun cpio-entry-header-start (entry)
+ "Return the start of the entry specified in ENTRY."
+ (let ((fname "cpio-entry-start"))
+ (aref entry *cpio-catalog-entry-header-start-idx*)))
+
+(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)))
+ (t
+ (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 -1))
+ (result))
+ (if (null entry-attrs)
+ (error "%s(): Could not get entry attributes for [[%s]]."
fname))
+ (goto-char contents-start)
+ (forward-char contents-size)
+ (setq result (buffer-substring-no-properties contents-start
(point))))))))
+
+(defun cpio-catalog ()
+ "Return the catalog relevant to the current buffer."
+ (let ((fname "cpio-catalog"))
+ (if *cab-parent*
+ (with-current-buffer *cab-parent*
+ *cpio-catalog*)
+ *cpio-catalog*)))
+
+(defun cpio-make-header-string (parsed-header)
+ "Build a cpio header string based on the given PARSED-HEADER."
+ (let ((fname "cpio-make-header-string"))
+ (funcall cpio-make-header-string-func parsed-header)))
+
+(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-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 from-lisp)
+ ;; HEREHERE This will have to deal with creating directories.
+ "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 FROM-LISP 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."
+ ;; (interactive "sName: \nP")
+ (let* ((fname "cpio-extract-entry")
+ (attrs (cpio-entry-attrs entry-name))
+ (entry-type (cpio-entry-type entry-name)))
+ (cond ((string-equal entry-type *cpio-modes-link*)
+ (warn "%s(): Link extraction is not yet implemented." fname))
+ ((string-equal entry-type *cpio-modes-reg*)
+ ;; (message "%s(%s): Extracting a regular file." fname entry-name)
(sit-for 0.1)
+ (cpio-extract-regular-file entry-name))
+ ((string-equal entry-type *cpio-modes-dir*)
+ ;; (message "%s(%s): Extracting a directory." fname entry-name)
(sit-for 0.1)
+ (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-unkown*)
+ (warn "%s(): Unknown entry type -- not extracting." fname))
+ (t (error "%s(): Impossible condition." fname)))))
+
+(defun cpio-extract-regular-file (entry-name)
+ "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-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))
+ (mod-time-string (cpio-mtime-to-touch-string (cpio-mtime attrs)))
+ (uid (cpio-uid-to-uid-string (cpio-uid attrs)))
+ (gid (cpio-gid-to-gid-string (cpio-gid attrs))))
+ (call-process "chown"
+ nil
+ nil
+ nil
+ uid
+ file-name)
+ (call-process "chgrp"
+ nil
+ nil
+ nil
+ gid
+ file-name)
+ (chmod file-name mode-value)
+ (call-process "touch"
+ nil
+ nil
+ nil
+ "-t"
+ mod-time-string
+ file-name)))
+
+(defun cpio-mtime-to-touch-string (mtime)
+ "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"))
+ (funcall cpio-adjust-trailer-func)))
+
+(defun cpio-delete-archive-entry (entry)
+ "Delete the entry in the cpio archive specified by 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+ (round-up (+ contents-start (cpio-entry-size attrs))
+ *cpio-padding-modulus*))))
+ (delete-region entry-start entry-end)))))
+
+(defun cpio-insert-padded-header (header-string)
+ "Insert an appropriately padded version of HEADER-STRING."
+ (let ((fname "cpio-insert-padded-header")
+ (padding))
+ (if *cab-parent*
+ (with-current-buffer *cab-parent*
+ (cpio-insert-padded-header header-string))
+ (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."
+ (let ((fname "cpio-insert-padded-contents"))
+ (if *cab-parent*
+ (with-current-buffer *cab-parent*
+ (cpio-insert-padded-contents contents))
+ (insert (cpio-padded contents *cpio-padding-modulus*
*cpio-padding-char*)))))
+
+(defun cpio-dired-buffer-name (archive-name)
+ "Return the name of the dired-style buffer for ARCHIVE-NAME."
+ (let ((fname "cpio-dired-buffer-name"))
+ (concat "CPIO archive: " (file-name-nondirectory archive-name))))
+
+(defun cpio-present-ala-dired (archive-buffer)
+ "Create a buffer with a ls -l format reflecting the contents of the current
cpio archive.
+This returns the buffer created."
+ (let* ((fname "cpio-present-ala-dired")
+ (archive-name (file-name-nondirectory (buffer-file-name)))
+ (buffer-name (cpio-dired-buffer-name archive-name))
+ (buffer (get-buffer-create buffer-name))
+ (entry-string)
+ (catalog *cpio-catalog*))
+ (with-current-buffer buffer
+ (setq *cpio-catalog* catalog)
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (insert "CPIO archive: " archive-name ":\n\n")
+ (mapc (lambda (e)
+ (let ((line (cpio-dired-format-entry (cdr e))))
+ (insert (concat line "\n"))))
+ (cpio-sort-catalog))
+ (setq buffer-read-only t)
+ (cpio-dired-mode)
+ (goto-char (point-min))
+ (cpio-dired-next-line 2))
+ ;; No, I do not yet understand why this must be done
+ ;; every time the presentation is updated.
+ (cab-register buffer archive-buffer)
+ buffer))
+
+(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-dired-format-entry (catalog-entry)
+ "Create a dired-style line for CATALOG-ENTRY."
+ (let* ((fname "cpio-dired-format-entry")
+ (entry-attrs (cpio-entry-attrs-from-catalog-entry catalog-entry))
+ (mode-string (cpio-int-mode-to-mode-string
(cpio-mode-value entry-attrs)))
+ (uid-string (cpio-uid-to-uid-string (cpio-uid
entry-attrs)))
+ (gid-string (cpio-gid-to-gid-string (cpio-gid
entry-attrs)))
+ (nlink-string (cpio-nlink-to-nlink-string (cpio-nlink
entry-attrs)))
+ (mtime-string (cpio-mtime-to-mtime-string (cpio-mtime
entry-attrs)))
+ (filesize-string (cpio-filesize-to-filesize-string
(cpio-entry-size entry-attrs)))
+ (dev-maj-string (cpio-dev-maj-to-dev-maj-string (cpio-dev-maj
entry-attrs)))
+ (dev-min-string (cpio-dev-min-to-dev-min-string (cpio-dev-min
entry-attrs)))
+ (entry-name-string (cpio-entry-name-to-entry-name-string
(cpio-entry-name entry-attrs)))
+ (fmt (if entry-name-string
+ (if cpio-try-names
+ (format " %%s %%3s %%8s %%8s %%8s %%7s %%s")
+ (format " %%s %%3s %%5s %%5s %%8s %%7s %%s"))
+ nil)))
+ (if fmt
+ (format fmt mode-string nlink-string uid-string gid-string
filesize-string mtime-string entry-name-string))))
+
+(defun cpio-uid-to-uid-string (uid)
+ "Convert the given UID, an integer, to a string."
+ (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-gid-to-gid-string (gid)
+ "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-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 (emacs-time-to-ticks (current-time)))
+ (tmp-time (emacs-time-to-ticks 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 emacs-time-to-ticks (emacs-time)
+ "Convert the given EMACS-TIME to a time in ticks.
+CAVEAT: This assumes that your version of emacs supports
+at least 32 bit integers."
+ (let ((fname "emacs-time-to-ticks"))
+ (+ (lsh (car emacs-time) 16) (cadr emacs-time))))
+
+
+(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-dired-mark-read-regexp (ARGS)
+ ;; Is this just an alias for the dired version?
+ "Do that. BUT TELL SOMEONE WHAT IT MEANS."
+ (let ((fname "cpio-dired-mark-read-regexp"))
+ (error "%s(): is not yet implemented." fname)))
+
+(defun cpio-dired-move-to-entry-name ()
+ "Move the point to the beginning of the entry on the current line
+if there is one."
+ (let ((fname "cpio-dired-move-to-entry-name"))
+ (beginning-of-line)
+ (if (looking-at *cpio-dired-entry-regexp*)
+ (goto-char (match-beginning *cpio-dired-name-idx*)))))
+
+
+;;
+;; 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.el because
+ ;; it is invoked in the archive's directory.
+ (interactive)
+ (let ((fname "cpio-view-dired-style-buffer"))
+ (switch-to-buffer (cpio-dired-buffer-name (buffer-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."))
+ (message "You're in a cpio buffer of type [[%s]]." (symbol-name
*cpio-format*)) (sit-for 1.0)
+ (let ((archive-buffer (current-buffer))
+ (cpio-dired-buffer))
+ (setq buffer-read-only t)
+ (message "Establishing local variables.")
+ (cpio-set-locals *cpio-format*)
+ (setq *cpio-archive-name* (buffer-file-name))
+ (cpio-build-catalog)
+ (setq cpio-dired-buffer (cpio-present-ala-dired (current-buffer)))
+ (cpio-create-keymap)
+ ;; cpio-mode is the top level function here,
+ ;; so this should control what we see at this point.
+ (switch-to-buffer cpio-dired-buffer)))
+
+(defvar *cpio-have-made-keymap* nil
+ "Flag to indicate that the cpio-mode-map has already been built.")
+(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-pattern*
+ (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))
+ (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* ())
+ (make-variable-buffer-local '*cpio-archive-name*)
+ (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"))))
+
+(defun cpio-set-local-newc-vars ()
+ "Set buffer local variables appropriate for a NEWC format CPIO archive."
+ (let ((fname "cpio-set-local-newc-vars"))
+ (cpio-set-local-newc-offset-vars)
+ (make-local-variable '*cpio-padding-modulus*)
+ (setq *cpio-padding-modulus* *cpio-newc-padding-modulus*)
+ (setq *cpio-padding-char* *cpio-newc-padding-char*)))
+
+;;
+;; Assuming this has worked. (It runs without errors.)
+;; I think I now need to use (symbol-value)
+;; to get the archive-specific information that I need.
+;;
+(defun cpio-set-local-newc-offset-vars ()
+ "Set the variables that define the offset to the fields of a NEWC format
CPIO archive.
+This also establishes those variables as buffer-local."
+ ;; There is an implicit contract that you are in the right buffer.
+ (let ((fname "cpio-set-local-newc-offset-vars")
+ (newc-offset-vars (list '*cpio-newc-magic-field-offset*
+ '*cpio-newc-ino-field-offset*
+ '*cpio-newc-mode-field-offset*
+ '*cpio-newc-uid-field-offset*
+ '*cpio-newc-gid-field-offset*
+ '*cpio-newc-nlink-field-offset*
+ '*cpio-newc-mtime-field-offset*
+ '*cpio-newc-filesize-field-offset*
+ '*cpio-newc-dev-maj-field-offset*
+ '*cpio-newc-dev-min-field-offset*
+ '*cpio-newc-rdev-maj-field-offset*
+ '*cpio-newc-rdev-min-field-offset*
+ '*cpio-newc-namesize-field-offset*
+ '*cpio-newc-chksum-field-offset*
+ '*cpio-newc-name-field-offset*))
+ (format-name "newc"))
+ (mapcar 'make-local-variable newc-offset-vars)
+ ;; We want a simple and consistent map
+ ;; between the global [meta-]variable's name
+ ;; and the format-specific variable's name.
+ ;; We know the format-specific names,
+ ;; so start with them.
+ ;; Here's the process:
+ ;; *newc-magic-field-offset*
+ ;; --> *cpio-magic-field-offset*
+ (mapcar (lambda (fsv) ;format-specific-variable
+ (let* ((fs-name (symbol-name fsv))
+ (general-name (progn (or (string-match (concat
"\\`\\*cpio-\\(" format-name "-\\)") fs-name)
+ (error "%s(): Some FSV isn't
playing by the rules! [[%s]]" fname fsv))
+ (replace-match "" t t fs-name 1)))
+ (general-var (make-symbol general-name)))
+ (set general-var fsv)))
+ newc-offset-vars)))
+
+(defun cpio-set-local-odc-vars ()
+ "Set buffer local variables appropriate for a ODC format CPIO archive."
+ (let ((fname "cpio-set-local-odc-vars"))
+ (error "%s() is not yet implemented" fname)))
+
+(defun cpio-set-local-crc-vars ()
+ "Set buffer local variables appropriate for a CRC format CPIO archive."
+ (let ((fname "cpio-set-local-crc-vars"))
+ (error "%s() is not yet implemented" fname)))
+
+(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)
+;;; cpio.el ends here
- [elpa] externals/cpio-mode 8011050 20/61: Create cpio-tar.el, (continued)
- [elpa] externals/cpio-mode 8011050 20/61: Create cpio-tar.el, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 12877b1 22/61: Create cpio-ustar.el, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 0af3b11 15/61: Create cpio-modes.el, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode bf69494 27/61: Create NEWS, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode e36cab4 23/61: Create cpio-wanted.el, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 4b18220 12/61: Create cpio-generic-tests.el, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 590e82a 30/61: Create THANKS, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode c938972 17/61: Create cpio-newc.el, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode bcf19a6 33/61: Corrected version number., Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 498802f 31/61: Delete Makefilein, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode ec9c085 08/61: Create cpio.el,
Stefan Monnier <=
- [elpa] externals/cpio-mode f80714d 28/61: Create QUESTIONS, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode f292a2e 32/61: Create Makefile.in, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 12a3c73 43/61: Fixes to (cdmt-*reset)., Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode ae56d68 50/61: Version 0.12β, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 38693e2 54/61: Deleted obsolete file., Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 9299db5 40/61: Build archives of all formats., Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 2bcd643 29/61: Create stamp-h.in, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 4dbed5e 55/61: Empty initial file., Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 6f0676b 25/61: Create install-sh, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode ce91145 26/61: Create Makefilein, Stefan Monnier, 2019/01/11