[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/cpio-mode f2bad29 60/61: Moved to cpio-mode.el.
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] externals/cpio-mode f2bad29 60/61: Moved to cpio-mode.el. |
|
Date: |
Fri, 11 Jan 2019 15:25:39 -0500 (EST) |
branch: externals/cpio-mode
commit f2bad290129e48eb24be34e54f6350df1cdba881
Author: Douglas Lewan <address@hidden>
Commit: Douglas Lewan <address@hidden>
Moved to cpio-mode.el.
---
cpio.el | 1912 ---------------------------------------------------------------
1 file changed, 1912 deletions(-)
diff --git a/cpio.el b/cpio.el
deleted file mode 100644
index af43596..0000000
--- a/cpio.el
+++ /dev/null
@@ -1,1912 +0,0 @@
-;;; cpio.el --- Handle cpio archives in the style of dired. -*- coding: utf-8
-*-
-
-;; COPYRIGHT 2015, 2017, 2018, 2019 Douglas Lewan, address@hidden
-;; 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/>.
-
-;; Author: Douglas Lewan <address@hidden>
-;; Maintainer: Douglas Lewan <address@hidden>
-;; Created: 2015 Jan 03
-;; Version: 0.13β
-;; Keywords: files
-
-;;; Commentary:
-
-;; This package implements cpio-mode, a mode for viewing cpio archives
-;; through a dired-like interface.
-
-;;
-;; 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.
-;;
-
-;;; Documentation:
-
-
-;;
-;; 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.)
-;;
-
-;;; 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.")
-(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.")
-
-(defvar *cpio-ustar-header-re* "not yet set"
- "RE to match ustar format cpio archives.")
-
-(defvar *cpio-hpbin-header-re* "not yet set"
- "RE to match hpbin format cpio archives.")
-
-(defvar *cpio-hpodc-header-re* "not yet set"
- "RE to match hpodc format cpio archives.")
-
-;; 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 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-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.")
-(defvar *cpio-padding-char* ()
- "The character to be used for building padded strings.")
-(defvar *cpio-padding-str* ()
- "A single character string of the character to be used for building padded
strings.")
-
-(defvar *cpio-archive-syntax-table* ()
- "Every character in a cpio archive has word syntax.")
-
-(defvar *cpio-header-length* ()
- "A buffer-local variable to hold the length of the header
-for a cpio archive of the current format.")
-
-
-;;
-;; 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"))
- (unless (integerp mode)
- (setq mode (string-to-number mode)))
- (aset parsed-header *cpio-mode-parsed-idx* 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 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-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))
- (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"))
- (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)
- "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 (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.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.")
-(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.
- (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-unmodified))
- (setq *cpio-dired-modified* nil)
- (set-buffer-modified-p nil))))
-
-(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-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)
-;;; cpio.el ends here
- [elpa] externals/cpio-mode d15c60c 53/61: Deleted obsolete file., (continued)
- [elpa] externals/cpio-mode d15c60c 53/61: Deleted obsolete file., Stefan Monnier, 2019/01/11
- [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 <=
- [elpa] externals/cpio-mode 38a59a6 59/61: Renamed from cpio.el., Stefan Monnier, 2019/01/11
- [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