[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
- [elpa] externals/cpio-mode 97eb77c 45/61: Version 0.08, (continued)
- [elpa] externals/cpio-mode 97eb77c 45/61: Version 0.08, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode b9cee9d 35/61: Add files via upload, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 50d0df9 56/61: Initial code derived from the previous Makefile., Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode e37b7ed 57/61: Version: 0.13β, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 0fe3abc 37/61: Removed commented out stub debuggers., Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 0c4985a 52/61: Makefile to be replaced by Makefile.in, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode eb7e950 07/61: Create cpio-dired.el, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 0976f38 49/61: Version 0.12β, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 12e550e 58/61: Version 0.14β, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode f2bad29 60/61: Moved to cpio-mode.el., Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 38a59a6 59/61: Renamed from cpio.el.,
Stefan Monnier <=
- [elpa] externals/cpio-mode 90f1236 61/61: New version with copyright assigned to the FSF., Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 6c0fa51 38/61: version 0.04, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode f4a1a89 44/61: Version 0.08, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 4cc60b1 51/61: Version: 0.13β, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 86b255b 46/61: Version 0.09 -- a little polish, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 8047799 42/61: Version 0.07 -- fontification, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 2a01909 34/61: Add files via upload, Stefan Monnier, 2019/01/11
- [elpa] externals/cpio-mode 5a87960 47/61: Version 0.10, Stefan Monnier, 2019/01/13
- [elpa] externals/cpio-mode 889e8fe 41/61: Version 0.06, Stefan Monnier, 2019/01/16