oleary@cascade.carleton.CDN (John O'Leary) (10/07/88)
Hi there, I'm looking for a copy of dired.el that has been modified/rewritten to work under VMS. Has anyone done this already? Please reply to me directly, as I don't read this list regularly. Regards, John O'Leary, Bell-Northern Research, Ottawa JWO@BNR.CA oleary@cascade.carleton.ca
jimp@cognos.uucp (Jim Patterson) (10/11/88)
In article <186*oleary@cascade.carleton.cdn> oleary@cascade.carleton.CDN (John O'Leary) writes: >Hi there, > >I'm looking for a copy of dired.el that has been modified/rewritten >to work under VMS. Has anyone done this already? Here's some changes that I've put into GNU Emacs 18.47 that should do the trick. I've added a few new functions to dired.el to replace some inline code, and then redefined those functions in vms-patch.el. This avoids making VMS-specific changes to dired.el, so it should still work properly on unix systems. I also added a function "subprocess-command-to-buffer" which runs a DCL command and puts the output to a buffer; this shares the DCL subprocess shell rather than running a new subprocess each time to get the DIRECTORY output. The format that comes back from DIR is a little different and doesn't include file protections (which are quite a bit more verbose than the 'ls' protection string) so that a reasonable length filename can be included. Following is a set of context diffs from unix "diff -c", which should work with unix patch. If you only have a VMS system, it shouldn't be too hard to apply these changes manually. (I've mailed these to John O'Leary, but since I imagine others have encountered the lack of a VMS dired implementation I though I should post it as well). *** dired.el Wed Mar 2 17:57:54 1988 --- ../newlisp/dired.el Tue Oct 11 10:39:59 1988 *************** *** 34,47 **** (let ((buffer-read-only nil)) (widen) (erase-buffer) ! (setq dirname (expand-file-name dirname)) ! (if (file-directory-p dirname) ! (call-process "ls" nil buffer nil ! dired-listing-switches dirname) ! (let ((default-directory (file-name-directory dirname))) ! (call-process shell-file-name nil buffer nil ! "-c" (concat "ls " dired-listing-switches " " ! (file-name-nondirectory dirname))))) (goto-char (point-min)) (while (not (eobp)) (insert " ") --- 34,40 ---- (let ((buffer-read-only nil)) (widen) (erase-buffer) ! (dired-read-directory dirname buffer) (goto-char (point-min)) (while (not (eobp)) (insert " ") *************** *** 48,53 **** --- 41,57 ---- (forward-line 1)) (goto-char (point-min))))) + (defun dired-read-directory (dirname buffer) + (setq dirname (expand-file-name dirname)) + (if (file-directory-p dirname) + (call-process "ls" nil buffer nil + dired-listing-switches dirname) + (let ((default-directory (file-name-directory dirname))) + (call-process shell-file-name nil buffer nil + "-c" (concat "ls " dired-listing-switches " " + (file-name-nondirectory dirname))))) + ) + (defun dired-find-buffer (dirname) (let ((blist (buffer-list)) found) *************** *** 83,95 **** (defun dired-noselect (dirname) "Like M-x dired but returns the dired buffer as value, does not select it." ! (or dirname (setq dirname default-directory)) ! (if (string-match "./$" dirname) ! (setq dirname (substring dirname 0 -1))) ! (setq dirname (expand-file-name dirname)) ! (and (not (string-match "/$" dirname)) ! (file-directory-p dirname) ! (setq dirname (concat dirname "/"))) (let ((buffer (dired-find-buffer dirname))) (save-excursion (set-buffer buffer) --- 87,93 ---- (defun dired-noselect (dirname) "Like M-x dired but returns the dired buffer as value, does not select it." ! (setq dirname (dired-fix-directory dirname)) (let ((buffer (dired-find-buffer dirname))) (save-excursion (set-buffer buffer) *************** *** 98,103 **** --- 96,113 ---- (dired-mode dirname)) buffer)) + (defun dired-fix-directory (dirname) + "Fix up dirname to be a valid directory name and return it" + (or dirname (setq dirname default-directory)) + (if (string-match "./$" dirname) + (setq dirname (substring dirname 0 -1))) + (setq dirname (expand-file-name dirname)) + (and (not (string-match "/$" dirname)) + (file-directory-p dirname) + (setq dirname (concat dirname "/"))) + dirname + ) + (defun dired-revert (&optional arg noconfirm) (let ((opoint (point)) (ofile (dired-get-filename t t)) *************** *** 109,114 **** --- 119,128 ---- (goto-char opoint)) (beginning-of-line))) + (defvar dired-match-date + "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+" + "Regexp to match the date on a filename") + (defvar dired-mode-map nil "Local keymap for dired-mode buffers.") (if dired-mode-map nil *************** *** 289,296 **** (end-of-line) (setq eol (point)) (beginning-of-line) ! (if (re-search-forward ! "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+" eol t) (progn (skip-chars-forward " ") (skip-chars-forward "^ " eol) --- 303,309 ---- (end-of-line) (setq eol (point)) (beginning-of-line) ! (if (re-search-forward dired-match-date eol t) (progn (skip-chars-forward " ") (skip-chars-forward "^ " eol) *** vmsproc.el Wed Mar 2 17:59:55 1988 --- ../newlisp/vmsproc.el Tue Oct 11 10:21:53 1988 *************** *** 68,73 **** --- 68,96 ---- (and subprocess-running (send-command-to-subprocess 1 "ON SEVERE_ERROR THEN CONTINUE"))) + (defun subprocess-command-to-buffer (command buffer) + "Execute command and redirect output into buffer. + + BUGS: only the output up to the end of the first image activation is trapped." + (if (not subprocess-running) + (start-subprocess)) + (save-excursion + (set-buffer buffer) + (let ((output-filename (concat "SYS$SCRATCH:OUTPUT-FOR-" + (getenv "USER") ".LISTING"))) + (while (file-attributes output-filename) + (delete-file output-filename)) + (send-command-to-subprocess 1 + (concat "DEFINE/USER SYS$OUTPUT " + output-filename "-NEW")) + (send-command-to-subprocess 1 command) + (send-command-to-subprocess 1 (concat + "RENAME " output-filename + "-NEW " output-filename)) + (while (not (file-attributes output-filename)) + (sleep-for 2)) + (insert-file output-filename)))) + (defun subprocess-command () "Starts asynchronous subprocess if not running and switches to its window." (interactive) *************** *** 78,84 **** (defun command-send-input () "If at last line of buffer, sends the current line to ! the spawned subprocess. Otherwise brings back current line to the last line for resubmission." (interactive) (beginning-of-line) --- 101,107 ---- (defun command-send-input () "If at last line of buffer, sends the current line to ! ;the spawned subprocess. Otherwise brings back current line to the last line for resubmission." (interactive) (beginning-of-line) *** vms-patch.el Wed Mar 2 17:59:54 1988 --- ../newlisp/vms-patch.el Tue Oct 11 10:21:52 1988 *************** *** 1,4 **** ! ;; Override parts of files.el for VMS. ;; Copyright (C) 1986 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. --- 1,4 ---- ! ;; Override parts of files.el and dired.el for VMS. ;; Copyright (C) 1986 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. *************** *** 50,52 **** --- 50,97 ---- FILENAME should lack slashes. This is a separate function so your .emacs file or site-init.el can redefine it." (string-match "^_\\$.*\\$" filename)) + + (defun dired-read-directory (dirname buffer) + "Read a set of files for dired. This replaces the function defined in + dired.el, which uses the unix ls command" + + (subprocess-command-to-buffer (concat + dired-directory-command " " + dirname) buffer) + (save-excursion + (replace-regexp " *$" "") + ) + ) + + + (defvar dired-directory-command + "DIRECTORY/SIZE/DATE/OWNER/WIDTH=(FILENAME=32,SIZE=5)" + "Directory command for dired") + + (setq dired-listing-switches "") + + (defun dired-get-filename (&optional localp no-error-if-not-filep) + "In dired, return name of file mentioned on this line. + Value returned normally includes the directory name. + A non-nil 1st argument means do not include it. A non-nil 2nd argument + says return nil if no filename on this line, otherwise an error occurs." + (let (eol) + (save-excursion + (end-of-line) + (setq eol (point)) + (beginning-of-line) + (if (and (not (looking-at "..Directory ")) + (not (looking-at "..Total ")) + (re-search-forward "^..\\([][.A-Z-0-9_$;<>]+\\)" + eol t)) + (progn + (buffer-substring (match-beginning 1) (match-end 1)) + ) + (if no-error-if-not-filep nil + (error "No file on this line")))))) + + (defun dired-fix-directory (dirname) + "Fix up dirname to be a valid directory name and return it" + (or dirname (setq dirname default-directory)) + (setq dirname (expand-file-name dirname)) + ) -- Jim Patterson Cognos Incorporated UUCP:decvax!utzoo!dciem!nrcaer!cognos!jimp P.O. BOX 9707 PHONE:(613)738-1440 3755 Riverside Drive Ottawa, Ont K1G 3Z4