Function: ange-ftp-vms-make-compressed-filename

ange-ftp-vms-make-compressed-filename is a byte-compiled function defined in ange-ftp.el.gz.

Signature

(ange-ftp-vms-make-compressed-filename NAME &optional REVERSE)

Source Code

;; Defined in /usr/src/emacs/lisp/net/ange-ftp.el.gz
;;; Tree dired support:

;; For this code I have borrowed liberally from Sebastian Kremer's
;; dired-vms.el


;;;; These regexps must be anchored to beginning of line.
;;;; Beware that the ftpd may put the device in front of the filename.

;;(defconst ange-ftp-dired-vms-re-exe "^. [^ \t.]+\\.\\(EXE\\|exe\\)[; ]"
;;  "Regular expression to use to search for VMS executable files.")

;;(defconst ange-ftp-dired-vms-re-dir "^. [^ \t.]+\\.\\(DIR\\|dir\\)[; ]"
;;  "Regular expression to use to search for VMS directories.")

;;(or (assq 'vms ange-ftp-dired-re-exe-alist)
;;    (setq ange-ftp-dired-re-exe-alist
;;	  (cons (cons 'vms  ange-ftp-dired-vms-re-exe)
;;		ange-ftp-dired-re-exe-alist)))

;;(or (assq 'vms ange-ftp-dired-re-dir-alist)
;;    (setq ange-ftp-dired-re-dir-alist
;;	  (cons (cons 'vms  ange-ftp-dired-vms-re-dir)
;;		ange-ftp-dired-re-dir-alist)))

;;(defun ange-ftp-dired-vms-insert-headerline (dir)
;;  ;; VMS inserts a headerline. I would prefer the headerline
;;  ;; to be in ange-ftp format. This version tries to
;;  ;; be careful, because we can't count on a headerline
;;  ;; over ftp, and we wouldn't want to delete anything
;;  ;; important.
;;  (save-excursion
;;    (if (looking-at "^  wildcard ")
;;	(forward-line 1))
;;    (if (looking-at "^[ \n\t]*[^\n]+\\][ \t]*\n")
;;	(delete-region (point) (match-end 0))))
;;  (ange-ftp-real-dired-insert-headerline dir))

;;(or (assq 'vms ange-ftp-dired-insert-headerline-alist)
;;    (setq ange-ftp-dired-insert-headerline-alist
;;	  (cons '(vms . ange-ftp-dired-vms-insert-headerline)
;;		ange-ftp-dired-insert-headerline-alist)))

;;(defun ange-ftp-dired-vms-move-to-filename (&optional raise-error eol)
;;  "In dired, move to first char of filename on this line.
;;Returns position (point) or nil if no filename on this line."
;;  ;; This is the VMS version.
;;  (let (case-fold-search)
;;    (or eol (setq eol (progn (end-of-line) (point))))
;;    (beginning-of-line)
;;    (if (re-search-forward ange-ftp-vms-filename-regexp eol t)
;;	(goto-char (match-beginning 1))
;;      (if raise-error
;;	  (error "No file on this line")
;;	nil))))

;;(or (assq 'vms ange-ftp-dired-move-to-filename-alist)
;;    (setq ange-ftp-dired-move-to-filename-alist
;;	  (cons '(vms . ange-ftp-dired-vms-move-to-filename)
;;		ange-ftp-dired-move-to-filename-alist)))

;;(defun ange-ftp-dired-vms-move-to-end-of-filename (&optional no-error eol)
;;  ;; Assumes point is at beginning of filename.
;;  ;; So, it should be called only after (dired-move-to-filename t).
;;  ;; case-fold-search must be nil, at least for VMS.
;;  ;; On failure, signals an error or returns nil.
;;  ;; This is the VMS version.
;;  (let (opoint hidden case-fold-search)
;;    (setq opoint (point))
;;    (or eol (setq eol (line-end-position)))
;;    (setq hidden (and selective-display
;;		      (save-excursion (search-forward "\r" eol t))))
;;    (if hidden
;;	nil
;;      (re-search-forward ange-ftp-vms-filename-regexp eol t))
;;    (or no-error
;;	(not (eq opoint (point)))
;;	(error
;;	 (if hidden
;;	     (substitute-command-keys
;;	      "File line is hidden, type \\[dired-hide-subdir] to unhide")
;;	   "No file on this line")))
;;    (if (eq opoint (point))
;;	nil
;;      (point))))

;;(or (assq 'vms ange-ftp-dired-move-to-end-of-filename-alist)
;;    (setq ange-ftp-dired-move-to-end-of-filename-alist
;;	  (cons '(vms . ange-ftp-dired-vms-move-to-end-of-filename)
;;		ange-ftp-dired-move-to-end-of-filename-alist)))

;;(defun ange-ftp-dired-vms-between-files ()
;;  (save-excursion
;;    (beginning-of-line)
;;    (or (equal (following-char) 10) ; newline
;;     (equal (following-char) 9)     ; tab
;;     (progn (forward-char 2)
;;	    (or (looking-at "Total of")
;;		(equal (following-char) 32))))))

;;(or (assq 'vms ange-ftp-dired-between-files-alist)
;;    (setq ange-ftp-dired-between-files-alist
;;	  (cons '(vms . ange-ftp-dired-vms-between-files)
;;		ange-ftp-dired-between-files-alist)))

;; Beware! In VMS filenames must be of the form "FILE.TYPE".
;; Therefore, we cannot just append a ".Z" to filenames for
;; compressed files. Instead, we turn "FILE.TYPE" into
;; "FILE.TYPE-Z". Hope that this is a reasonable thing to do.

(defun ange-ftp-vms-make-compressed-filename (name &optional _reverse)
  (cond
   ((string-match "-Z;[0-9]+\\'" name)
    (list nil (substring name 0 (match-beginning 0))))
   ((string-match ";[0-9]+\\'" name)
    (list nil (substring name 0 (match-beginning 0))))
   ((string-match "-Z\\'" name)
    (list nil (substring name 0 -2)))
   (t
    (list t
	  (if (string-match ";[0-9]+\\'" name)
	      (concat (substring name 0 (match-beginning 0))
		      "-Z")
	    (concat name "-Z"))))))