Tail & Head implementation in Emacs Lisp

gistfile1.txt

Print the last 10 lines of each FILE to standard output.
With more than one FILE, precede each with a header giving the file name.

Mandatory arguments to long options are mandatory for short options too.
  -c, --bytes=[+]NUM       output the last NUM bytes; or use -c +NUM to
                             output starting with byte NUM of each file
  -f, --follow[={name|descriptor}]
                           output appended data as the file grows;
                             an absent option argument means 'descriptor'
  -F                       same as --follow=name --retry
  -n, --lines=[+]NUM       output the last NUM lines, instead of the last 10;
                             or use -n +NUM to output starting with line NUM
      --max-unchanged-stats=N
                           with --follow=name, reopen a FILE which has not
                             changed size after N (default 5) iterations
                             to see if it has been unlinked or renamed
                             (this is the usual case of rotated log files);
                             with inotify, this option is rarely useful
      --pid=PID            with -f, terminate after process ID, PID dies
  -q, --quiet, --silent    never output headers giving file names
      --retry              keep trying to open a file if it is inaccessible
  -s, --sleep-interval=N   with -f, sleep for approximately N seconds
                             (default 1.0) between iterations;
                             with inotify and --pid=P, check process P at
                             least once every N seconds
  -v, --verbose            always output headers giving file names
  -z, --zero-terminated    line delimiter is NUL, not newline
      --help     display this help and exit
      --version  output version information and exit

NUM may have a multiplier suffix:
b 512, kB 1000, K 1024, MB 1000*1000, M 1024*1024,
GB 1000*1000*1000, G 1024*1024*1024, and so on for T, P, E, Z, Y.
Binary prefixes can be used, too: KiB=K, MiB=M, and so on.

With --follow (-f), tail defaults to following the file descriptor, which
means that even if a tail'ed file is renamed, tail will continue to track
its end.  This default behavior is not desirable when you really want to
track the actual name of the file, not the file descriptor (e.g., log
rotation).  Use --follow=name in that case.  That causes tail to track the
named file in a way that accommodates renaming, removal and creation.

tail.el

;;; tail.el --- tail -- output the last part of file(s)  -*- lexical-binding: t; -*-

;; Copyright (C) 2024  Arthur Miller

;; Author: Arthur Miller <[email protected]>
;; Keywords: 

;; 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 <https://www.gnu.org/licenses/>.

;;; Commentary (from the GNU tail.c):

;; Can display any amount of data, unlike the Unix version, which uses
;; a fixed size buffer and therefore can only deliver a limited number
;; of lines.

;; Original version by Paul Rubin <[email protected]>.
;; Extensions by David MacKenzie <[email protected]>.
;; tail -f for multiple files by Ian Lance Taylor <[email protected]>.
;; inotify back-end by Giuseppe Scrivano <[email protected]>.

;; Unlike GNU tail, this version lets you also configure header format and set
;; size of the intermediate buffer. A bigger chunk size means less file accesses
;; when dealing with huge files.

;; Not implemented:

;; follow PID (possible, patch welcome).
;; Tail and follow remote (probably possible, but really, no idea)

;; Implementation difference:

;; You can only follow named files

;; does not recognize '=' between options. Possible, but I don't see why bother.

;; help is not hard-coded into the compiled file, but resides in a separate
;; text file loaded on demand. Most of times we don't need help, so
;; why eat RAM for something that isn't used and can be loaded if needed? If
;; help is displayed, we are terminating anyway, so not in a fast path anyway.

;;; Code:

(defvar tail-version "0.0.1")

(defvar tail-header-format "==> %s <==\n")

(defvar tail-usage-message
  "Usage: tail [OPTION]... [FILE]...")

(defvar tail-help-file nil)
(defvar tail-startup-flags nil)

(eval-and-compile
  (require 'cl-macs)
  (defvar tail-flags
    (list '-c '-f '-n '-q '-s '-u '-v '-z '-F '-H
          '--usage '--version '--help '--lines '--verbose '--quiet '--silent
          '--bytes '--zero-terminated '--sleep-interval '--follow '--retry
          '--head '--unknown-option))

  (dolist (flag tail-flags) (intern (symbol-name flag)) (set flag flag))

  (setf tail-help-file (expand-file-name "./tail-help.en"))
  (setf tail-startup-flags ())
  
  (defalias 'case 'cl-case)
  (defalias 'incf 'cl-incf)
  (defalias 'decf 'cl-decf)
  (defalias 'block 'cl-block)
  (defalias 'typecase 'cl-typecase)
  (defalias 'defstruct 'cl-defstruct)
  (defalias 'return-from 'cl-return-from))

(defstruct tail
  "Options for an instance of tail"
  count retry sleep follow verbose zero-terminate
  quiet files action forward chunk-size unknown-option
  delete-limit head)

(defun tail-help ()
  (with-temp-buffer
    (insert-file-contents-literally tail-help-file)
    (buffer-substring-no-properties (point-min) (point-max))))

(defun tail--forward-char (n &optional head)
  (let ((N (abs n))
        (direction (if head -1 1)))
    (ignore-errors
      (dotimes (_ N)
        (forward-char direction)
        (decf N)))
    (if head N (- N))))

(defun tail--forward-line (n &optional head)
  (forward-line (if head n (- n))))

(defun tail--dotail (inst)
  (and (> (length (tail-files inst)) 1) (not (tail-quiet inst))
       (setf (tail-verbose inst) t))
  (let ((errors))
    (dolist (file (tail-files inst))
      (block loop
        (unless (file-readable-p file)
          (push
           (format
            "cannot open file '%s' for reading: no such file or directory"
            file) errors)
          (return-from loop))
        (let* ((head (tail-head inst))
               (size (file-attribute-size (file-attributes file)))
               (chunk-size (tail-chunk-size inst))
               (n (tail-count inst))
               (beg (if head (point-min) (- size chunk-size)))
               (end (if head chunk-size size))
               (header-end (point-min)))
          ;; (switch-to-buffer (current-buffer))
          (when (< beg 1) (setf beg 1))
          (goto-char (point-max))
          (when (tail-verbose inst)
            (insert (format tail-header-format file)))
          (setf header-end (point))
          (block lines
            (while (> n 0)
              (insert-file-contents-literally file nil beg end)
              (goto-char (if head beg (point-max)))
              (let ((left (funcall (tail-forward inst) (tail-count inst) head)))
                (incf n (+ (tail-count inst) left))
                (cond
                 ((or (= 0 left) (= (point) (point-min)))
                  (if head
                      (when (< (point) (point-max))
                        (delete-region (1- (point)) (point-max)))
                      (when (> (point) (point-min))
                        (delete-region header-end (funcall (tail-delete-limit inst)))))
                  (return-from lines))
                 (t
                  (cond
                   (head
                    (setf beg (+ beg chunk-size)
                          end (+ beg chunk-size))
                    (goto-char (point-max)))
                   (t
                    (setf end (- end chunk-size)
                          beg (- end chunk-size))
                    (goto-char (point-min))))))))))))
    (goto-char (point-min))
    (dolist (err errors)
      (insert err "\n")))

  (when (tail-zero-terminate inst)
    (goto-char 1)
    (while (not (eobp))
      (when (or (= (char-after) 10) (= (char-after) 13))
        (delete-char 1)
        (insert ?\0))
      (forward-char)))

  (buffer-substring-no-properties (point-min) (point-max)))

(defun tail-flag-p (object)
  (typecase object
    (symbol (= ?- (aref (symbol-name object) 0)))
    (string (= ?- (aref object 0)))))

(defun tail--parse-options (options)         
  (let ((inst (make-tail :count 10 :chunk-size 1024 :sleep 1.0
                         :forward #'tail--forward-line
                         :delete-limit #'line-beginning-position))
        action)
    (setf action
          (block tail
                 (while options
                   (case (setf action (pop options))
                     ((or -n --lines)
                      (setf (tail-count inst) (pop options))
                      (unless (natnump (tail-count inst))
                        (push --help options)))
                     ((or -c --bytes)
                      (setf (tail-count inst) (pop options)
                            (tail-forward inst) #'tail--forward-char
                            (tail-delete-limit inst) #'point)
                      (unless (natnump (tail-count inst))
                        (push --help options)))
                     ((or -v --verbose)
                      (setf (tail-verbose inst) t))
                     ((or -z --zero-terminated)
                      (setf (tail-zero-terminate inst) t))
                     ((or -q --quiet --silent)
                      (setf (tail-quiet inst) t))
                     ((or -s --sleep-interval)
                      (setf (tail-sleep inst) (pop options))
                      (when (or (not (numberp (tail-sleep inst)))
                                (< (tail-sleep inst) 0))
                        (return-from tail --help)))
                     ((or -f --follow)
                      (setf (tail-follow inst) t))
                     ((or -H --head)
                      (setf (tail-head inst) t))
                     (-F
                      (setf (tail-retry inst) t (tail-follow inst) t))
                     (--retry
                      (setf (tail-retry inst) t))
                     (--usage
                      (return-from tail --usage))
                     (--version
                      (return-from tail --version))
                     (--help
                      (return-from tail --help))
                     (otherwise
                      (if (stringp action)
                          (push action (tail-files inst))
                        (setf (tail-unknown-option inst) action)
                        (return-from tail --unknown-option)))))))
    (case action
      (--usage (message tail-usage-message))
      (--version (message tail-version))
      (--help (message (tail-help)))
      (--unknown-option (message "Unkown option: %s" (tail-unknown-option inst)))
      (otherwise
       (if (tail-follow inst)
           (condition-case _
               (while t
                 (tail--dotail inst)
                 (sleep-for (tail-sleep inst)))
             (quit (ignore)))
         (tail--dotail inst))))))

(defun tail-lines (&rest options)
  "Return N lines from the end of each file in FILES."
  (with-temp-buffer (tail--parse-options options)))

(defun head-lines (&rest options)
  "Return N lines from the start of each file in FILES."
  (push --head options)
  (with-temp-buffer (tail--parse-options options)))

(defmacro tail (&rest options)
  "Return N lines from the end of each file in FILES."
  (let (opts)
    (dolist (option options)
      (typecase option
        (symbol
         (if (tail-flag-p option)
             (push option opts)
           (push (symbol-name option) opts)))
        (otherwise
         (push option opts))))
    (apply #'tail-lines (nreverse opts))))

(defmacro head (&rest options)
  "Return N lines from the start of each file in FILES."
  (let (opts)
    (dolist (option options)
      (typecase option
        (symbol
         (if (tail-flag-p option)
             (push option opts)
           (push (symbol-name option) opts)))
        (otherwise
         (push option opts))))
    (push --head opts)
    (apply #'tail-lines (nreverse opts))))

(defmacro with-file-tail (args &rest body)
  "Implement this")

(defmacro with-file-head (args &rest body)
  "Implement this")

;; (defmacro tail-script (&rest args)
;;   (let* ((options (or args (cdr (cddddr command-line-args))))
;;          (iterator options)
;;          option)
;;     (while iterator
;;       (typecase (setf option (car iterator))
;;         (string
;;          (cond
;;           ((tail-flag-p option)
;;            (setcar iterator (intern-soft option)))
;;           ((<= ?0 (aref option 0) ?9)
;;            (let ((number (string-to-number option)))
;;              (when (> number 0)
;;                (setcar iterator number)))))))
;;       (setf iterator (cdr iterator)))
;;     (apply #'tail-lines options)))

(provide 'tail)
;;; tail.el ends here